summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKeith Seitz <keiths@redhat.com>2002-09-24 20:24:18 +0000
committerKeith Seitz <keiths@redhat.com>2002-09-24 20:24:18 +0000
commit07296cfdb73a6d68eb6b921fd25c7c9dacdf1eec (patch)
tree37a49b29fd1dc67eece5b1f38f8b0115f5543814
parent0e8f9dd357b81ada6f8f4a215b928d63ca983f97 (diff)
downloadgdb-07296cfdb73a6d68eb6b921fd25c7c9dacdf1eec.tar.gz
import tk 8.4.0
-rw-r--r--tcl/ChangeLog10355
-rw-r--r--tcl/README187
-rw-r--r--tcl/bitmaps/error.bmp8
-rw-r--r--tcl/bitmaps/gray12.bmp6
-rw-r--r--tcl/bitmaps/gray25.bmp6
-rw-r--r--tcl/bitmaps/gray50.bmp6
-rw-r--r--tcl/bitmaps/gray75.bmp6
-rw-r--r--tcl/bitmaps/hourglass.bmp9
-rw-r--r--tcl/bitmaps/info.bmp5
-rw-r--r--tcl/bitmaps/questhead.bmp9
-rw-r--r--tcl/bitmaps/question.bmp10
-rw-r--r--tcl/bitmaps/warning.bmp5
-rw-r--r--tcl/changes8793
-rw-r--r--tcl/compat/license.terms9
-rw-r--r--tcl/doc/3DBorder.3305
-rw-r--r--tcl/doc/AddOption.360
-rw-r--r--tcl/doc/BindTable.3157
-rw-r--r--tcl/doc/CanvPsY.3122
-rw-r--r--tcl/doc/CanvTkwin.3161
-rw-r--r--tcl/doc/CanvTxtInfo.3104
-rw-r--r--tcl/doc/Clipboard.380
-rw-r--r--tcl/doc/ClrSelect.342
-rw-r--r--tcl/doc/ConfigWidg.3628
-rw-r--r--tcl/doc/ConfigWind.3153
-rw-r--r--tcl/doc/CoordToWin.351
-rw-r--r--tcl/doc/CrtCmHdlr.369
-rw-r--r--tcl/doc/CrtErrHdlr.3145
-rw-r--r--tcl/doc/CrtGenHdlr.384
-rw-r--r--tcl/doc/CrtImgType.3283
-rw-r--r--tcl/doc/CrtItemType.3626
-rw-r--r--tcl/doc/CrtPhImgFmt.3245
-rw-r--r--tcl/doc/CrtSelHdlr.3120
-rw-r--r--tcl/doc/CrtWindow.3151
-rw-r--r--tcl/doc/DeleteImg.335
-rw-r--r--tcl/doc/DrawFocHlt.340
-rw-r--r--tcl/doc/EventHndlr.379
-rw-r--r--tcl/doc/FindPhoto.3234
-rw-r--r--tcl/doc/FontId.395
-rw-r--r--tcl/doc/FreeXId.352
-rw-r--r--tcl/doc/GeomReq.397
-rw-r--r--tcl/doc/GetAnchor.386
-rw-r--r--tcl/doc/GetBitmap.3318
-rw-r--r--tcl/doc/GetCapStyl.363
-rw-r--r--tcl/doc/GetClrmap.373
-rw-r--r--tcl/doc/GetColor.3190
-rw-r--r--tcl/doc/GetCursor.3246
-rw-r--r--tcl/doc/GetDash.370
-rw-r--r--tcl/doc/GetFont.3125
-rw-r--r--tcl/doc/GetGC.374
-rw-r--r--tcl/doc/GetHINSTANCE.325
-rw-r--r--tcl/doc/GetHWND.329
-rw-r--r--tcl/doc/GetImage.3135
-rw-r--r--tcl/doc/GetJoinStl.362
-rw-r--r--tcl/doc/GetJustify.393
-rw-r--r--tcl/doc/GetOption.346
-rw-r--r--tcl/doc/GetPixels.3111
-rw-r--r--tcl/doc/GetPixmap.356
-rw-r--r--tcl/doc/GetRelief.383
-rw-r--r--tcl/doc/GetRootCrd.343
-rw-r--r--tcl/doc/GetScroll.378
-rw-r--r--tcl/doc/GetSelect.379
-rw-r--r--tcl/doc/GetUid.350
-rw-r--r--tcl/doc/GetVRoot.349
-rw-r--r--tcl/doc/GetVisual.398
-rw-r--r--tcl/doc/Grab.365
-rw-r--r--tcl/doc/HWNDToWindow.330
-rw-r--r--tcl/doc/HandleEvent.349
-rw-r--r--tcl/doc/IdToWindow.336
-rw-r--r--tcl/doc/ImgChanged.369
-rw-r--r--tcl/doc/InternAtom.358
-rw-r--r--tcl/doc/MainLoop.332
-rw-r--r--tcl/doc/MainWin.346
-rw-r--r--tcl/doc/MaintGeom.3103
-rw-r--r--tcl/doc/ManageGeom.394
-rw-r--r--tcl/doc/MapWindow.353
-rw-r--r--tcl/doc/MeasureChar.3137
-rw-r--r--tcl/doc/MoveToplev.355
-rw-r--r--tcl/doc/Name.382
-rw-r--r--tcl/doc/NameOfImg.334
-rw-r--r--tcl/doc/OwnSelect.352
-rw-r--r--tcl/doc/ParseArgv.3351
-rw-r--r--tcl/doc/QWinEvent.353
-rw-r--r--tcl/doc/Restack.349
-rw-r--r--tcl/doc/RestrictEv.381
-rw-r--r--tcl/doc/SetAppName.365
-rw-r--r--tcl/doc/SetCaret.340
-rw-r--r--tcl/doc/SetClass.361
-rw-r--r--tcl/doc/SetClassProcs.391
-rw-r--r--tcl/doc/SetGrid.367
-rw-r--r--tcl/doc/SetOptions.3653
-rw-r--r--tcl/doc/SetVisual.354
-rw-r--r--tcl/doc/StrictMotif.341
-rw-r--r--tcl/doc/TextLayout.3280
-rw-r--r--tcl/doc/TkInitStubs.377
-rw-r--r--tcl/doc/Tk_Init.388
-rw-r--r--tcl/doc/Tk_Main.361
-rw-r--r--tcl/doc/WindowId.3186
-rw-r--r--tcl/doc/bell.n35
-rw-r--r--tcl/doc/bind.n531
-rw-r--r--tcl/doc/bindtags.n81
-rw-r--r--tcl/doc/bitmap.n114
-rw-r--r--tcl/doc/button.n198
-rw-r--r--tcl/doc/canvas.n1750
-rw-r--r--tcl/doc/checkbutton.n260
-rw-r--r--tcl/doc/chooseColor.n49
-rw-r--r--tcl/doc/chooseDirectory.n52
-rw-r--r--tcl/doc/clipboard.n94
-rw-r--r--tcl/doc/colors.n782
-rw-r--r--tcl/doc/console.n142
-rw-r--r--tcl/doc/cursors.n154
-rw-r--r--tcl/doc/destroy.n34
-rw-r--r--tcl/doc/dialog.n65
-rw-r--r--tcl/doc/entry.n549
-rw-r--r--tcl/doc/event.n366
-rw-r--r--tcl/doc/focus.n113
-rw-r--r--tcl/doc/focusNext.n60
-rw-r--r--tcl/doc/font.n287
-rw-r--r--tcl/doc/frame.n136
-rw-r--r--tcl/doc/getOpenFile.n171
-rw-r--r--tcl/doc/grab.n122
-rw-r--r--tcl/doc/grid.n379
-rw-r--r--tcl/doc/image.n98
-rw-r--r--tcl/doc/keysyms.n930
-rw-r--r--tcl/doc/label.n114
-rw-r--r--tcl/doc/labelframe.n147
-rw-r--r--tcl/doc/license.terms9
-rw-r--r--tcl/doc/listbox.n556
-rw-r--r--tcl/doc/loadTk.n76
-rw-r--r--tcl/doc/lower.n38
-rw-r--r--tcl/doc/menu.n784
-rw-r--r--tcl/doc/menubar.n33
-rw-r--r--tcl/doc/menubutton.n203
-rw-r--r--tcl/doc/message.n149
-rw-r--r--tcl/doc/messageBox.n89
-rw-r--r--tcl/doc/option.n91
-rw-r--r--tcl/doc/optionMenu.n40
-rw-r--r--tcl/doc/options.n333
-rw-r--r--tcl/doc/pack-old.n196
-rw-r--r--tcl/doc/pack.n268
-rw-r--r--tcl/doc/palette.n73
-rw-r--r--tcl/doc/panedwindow.n246
-rw-r--r--tcl/doc/photo.n443
-rw-r--r--tcl/doc/place.n250
-rw-r--r--tcl/doc/popup.n33
-rw-r--r--tcl/doc/radiobutton.n256
-rw-r--r--tcl/doc/raise.n38
-rw-r--r--tcl/doc/scale.n247
-rw-r--r--tcl/doc/scrollbar.n341
-rw-r--r--tcl/doc/selection.n136
-rw-r--r--tcl/doc/send.n97
-rw-r--r--tcl/doc/spinbox.n582
-rw-r--r--tcl/doc/text.n1776
-rw-r--r--tcl/doc/tk.n104
-rw-r--r--tcl/doc/tkerror.n38
-rw-r--r--tcl/doc/tkvars.n80
-rw-r--r--tcl/doc/tkwait.n51
-rw-r--r--tcl/doc/toplevel.n161
-rw-r--r--tcl/doc/winfo.n332
-rw-r--r--tcl/doc/wish.1186
-rw-r--r--tcl/doc/wm.n556
-rw-r--r--tcl/generic/README6
-rw-r--r--tcl/generic/default.h32
-rw-r--r--tcl/generic/ks_names.h923
-rw-r--r--tcl/generic/prolog.ps284
-rw-r--r--tcl/generic/tk.decls1384
-rw-r--r--tcl/generic/tk.h1619
-rw-r--r--tcl/generic/tk3d.c1410
-rw-r--r--tcl/generic/tk3d.h102
-rw-r--r--tcl/generic/tkArgv.c438
-rw-r--r--tcl/generic/tkAtom.c217
-rw-r--r--tcl/generic/tkBind.c4644
-rw-r--r--tcl/generic/tkBitmap.c1190
-rw-r--r--tcl/generic/tkButton.c1761
-rw-r--r--tcl/generic/tkButton.h322
-rw-r--r--tcl/generic/tkCanvArc.c2145
-rw-r--r--tcl/generic/tkCanvBmap.c985
-rw-r--r--tcl/generic/tkCanvImg.c899
-rw-r--r--tcl/generic/tkCanvLine.c2467
-rw-r--r--tcl/generic/tkCanvPoly.c1928
-rw-r--r--tcl/generic/tkCanvPs.c1834
-rw-r--r--tcl/generic/tkCanvText.c1515
-rw-r--r--tcl/generic/tkCanvUtil.c1481
-rw-r--r--tcl/generic/tkCanvWind.c1100
-rw-r--r--tcl/generic/tkCanvas.c5704
-rw-r--r--tcl/generic/tkCanvas.h312
-rw-r--r--tcl/generic/tkClipboard.c760
-rw-r--r--tcl/generic/tkCmds.c2051
-rw-r--r--tcl/generic/tkColor.c813
-rw-r--r--tcl/generic/tkColor.h89
-rw-r--r--tcl/generic/tkConfig.c2217
-rw-r--r--tcl/generic/tkConsole.c818
-rw-r--r--tcl/generic/tkCursor.c868
-rw-r--r--tcl/generic/tkDecls.h2275
-rw-r--r--tcl/generic/tkEntry.c4620
-rw-r--r--tcl/generic/tkError.c307
-rw-r--r--tcl/generic/tkEvent.c1459
-rw-r--r--tcl/generic/tkFileFilter.c485
-rw-r--r--tcl/generic/tkFileFilter.h92
-rw-r--r--tcl/generic/tkFocus.c1058
-rw-r--r--tcl/generic/tkFont.c3759
-rw-r--r--tcl/generic/tkFont.h226
-rw-r--r--tcl/generic/tkFrame.c1929
-rw-r--r--tcl/generic/tkGC.c398
-rw-r--r--tcl/generic/tkGeometry.c700
-rw-r--r--tcl/generic/tkGet.c751
-rw-r--r--tcl/generic/tkGrab.c1599
-rw-r--r--tcl/generic/tkGrid.c3087
-rw-r--r--tcl/generic/tkImage.c1060
-rw-r--r--tcl/generic/tkImgBmap.c1297
-rw-r--r--tcl/generic/tkImgGIF.c2121
-rw-r--r--tcl/generic/tkImgPPM.c432
-rw-r--r--tcl/generic/tkImgPhoto.c5623
-rw-r--r--tcl/generic/tkImgUtil.c78
-rw-r--r--tcl/generic/tkInitScript.h58
-rw-r--r--tcl/generic/tkInt.decls2234
-rw-r--r--tcl/generic/tkInt.h1177
-rw-r--r--tcl/generic/tkIntDecls.h1547
-rw-r--r--tcl/generic/tkIntPlatDecls.h1220
-rw-r--r--tcl/generic/tkIntXlibDecls.h2414
-rw-r--r--tcl/generic/tkListbox.c3453
-rw-r--r--tcl/generic/tkMacWinMenu.c143
-rw-r--r--tcl/generic/tkMain.c453
-rw-r--r--tcl/generic/tkMenu.c3490
-rw-r--r--tcl/generic/tkMenu.h584
-rw-r--r--tcl/generic/tkMenuDraw.c1051
-rw-r--r--tcl/generic/tkMenubutton.c948
-rw-r--r--tcl/generic/tkMenubutton.h242
-rw-r--r--tcl/generic/tkMessage.c891
-rw-r--r--tcl/generic/tkObj.c858
-rw-r--r--tcl/generic/tkOldConfig.c1032
-rw-r--r--tcl/generic/tkOption.c1634
-rw-r--r--tcl/generic/tkPack.c1851
-rw-r--r--tcl/generic/tkPanedWindow.c2752
-rw-r--r--tcl/generic/tkPlace.c1171
-rw-r--r--tcl/generic/tkPlatDecls.h300
-rw-r--r--tcl/generic/tkPointer.c653
-rw-r--r--tcl/generic/tkPort.h38
-rw-r--r--tcl/generic/tkRectOval.c1391
-rw-r--r--tcl/generic/tkScale.c1435
-rw-r--r--tcl/generic/tkScale.h256
-rw-r--r--tcl/generic/tkScrollbar.c711
-rw-r--r--tcl/generic/tkScrollbar.h206
-rw-r--r--tcl/generic/tkSelect.c1599
-rw-r--r--tcl/generic/tkSelect.h185
-rw-r--r--tcl/generic/tkSquare.c621
-rw-r--r--tcl/generic/tkStubImg.c76
-rw-r--r--tcl/generic/tkStubInit.c1132
-rw-r--r--tcl/generic/tkStubLib.c119
-rw-r--r--tcl/generic/tkStyle.c1664
-rw-r--r--tcl/generic/tkTest.c2541
-rw-r--r--tcl/generic/tkText.c3013
-rw-r--r--tcl/generic/tkText.h922
-rw-r--r--tcl/generic/tkTextBTree.c3755
-rw-r--r--tcl/generic/tkTextDisp.c5225
-rw-r--r--tcl/generic/tkTextImage.c898
-rw-r--r--tcl/generic/tkTextIndex.c1196
-rw-r--r--tcl/generic/tkTextMark.c779
-rw-r--r--tcl/generic/tkTextTag.c1423
-rw-r--r--tcl/generic/tkTextWind.c1176
-rw-r--r--tcl/generic/tkTrig.c1475
-rw-r--r--tcl/generic/tkUndo.c400
-rw-r--r--tcl/generic/tkUndo.h90
-rw-r--r--tcl/generic/tkUtil.c953
-rw-r--r--tcl/generic/tkVisual.c541
-rw-r--r--tcl/generic/tkWindow.c3076
-rw-r--r--tcl/library/bgerror.tcl292
-rw-r--r--tcl/library/button.tcl639
-rw-r--r--tcl/library/choosedir.tcl283
-rw-r--r--tcl/library/clrpick.tcl697
-rw-r--r--tcl/library/comdlg.tcl303
-rw-r--r--tcl/library/console.tcl934
-rw-r--r--tcl/library/demos/README46
-rw-r--r--tcl/library/demos/arrow.tcl239
-rw-r--r--tcl/library/demos/bind.tcl79
-rw-r--r--tcl/library/demos/bitmap.tcl55
-rw-r--r--tcl/library/demos/browse66
-rw-r--r--tcl/library/demos/button.tcl36
-rw-r--r--tcl/library/demos/check.tcl33
-rw-r--r--tcl/library/demos/clrpick.tcl56
-rw-r--r--tcl/library/demos/colors.tcl101
-rw-r--r--tcl/library/demos/cscroll.tcl96
-rw-r--r--tcl/library/demos/ctext.tcl147
-rw-r--r--tcl/library/demos/dialog1.tcl15
-rw-r--r--tcl/library/demos/dialog2.tcl19
-rw-r--r--tcl/library/demos/entry1.tcl36
-rw-r--r--tcl/library/demos/entry2.tcl48
-rw-r--r--tcl/library/demos/entry3.tcl187
-rw-r--r--tcl/library/demos/filebox.tcl70
-rw-r--r--tcl/library/demos/floor.tcl1370
-rw-r--r--tcl/library/demos/form.tcl40
-rw-r--r--tcl/library/demos/hello22
-rw-r--r--tcl/library/demos/hscale.tcl47
-rw-r--r--tcl/library/demos/icon.tcl52
-rw-r--r--tcl/library/demos/image1.tcl36
-rw-r--r--tcl/library/demos/image2.tcl104
-rw-r--r--tcl/library/demos/images/earth.gifbin0 -> 51712 bytes
-rw-r--r--tcl/library/demos/images/earthris.gifbin0 -> 6343 bytes
-rw-r--r--tcl/library/demos/images/face.bmp173
-rw-r--r--tcl/library/demos/images/flagdown.bmp27
-rw-r--r--tcl/library/demos/images/flagup.bmp27
-rw-r--r--tcl/library/demos/images/gray25.bmp6
-rw-r--r--tcl/library/demos/images/letters.bmp27
-rw-r--r--tcl/library/demos/images/noletter.bmp27
-rw-r--r--tcl/library/demos/images/pattern.bmp6
-rw-r--r--tcl/library/demos/images/tcllogo.gifbin0 -> 2341 bytes
-rw-r--r--tcl/library/demos/images/teapot.ppm31
-rw-r--r--tcl/library/demos/items.tcl285
-rw-r--r--tcl/library/demos/ixset335
-rw-r--r--tcl/library/demos/label.tcl40
-rw-r--r--tcl/library/demos/labelframe.tcl80
-rw-r--r--tcl/library/demos/license.terms39
-rw-r--r--tcl/library/demos/menu.tcl160
-rw-r--r--tcl/library/demos/menubu.tcl94
-rw-r--r--tcl/library/demos/msgbox.tcl65
-rw-r--r--tcl/library/demos/paned1.tcl34
-rw-r--r--tcl/library/demos/paned2.tcl76
-rw-r--r--tcl/library/demos/plot.tcl99
-rw-r--r--tcl/library/demos/puzzle.tcl84
-rw-r--r--tcl/library/demos/radio.tcl59
-rw-r--r--tcl/library/demos/rmt210
-rw-r--r--tcl/library/demos/rolodex196
-rw-r--r--tcl/library/demos/ruler.tcl173
-rw-r--r--tcl/library/demos/sayings.tcl46
-rw-r--r--tcl/library/demos/search.tcl141
-rw-r--r--tcl/library/demos/spin.tcl55
-rw-r--r--tcl/library/demos/square55
-rw-r--r--tcl/library/demos/states.tcl45
-rw-r--r--tcl/library/demos/style.tcl152
-rw-r--r--tcl/library/demos/tclIndex67
-rw-r--r--tcl/library/demos/tcolor366
-rw-r--r--tcl/library/demos/text.tcl88
-rw-r--r--tcl/library/demos/timer47
-rw-r--r--tcl/library/demos/twind.tcl197
-rw-r--r--tcl/library/demos/vscale.tcl48
-rw-r--r--tcl/library/demos/widget393
-rw-r--r--tcl/library/dialog.tcl199
-rw-r--r--tcl/library/entry.tcl652
-rw-r--r--tcl/library/focus.tcl181
-rw-r--r--tcl/library/images/README12
-rw-r--r--tcl/library/images/logo.eps2091
-rw-r--r--tcl/library/images/logo100.gifbin0 -> 2341 bytes
-rw-r--r--tcl/library/images/logo64.gifbin0 -> 1670 bytes
-rw-r--r--tcl/library/images/logoLarge.gifbin0 -> 11000 bytes
-rw-r--r--tcl/library/images/logoMed.gifbin0 -> 3889 bytes
-rw-r--r--tcl/library/images/pwrdLogo.eps1897
-rw-r--r--tcl/library/images/pwrdLogo100.gifbin0 -> 1615 bytes
-rw-r--r--tcl/library/images/pwrdLogo150.gifbin0 -> 2489 bytes
-rw-r--r--tcl/library/images/pwrdLogo175.gifbin0 -> 2981 bytes
-rw-r--r--tcl/library/images/pwrdLogo200.gifbin0 -> 3491 bytes
-rw-r--r--tcl/library/images/pwrdLogo75.gifbin0 -> 1171 bytes
-rw-r--r--tcl/library/images/tai-ku.gifbin0 -> 5473 bytes
-rw-r--r--tcl/library/license.terms9
-rw-r--r--tcl/library/listbox.tcl505
-rw-r--r--tcl/library/menu.tcl1295
-rw-r--r--tcl/library/mkpsenc.tcl1367
-rw-r--r--tcl/library/msgbox.tcl419
-rw-r--r--tcl/library/msgs/cs.msg70
-rw-r--r--tcl/library/msgs/de.msg70
-rw-r--r--tcl/library/msgs/el.msg86
-rw-r--r--tcl/library/msgs/en.msg70
-rw-r--r--tcl/library/msgs/en_gb.msg3
-rw-r--r--tcl/library/msgs/es.msg70
-rw-r--r--tcl/library/msgs/fr.msg70
-rw-r--r--tcl/library/msgs/it.msg70
-rw-r--r--tcl/library/msgs/nl.msg106
-rw-r--r--tcl/library/msgs/ru.msg73
-rw-r--r--tcl/library/obsolete.tcl21
-rw-r--r--tcl/library/optMenu.tcl45
-rw-r--r--tcl/library/palette.tcl242
-rw-r--r--tcl/library/panedwindow.tcl181
-rw-r--r--tcl/library/safetk.tcl277
-rw-r--r--tcl/library/scale.tcl274
-rw-r--r--tcl/library/scrlbar.tcl415
-rw-r--r--tcl/library/spinbox.tcl568
-rw-r--r--tcl/library/tclIndex343
-rw-r--r--tcl/library/tearoff.tcl166
-rw-r--r--tcl/library/text.tcl1136
-rw-r--r--tcl/library/tk.tcl580
-rw-r--r--tcl/library/tkfbox.tcl1803
-rw-r--r--tcl/library/unsupported.tcl297
-rw-r--r--tcl/library/xmfbox.tcl961
-rw-r--r--tcl/license.terms9
-rw-r--r--tcl/mac/MW_TkBuildLibHeader.h7
-rw-r--r--tcl/mac/MW_TkBuildLibHeader.pch36
-rwxr-xr-xtcl/mac/MW_TkHeader.h7
-rw-r--r--tcl/mac/MW_TkHeader.pch34
-rw-r--r--tcl/mac/MW_TkHeaderCommon.h40
-rwxr-xr-xtcl/mac/MW_TkOldImgHeader.h3
-rw-r--r--tcl/mac/MW_TkOldImgStaticHeader.h3
-rw-r--r--tcl/mac/MW_TkStaticHeader.h7
-rw-r--r--tcl/mac/MW_TkStaticHeader.pch36
-rwxr-xr-xtcl/mac/MW_TkTestHeader.h7
-rwxr-xr-xtcl/mac/MW_TkTestHeader.pch42
-rw-r--r--tcl/mac/README82
-rw-r--r--tcl/mac/bugs.doc86
-rw-r--r--tcl/mac/license.terms9
-rwxr-xr-xtcl/mac/tclets.r172
-rw-r--r--tcl/mac/tclets.tcl225
-rw-r--r--tcl/mac/tkMac.h56
-rw-r--r--tcl/mac/tkMacAppInit.c443
-rwxr-xr-xtcl/mac/tkMacAppearanceStubs.c104
-rw-r--r--tcl/mac/tkMacApplication.r317
-rw-r--r--tcl/mac/tkMacBitmap.c279
-rw-r--r--tcl/mac/tkMacButton.c1699
-rw-r--r--tcl/mac/tkMacClipboard.c303
-rw-r--r--tcl/mac/tkMacColor.c504
-rw-r--r--tcl/mac/tkMacConfig.c45
-rw-r--r--tcl/mac/tkMacCursor.c401
-rw-r--r--tcl/mac/tkMacCursors.r130
-rw-r--r--tcl/mac/tkMacDefault.h529
-rw-r--r--tcl/mac/tkMacDialog.c1420
-rw-r--r--tcl/mac/tkMacDraw.c1196
-rw-r--r--tcl/mac/tkMacEmbed.c1192
-rw-r--r--tcl/mac/tkMacFont.c2151
-rw-r--r--tcl/mac/tkMacHLEvents.c441
-rw-r--r--tcl/mac/tkMacInit.c228
-rw-r--r--tcl/mac/tkMacInt.h233
-rw-r--r--tcl/mac/tkMacKeyboard.c648
-rw-r--r--tcl/mac/tkMacLibrary.r73
-rw-r--r--tcl/mac/tkMacMDEF.c116
-rw-r--r--tcl/mac/tkMacMDEF.r45
-rw-r--r--tcl/mac/tkMacMenu.c4607
-rw-r--r--tcl/mac/tkMacMenu.r47
-rw-r--r--tcl/mac/tkMacMenubutton.c483
-rw-r--r--tcl/mac/tkMacMenus.c355
-rw-r--r--tcl/mac/tkMacPort.h162
-rw-r--r--tcl/mac/tkMacProjects.sea.hqx3755
-rw-r--r--tcl/mac/tkMacRegion.c248
-rw-r--r--tcl/mac/tkMacResource.r437
-rw-r--r--tcl/mac/tkMacScale.c439
-rw-r--r--tcl/mac/tkMacScrlbr.c1069
-rw-r--r--tcl/mac/tkMacSend.c548
-rw-r--r--tcl/mac/tkMacSubwindows.c1258
-rw-r--r--tcl/mac/tkMacTclCode.r71
-rw-r--r--tcl/mac/tkMacTest.c82
-rw-r--r--tcl/mac/tkMacWindowMgr.c1791
-rw-r--r--tcl/mac/tkMacWm.c5787
-rw-r--r--tcl/mac/tkMacXCursors.r961
-rw-r--r--tcl/mac/tkMacXStubs.c828
-rw-r--r--tcl/mac/widget.r18
-rw-r--r--tcl/macosx/Makefile16
-rw-r--r--tcl/macosx/Wish.icnsbin0 -> 35960 bytes
-rw-r--r--tcl/macosx/Wish.pbproj/jingham.pbxuser1502
-rw-r--r--tcl/macosx/Wish.pbproj/project.pbxproj3619
-rw-r--r--tcl/macosx/tclets.r172
-rw-r--r--tcl/macosx/tkAboutDlg.r393
-rw-r--r--tcl/macosx/tkMacOSX.h34
-rw-r--r--tcl/macosx/tkMacOSXAppInit.c241
-rw-r--r--tcl/macosx/tkMacOSXApplication.r276
-rw-r--r--tcl/macosx/tkMacOSXBitmap.c283
-rw-r--r--tcl/macosx/tkMacOSXButton.c1580
-rw-r--r--tcl/macosx/tkMacOSXClipboard.c321
-rw-r--r--tcl/macosx/tkMacOSXColor.c448
-rw-r--r--tcl/macosx/tkMacOSXConfig.c46
-rw-r--r--tcl/macosx/tkMacOSXCursor.c406
-rw-r--r--tcl/macosx/tkMacOSXCursors.r130
-rw-r--r--tcl/macosx/tkMacOSXDebug.c439
-rw-r--r--tcl/macosx/tkMacOSXDebug.h69
-rw-r--r--tcl/macosx/tkMacOSXDefault.h531
-rw-r--r--tcl/macosx/tkMacOSXDialog.c1229
-rw-r--r--tcl/macosx/tkMacOSXDraw.c1714
-rw-r--r--tcl/macosx/tkMacOSXEmbed.c1193
-rw-r--r--tcl/macosx/tkMacOSXEvent.c276
-rw-r--r--tcl/macosx/tkMacOSXEvent.h86
-rw-r--r--tcl/macosx/tkMacOSXFont.c2191
-rw-r--r--tcl/macosx/tkMacOSXHLEvents.c447
-rw-r--r--tcl/macosx/tkMacOSXInit.c221
-rw-r--r--tcl/macosx/tkMacOSXInt.h155
-rw-r--r--tcl/macosx/tkMacOSXKeyEvent.c501
-rw-r--r--tcl/macosx/tkMacOSXKeyboard.c682
-rw-r--r--tcl/macosx/tkMacOSXLibrary.r510
-rw-r--r--tcl/macosx/tkMacOSXMenu.c4691
-rw-r--r--tcl/macosx/tkMacOSXMenu.r47
-rw-r--r--tcl/macosx/tkMacOSXMenubutton.c861
-rw-r--r--tcl/macosx/tkMacOSXMenus.c325
-rw-r--r--tcl/macosx/tkMacOSXMouseEvent.c740
-rw-r--r--tcl/macosx/tkMacOSXNotify.c1162
-rw-r--r--tcl/macosx/tkMacOSXPort.h154
-rw-r--r--tcl/macosx/tkMacOSXRegion.c252
-rw-r--r--tcl/macosx/tkMacOSXResource.r502
-rw-r--r--tcl/macosx/tkMacOSXScale.c431
-rw-r--r--tcl/macosx/tkMacOSXScrlbr.c1076
-rw-r--r--tcl/macosx/tkMacOSXSend.c552
-rw-r--r--tcl/macosx/tkMacOSXSubwindows.c1304
-rw-r--r--tcl/macosx/tkMacOSXTest.c82
-rw-r--r--tcl/macosx/tkMacOSXUtil.c330
-rw-r--r--tcl/macosx/tkMacOSXUtil.h65
-rw-r--r--tcl/macosx/tkMacOSXWindowEvent.c693
-rw-r--r--tcl/macosx/tkMacOSXWm.c5512
-rw-r--r--tcl/macosx/tkMacOSXWm.h302
-rw-r--r--tcl/macosx/tkMacOSXXCursors.r961
-rw-r--r--tcl/macosx/tkMacOSXXStubs.c862
-rw-r--r--tcl/tests/README91
-rw-r--r--tcl/tests/all.tcl20
-rw-r--r--tcl/tests/arc.tcl153
-rw-r--r--tcl/tests/bell.test64
-rw-r--r--tcl/tests/bevel.tcl141
-rw-r--r--tcl/tests/bgerror.test76
-rw-r--r--tcl/tests/bind.test2681
-rw-r--r--tcl/tests/bitmap.test111
-rw-r--r--tcl/tests/border.test181
-rw-r--r--tcl/tests/bugs.tcl43
-rw-r--r--tcl/tests/butGeom.tcl128
-rw-r--r--tcl/tests/butGeom2.tcl126
-rw-r--r--tcl/tests/button.test812
-rw-r--r--tcl/tests/canvImg.test409
-rw-r--r--tcl/tests/canvPs.test115
-rw-r--r--tcl/tests/canvPsArc.tcl45
-rw-r--r--tcl/tests/canvPsBmap.tcl84
-rw-r--r--tcl/tests/canvPsGrph.tcl100
-rw-r--r--tcl/tests/canvPsImg.tcl84
-rw-r--r--tcl/tests/canvPsText.tcl96
-rw-r--r--tcl/tests/canvRect.test341
-rw-r--r--tcl/tests/canvText.test534
-rw-r--r--tcl/tests/canvWind.test147
-rw-r--r--tcl/tests/canvas.test459
-rw-r--r--tcl/tests/choosedir.test154
-rw-r--r--tcl/tests/clipboard.test262
-rw-r--r--tcl/tests/clrpick.test219
-rw-r--r--tcl/tests/cmap.tcl74
-rw-r--r--tcl/tests/cmds.test60
-rw-r--r--tcl/tests/color.test276
-rw-r--r--tcl/tests/config.test897
-rw-r--r--tcl/tests/constraints.tcl181
-rw-r--r--tcl/tests/cursor.test139
-rw-r--r--tcl/tests/dialog.test64
-rw-r--r--tcl/tests/embed.test51
-rw-r--r--tcl/tests/entry.test1599
-rw-r--r--tcl/tests/event.test1169
-rw-r--r--tcl/tests/filebox.test404
-rw-r--r--tcl/tests/focus.test660
-rw-r--r--tcl/tests/focusTcl.test296
-rw-r--r--tcl/tests/font.test1380
-rw-r--r--tcl/tests/frame.test878
-rw-r--r--tcl/tests/geometry.test267
-rw-r--r--tcl/tests/get.test165
-rw-r--r--tcl/tests/grab.test185
-rw-r--r--tcl/tests/grid.test1502
-rw-r--r--tcl/tests/id.test109
-rw-r--r--tcl/tests/image.test379
-rw-r--r--tcl/tests/imgBmap.test490
-rw-r--r--tcl/tests/imgPPM.test172
-rw-r--r--tcl/tests/imgPhoto.test661
-rw-r--r--tcl/tests/license.terms9
-rw-r--r--tcl/tests/listbox.test2141
-rw-r--r--tcl/tests/macEmbed.test269
-rw-r--r--tcl/tests/macFont.test286
-rw-r--r--tcl/tests/macMenu.test1549
-rw-r--r--tcl/tests/macWinMenu.test105
-rw-r--r--tcl/tests/macscrollbar.test95
-rw-r--r--tcl/tests/main.test1197
-rw-r--r--tcl/tests/menu.test2492
-rw-r--r--tcl/tests/menuDraw.test537
-rw-r--r--tcl/tests/menubut.test359
-rw-r--r--tcl/tests/message.test125
-rw-r--r--tcl/tests/msgbox.test185
-rw-r--r--tcl/tests/obj.test599
-rw-r--r--tcl/tests/oldpack.test527
-rw-r--r--tcl/tests/option.file117
-rw-r--r--tcl/tests/option.file22
-rw-r--r--tcl/tests/option.test248
-rw-r--r--tcl/tests/pack.test1109
-rw-r--r--tcl/tests/panedwindow.test2392
-rw-r--r--tcl/tests/place.test374
-rw-r--r--tcl/tests/raise.test307
-rw-r--r--tcl/tests/safe.test645
-rw-r--r--tcl/tests/scale.test825
-rw-r--r--tcl/tests/scrollbar.test687
-rw-r--r--tcl/tests/select.test1061
-rw-r--r--tcl/tests/send.test630
-rw-r--r--tcl/tests/spinbox.test1589
-rw-r--r--tcl/tests/text.test1594
-rw-r--r--tcl/tests/textBTree.test916
-rw-r--r--tcl/tests/textDisp.test2866
-rw-r--r--tcl/tests/textImage.test368
-rw-r--r--tcl/tests/textIndex.test687
-rw-r--r--tcl/tests/textMark.test239
-rw-r--r--tcl/tests/textTag.test784
-rw-r--r--tcl/tests/textWind.test841
-rw-r--r--tcl/tests/tk.test137
-rw-r--r--tcl/tests/unixButton.test183
-rw-r--r--tcl/tests/unixEmbed.test577
-rw-r--r--tcl/tests/unixFont.test332
-rw-r--r--tcl/tests/unixMenu.test953
-rw-r--r--tcl/tests/unixSelect.test239
-rw-r--r--tcl/tests/unixWm.test2408
-rw-r--r--tcl/tests/util.test359
-rw-r--r--tcl/tests/visual.test320
-rw-r--r--tcl/tests/visual_bb.test119
-rw-r--r--tcl/tests/winButton.test150
-rw-r--r--tcl/tests/winClipboard.test85
-rw-r--r--tcl/tests/winDialog.test327
-rw-r--r--tcl/tests/winFont.test188
-rw-r--r--tcl/tests/winMenu.test1051
-rw-r--r--tcl/tests/winSend.test412
-rw-r--r--tcl/tests/winWm.test276
-rw-r--r--tcl/tests/window.test150
-rw-r--r--tcl/tests/winfo.test376
-rw-r--r--tcl/tests/wm.test1636
-rw-r--r--tcl/tests/xmfbox.test158
-rw-r--r--tcl/unix/Makefile.in1651
-rw-r--r--tcl/unix/README152
-rwxr-xr-xtcl/unix/configure5858
-rwxr-xr-xtcl/unix/configure.in691
-rw-r--r--tcl/unix/license.terms39
-rwxr-xr-xtcl/unix/mkLinks2920
-rw-r--r--tcl/unix/tk.spec52
-rw-r--r--tcl/unix/tkAppInit.c136
-rw-r--r--tcl/unix/tkConfig.sh.in93
-rw-r--r--tcl/unix/tkUnix.c108
-rw-r--r--tcl/unix/tkUnix3d.c501
-rw-r--r--tcl/unix/tkUnixButton.c684
-rw-r--r--tcl/unix/tkUnixColor.c424
-rw-r--r--tcl/unix/tkUnixConfig.c45
-rw-r--r--tcl/unix/tkUnixCursor.c410
-rw-r--r--tcl/unix/tkUnixDefault.h519
-rw-r--r--tcl/unix/tkUnixDialog.c207
-rw-r--r--tcl/unix/tkUnixDraw.c211
-rw-r--r--tcl/unix/tkUnixEmbed.c1034
-rw-r--r--tcl/unix/tkUnixEvent.c619
-rw-r--r--tcl/unix/tkUnixFocus.c148
-rw-r--r--tcl/unix/tkUnixFont.c2830
-rw-r--r--tcl/unix/tkUnixInit.c117
-rw-r--r--tcl/unix/tkUnixInt.h29
-rw-r--r--tcl/unix/tkUnixKey.c413
-rw-r--r--tcl/unix/tkUnixMenu.c1807
-rw-r--r--tcl/unix/tkUnixMenubu.c448
-rw-r--r--tcl/unix/tkUnixPort.h227
-rw-r--r--tcl/unix/tkUnixScale.c698
-rw-r--r--tcl/unix/tkUnixScrlbr.c476
-rw-r--r--tcl/unix/tkUnixSelect.c1545
-rw-r--r--tcl/unix/tkUnixSend.c1899
-rw-r--r--tcl/unix/tkUnixWm.c6336
-rw-r--r--tcl/unix/tkUnixXId.c613
-rw-r--r--tcl/win/Makefile.in824
-rw-r--r--tcl/win/README119
-rw-r--r--tcl/win/buildall.vc.bat9
-rwxr-xr-xtcl/win/configure526
-rwxr-xr-xtcl/win/configure.in235
-rw-r--r--tcl/win/lamp.bmpbin0 -> 2102 bytes
-rw-r--r--tcl/win/license.terms9
-rw-r--r--tcl/win/makefile.bc859
-rw-r--r--tcl/win/makefile.vc857
-rw-r--r--tcl/win/mkd.bat36
-rw-r--r--tcl/win/rc/buttons.bmpbin0 -> 846 bytes
-rw-r--r--tcl/win/rc/cursor00.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor02.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor04.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor06.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor08.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor0a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor0c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor0e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor10.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor12.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor14.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor16.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor18.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor1a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor1c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor1e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor20.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor22.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor24.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor26.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor28.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor2a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor2c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor2e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor30.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor32.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor34.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor36.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor38.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor3a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor3c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor3e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor40.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor42.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor44.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor46.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor48.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor4a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor4c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor4e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor50.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor52.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor54.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor56.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor58.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor5a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor5c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor5e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor60.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor62.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor64.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor66.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor68.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor6a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor6c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor6e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor70.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor72.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor74.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor76.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor78.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor7a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor7c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor7e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor80.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor82.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor84.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor86.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor88.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor8a.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor8c.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor8e.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor90.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor92.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor94.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor96.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/cursor98.curbin0 -> 326 bytes
-rw-r--r--tcl/win/rc/tk.icobin0 -> 1398 bytes
-rw-r--r--tcl/win/rc/tk.rc76
-rw-r--r--tcl/win/rc/tk_base.rc131
-rw-r--r--tcl/win/rc/wish.exe.manifest23
-rw-r--r--tcl/win/rc/wish.icobin0 -> 3630 bytes
-rw-r--r--tcl/win/rc/wish.rc89
-rw-r--r--tcl/win/rmd.bat49
-rw-r--r--tcl/win/rules.vc2
-rw-r--r--tcl/win/stubs.c393
-rw-r--r--tcl/win/tcl.m440
-rw-r--r--tcl/win/tkConfig.sh.in87
-rw-r--r--tcl/win/tkWin.h55
-rw-r--r--tcl/win/tkWin32Dll.c85
-rw-r--r--tcl/win/tkWin3d.c575
-rw-r--r--tcl/win/tkWinButton.c1215
-rw-r--r--tcl/win/tkWinClipboard.c454
-rw-r--r--tcl/win/tkWinColor.c616
-rw-r--r--tcl/win/tkWinConfig.c60
-rw-r--r--tcl/win/tkWinCursor.c251
-rw-r--r--tcl/win/tkWinDefault.h524
-rw-r--r--tcl/win/tkWinDialog.c2596
-rw-r--r--tcl/win/tkWinDraw.c1339
-rw-r--r--tcl/win/tkWinEmbed.c672
-rw-r--r--tcl/win/tkWinFont.c2383
-rw-r--r--tcl/win/tkWinImage.c329
-rw-r--r--tcl/win/tkWinInit.c138
-rw-r--r--tcl/win/tkWinInt.h205
-rw-r--r--tcl/win/tkWinKey.c742
-rw-r--r--tcl/win/tkWinMenu.c2937
-rw-r--r--tcl/win/tkWinPixmap.c198
-rw-r--r--tcl/win/tkWinPointer.c528
-rw-r--r--tcl/win/tkWinPort.h129
-rw-r--r--tcl/win/tkWinRegion.c204
-rw-r--r--tcl/win/tkWinScrlbr.c761
-rw-r--r--tcl/win/tkWinSend.c86
-rw-r--r--tcl/win/tkWinTest.c346
-rw-r--r--tcl/win/tkWinWindow.c813
-rw-r--r--tcl/win/tkWinWm.c7111
-rw-r--r--tcl/win/tkWinX.c1649
-rw-r--r--tcl/win/winMain.c407
-rw-r--r--tcl/xlib/X11/X.h677
-rw-r--r--tcl/xlib/X11/Xatom.h79
-rw-r--r--tcl/xlib/X11/Xfuncproto.h60
-rw-r--r--tcl/xlib/X11/Xlib.h1214
-rw-r--r--tcl/xlib/X11/Xutil.h855
-rw-r--r--tcl/xlib/X11/cursorfont.h79
-rw-r--r--tcl/xlib/X11/keysym.h39
-rw-r--r--tcl/xlib/X11/keysymdef.h1169
-rw-r--r--tcl/xlib/X11/license.terms39
-rw-r--r--tcl/xlib/license.terms39
-rw-r--r--tcl/xlib/xbytes.h58
-rw-r--r--tcl/xlib/xcolors.c914
-rw-r--r--tcl/xlib/xdraw.c82
-rw-r--r--tcl/xlib/xgc.c551
-rw-r--r--tcl/xlib/ximage.c71
-rw-r--r--tcl/xlib/xutil.c116
778 files changed, 402286 insertions, 20675 deletions
diff --git a/tcl/ChangeLog b/tcl/ChangeLog
index 2884fcf180c..0ff16040b3b 100644
--- a/tcl/ChangeLog
+++ b/tcl/ChangeLog
@@ -1,12 +1,12 @@
2002-09-10 Daniel Steffen <das@users.sourceforge.net>
- * unix/Makefile.in: added DYLIB_INSTALL_DIR variable for macosx
+ * unix/Makefile.in: added DYLIB_INSTALL_DIR variable for Darwin
and set it to default value ${LIB_RUNTIME_DIR}
* unix/tcl.m4 (Darwin): use DYLIB_INSTALL_DIR instead of
LIB_RUNTIME_DIR in the -install_name argument to ld.
* unix/configure: regen.
- * macosx/Tcl.pbproj/project.pbxproj:
+ * macosx/Wish.pbproj/project.pbxproj:
* macosx/Makefile: added support for building Tcl as an embedded
framework, i.e. using an dyld install_name containing
@executable_path/../Frameworks via the new DYLIB_INSTALL_DIR
@@ -16,103 +16,115 @@
*** 8.4.0 TAGGED FOR RELEASE ***
-2002-09-06 Don Porter <dgp@users.sourceforge.net>
+2002-09-09 Jeff Hobbs <jeffh@ActiveState.com>
- * doc/file.n: Format correction, and clarified [file normalize]
- returns an absolute path.
+ * macosx/tkMacOSXNotify.c (Tk_MacOSXSetupTkNotifier): corrected
+ Mac Jaguar event loop issue.
- * doc/tcltest.n: Added examples section, as long promised.
+ * library/tk.tcl: use command instead of control on Aqua bindings.
+ Force dialogs to appear below fixed native Mac menubar.
+ * macosx/tkMacOSXKeyEvent.c:
+ * macosx/tkMacOSXKeyboard.c: Keypress/release events for pure
+ modifier keys were not being passed to Tk.
+ Deadkey presses were inserting null characters into text windows.
+ Now they do nothing. (Still not ideal, but better than before!)
+ * macosx/tkMacOSXMenu.c: Allow more than 200 menus to exist -
+ increased to 2000.
+ * macosx/tkMacOSXMouseEvent.c: Bad interactions between floating
+ windows and ordinary ones. Ensure that local<->global coordinate
+ transformations are wrt to the correct window.
+ * macosx/tkMacOSXWm.c: Better error msg for 'wm attributes'.
+ Remove crash in 'wm transient'.
+ Add 'noActivates' and 'noUpdates' flags to unsupported command.
+ [Patch #606658] (darley)
-2002-09-06 Reinhard Max <max@suse.de>
+ * library/xmfbox.tcl (::tk::MotifFDialog_ActivateSEnt): corrected
+ msgcat code with XPG specifier. [Patch #606719] (miller)
- * tests/tcltest.test: Added nonRoot flag to tests 8.3, 8.4, and 8.12.
+2002-09-06 Don Porter <dgp@users.sf.net>
-2002-09-05 Don Porter <dgp@users.sourceforge.net>
+ * tests/unixWm.test (unixWm-50.3): Constrained test that hangs
+ on Windows.
- * doc/tcltest.n: Clarified phrasing.
+2002-09-05 Daniel Steffen <das@users.sourceforge.net>
- * generic/tclBasic.c (TclRenameCommand,CallCommandTraces):
- * tests/trace.test (trace-27.1): Corrected memory leak when a rename
- trace deleted the command being traced. Test added. Thanks to
- Hemang Lavana for the fix. [Bug 604609]
+ * macosx/Wish.pbproj/project.pbxproj: added overlooked missing
+ TK_PATCH_LEVEL version bump to 8.4.0.
- * generic/tclVar.c (TclDeleteVars): Corrected logic for setting the
- TCL_INTERP_DESTROYED flag when calling variable traces. [Tk Bug 605121]
+2002-09-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-2002-09-04 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks
- to dkf and dgp for the long and difficult discussion in the chat.
+ * win/Makefile.in (install-libraries): Added code section to
+ install the message catalogs. Copied same section from
+ unix/Makefile.in and adapted it to the slightly different
+ environment.
2002-09-03 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclVar.c (Tcl_UpVar2): code cleanup to not use goto
-
- * unix/configure: remove -pthread from LIBS on FreeBSD in thread
- * unix/tcl.m4: enabled build. [Bug #602849]
-
-2002-09-03 Miguel Sofer <msofer@users.sourceforge.net>
+ * library/button.tcl: further restrict buttons to not resetting
+ the "original" relief if it has changed in the interim. This
+ prevents code that simulated overrelief buttons from not working
+ in 8.4. [Bug #604270]
- * generic/tclInterp.c (AliasCreate): a Tcl_Obj was leaked on error
- return from TclPreventAliasLoop.
-
2002-09-03 Daniel Steffen <das@users.sourceforge.net>
- * macosx/Tcl.pbproj/project.pbxproj: Bumped version number to
+ * macosx/Wish.pbproj/project.pbxproj: Bumped version number to
8.4.0 and updated copyright info.
-2002-09-03 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on
- error return from TclGetFrame.
+2002-09-03 Vince Darley <vincentdarley@users.sourceforge.net>
-2002-09-03 Don Porter <dgp@users.sourceforge.net>
+ * macosx/tkMacOSXWm.c: fix to 'wm attributes' error-handling bug.
+
+2002-09-03 Don Porter <dgp@users.sf.net>
- * changes: Updated changes for 8.4.0 release.
+ * changes: Updated for 8.4.0 release
2002-09-02 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/tclUnixFile.c (TclpObjLink): removed unnecessary/unfreed
- extra native char*.
+ * tests/cursor.test: reverted 2002-08-31 change for OS X to use
+ 'heart' cursor because 'arrow' on windows has a pre-skewed use
+ count. [Bug #602667]
- * unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): make sure to init
- flags field of TcpState ptr to 0.
+ * tests/button.test: added button-14.1
+ * win/tkWinButton.c (TkpComputeButtonGeometry): correct Win button
+ sizing to be equal for one-line buttons with -height of 0 or 1, as
+ well as -height 0 buttons with empty text and no image, which
+ should be the same as single-line text buttons. [Bug #565485]
- * unix/configure:
- * unix/tcl.m4: added 64-bit gcc compilation support on HP-11.
- [Patch #601051] (martin)
+ * library/button.tcl (::tk::ButtonLeave): correctly restore state
+ of button to normal for unix bindings. [Bug #597920]
+
+ * doc/tk.n: added tk windowingsystem docs.
+
+ * tests/wm.test:
+ * unix/tkUnixWm.c: remove possible 2-second delay in 'raise'.
+ [Patch #601518] (english) TIP #107
+
+ * unix/tcl.m4: add support for 64-bit builds on HP-11 with gcc.
+ * unix/configure.in: make sure to substitute LD_LIBRARY_PATH_VAR.
+ * unix/configure: regend
* README: Bumped version number to 8.4.0
- * generic/tcl.h:
- * tools/tcl.wse.in:
+ * generic/tk.h:
* unix/configure:
* unix/configure.in:
- * unix/tcl.spec:
- * win/README.binary:
+ * unix/tk.spec:
* win/configure:
* win/configure.in:
- * generic/tclInterp.c (SlaveCreate): make sure that the memory and
- checkmem commands are initialized in non-safe slave interpreters
- when TCL_MEM_DEBUG is used. [Bug #583445]
-
- * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable
- pipe if there was something to write. This may prevent infinite
- wait on exit.
+ * generic/tkCmds.c:
+ * generic/tkWindow.c: made 'tk' available in safe interpreters,
+ but only the caret and windowingsystem subcommands may be called.
+ * tests/safe.test (safe-1.2): noted that tk is now available in
+ safe interps, but not the appname/scaling subcommands.
- * tests/exec.test: marked exec-18.1 unixOnly until the Windows
- incompatability (in the test, not the core) can be resolved.
-
- * tests/http.test (http-3.11): added close $fp that was causing an
- error on Windows because the file was not closed before deleting.
-
- * unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static
- function only appear when HAVE_CFBUNDLE is defined.
+ * tests/tk.test (tk-1.2): noted new tk windowingsystem subcommand
2002-08-31 Daniel Steffen <das@users.sourceforge.net>
- * unix/tcl.m4: added TK_SHLIB_LD_EXTRAS analogue of existing
- TCL_SHLIB_LD_EXTRAS for linker settings only used when linking Tk.
+ * unix/tcl.m4: update from Tcl
+
+ * unix/Makefile.in: import of TK_SHLIB_LD_EXTRAS for Tk library
+ specific linker settings. Added use of new LD_LIBRARY_PATH_VAR.
* unix/configure: regen
@@ -120,3954 +132,7255 @@
*** macosx-8-4-branch merged into the mainline [tcl patch #602770] ***
- * generic/tcl.decls: added new macosx specific entry to stubs table.
+ * generic/tk.decls:
+ * generic/tkInt.decls: added new "aqua" specific entries to the
+ stubs tables. Changed all "unix" entries to "x11" to allow us to
+ distinguish and build both "aqua" on MacOSX and "x11" on MacOSX.
- * tools/genStubs.tcl: added generation of platform guards for
- macosx. This is a little more complex than it seems, because MacOS
- X IS "unix" plus a little bit, for the purposes of Tcl. BUT
- unfortunately, Tk uses "unix" to mean X11. So added platform keys
- for macosx (the little added to "unix"), "aqua" and "x11" to
- distinguish these for Tk.
+ * generic/tk.h: added a #ifnded RESOURCE_INCLUDED so that tk.h can
+ be passed to the resource compiler.
- * generic/tcl.h: added a #ifnded RESOURCE_INCLUDED so that tcl.h
- can be passed to the resource compiler.
-
- * generic/tcl.h:
- * generic/tclNotify.c: added a few Notifier procs, to be able to
- modify more bits of the Tcl notifier dynamically. Required to get
- Mac OS X Tk to live on top of the Tcl Unix threaded notifier.
- Changes the size of the Tcl_NotifierProcs structure, but doesn't
- move any elements around.
+ * generic/tkCmds.c (Tk_TkObjCmd): added [tk windowingsystem]
+ subcommand: returns "x11" when running on X11, "win32" on Windows,
+ "classic" on MacOS9 and "aqua" on MacOSX Aqua (i.e. Carbon)
- * unix/tclUnixNotfy.c: moved the call to Tcl_ConditionNotify till
- AFTER we are done mucking with the pointer swap. Fixes cases where
- the thread waiting on the condition wakes & accesses the
- waitingListPtr before it gets reset, causing a hang.
+ * generic/tkFont.c (TkFontGetFirstTextLayout): new private function
+ returning the first chunk of a Tk_TextLayout, i.e. until the first
+ font change on the first line (or the whole first line if there is
+ no such font change).
- * library/auto.tcl (tcl_findLibrary): added checking the
- directories in the tcl_pkgPath for library files on macosx to
- enable support of the standard Mac OSX library locations
+ * generic/tkMain.c: made Tcl_ThreadDataKey static
- * unix/Makefile.in:
- * unix/configure.in:
- * unix/tcl.m4: added MAC_OSX_DIR. Added PLAT_OBJS to the OBJS:
- there are some MacOS X specific files now for Tcl, and when I get
- he resource & applescript stuff ported over, and restore support
- for FindFiles, etc, there will be a few more.
- Added LD_LIBRARY_PATH_VAR configure variable to avoid having to set
- all possible LD_LIBRARY_PATH analogues on all platforms.
- LD_LIBRARY_PATH_VAR is "LD_LIBRARY_PATH" by default, "LIBPATH" on
- AIX, "SHLIB_PATH" on HPUX and "DYLD_LIBRARY_PATH" on Mac OSX.
- Added configure option to package Tcl as a framework on Mac OSX.
-
- * macosx/tclMacOSXBundle.c (new): support for finding Tcl extension
- packaged as 'bundles' in the standard Mac OSX library locations.
-
- * unix/tclUnixInit.c: added support for findig the tcl script
- library inside Tcl packaged as a framework on Mac OSX.
-
- * macosx/Tcl.pbproj/jingham.pbxuser (new):
- * macosx/Tcl.pbproj/project.pbxproj (new): project for Apple's
+ * library/demos/puzzle.tcl: fixed button metrics for aqua
+
+ * tests/cursor.test: check for presence of arrow cursor instead of
+ heart cursor
+
+ * xlib/xcolors.c: changed xColors static initialization to more
+ standard C
+
+ * macosx/Wish.pbproj/jingham.pbxuser (new):
+ * macosx/Wish.pbproj/project.pbxproj (new): project for Apple's
ProjectBuilder IDE.
* macosx/Makefile (new): simple makefile for building the project
from the command line via the ProjectBuilder tool 'pbxbuild'.
- * unix/configure:
- * generic/tclStubInit.c:
- * generic/tclPlatDecls.h: regen
+ * macosx/tkMacOSXAppInit.c (new): macosx specific AppInit looking
+ for a AppMain.tcl file in its bundled Resources/Scripts folder. If
+ present, argv[1] is set to that file and the Scripts folder is
+ added to the auto_path. This allows tk apps to embed scripts within
+ their bundle directory structure.
+
+ * macosx/tkMacOSXInit.c (new): macosx adapted version of
+ tkUnixInit.c: we initialize & cache the Carbon native encoding
+ (e.g. 'macRoman') and try to find the tk script library files
+ inside Tk packaged as a framework.
+
+ * macosx/tkMacOSXNotify.c (new): new macosx specific merged
+ Carbon/select-based notifier.
+
+ * macosx/tkMacOSXEvent.c (new):
+ * macosx/tkMacOSXEvent.h (new):
+ * macosx/tkMacOSXKeyEvent.c (new):
+ * macosx/tkMacOSXMouseEvent.c (new):
+ * macosx/tkMacOSXWindowEvent.c (new): new macosx specific event
+ handling functionality.
+
+ * macosx/tkMacOSX.h (new):
+ * macosx/tkMacOSXBitmap.c (new):
+ * macosx/tkMacOSXButton.c (new):
+ * macosx/tkMacOSXClipboard.c (new):
+ * macosx/tkMacOSXColor.c (new):
+ * macosx/tkMacOSXConfig.c (new):
+ * macosx/tkMacOSXCursor.c (new):
+ * macosx/tkMacOSXDefault.h (new):
+ * macosx/tkMacOSXDialog.c (new):
+ * macosx/tkMacOSXDraw.c (new):
+ * macosx/tkMacOSXEmbed.c (new):
+ * macosx/tkMacOSXFont.c (new):
+ * macosx/tkMacOSXHLEvents.c (new):
+ * macosx/tkMacOSXInt.h (new):
+ * macosx/tkMacOSXKeyboard.c (new):
+ * macosx/tkMacOSXMenu.c (new):
+ * macosx/tkMacOSXMenubutton.c (new):
+ * macosx/tkMacOSXMenus.c (new):
+ * macosx/tkMacOSXPort.h (new):
+ * macosx/tkMacOSXRegion.c (new):
+ * macosx/tkMacOSXScale.c (new):
+ * macosx/tkMacOSXScrlbr.c (new):
+ * macosx/tkMacOSXSubwindows.c (new):
+ * macosx/tkMacOSXTest.c (new):
+ * macosx/tkMacOSXUtil.c (new):
+ * macosx/tkMacOSXUtil.h (new):
+ * macosx/tkMacOSXWm.c (new):
+ * macosx/tkMacOSXWm.h (new):
+ * macosx/tkMacOSXXStubs.c (new): macosx ports of classic mac Tk
+ implementation in tk/mac.
+
+ * macosx/tkMacOSXSend.c (new): only send to local interp
+ implemented currently.
+
+ * macosx/tkMacOSXDebug.h (new):
+ * macosx/tkMacOSXDebug.c (new): new macosx specific functions for
+ debugging MacOS events, regions, etc.
+
+ * macosx/tkAboutDlg.r (new):
+ * macosx/tkMacOSXApplication.r (new):
+ * macosx/tkMacOSXCursors.r (new):
+ * macosx/tkMacOSXLibrary.r (new):
+ * macosx/tkMacOSXMenu.r (new):
+ * macosx/tkMacOSXResource.r (new):
+ * macosx/tkMacOSXXCursors.r (new):
+ * macosx/tclets.r (new): sources for Rez resource compiler.
+
+ * macosx/Wish.icns (new): Wish application icon.
+
+ * generic/tk.h:
+ * generic/default.h:
+ * generic/tkBind.c:
+ * generic/tkCmds.c:
+ * generic/tkGrab.c:
+ * generic/tkPointer.c:
+ * generic/tkPort.h:
+ * generic/tkSelect.c:
+ * generic/tkStubLib.c:
+ * generic/tkTest.c:
+ * generic/tkText.c:
+ * generic/tkWindow.c:
+ * unix/tkUnix3d.c:
+ * xlib/xgc.c:
+ * xlib/X11/X.h:
+ * xlib/X11/Xlib.h:
+ * xlib/X11/Xutil.h: added #includes and #ifdefs for macosx
+
+ * library/bgerror.tcl:
+ * library/button.tcl:
+ * library/console.tcl:
+ * library/dialog.tcl:
+ * library/entry.tcl:
+ * library/listbox.tcl:
+ * library/menu.tcl:
+ * library/msgbox.tcl:
+ * library/scrlbar.tcl:
+ * library/spinbox.tcl:
+ * library/text.tcl:
+ * library/tk.tcl:
+ * library/demos/menu.tcl:
+ * library/demos/menubu.tcl:
+ * library/demos/widget: check [tk windowingsystem] instead of
+ and/or in addition to $tcl_platform(platform).
+
+ * generic/tkInt.h:
+ * mac/tkMacBitmap.c:
+ * mac/tkMacWm.c: added missing CONSTification
+
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkIntXlibDecls.h:
+ * generic/tkPlatDecls.h:
+ * generic/tkStubInit.c: regen
+
+2002-08-27 D. Richard Hipp <drh@hwaci.com>
+
+ * doc/checkbutton.n: [Bug 582457] Fix the -offrelief option so
+ * doc/radiobutton.n: that when -offrelief is flat and -relief is
+ * mac/tkMacButton.c: sunken and -overrelief is raised, buttons
+ * unix/tkUnixButton.c: work look toolbar buttons under Windows.
+ * win/tkWinButton.c: See also: TIP #82.
+
+2002-08-26 Don Porter <dgp@users.sf.net>
+
+ * win/Makefile.in: Removed dependence on the (parts of) the
+ * win/winMain.c: tcltest executable on Windows. It was not
+ used, and the dependency complicated the Makefile. [Bug 592638].
+
+2002-08-20 Don Porter <dgp@users.sf.net>
-2002-08-29 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ * README: Bumped version number to 8.4b3 to distinguish
+ * generic/tk.h: HEAD from the 8.4b2 release.
+ * unix/configure.in:
+ * win/configure.in:
+ * unix/tk.spec:
+
+ * unix/configure: autoconf
+ * win/configure:
- * win/tclWinThrd.c (TclpFinalizeThreadData, TclWinFreeAllocCache):
- Applied patch for bug #599428, provided by Miguel Sofer
- <msofer@users.sourceforge.net>.
+ * generic/tk.h: Added compile-time check that the tcl.h header file
+ #included by Tk 8.4 is one from Tcl 8.4. This is needed to be sure
+ that new #defines like CONST84 are available. [Bug 597432].
-2002-08-28 David Gravereaux <davygrvy@pobox.com>
+2002-08-16 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclEnv.c:
- * unix/configure.in:
- * win/tclWinPort.h: putenv() on some systems copies the buffer
- rather than taking reference to it. This causes memory leaks
- and is know to effect mswindows (msvcrt) and NetBSD 1.5.2 . This
- patch tests for this behavior and turns on -DHAVE_PUTENV_THAT_COPIES=1
- when approriate. Thanks to David Welton for assistance.
- [Bug 414910]
+ * unix/Makefile.in (install-binaries): simplified pkgIndex.tcl
+ file created on installation.
+ * win/Makefile.in (install-binaries): corrected and simplified
+ creation of pkgIndex.tcl file on installation.
- * unix/configure: regen'd
+2002-08-14 Vince Darley <vincentdarley@users.sourceforge.net>
-2002-08-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * win/tkWinDialog.c:
+ * win/makefile.vc: broken compilation and link from changes
+ Hobbs-08-07 fixed.
+ * win/tkWinTest.c: CONST problem resolved.
- * doc/eval.n: Added mention of list command and corrected "SEE ALSO".
+2002-08-13 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/configure.in: Cache handling of ac_cv_type_socklen_t was
- wrong. [Bug 600931] reported by John Ellson. Fixed by putting the
- brackets where they belong.
+ * library/button.tcl: change the bindings to use Priv($w,relief)
+ instead of just Priv(relief). This ensures that neighboring
+ buttons don't confuse (over)relief settings.
-2002-08-26 Miguel Sofer <msofer@users.sourceforge.net>
+2002-08-13 Reinhard Max <max@suse.de>
- * generic/tclCompCmds.c: fix for [Bug 599788] (error in element
- name causing segfault), reported by Tom Wilkason. Fixed by copying
- the tokens instead of the source string.
+ * unix/tkUnixSend.c (Tk_SetAppName): Fixed a compiler warning.
-2002-08-26 Miguel Sofer <msofer@users.sourceforge.net>
+2002-08-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclThreadAlloc.c: small optimisation, reducing the
- new allocator's overhead.
-
-2002-08-23 Miguel Sofer <msofer@users.sourceforge.net>
+ * library/demos/image2.tcl: Tweaked the behaviour of the directory
+ box on resize, as resizing of the overall window tends to be
+ common given the sample images.
- * generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936].
- Thanks to Zoran Vasiljevic.
+2002-08-08 Mo DeJong <mdejong@users.sourceforge.net>
-2002-08-23 Miguel Sofer <msofer@users.sourceforge.net>
+ * unix/tkUnixWm.c (WmTransientCmd): Apply fix for
+ wm transient assertion error that was applied
+ to tkWinWm.c for Tk Bug #592201.
- * generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects
- between caches as a block, instead of one-by-one.
+2002-08-08 Mo DeJong <mdejong@users.sourceforge.net>
-2002-08-22 Miguel Sofer <msofer@users.sourceforge.net>
+ * tests/wm.test: Add deleteWindows at start of
+ new transient tests so they do not fail if the
+ toplevels already exist.
+ * unix/tkUnixWm.c: Revert patch for Tk Bug #592201
+ which incorrectly removed numTransients member.
- * generic/tclBasic.c:
- * generic/tclCmdMZ.c: fix for freed memory r/w in delete traces
- [Bug 589863], patch by Hemang Lavana.
+2002-08-08 Joe English <jenglish@users.sourceforge.net>
-2002-08-20 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ * unix/tkUnixWm.c:
+ * win/tkWinWm.c:
+ * tests/wm.test: Fix for Tk Bug #592201 "wm transient fails with two
+ masters"; fixes panic after a transient window is reassigned to
+ new master and either master is subsequently destroyed.
- * win/Makefile.in (CFLAGS):
- * unix/Makefile.in (MEM_DEBUG_FLAGS): Added usage of @MEM_DEBUG_FLAGS@.
- * win/configure.in:
- * unix/configure.in: Added usage of SC_ENABLE_MEMDEBUG.
- * win/tcl.m4:
- * unix/tcl.m4: Added macro SC_ENABLE_MEMDEBUG. Allows a user of
- configure to (de)activate memory validation and debugging
- (TCL_MEM_DEBUG). No need to modify the makefile anymore.
+2002-08-08 Don Porter <dgp@users.sf.net>
-2002-08-20 Don Porter <dgp@users.sourceforge.net>
+ * tests/unixWm.test: Corrected packaging of unixWm-50.3 so that
+ [setupbg] and [cleanupbg] always balance, no matter what tests
+ are skipped.
- * generic/tclCkalloc.c: CONSTified MemoryCmd and CheckmemCmd.
+2002-08-08 Reinhard Max <max@suse.de>
- * README: Bumped version number to 8.4b3 to distinguish
- * generic/tcl.h: HEAD from the 8.4b2 release.
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/README.binary:
- * win/configure.in:
+ * unix/Makefile.in: Fixed typos in DISTNAME, and ZIPNAME.
+
+2002-08-08 Jeff Hobbs <jeffh@ActiveState.com>
+
+ *** 8.4b2 TAGGED FOR RELEASE ***
+
+ * generic/tkButton.c (TkButtonWorldChanged): added GCFont handling
+ to the disabledGc of buttons when compound != none. The drawing
+ appears to be incorrect across platforms still. [Bug #477740]
+
+ * generic/tkImgGIF.c (FileReadGIF): fixed -from handling for gifs
+ [Bug #467524] (obermeier)
+
+2002-08-07 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkCanvUtil.c (TkSmoothParseProc): recognize the built-in
+ bezier method by name. [Bug #578654]
+ * doc/canvas.n: update to note that -smooth really doesn't take
+ or return just booleans.
+
+ * win/tkWinMenu.c (TkpSetWindowMenuBar): fixed logic bug in when
+ to idle call ReconfigureWindowsMenu.
+
+ * doc/GetBitmap.3: removed doc refs to deprecated
+ Tk_GetBitmapFromData. [Bug #590379]
+
+ * generic/tkPanedWindow.c (Tk_PanedWindowObjCmd):
+ * library/panedwindow.tcl: changed class from PanedWindow to
+ Panedwindow to not conflict with existing bwidgets, but also to be
+ more regular with other names used in the core.
+
+ * tests/panedwindow.test: added -text foobar to some test buttons
+ to enable correct testing of panedwindow across platforms.
+ [Bug #582370]
+
+ * win/tkWinDialog.c: enabled use of the updated native Windows
+ directory browser (tk_chooseDirectory). This does require
+ shell32.dll v4.71 or greater. [Patch #468139]
- * unix/configure: autoconf
* win/configure:
+ * win/tcl.m4: added shell32 to libs for updated native Windows
+ tk_chooseDirectory dialog.
+
+2002-08-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tkPanedWindow.c (RESIZE_PENDING): Separated out flag for
+ indicating that a resize needs to be issued.
+ (PanedWindowReqProc): Do the old behaviour when the panedwindow is
+ not mapped; easiest way of making the test suite pass while still
+ preserving improved behaviour in the face of children whose size
+ is not known immediately.
+
+2002-08-06 Don Porter <dgp@users.sf.net>
+
+ * tests/defs.tcl: removed file. No longer needed now that Tk is
+ using the tcltest package to do its testing.
+
+2002-08-05 Don Porter <dgp@users.sf.net>
+
+ * win/tkWinFont.c: Additional changes to fix CONST warnings on
+ * win/tkWinWM.c: Windows due to latest patch. Tks Vince Darley.
+
+ * doc/3DBorder.3: Applied companion patch for Tcl Patch 585105,
+ * doc/BindTable.3: updating Tk to use Tcl 8.4's fully CONST-ified
+ * doc/ConfigWidg.3: interface, and fully CONSTifying Tk at the
+ * doc/CrtImgType.3: same time.
+ * doc/CrtWindow.3:
+ * doc/DeleteImg.3: This patch includes purging Tk of its last
+ * doc/FindPhoto.3: direct access to interp->result. [Bug 589853]
+ * doc/GetAnchor.3:
+ * doc/GetBitmap.3: The substantial changes include copying
+ * doc/GetCapStyl.3: event sequence strings into Tcl_DStrings
+ * doc/GetClrmap.3: in tkBind.c, and copying [text] indices into
+ * doc/GetColor.3: Tcl_DStrings because parsing them involved
+ * doc/GetCursor.3: overwriting them. If this causes performance
+ * doc/GetFont.3: trouble, that can be resolved by further
+ * doc/GetImage.3: converting them to Tcl_Obj's.
+ * doc/GetJoinStl.3:
+ * doc/GetJustify.3: The #defines USE_NON_CONST and USE_COMPAT_CONST
+ * doc/GetOption.3: have the same effect for Tk as they do for Tcl.
+ * doc/GetRelief.3: (They actually change tcl.h)
+ * doc/GetScroll.3:
+ * doc/GetVisual.3:
+ * doc/InternAtom.3:
+ * doc/NameOfImg.3:
+ * doc/SetAppName.3:
+ * doc/WindowId.3:
+ * generic/tk.decls:
+ * generic/tk.h:
+ * generic/tk3d.c:
+ * generic/tkAtom.c:
+ * generic/tkBind.c:
+ * generic/tkBitmap.c:
+ * generic/tkButton.c:
+ * generic/tkCanvArc.c:
+ * generic/tkCanvBmap.c:
+ * generic/tkCanvImg.c:
+ * generic/tkCanvLine.c:
+ * generic/tkCanvPoly.c:
+ * generic/tkCanvPs.c:
+ * generic/tkCanvText.c:
+ * generic/tkCanvUtil.c:
+ * generic/tkCanvWind.c:
+ * generic/tkCanvas.c:
+ * generic/tkCanvas.h:
+ * generic/tkClipboard.c:
+ * generic/tkCmds.c:
+ * generic/tkColor.c:
+ * generic/tkConfig.c:
+ * generic/tkConsole.c:
+ * generic/tkCursor.c:
+ * generic/tkDecls.h:
+ * generic/tkEntry.c:
+ * generic/tkFont.c:
+ * generic/tkFrame.c:
+ * generic/tkGet.c:
+ * generic/tkGrid.c:
+ * generic/tkImage.c:
+ * generic/tkImgBmap.c:
+ * generic/tkImgPhoto.c:
+ * generic/tkInt.decls:
+ * generic/tkInt.h:
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkListbox.c:
+ * generic/tkMenu.c:
+ * generic/tkMenubutton.c:
+ * generic/tkMessage.c:
+ * generic/tkOldConfig.c:
+ * generic/tkOption.c:
+ * generic/tkRectOval.c:
+ * generic/tkScale.c:
+ * generic/tkScrollbar.c:
+ * generic/tkSelect.c:
+ * generic/tkStyle.c:
+ * generic/tkTest.c:
+ * generic/tkText.c:
+ * generic/tkText.h:
+ * generic/tkTextBTree.c:
+ * generic/tkTextDisp.c:
+ * generic/tkTextImage.c:
+ * generic/tkTextIndex.c:
+ * generic/tkTextMark.c:
+ * generic/tkTextTag.c:
+ * generic/tkTextWind.c:
+ * generic/tkUtil.c:
+ * generic/tkVisual.c:
+ * generic/tkWindow.c:
+ * mac/tkMacConfig.c:
+ * mac/tkMacCursor.c:
+ * mac/tkMacEmbed.c:
+ * mac/tkMacSend.c:
+ * unix/tkUnixConfig.c:
+ * unix/tkUnixCursor.c:
+ * unix/tkUnixEmbed.c:
+ * unix/tkUnixFont.c:
+ * unix/tkUnixSelect.c:
+ * unix/tkUnixSend.c:
+ * unix/tkUnixWm.c:
+ * win/tkWinConfig.c:
+ * win/tkWinCursor.c:
+ * win/tkWinEmbed.c:
+ * win/tkWinMenu.c:
+ * win/tkWinSend.c:
+
+2002-08-02 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tkPanedWindow.c (DestroyPanedWindow): Idle calls need to
+ be deleted on destruction of the window, or things can *really* go
+ pear-shaped.
- * library/http/http.tcl: Corrected installation directory of
- * library/msgcat/msgcat.tcl: the package tcltest 2.2. Added
- * library/opt/optparse.tcl: comments in other packages to remind
- * library/tcltest/tcltest.tcl: that installation directories need
- * unix/Makefile.in: updates to match increasing version
- * win/Makefile.in: numbers. [Bug 597450]
- * win/makefile.bc:
+2002-07-31 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tkPanedWindow.c (PanedWindowReqProc): Postpone pane
+ arrangement until idle, as is done in other window managers, to
+ fix problems with size calculations when the children don't
+ already know their sizes anyway.
+
+ * unix/configure: Regen.
+ * unix/tcl.m4: Update from Tcl.
+
+2002-07-29 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/configure.in: Remove code that was setting
+ CC_SEARCH_FLAGS and LD_SEARCH_FLAGS to try to
+ account for cc vs ld linking. Tcl now handles this.
+ * unix/tcl.m4: Update from Tcl.
+
+2002-07-27 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/Makefile.in: Add MAJOR_VERSION, MINOR_VERSION,
+ PATCH_LEVEL, INSTALL_LIBRARY, STUB_LIB_FILE, and LIB_FILE
+ to support changes in tcl.m4 related to library builds.
+ Use MAKE_LIB macro to avoid dealing with RANLIB issues.
+ Rename TK_CC_SEARCH_FLAGS to CC_SEARCH_FLAGS and
+ rename TK_LD_SEARCH_FLAGS to LD_SEARCH_FLAGS.
+ Use new INSTALL_LIB and INSTALL_STUB_LIB substs to
+ deal with ranlib issues when install libraries.
+ * unix/configure: Regen.
+ * unix/configure.in: Remove AC_PROG_RANLIB since
+ this is done by tcl.m4 now. Define CC_SEARCH_FLAGS
+ instead of TK_CC_SEARCH_FLAGS and so on.
+ Use MAKE_LIB and MAKE_STUB_LIB from tcl.m4.
+ Remove AC_SUBST calls that are no done in tcl.m4.
+ * unix/tcl.m4: Update from Tcl.
+ * unix/tkConfig.sh.in: Subst CC_SEARCH_FLAGS and
+ LD_SEARCH_FLAGS.
+
+2002-07-25 Peter Spjuth <peter.spjuth@space.se>
+
+ * generic/tkInt.h:
+ * generic/tkWindow.c:
+ * mac/tkMacWm.c:
+ * unix/tkUnixWm.c:
+ * win/tkWinWm.c:
+ * tests/wm.test:
+ * tests/winWm.test:
+ * tests/unixWm.test: Objectifed wm. [Patch #564521]
+ Note: At this point the Mac file is completely untested
+ and may not even compile.
+
+2002-07-25 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/spinbox.test: added spinbox-22.[1-3]
+ * generic/tkEntry.c (ConfigureEntry): made the textvariable value
+ take precedence over changed -from/-to values, unless it must be
+ constrained. [Bug #559078]
+
+ * library/spinbox.tcl (MouseSelect): when not in the entry, just
+ return instead of invoking - ButtonUp handles invoking already.
+ [Bug #499168]
+
+ * library/tk.tcl (RestoreFocusGrab): handle the case where the
+ FocusGrab info is not set. [Bug #553283]
+
+2002-07-24 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/canvas.test: added canvas-14.[1-6]
+ * generic/tkCanvas.c (CanvasWidgetCmd): corrected handling of
+ 'scan' subcommand args. Also removed early return cases to goto
+ done instead where the canvasPtr would be Tcl_Release'd. This may
+ solve other problems with unreleased canvasPtr's. [Bug #581560]
+
+ * win/tkWinButton.c (TkpDisplayButton): corrected display of focus
+ ring around the actual text when the button is a compound button.
+ [Bug #583691]
+
+ * unix/README: Corrected notes about running user interactive Tk
+ tests. [Bug #462320]
+
+ * generic/tkText.c (TextEditUndo): set isDirtyIncrement to -1 when
+ reverting to note proper "dirtiness". [Bug #580362] (callewaert)
+
+ * generic/tkEntry.c (DisplayEntry): correct cursor position before
+ calling Tk_SetCaretPos. (yamamoto)
+
+2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4: Update from Tcl.
+
+2002-07-22 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * library/choosedir.tcl (tk::dialog::file::chooseDir):
+ * library/clrpick.tcl (tk::dialog::file::chooseDir):
+ * library/msgbox.tcl (tk::MessageBox):
+ * library/tkfbox.tcl (tk::dialog::file):
+ * library/xmfbox.tcl (tk::MotifFDialog):
+ Revert [Tk patch 568278]. The transient window workaround
+ is no longer needed since the fix for [Tk bug 570764]
+ solved the problem for withdrawn transients.
+
+2002-07-19 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure:
+ * unix/configure.in:
+ * win/configure:
+ * win/configure.in: Add AC_PREREQ(2.13) in an attempt
+ to make it more clear that the configure scripts
+ must be generated with autoconf version 2.13.
+ [Tcl Bug 583573]
+
+2002-07-19 D. Richard Hipp <drh@hwaci.com>
+
+ * library/mkpsec.tcl: Fix a bug that was causing postscript generation
+ to fail under Win2K.
+
+2002-07-18 Reinhard Max <max@suse.de>
+
+ * unix/tkUnixSend.c: Using Tcl_GetTime instead of TclpGetTime.
+
+2002-07-17 Reinhard Max <max@suse.de>
+
+ * library/unsupported.tcl: Extended ExposePrivateVariable, and
+ ExposePrivateCommand to accept patterns as well.
+
+2002-07-17 Don Porter <dgp@users.sf.net>
+
+ * generic/tkFont.c: Corrected reversed logic in assert -> panic
+ conversion. [Bug 582799]
+
+2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkFont.c (TkFontPkgFree): Call panic instead
+ of assert since assert is not used in the rest of Tk.
+ [Tk bug 579651]
+
+2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/Makefile.in:
+ * win/Makefile.in: Add a more descriptive warning
+ in the event `make genstubs` needs to be rerun.
+
+2002-07-16 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * win/tkWinWm.c:
+ * doc/wm.n: fix for part of [Bug 581627], and made iconbitmap
+ code on Windows more flexible about reading in icons [Bug
+ 220800].
+
+2002-07-15 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.bc (new): re-add of the borland makefile. Submitted
+ by Helmut Giese <hgiese@ratiosoft.com>. This needs testing, still.
+
+2002-07-15 Don Porter <dgp@users.sf.net>
+
+ * Fixes for [Bug 581627, 581795].
+ * generic/tkTest.c: Test commands not supported on non-Unix
+ platforms should not be defined there in the first place.
+ * tests/constraints.tcl: Fixed "secureserver" constraint.
+ * tests/unixWm.test: Some tests needed "unix" constraint.
+ * win/tkWinWm.c: Typo in error message.
+
+2002-07-14 Don Porter <dgp@users.sf.net>
+
+ * tests/event.test: Fixes to enable testing of only userInteraction
+ * tests/visual_bb.test: tests.
+
+ * README: Bumped HEAD to version 8.4b2 in order to
+ * generic/tk.h: distinguish it from the 8.4b1 release.
+ * unix/configure*: Also extended LOCALES to cover all message
+ * unix/tk.spec: catalogs.
+ * win/configure*:
+
+ * tests/focustTcl.test: Conversion bug: Corrected backwards logic.
+ * tests/imgPhoto.test: Conversion bug: overwrote unix/README.
+
+ * tests/all.tcl: Completed conversion of Tk test suite
+ * tests/constraints.tcl: to use tcltest.
+ * tests/[b-v]*.test:
+ * unix/Makefile.in:
+
+2002-07-12 Don Porter <dgp@users.sf.net>
+
+ * tests/constraints.tcl: Converted more files to tcltest and
+ * tests/[g-x]*.test: factored out common code.
+
+2002-07-11 Don Porter <dgp@users.sf.net>
+
+ * tests/canvPsImg.tcl: Converted several files in the
+ * tests/constraints.tcl (new file): Tk test suite for testing by
+ * tests/[r-x]*.test: tcltest 2.1.
+ * unix/Makefile.in:
+
+2002-07-11 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinDialog.c (Tk_ChooseDirectoryObjCmd): initialize
+ utfTitle to NULL, add a few more notes about limitations of
+ possible new Tk_ChooseDirectoryObjCmd function.
+
+2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/imgPhoto.test (imgPhoto-15.1): Added test of mem-alloc
+ failure, but this is non-portable.
+ * generic/tkImgPhoto.c (ImgPhotoSetSize): Allowed this function to
+ fail when it can't allocate enough memory. Note that not all the
+ places that call it can fail nicely without API changes; some
+ still panic but at least some of the potential failures are now
+ handled gracefully.
+
+ * tests/visual_bb.test (lpr): Stopped this from relying on
+ external files; direct piping is much more flexible for this
+ application.
+
+2002-07-09 Don Porter <dgp@users.sf.net>
+
+ * generic/tkTest.c: Removed unused dependence on TclThread_Init()
+ * tests/defs.tcl: and [testthread]. [Bug 578165, Tcl Bug 531413]
+
+2002-07-08 David Gravereaux <davygrvy@pobox.com>
+
+ * unix/Makefile.in: Added missing win/lamp.bmp to the dist
+ target.
+
+2002-07-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ *** 8.4b1 TAGGED FOR RELEASE ***
+
+2002-07-04 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/bgerror.tcl (bgerror): Stopped the bgerror dialog from
+ getting wider than the screen; in theory really long messages
+ could make it become taller than the screen now, but that's much
+ less likely to happen. Also trimmed a little bit of internal
+ space so that the icon-message gap is the same as the icon-frame
+ and message-frame gaps.
+
+2002-07-01 Don Porter <dgp@users.sf.net>
+
+ * unix/configure:
+ * unix/tcl.m4: Updated to latest tcl.m4 from Tcl.
+
+2002-06-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/msgbox.tcl (MessageBox): Force all non-button widgets to
+ have the same background as the containing toplevel. [Bug #552515]
+
+2002-06-27 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * win/Makefile.in (install-binaries): Fix of troubled Makefile
+ quoting introduced by [Patch 521356] causing the installed to
+ fail.
+
+2002-06-25 Don Porter <dgp@users.sf.net>
+
+ * unix/tkUnixFont.c: (Tk_DrawChars) silence compiler warning.
+
+2002-06-26 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tkStyle.c: <eol> of the committing cvs client didn't
+ match the <eol> of the file itself. Windows users where getting
+ \r\r\n. Problem fixed.
+
+2002-06-26 Anton Kovalenko <a_kovalenko@users.sourceforge.net>
+
+ * generic/tkFont.c (TkTextLayoutToPostscript): fixed potential
+ buffer overflow which could be intentionally triggered from
+ within safe interpreter -- malicious applet could modify
+ tk::psglyphs array.
+
+2002-06-26 Anton Kovalenko <a_kovalenko@users.sourceforge.net>
+
+ * tests/font.test (font-32.1): updated this test
+ to expect the new behavior of canvas postscript.
+
+2002-06-25 Don Porter <dgp@users.sf.net>
+
+ * unix/Makefile.in: Expanded install-binaries target to create
+ * win/Makefile.in: and install a pkgIndex.tcl file to enable
+ Tk as a loadable package [Patch 521356]
+
+2002-06-25 Anton Kovalenko <a_kovalenko@users.sourceforge.net>
+
+ * library/mkpsenc.tcl: (added) utilities to generate
+ Postscript prolog for current system encoding.
+ * generic/tkCanvPs.c (TkCanvPostscriptCmd): now
+ uses mkpsenc.tcl to generate Postscript prolog.
+ * generic/tkFont.c (TkTextLayoutToPostscript): modified
+ according to patch #546910. Now outputs system-encoded
+ characters (for unibyte) or Adobe glyph names (for
+ multibyte or outside-locale).
+ * tests/canvText.test (canvText-17.1): updated this test
+ to expect the new behavior of canvas postscript.
+
+2002-06-25 Reinhard Max <max@suse.de>
+
+ * unix/tcl.m4: New macro SC_CONFIG_MANPAGES.
+ * unix/configure.in: Added support for symlinks and compression
+ * unix/Makefile.in: when installing the manpages. [Patch 518052]
+ Default is still hardlinks and no compression.
+
+ * unix/mkLinks: generated
+ * unix/configure:
+
+ * unix/README: Added documentation for the new features.
+
+ * unix/configure: Replaced ${exec_prefix}/lib
+ * unix/tcl.m4 (SC_PATH_TCLCONFIG): by ${libdir}.
+
+2002-06-24 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/winWm.test: Verify that both an unmapped
+ and already mapped toplevel are raised and receive
+ the focus when deiconified.
+ * tests/wm.test: Add wm deiconify tests. Check that
+ a toplevel that has never been mapped is not mapped
+ by the deiconify command since it should be done
+ at idle by MapFrame.
+ * win/tkWinWm.c (Tk_WmCmd): Check the WM_NEVER_MAPPED
+ flag while processing the wm deiconify command.
+ The WM_UPDATE_PENDING flag should never be set when
+ WM_NEVER_MAPPED is set, but double check so that
+ the implementation is more explicit and matches
+ the comment just above.
+ Return without invoking TkWmRestackToplevel or
+ TkSetFocusWin on a toplevel that has never been
+ mapped. This fixes a bug where a toplevel is mapped
+ with the wrong size and is then resized by the
+ idle call to MapFrame. [Tk bug 233150]
+
+2002-06-23 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinWm.c (UpdateGeometryInfo): remove the check for a null
+ wrapper introduced in r1.41 on 2002-06-15 because it prevented
+ geometry setting from taking effect if the window was not on the
+ screen. Another check may go in it's place as IsIconic and
+ IsZoomed should not be passed NULL.
+
+2002-06-22 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/wm.test: Remove invalid minsize test. Add update
+ calls to wm transient tests so that idle handlers get
+ run. This is needed to get the tests to pass under Win32.
+ * unix/tkUnixWm.c (WmWaitMapProc): Move the special
+ transient withdrawn check into the if body to
+ make it easier to set a breakpoint on this test
+ inside a debugger. No functional changes.
+ * win/tkWinWm.c (WmWaitVisibilityOrMapProc): Ditto.
+
+2002-06-22 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/wm.n: TIP #95 Windows implementation and
+ * mac/tkMacWm.c (Tk_WmCmd): docs with mac and unix stubs.
+ * unix/tkUnixWm.c (Tk_WmCmd):
+ * win/tkWinWm.c (Tk_WmCmd):
+ * tests/unixWm.test:
+ * tests/winWm.test: more wm attr tests will be needed.
+
+ * generic/tkGrid.c (GridReqProc): check that gridPtr is not NULL
+ (may be when embedded). [Bug #548791] (halliday)
+
+ * generic/tkFont.c (TkFontPkgFree): changed panic on freeing fonts
+ to an assert, and wrapped panic in #ifdef PURIFY. [Bug #568701]
+
+ * library/menu.tcl: corrected menus from being posted offscreen
+ on Windows. [Bug #464451] (darley)
+
+ * library/console.tcl: corrected the defaultPrompt substitution
+ [Bug #553207] and made Tab a default expansion key (like Escape).
+
+ * win/tkWinEmbed.c (EmbedWindowDeleted): added a check for a null
+ containerPtr. The core of this bug is likely elsewhere. [Bug #476176]
+
+ * doc/text.n: TIP #93 implementation that
+ * generic/tkText.c (TextWidgetCmd): enhances the text get and
+ * generic/tkTextIndex.c (TkTextGetIndex): delete methods to accept
+ * tests/text.test: multiple range pairs.
+ This handles the delete case in an atomic, fixed-index fashion.
+
+2002-06-21 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/wm.test: Add tests to make sure a withdrawn
+ transient does not get remapped by state changes
+ in the master.
+ * unix/tkUnixWm.c (Tk_WmCmd, WmWaitMapProc):
+ * win/tkWinWm.c (Tk_WmCmd, WmWaitVisibilityOrMapProc):
+ Add a WM_TRANSIENT_WITHDRAWN flag that gets set by the
+ withdraw, deiconify, or state wm subcommands. Check
+ this flag before mapping a transient when processing
+ a MapNotify event. [Tk bug 570764]
+
+2002-06-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * unix/tk.spec (version), README, win/configure.in, unix/configure.in:
+ * generic/tk.h (TK_RELEASE_*, TK_PATCH_LEVEL): Bumped to beta1.
+
+2002-06-21 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/text.n: TIP #104 implementation which generalizes the
+ * generic/tkText.c: undo/redo stack to not be tied solely to the
+ * generic/tkText.h: text widget. The APIs are still private.
+ * generic/tkUndo.c: This also adds a stack limiting ability and
+ * generic/tkUndo.h: a -maxundo option to the text widget (in
+ * library/text.tcl: addition to the options from TIP #26) should
+ * mac/tkMacDefault.h: users want to limit the undo/redo stack
+ * tests/text.test: (should not be necessary in most cases).
+ * unix/Makefile.in: [Patch #554763] (callewart)
+ * unix/tkUnixDefault.h:
+ * win/Makefile.in:
* win/makefile.vc:
+ * win/tkWinDefault.h:
+
+2002-06-21 Don Porter <dgp@users.sf.net>
+
+ * unix/Makefile.in: Removed unnecessary dependence of tktest
+ * unix/tkAppInit.c: executable on the tcltest executable on
+ Unix. If there are similar dependencies on other platforms, they
+ can probably be removed as well. [Bug 572134].
+
+2002-06-20 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/listbox.n:
+ * generic/tkListbox.c (DisplayListbox):
+ * mac/tkMacDefault.h: TIP #94 implementation adding -activestyle
+ * tests/listbox.test: option to the listbox. This adds the ability
+ * unix/tkUnixDefault.h: to have listboxes look native on Windows, and
+ * win/tkWinDefault.h: "nicer" elsewhere using the 'dotbox' style.
+
+2002-06-20 Peter Spjuth <peter.spjuth@space.se>
+
+ * generic/tkGrid.c: Corrected the test for grid propagate change.
+ [Bug #571433]
+
+2002-06-19 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/panedwindow.test:
+ * generic/tkPanedWindow.c: ensure that sash index is lower bounds
+ checked. [Bug #548727]
+
+2002-06-19 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkClipboard.c (TkClipCleanup): Add code
+ to set dispPtr->clipWindow to NULL, this was
+ accidently removed by last commit. Fixes
+ a crash while running the tests under win32.
+
+2002-06-19 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkBind.c (TkBindDeadWindow):
+ Handle case where Tk_DestroyWindow is invoked
+ on clipboard and send windows.
+ * generic/tkClipboard.c (TkClipCleanup):
+ Invoke Tk_DestroyWindow to cleanup the
+ dispPtr->clipWindow. Call Tcl_Preserve
+ and Tcl_Release on the window to avoid an
+ invalid memory ref on shutdown.
+ * generic/tkEvent.c (Tk_HandleEvent):
+ Panic if XCreateIC is invoked twice for
+ the same window. This should never happen,
+ the check were just added to make sure it
+ does not since this could lead to crashes
+ in XCloseIM.
+ * generic/tkFocus.c (TkFocusDeadWindow):
+ Handle case where Tk_DestroyWindow is invoked
+ on clipboard and send windows.
+ * generic/tkOption.c (TkOptionDeadWindow): Ditto.
+ * generic/tkWindow.c (TkCloseDisplay): Move
+ deletion of dispPtr->winTable after TkpCloseDisplay
+ call since Tk_DestroyWindow uses it and could
+ be called by TkpCloseDisplay for clipboard/send windows.
+ Also invoke ckfree for the dispPtr instead of
+ doing it in TkpCloseDisplay.
+ (Tk_DestroyWindow): Check for a null winPtr->mainPtr
+ before doing certain cleanup tasks so the we can
+ invoke Tk_DestroyWindow on clipboard and send windows.
+ We need to do this so that XDestroyIC will get invoked
+ for the input contexts of each window.
+ * mac/tkMacXStubs.c (TkpCloseDisplay): Don't free
+ the displayPtr since this is now done in TkCloseDisplay.
+ * unix/tkUnixEvent.c (TkpCloseDisplay, OpenIM): Remove
+ conditional compilation around calls to XCloseIM
+ since I am confident that the crashes related to
+ input contexts has been fixed. Don't free
+ the displayPtr since this is now done in TkCloseDisplay.
+ * unix/tkUnixSend.c (TkSendCleanup): Invoke the
+ Tk_DestroyWindow method to cleanup the special
+ send window. This will call XDestroyIC and thereby
+ avoid a crash in XCloseIM. The send window needs
+ to be Tcl_Preserve and Tcl_Release to avoid an
+ invalid memory ref on shutdown.
+ * win/tkWinX.c (TkpCloseDisplay): Don't free
+ the displayPtr since this is now done in TkCloseDisplay.
+ [Tk patch 570902]
+
+2002-06-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tkStyle.c: TIP#48 style engine.
+ See http://purl.org/tcl/tip/48.html for details.
+
+ * generic/tkConfig.c (GetOptionFromObj): Split to allow for access
+ to option tables via name as well as via object.
+ (TkGetOptionSpec): Semi-public interface to GetOption functionality.
+ (DoObjConfig, Tk_RestoreSavedOptions, FreeResources)
+ (GetObjectForOption): Basic style support for configure.
+
+ * generic/tkWindow.c (TkCreateMainWindow, Tk_DestroyWindow): Added
+ calls to set up and tear down the style subsystem.
+
+ * generic/tk.decls, generic/tk.h: Many declarations forming TIP#48
+ public interface.
+
+ * generic/tkInt.decls (TkStylePkgInit,TkStylePkgFree):
+ * generic/tkInt.h (TkGetOptionSpec): Supporting declarations.
+
+ * unix/Makefile.in, win/Makefile.in, win/makefile.vc: Added
+ tkStyle.c to list of generic source files.
+
+2002-06-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/defs.tcl (makeFile): Defined the return value of this
+ procedure to be the filename of the created file, as in the real
+ tcltest package...
+
+2002-06-17 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkImage.c (Tk_ImageObjCmd, DeleteImage): Call
+ Tcl_Preserve and Tcl_Release for the masterPtr->winPtr
+ window to avoid accessing memory that had already
+ been deallocated in DeleteImage.
-2002-08-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2002-06-17 David Gravereaux <davygrvy@pobox.com>
+
+ Trims to support the removal of RESOURCE_INCLUDED from rc
+ scripts from Tcl's accepted FR #565088.
- * unix/tclUnixTest.c (TestfilehandlerCmd): Changed
- readable/writable to the more common readable|writable.
+ * generic/tk.h: Changed RESOURCE_INCLUDED to be RC_INVOKED
+ as the RC tool defines this already by default.
- Fixes SF #596034 reported by Larry Virden
- <lvirden@users.sourceforge.net>.
+ * win/rc/tk.rc:
+ * win/rc/wish.rc: removed the #define RESOURCE_INCLUDED lines.
-2002-08-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+2002-06-17 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in (dist): correct installation of
+ wish.exe.manifest to DISTDIR target directory.
+
+ * generic/tkCmds.c (Tk_TkObjCmd):
+ * generic/tkInt.h (struct TkCaret):
+ * mac/tkMacXStubs.c (Tk_SetCaretPos):
+ * unix/tkUnixKey.c (TkpGetString, Tk_SetCaretPos):
+ * win/tkWinX.c (Tk_SetCaretPos):
+ * tests/tk.test: Added 'tk caret' implementation of TIP#96
+ * doc/SetCaret.3 (new): which adds a TkCaret structure element to
+ * doc/tk.n: TkDisplay for maintaining state.
+
+ * unix/tkUnixSend.c (TkSendCleanup): special cleanup of
+ inputContext to avoid bug in XCloseIM. (dejong)
+
+2002-06-17 Don Porter <dgp@users.sf.net>
+
+ * library/msgs/en_gb.msg: Added catalog for UK English.
+ Currently includes only Color -> Colour translation.
+
+2002-06-17 D. Richard Hipp <drh@hwaci.com>
+
+ * doc/checkbutton.n:
+ * doc/radiobutton.n:
+ * generic/tkButton.c:
+ * generic/tkButton.h:
+ * mac/tkMacButton.c:
+ * tests/button.test:
+ * unix/tkUnixButton.c:
+ * win/tkWinButton.c: Implementation of TIP#82 - Added the
+ -offrelief option to checkbutton and radiobutton.
+
+2002-06-14 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkWindow.c (Tk_DestroyWindow): Set the pathName
+ component of a window to NULL after its memory has been
+ deallocated to avoid a possible illegal memory access
+ as a result of a call to Tk_PathName() on a Tk_Window
+ structure of a window that has already been destroyed.
+ [Tk bug 521946]
+
+2002-06-14 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkOption.c (Tk_GetOption): Allocate
+ memory with ckalloc not malloc. This keeps
+ Tk from erroring out when built with
+ TCL_MEM_DEBUG.
+
+2002-06-14 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkBind.c (HandleEventGenerate):
+ * generic/tkInt.h: changed warpInProgress boolean from int to a
+ bit in the flags variable (TK_DISPLAY_IN_WARP)
+
+ * generic/tkCmds.c (Tk_TkObjCmd):
+ * unix/tkUnixKey.c (TkpGetString):
+ * generic/tkEvent.c (Tk_HandleEvent):
+ * generic/tkInt.h: changed useInputMethods boolean from int to a
+ bit in the flags variable (TK_DISPLAY_USE_IM)
+
+ * generic/tkInt.h:
+ * generic/tkCmds.c (Tk_WmObjCmd):
+ * unix/tkUnixWm.c (Tk_WmCmd):
+ * win/tkWinWm.c (Tk_WmCmd): changed wmTracing from being an int to
+ just a bit in the flags variable (TK_DISPLAY_WM_TRACING)
+
+ * generic/tkEvent.c (Tk_HandleEvent):
+ * unix/tkUnixEvent.c (OpenIM):
+ * unix/tkUnixKey.c (TkpGetString):
+ * generic/tkInt.h: added TK_DISPLAY_XIM_SPOT flag bit for TkDisplay
+ and used this to allow a runtime check to see if over-the-spot XIM
+ is possible. If not it will try and fallback to the old-style
+ input context, which handles things like dead keys input.
+
+ * generic/tk.decls: added TIP #84 implementation that adds a
+ * generic/tkDecls.h: Tk_CollapseMotionEvents API which controls
+ * generic/tkEvent.c: Tk's collapsing of incoming motion events
+ * generic/tkInt.h: on its windows. The default remains to do
+ * generic/tkStubInit.c: collapsing. Added a flags parameter to the
+ * generic/tkWindow.c: internal display structure to support this
+ * doc/QWinEvent.3: and be used in the future for other bits.
+ [Tk patch 564642]
+
+ * unix/mkLinks: updated from current docs
+
+2002-06-14 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkEvent.c (TkXErrorHandler): Declare static
+ function to avoid compiler error with VC++.
+ * generic/tkBind.c (ExpandPercents): Cast argument to
+ Tk_GetAtomName in order to avoid compiler warning.
+
+2002-06-14 Joe English <jenglish@users.sf.net>
+
+ * doc/bind.n:
+ * generic/tk.h:
+ * generic/tkBind.c:
+ * generic/tkCanvWind.c:
+ * generic/tkCmds.c:
+ * generic/tkEvent.c:
+ * generic/tkFocus.c:
+ * generic/tkGrab.c:
+ * generic/tkGrid.c:
+ * generic/tkImage.c:
+ * generic/tkPack.c:
+ * generic/tkPlace.c:
+ * generic/tkPointer.c:
+ * generic/tkTextWind.c:
+ * generic/tkWindow.c:
+ * mac/tkMacSubwindows.c:
+ * mac/tkMacWindowMgr.c
+ * mac/tkMacWm.c:
+ * unix/Makefile.in:
+ * unix/tkUnixEmbed.c:
+ * unix/tkUnixWm.c:
+ * win/tkWinScrlbr.c:
+ * win/tkWinWindow.c:
+ * win/tkWinWm.c: Implementation of TIP #47 by Neil McKay
+ "Modifying Tk to Allow Writing X Window managers".
+ Add CirculateRequest, Create, MapRequest, ResizeRequest,
+ and ConfigureRequest event types;
+ Split TK_TOPLEVEL flag into TK_TOPLEVEL, TK_HAS_WRAPPER,
+ TK_WIN_MANAGED, and TK_TOP_HIERARCHY. [Tk patch 572978]
+
+2002-06-14 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * unix/tkAppInit.c: Removed now unneeded and erroneous reference
+ to 'matherr'. See Tcl ChangeLog entry 2002-05-31 Don Porter.
- * tests/fCmd.test: Added test to make sure that the cause of the
- problem is detectable with an unpatched Tcl.
- * doc/ObjectType.3: Added note on the root cause of this problem
- to the documentation, since it is possible for user code to
- trigger this sort of behaviour too.
- * generic/tclIOUtil.c (SetFsPathFromAny): Objects should only have
- their old representation deleted when we know that we are about to
- install a new one. This stops a weird TclX bug under Linux with
- certain kinds of memory debugging enabled which essentally came
- down to a double-free of a string.
+2002-06-14 David Gravereaux <davygrvy@pobox.com>
+
+ * win/rules.vc: The test for compiler optimizations was in error.
+ Thanks goes to Roy Terry <royterry@earthlink.net> for his
+ assistance with this.
-2002-08-14 Miguel Sofer <msofer@users.sourceforge.net>
+2002-06-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclInt.h:
- * generic/tclObj.c: (code cleanup) factored the parts in the macros
- TclNewObj() / TclDecrRefCount() into a common part for all
- memory allocators and two new macros TclAllocObjStorage() /
- TclFreeObjStorage() that are specific to each allocator and fully
- describe the differences. Removed allocator-specific code from
- tclObj.c by using the macros.
+ Implement TIP 98 [Tk patch 566765]
-2002-08-12 Miguel Sofer <msofer@users.sourceforge.net>
+ * doc/FindPhoto.3, generic/tk.h, generic/tk.decls:
+ * generic/tkImgPhoto.c: Changed *_Old to *_NoComposite and
+ USE_OLD_PHOTO_PUT_BLOCK to USE_COMPOSITELESS_PHOTO_PUT_BLOCK
+ following a suggestion from Don Porter.
+
+ * tests/imgPhoto.test: Added tests of -compositingrule
+
+ * doc/photo.n: Added documentation for "-compositingrule".
+ * generic/tkImgPhoto.c (ImgPhotoCmd, ParseSubcommandOptions): New
+ "-compositingrule" option for [$photo copy] subcommand, using
+ OPT_COMPOSITE flag and compositingRule field in SubcommandOptions
+ structure.
+
+ * doc/FindPhoto.3: Documented the extra argument for the
+ compositing rule and the action to take if anyone wants to
+ maintain total backward-compatability.
+
+ * generic/tk.h (TK_PHOTO_COMPOSITE_*): Defined values for use as
+ compositing rules.
+ (USE_OLD_PHOTO_PUT_BLOCK): Added a way for users to select the old
+ interface to Tk_PhotoPutBlock to provide an easier upgrade path.
+
+ * generic/tk.decls: Alter Tk_PhotoPut*Block to Tk_PhotoPut*Block_Old
+ and introduce new slots for the old name of function with an extra
+ argument at the end for the compositing rule.
+
+ * generic/tkImgPhoto.c (ImgPhotoCmd): Updated "transparency set"
+ subcommand to use TkSubtractRegion().
+
+ * win/tkWinRegion.c (TkSubtractRegion):
+ * mac/tkMacRegion.c (TkSubtractRegion):
+ * generic/tkInt.decls (TkSubtractRegion):
+ * unix/tkUnixPort.h (TkSubtractRegion): Added function to perform
+ the set-difference operation on regions; it seems all platforms
+ can support it, and it makes removing rectangular bits from
+ regions much easier.
+
+ * generic/tkImgPPM.c (FileReadPPM): Reading a PPM/PGM always uses
+ the SET compositing rule because it is faster and the format does
+ not have any transparency information.
+
+ * generic/tkImgGIF.c (FileReadGIF): Reading a GIF always uses the
+ SET compositing rule because GIF files model transparency as a
+ single special colour.
+
+ * generic/tkImgPhoto.c (Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock):
+ Added a compositing rule to allow better control over what happens
+ to transparent pixels when inserting data into a photo image.
- * generic/tclCmdMZ.c: fixing UMR in delete traces, [Bug 589863].
+2002-06-13 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/winfo.test: Add basic tests for winfo ismapped.
+
+2002-06-13 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/unixWm.test:
+ * tests/wm.test: Move wm minsize and wm maxsize
+ usage tests into the cross platform wm tests.
+
+2002-06-13 Don Porter <dgp@users.sf.net>
+
+ * tests/cursor.test: corrected error after cursor-2.2.
+ * tests/defs.tcl: Added enhancements to Tk's fake version of
+ tcltest required by recent cursor.test changes.
+
+2002-06-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/cursor.test (cursor-2.[34]): Tests added to ensure that
+ cursor specs really are well-behaved lists. Also some general
+ clean-up...
+ * win/tkWinCursor.c (TkGetCursorByName): Undone Jeff's back-off
+ and fixed things so that they should work now. Cursor specs are
+ lists first and foremost.
+
+2002-06-12 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * changes: Clearly label wm transient changes as
+ a POTENTIAL INCOMPATIBILITY.
+ * doc/wm.n: Remove "some window managers will" text
+ and explicitly state what behavior a transient
+ window will display. Also mention that it is an
+ error to make a window a transient of itself.
+
+2002-06-12 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * library/choosedir.tcl (tk::dialog::file::chooseDir):
+ * library/clrpick.tcl (tk::dialog::file::chooseDir):
+ * library/msgbox.tcl (tk::MessageBox):
+ * library/tkfbox.tcl (tk::dialog::file):
+ * library/xmfbox.tcl (tk::MotifFDialog): Remove the
+ transient property on dialogs after they have been
+ dismissed to insulate them from further state changes
+ in the master. This keeps a withdrawn dialog from
+ being mapped when the master is deiconified. [Tk patch 568278]
+
+2002-06-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinCursor.c (TkGetCursorByName): reverted fix from
+ 2002-06-06 because it broke the ability to use built-in cursors
+ like left_ptr.
+
+2002-06-12 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * library/choosedir.tcl (tk::dialog::file::chooseDir):
+ * library/clrpick.tcl (tk::dialog::color):
+ * library/dialog.tcl (tk_dialog):
+ * library/msgbox.tcl (tk::MessageBox):
+ * library/tkfbox.tcl (tk::dialog::file):
+ * library/xmfbox.tcl (tk::MotifFDialog_Create):
+ Only make the dialog window a transient if
+ the master is visible. This check already
+ appeared in some of the dialogs. This patch
+ just copies the check into those that were
+ lacking. [Tk patch 568253]
+
+2002-06-12 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * changes: Add note about new transient behavior.
+ * tests/unixWm.test: Check that the WM_TRANSIENT_FOR
+ property for a transient window is being cleared
+ when the master is destroyed.
+ * tests/wm.test: Source defs.tcl instead of using
+ tcltest to match the rest of Tk's test files.
+ Add new tests that ensure that a transient's state
+ mirrors the state of the master.
+ * unix/tkUnixWm.c (WmInfo, TkWmNewWindow, TkWmMapWindow,
+ TkWmDeadWindow, Tk_WmCmd, WmWaitMapProc): Add numTransients
+ member to WmInfo structure. Keep state of master and
+ transient in sync using a callback that tracks MapNotify
+ and UnmapNotify events. When the master is mapped, map
+ the transient. When the master is unmapped or iconified,
+ withdraw the transient.
+ * win/tkWinWm.c (TkWmMapWindow, TkpWmSetState,
+ TkWmDeadWindow, Tk_WmCmd, WmWaitVisibilityOrMapProc):
+ Keep state of master and transient in sync using a
+ callback that tracks MapNotify and UnmapNotify events.
+ Move masterPtr check from TkpWmSetState into TkWmMapWindow
+ to deal with WM_NEVER_MAPPED transients. Cleanup
+ numTransients and the callback in TkWmDeadWindow.
+ Cleanup numTransients and the callback only after
+ deleting a master in wm transient command to avoid
+ deleting the callback when an error is raised.
+ Add support for MapNotify and UnmapNotify events
+ to the master callback. [Tk patch 561708]
+
+2002-06-11 Joe English <jenglish@users.sf.net>
+
+ * library/menu.tcl: fix for bug report #530212 "Bad Window Path
+ Name in tkMenuFind"
+
+2002-06-10 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: Fixed a win98 issue where the /exclude option
+ for xcopy is unsupported.
+ Reported by Roy Terry <royterry@earthlink.net>.
+
+2002-06-10 Anton Kovalenko <a_kovalenko@users.sourceforge.net>
+
+ * library/tk.tcl: added utility functions to get "-underline" and
+ "-text" for labels and buttons from translatable string containing
+ "magic ampersand" [patch #566605]
+ * library/clrpick.tcl:
+ * library/msgbox.tcl:
+ * library/tkfbox.tcl:
+ * library/xmfbox.tcl: some places where msgcat is used to get
+ translated label are modified to handle labels with magic ampersand.
+ * library/msgs/ru.msg: russian translations added
+ * library/msgs/cs.msg:
+ * library/msgs/de.msg:
+ * library/msgs/el.msg:
+ * library/msgs/es.msg:
+ * library/msgs/fr.msg:
+ * library/msgs/it.msg:
+ * library/msgs/nl.msg: all translation files now have labels with
+ 'magic ampersand' where appropriate. In el.msg some ampersands are
+ missing, as I don't know which underline positions seems natural
+ to "el" users.
+
+2002-06-09 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * library/bgerror.tcl (tk::dialog::error::bgerror):
+ Don't set the bgerror dialog as a transient of
+ itself since this operation is ill defined.
+
+2002-06-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * win/tkWinCursor.c (TkGetCursorByName): Fixed so that the reading
+ of cursors from a file with a cursor spec was built using [list]
+ works when the file has a space in instead of requiring fiddling
+ with backslashes.
+
+2002-06-06 Anton Kovalenko <a_kovalenko@users.sourceforge.net>
+
+ * library/msgbox.tcl (MessageBox): Add -default normal
+ when creating non-default buttons for message box.
+ They already get -default normal when they're
+ unfocused, and dialog window size used to change suddenly
+ in such cases.
+
+2002-06-05 Anton Kovalenko <a_kovalenko@users.sourceforge.net>
+
+ * unix/tkUnixFont.c (Tk_DrawChars): Don't assume that
+ one char is always one byte, and that required
+ subfont for the last character in any string is
+ the same as for the previous character
+ [Bug #559435] [Patch #559437]
+
+2002-05-27 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * changes: Document [wm transient .t .t] error.
+ * tests/wm.test: Check that setting a window
+ as a transient of itself raises an error. Check
+ that passing a non-toplevel window to the wm
+ transient command uses the enclosing toplevel.
+ * unix/tkUnixWm.c (Tk_WmCmd): Raise an error
+ if the user tries to make a toplevel a
+ transient of itself.
+ * win/tkWinWm.c (Tk_WmCmd): Raise an error
+ if the user tries to make a toplevel a
+ transient of itself. Test for other error
+ before checking for the transient self error.
+
+2002-05-27 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/tkUnixWm.c (WmInfo, TkWmCleanup, TkWmNewWindow,
+ TkWmMapWindow, TkWmDeadWindow, Tk_WmCmd): Replace
+ WmInfo's master and masterWindowName members with
+ a masterPtr member. This implementation is much
+ simpler and mirrors the Win32 implementation. This
+ change makes it easy to check the flags of the
+ master window. No user visible changes.
+
+2002-05-27 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tkInt.decls: Add unix decl for TkpWmSetState.
+ * generic/tkIntPlatDecls.h: Regen.
+ * generic/tkStubInit.c: Regen.
+ * tests/wm.test: Test state changes between iconic,
+ normal, and withdrawn both before and after initial
+ mapping.
+ * unix/tkUnixWm.c (Tk_WmCmd, TkpWmSetState): Move
+ state change code into TkpWmSetState to more closely
+ match the Win32 implementation. No user visible changes.
+
+2002-05-27 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/embed.test: Added cross platform embed tests.
+ Check that window passed to -use has the -container
+ option set.
+ * tests/wm.test: Remove useless catch call. Deiconify
+ . just in case, stackorder tests will not pass unless
+ it is in the normal state. Add -container flag to
+ embedded stackorder test.
+ * unix/tkUnixEmbed.c (TkpUseWindow):
+ * win/tkWinEmbed.c (TkpUseWindow): Lookup Tk window
+ based on the id passed in as the value for -use.
+ Generate an error if the Tk window did not have
+ the -container option set.
+
+2002-05-26 Peter Spjuth <peter.spjuth@space.se>
+
+ * generic/tkButton.c (ConfigureButton): When creating
+ a radiobutton with -value "" it was not drawn properly
+ if the -variable was created by the radiobutton.
+ [Bug #548765]
+
+2002-05-26 Peter Spjuth <peter.spjuth@space.se>
+
+ * generic/tkCanvText.c (ComputeTextBbox): Negative
+ coordinates were rounded badly causing a 1 pixel
+ displacement. [Bug #556526]
-2002-08-08 David Gravereaux <davygrvy@pobox.com>
+2002-05-24 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * mac/tkMacWm.c (Tk_WmCmd):
+ * tests/unixWm.test: Move wm transient checks over
+ to wm.test so they will be run on all systems.
+ * tests/wm.test: Add tests to check for error when
+ an iconwindow is passed to the wm transient command.
+ * unix/tkUnixWm.c (Tk_WmCmd):
+ * win/tkWinWm.c (Tk_WmCmd): Raise an error if one
+ of the windows passed to the wm transient command
+ is an iconwindow for another toplevel.
+
+2002-05-23 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * mac/tkMacWm.c (TkWmStackorderToplevelWrapperMap):
+ * tests/wm.test: Add embedded Window test case for
+ the stackorder command.
+ * unix/tkUnixWm.c (TkWmStackorderToplevelWrapperMap):
+ * win/tkWinWm.c (TkWmStackorderToplevelWrapperMap):
+ Ignore embedded windows during wm stackorder command.
- * tools/man2help.tcl: Fixed $argv handling bug where if -bitmap
- wasn't specified $argc was off by one.
+2002-05-21 Mo DeJong <mdejong@users.sourceforge.net>
-2002-08-08 Miguel Sofer <msofer@users.sourceforge.net>
+ * unix/configure: Regen.
+ * unix/configure.in: Invoke SC_ENABLE_SHARED before
+ calling SC_CONFIG_CFLAGS so that the SHARED_BUILD
+ variable can be checked inside SC_CONFIG_CFLAGS.
+ * unix/tcl.m4: Update from Tcl.
- * tests/uplevel.test: added 6.1 to test [uplevel] with shadowed
- commands [Bug 524383]
+2002-05-20 Don Porter <dgp@users.sourceforge.net>
- * tests/subst.test: added 5.8-10 as further tests for [Bug 495207]
+ * library/tk.tcl: A little namespace cleanup on Daniel Steffen's
+ latest revisions to avoid defining new global commands.
-2002-08-08 Don Porter <dgp@users.sourceforge.net>
+2002-05-20 Daniel Steffen <das@users.sourceforge.net>
- * tests/README: Noted removal of defs.tcl.
+ * mac/tkMacInit.c:
+ * mac/tkMacTclCode.r: include msgcat package in resources
+ as bgerror depends on it. Restores ability of mac static
+ build to run standalone (except for encoding file issues).
-2002-08-08 Jeff Hobbs <jeffh@ActiveState.com>
+ * mac/tkMacInit.c:
+ * library/console.tcl:
+ * library/tk.tcl: fix tk.tcl not sourcing library files
+ that define bindings at startup on mac. (independent of
+ tk library files being in resources or on auto_path)
- * doc/lsearch.n: corrected lsearch docs to use -inline in examples.
+2002-05-08 Don Porter <dgp@users.sourceforge.net>
- *** 8.4b2 TAGGED FOR RELEASE ***
+ * library/bgerror.tcl:
+ * library/tclIndex: Cleaned up namespace usage of the bgerror
+ dialog. Completes soft dependence on msgcat. [FR 539309]
- * tests/fCmd.test:
- * tests/unixFCmd.test: updated tests for new link copy behavior.
- * generic/tclFCmd.c (CopyRenameOneFile): changed the behavior to
- follow links to endpoints and copy that file/directory instead of
- just copying the surface link. This means that trying to copy a
- link that has no endpoint (danling link) is an error.
- [Patch #591647] (darley)
- (CopyRenameOneFile): this is currently disabled by default until
- further issues with such behavior (like relative links) can be
- handled correctly.
-
- * tests/README: slight wording improvements
-
-2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
-
- * docs/BoolObj.3: added description of valid string reps for a
- boolean object [Bug 584794]
- * generic/tclObj.c: optimised Tcl_GetBooleanFromObj and
- SetBooleanFromAny to avoid parsing the string rep when it can be
- avoided [Bugs 584650, 472576]
-
-2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclCompile.h:
- * generic/tclObj.c: making tclCmdNameType static ([Bug 584567],
- Don Porter).
-
-2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclObj.c (Tcl_NewObj): added conditional code for
- USE_THREAD_ALLOC; objects allocated through Tcl_NewObj() were
- otherwise being leaked. [Bug 587488] reported by Sven Sass.
-
-2002-08-06 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclInt.decls:
- * unix/tclUnixThrd.c: Added stubs and implementations for
- non-threaded build for the tclUnixThrd.c procs TclpReaddir,
- TclpLocaltime, TclpGmtime and TclpInetNtoa.
- Fixes link errors in stubbed & threaded extensions that include
- tclUnixPort.h and use any of the procs readdir, localtime,
- gmtime or inet_ntoa (e.g. TclX 8.4) [Bug 589526]
- * generic/tclIntPlatDecls.h:
- * generic/tclStubInit.c: Regen.
-
-2002-08-05 Don Porter <dgp@users.sourceforge.net>
-
- * library/tcltest/tcltest.tcl: The setup and cleanup scripts are now
- * library/tcltest/pkgIndex.tcl: skipped when a test is skipped, fixing
- * tests/tcltest.test: [Bug 589859]. Test for bug added, and
- corrected tcltest package bumped to version 2.2.
-
- * generic/tcl.decls: Restored Tcl_Concat to return (char *). Like
- * generic/tclDecls.h: Tcl_Merge, it transfers ownership of a dynamic
- * generic/tclUtil.c: allocated string to the caller.
-
-2002-08-04 Don Porter <dgp@users.sourceforge.net>
-
- * doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify
- * doc/Concat.3: all remaining public interfaces of Tcl.
- * doc/CrtCommand.3: Notably, the parser no longer writes on
- * doc/CrtSlave.3: the string it is parsing, so it is no
- * doc/CrtTrace.3: longer necessary for Tcl_Eval() to be
- * doc/Eval.3: given a writable string. Also, the
- * doc/ExprLong.3: refactoring of the Tcl_*Var* routines
- * doc/LinkVar.3: by Miguel Sofer is included, so that the
- * doc/ParseCmd.3: "part1" argument for them no longer needs
- * doc/SetVar.3: to be writable either.
- * doc/TraceVar.3:
- * doc/UpVar.3: Compatibility support has been enhanced so
- * generic/tcl.decls that a #define of USE_NON_CONST will remove
- * generic/tcl.h all possible source incompatibilities with
- * generic/tclBasic.c the 8.3 version of the header file(s).
- * generic/tclCmdMZ.c The new #define of USE_COMPAT_CONST now does
- * generic/tclCompCmds.c what USE_NON_CONST used to do -- disable
- * generic/tclCompExpr.c only those new CONST's that introduce
- * generic/tclCompile.c irreconcilable incompatibilities.
- * generic/tclCompile.h
- * generic/tclDecls.h Several bugs are also fixed by this patch.
- * generic/tclEnv.c [Bugs 584051,580433] [Patches 585105,582429]
- * generic/tclEvent.c
- * generic/tclInt.decls
- * generic/tclInt.h
- * generic/tclIntDecls.h
- * generic/tclInterp.c
- * generic/tclLink.c
- * generic/tclObj.c
- * generic/tclParse.c
- * generic/tclParseExpr.c
- * generic/tclProc.c
- * generic/tclTest.c
- * generic/tclUtf.c
- * generic/tclUtil.c
- * generic/tclVar.c
- * mac/tclMacTest.c
- * tests/expr-old.test
- * tests/parseExpr.test
- * unix/tclUnixTest.c
- * unix/tclXtTest.c
- * win/tclWinTest.c
-
-2002-08-01 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c: bugfix (reading freed memory). Testsuite
- passed on linux/i386, compile-13.1 hung on linux/alpha.
-
-2002-08-01 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c: added a reference count for the complete
- execution stack, instead of Tcl_Preserve/Tcl_Release.
-
-2002-08-01 Mo DeJong <mdejong@users.sourceforge.net>
-
- * generic/tclCkalloc.c (TclFinalizeMemorySubsystem):
- Don't lock the ckalloc mutex before invoking the
- Tcl_DumpActiveMemory function since it also
- locks the same mutex. This code is only executed
- when "memory onexit filename" has been executed
- and Tcl is compiled with -DTCL_MEM_DEBUG.
-
-2002-08-01 Reinhard Max <max@suse.de>
-
- * win/tclWinPort.h: The windows headers don't provide socklen_t,
- so we have to do it.
-
-2002-07-31 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclInt.h (USE_THREAD_ALLOC): for unshared objects,
- TclDecrRefCount now frees the internal rep before the string rep -
- just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802].
- For the other allocators the fix was done on 2002-03-06.
-
-2002-07-31 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclInterp.c: signed/unsigned comparison warning fixed
- (Vince Darley).
+2002-05-07 David Gravereaux <davygrvy@pobox.com>
+ * win/makefile.vc: Problem with TCLDIR macro not accepting
+ forward slash path seperators resolved. Added the same logic
+ to INSTALLDIR, too. [Bug #553208]
-2002-07-31 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+2002-04-26 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure:
+ * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so
+ that the .sl knows its dependent libs.
+
+2002-04-24 Daniel Steffen <das@users.sourceforge.net>
+
+ * mac/tkMacTclCode.r:
+ * mac/tkMacResource.r: added check of
+ TCLTK_NO_LIBRARY_TEXT_RESOURCES #define to allow disabling the
+ inclusion of the tk library code in the resource fork of Tk
+ executables and shared libraries.
+ Moved tk library code inclusion to separate file like in tcl.
+ Added 'panedwindow' resource.
- * unix/tcl.m4 (SC_BUGGY_STRTOD): Enabled caching of test results.
+2002-04-22 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/tcl.m4 (SC_BUGGY_STRTOD): Solaris 2.8 still has a buggy
- strtod() implementation; make sure we detect it.
+ * library/button.tcl (ButtonLeave): corrected the 3
+ implementations of ButtonLeave to check for Priv(relief) existing
+ before trying to use it. [Patch #541849]
+
+ * generic/tkTextDisp.c (DisplayLineBackground):
+ * unix/tkUnix3d.c (Tk_3DHorizontalBevel):
+ * unix/tkUnixFont.c (Tk_DrawChars): applied fixes to not overrun
+ the X window 16-bit size limit. [Patch #541999] (bonfield)
+
+2002-04-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tkTextDisp.c (GetXView, GetYView): Comparison with
+ previous values of scrollbar range are now done in a way that is
+ sensitive to the bizarreness of floating-point on architectures
+ where IEEE-FP is not used on the processor. Also increased the
+ size of the temporary buffer to take account of the fact that
+ TCL_DOUBLE_SPACE is meant to only imply enough space to take a
+ printed double and trailing '\0', and no more. [Bug #223739]
+ (FP_EQUAL_SCALE): New macro to help compare floating-point numbers
+ for equality in a sane way, used in GetXView and GetYView.
+
+2002-04-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkWindow.c (TkCloseDisplay): Added to centralize where a
+ display was closed. This handles freeing memory associated with a
+ display and closing it.
+ (DeleteWindowsExitProc): actually close displays. This would also
+ ideally be done in Tk_DestroyWindow when the last window on the
+ display has been closed, but that still has unresolved order of
+ cleanup problems.
+ (Tk_DestroyWindow): added TkFocusFree call.
+
+ * generic/tkStubInit.c:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkIntDecls.h:
+ * generic/tkInt.decls: added TkFocusFree, TkClipCleanup and
+ TkGCCleanup generic private procs, and TkWmCleanup, TkSendCleanup
+ and TkFreeXId unix private procs.
+
+ * generic/tkInt.h:
+ * unix/tkUnixXId.c (TkFreeXId): frees XID resources.
+ Made idCleanupScheduled a Tcl_TimerToken (was int) in TkDisplay
+ structure to allow us to delete the timer scheduled for it.
+
+ * unix/tkUnixWm.c (TkWmStackorderToplevel): ensure children
+ structure is freed.
+ (ConfigureEvent, ComputeReparentGeometry): Add extra wm tracing info
+ (TkWmRestackToplevel): initialize changes to 0 to prevent UMR.
+ Use WaitForConfigureNotify on all windows. This part still
+ requires fixing as it is the root of the 2 second raise delay on
+ some window managers (those that use extra wrapper windows of
+ their own).
+
+ * unix/tkUnixSend.c (TkSendCleanup): free send-related resources
+
+ * unix/tkUnixEvent.c (TkpCloseDisplay): call TkSendCleanup and
+ TkWmCleanup.
+
+ * unix/tkUnixSelect.c (SelRcvIncrProc): added missing Tcl_Release
+ of interp
+
+ * generic/tkGet.c (FreeUidThreadExitProc): free thread-specific
+ resources on thread exit
+
+ * generic/tkFocus.c (TkFocusFree): frees TkMainInfo data
+ * generic/tkClipboard.c (TkClipCleanup): frees TkDisplay data
+ * generic/tkGC.c (TkGCCleanup): frees TkDisplay data
+
+ * unix/tkUnixFont.c (FontPkgCleanup): cleanup thread specific font
+ resources on thread exit.
+
+ * mac/tkMacXStubs.c (TkpOpenDisplay): memset the initial display
+ structures to 0.
+
+ * generic/tkOption.c (OptionThreadExitProc): freed tsd option
+ stacks on thread exit.
+ (Tk_GetOption): free mem used to get Tk_Uid
+
+ * generic/tkMenu.c (ConfigureMenu): freed saved options in all
+ error cases.
+
+ * win/tkWinInt.h: declaration for TkWinGetUnicodeEncoding
+ * win/tkWinDialog.c (GetFileNameW): use TkWinGetUnicodeEncoding
+ * win/tkWinInit.c (TkpDisplayWarning): use TkWinGetUnicodeEncoding
+ * win/tkWinFont.c: use TkWinGetUnicodeEncoding instead of static
+ unicodeEncoding.
+
+ * win/tkWinX.c (Tk_SetCaretPos): remove WM_IME_STARTCOMPOSITION
+ and place the IME position within Tk_SetCaretPos. Cache results in
+ Tk_SetCaretPos to reduce unnecessary repositioning. Also call
+ DestroyCaret if we receive WM_KILLFOCUS.
+ (TkpOpenDisplay): ZeroMemory the initial display structures.
+ (TkWinGetUnicodeEncoding): Added so that Windows only needs to
+ cache this value one, and then free it in TkWinXCleanup.
+ (HandleIMEComposition): add support for Win98 and ATOK13
+ IME. (yamamoto)
+
+ * generic/tkConsole.c (ConsoleCmd): correct return that should
+ have just set result code.
+
+ * generic/tkImgPhoto.c: Added PhotoFormatThreadExitProc to clean
+ up on thread exit. (Tk_PhotoPutBlock) slight code updates
+
+ * generic/tkPanedWindow.c (DestroyPanedWindow, ConfigureSlaves):
+ fix mem leaks in not freeing slave info
- * tests/expr.test (expr-22.*): Marked as non-portable because it
- seems that these tests have an annoying tendency to fail in
- unexpected ways. [Bugs 584825, 584950, 585986]
+ * win/configure:
+ * win/tcl.m4: Enabled COFF as well as CV style debug info with
+ --enable-symbols to allow Dr. Watson users to see function info.
+ More info on debugging levels can be obtained at:
+ http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp
-2002-07-30 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2002-04-10 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/io.test:
- * generic/tclIO.c (WriteChars): Added flag to break out of loop if
- nothing of the input is consumed at all, to prevent infinite
- looping of called with a non-UTF-8 string. Fixes Bug 584603
- (partially). Added new test "io-60.1". Might need additional
- changes to Tcl_Main so that unprintable results are printed as
- binary data.
+ * doc/wm.n:
+ * mac/tkMacWm.c:
+ * tests/wm.test:
+ * unix/tkUnixWm.c:
+ * win/tkWinWm.c: Update wm stackorder usage message
+ to make it clear that either 1 or 3 arguments are
+ required. [Bug 540013]
-2002-07-29 Mo DeJong <mdejong@users.sourceforge.net>
+2002-04-08 Daniel Steffen <das@users.sourceforge.net>
+
+ * mac/tkMacProjects.sea.hqx: added tkPanedWindow.c to projects
+ * mac/tkMacAppInit.c: fixes to MSL stdin/stdout hookup to the
+ TkConsole when using shared MSL libraries; fix for crashing
+ bug on exit: writing to stdin/sterr when console has already
+ been destroyed. (both fixes need support in MSL, see
+ 'CW Pro6 changes' in tcl/mac/tcltkMacBuildSupport.sea.hqx)
+ * mac/tkMacDialog.c: fixes to Navigation Services Dialog filter.
+ * mac/tkMacDraw.c: add panic for overwide TkImages that would
+ crash Tk on mac otherwise.
+
+2002-04-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * mac/tkMacXStubs.c: added Tk_SetCaretPos stub (does nothing).
+ * win/tkWinX.c: added Tk_SetCaretPos code to position IME windows
+ correctly when WM_IME_STARTCOMPOSITION is received.
+ * unix/tkUnixKey.c: added Tk_SetCaretPos and code for setting
+ XIM caret in TkpGetString.
+
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h:
+ * generic/tk.decls: added Tk_SetCaretPos declaration. This command
+ allows users to indicate the cursor position and is used by XIM
+ (Unix) or IME (Windows) to place the caret box correctly. It is
+ also part of correct Accessibility style on Windows to make the
+ magnifier jump to the focus point.
+
+ * win/tkWinButton.c (TkpDisplayButton):
+ * generic/tkTextMark.c (TkTextInsertDisplayProc):
+ * generic/tkCanvText.c (DisplayCanvText):
+ * generic/tkEntry.c (DisplayEntry): added Tk_SetCaretPos calls
+
+ * generic/tkInt.h: added TK_XIM_SPOT #define (default 1).
+ Added XFontSet attribute to TkDisplay when TK_XIM_SPOT is true.
+ * generic/tkEvent.c (Tk_HandleEvent): made sure inputContexts are
+ not getting created on DestroyNotify events (for dead windows).
+ Added over-the-spot support if TK_XIM_SPOT is defined (default).
+ The is the nicer XIM behavior, but uses a bit more memory.
+
+ * unix/tkUnixEvent.c:
+ * generic/tkWindow.c: moved OpenIM over to tkUnixEvent.c.
+ Removed setting inputContext to null in Tk_MakeWindowExist as it
+ was redundant.
+
+ * unix/tkUnixWm.c (CreateWrapper): Removed redundat setting of
+ inputContext to null.
+
+ * win/Makefile.in: changed gdb and shell targets to properly build
+ all binaries before running (otherwise an error often occured).
+
+2002-03-28 David Gravereaux <davygrvy@pobox.com>
+
+ * win/.cvsignore (new):
+ * win/lamp.bmp (new):
+ * win/makefile.vc:
+ * win/nmakehlp.c (new):
+ * win/rules.vc: Brought the makefile up-to-date with Tcl's one.
+ This now has support for Win9x issues and the winhelp target now
+ exists. Color scheme can be changed. I'm just imparting a first
+ suggestion using orange :) I'll have to think about the install
+ portion of the helpfile as I'll need to do some tricks to insert
+ tk's contents file into Tcl's using some special winhlp32.exe
+ switches. [Bug 533862 527941]
+
+ * win/makefile.vc: Tk helpfile is now installing itself into Tcl's
+ contents file as part of the install target and rebuilding the
+ contents table as desired. [Bug 527941]
+
+ * doc/console.n: Changed topic from "Tcl Built-In Commands" to
+ "Tk Built-In Commands"
+
+ * win/buildall.vc.bat: Update to match Tcl.
+
+2002-03-26 Andreas Kupries <andreask_kupries@users.sourceforge.net>
+
+ * unix/tkUnixFont.c: Added inclusion of <arpa/inet.h>. This fixes
+ a GCC/HPUX problem with missing a "htons". See also
+ "tclUnixPort.h" for equivalent code.
+
+2002-03-21 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: Changed optimize flag to -0ti instead of -02.
+ [Bug 528441]
+
+2002-03-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tkButton.c (ButtonTextVarProc,ButtonVarProc):
+ * generic/tkCmds.c (WaitVariableProc):
+ * generic/tkEntry.c (EntryTextVarProc):
+ * generic/tkListbox.c (ListboxListVarProc):
+ * generic/tkMenu.c (MenuVarProc):
+ * generic/tkMenubutton.c (MenuButtonTextVarProc):
+ * generic/tkMessage.c (MessageTextVarProc):
+ * generic/tkScale.c (ScaleVarProc): Updates to handle change in
+ type of part2 argument of Tcl_VarTraceProc typedef. [TIP 27]
+ [Patch 532644].
+
+2002-03-19 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkOldConfig.c (Tk_ConfigureValue): prevent leaving
+ interp->result as NULL.
+
+2002-03-07 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/text.tcl (TextPasteSelection): Renaming of TextPaste to
+ prevent confusion with tk_textPaste. Stopped code from inserting
+ selections twice, which seems to have happened with TIP#26, and
+ reorganized code to reduce amount of stuff protected by catch
+ which is tricky to maintain.
+ (tk_textPaste): Reduce amount of code protected by catch.
+
+2002-03-06 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/tkWinX.c: Define _WIN32_IE as 0x0300
+ before including commctrl.h so that we can
+ access the InitCommonControlsEx API when
+ building Tk with mingw.
+
+2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * README, generic/tk.h, unix/configure.in, unix/tk.spec:
+ * win/configure.in: Bumped patchlevel; this might need to change
+ in the future, but it will help us distinguish between the CVS
+ version and the most recent released version.
+
+2002-03-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ *** 8.4a4 TAGGED FOR RELEASE ***
+
+ * unix/README: updated --* options docs.
+
+ * unix/tk.spec: fixed URL refs to use www.tcl.tk or SF.
+
+2002-03-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * README:
+ * mac/README:
+ * unix/README:
+ * win/README: updated to use www.tcl.tk URL.
+
+2002-03-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/entry.tcl: added catch around Triple-1 binding use of
+ sel.last
+
+2002-02-28 Don Porter <dgp@users.sourceforge.net>
+
+ * library/console.tcl (ConsoleBind): Corrected console <<Paste>>
+ binding on Unix platforms.
+
+2002-02-26 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/Makefile.in: Use CC_SEARCH_FLAGS instead of
- LD_SEARCH_FLAGS when linking with ${CC}.
* unix/configure: Regen.
- * unix/configure.in: Don't subst CC_SEARCH_FLAGS or
- LD_SEARCH_FLAGS since this is now done in tcl.m4.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Document and
- set CC_SEARCH_FLAGS whenever LD_SEARCH_FLAGS is set.
- [Tcl patch 588290]
-
-2002-07-29 Reinhard Max <max@suse.de>
-
- * unix/tcl.m4 (SC_SERIAL_PORT): Fixed detection for cases when
- configure's stdin is not a tty.
-
- * unix/tclUnixPort.h:
- * generic/tclIOSock.c: Changed size_t to socklen_t in
- socket-related function calls.
-
- * unix/configure.in: Added test and fallback definition
- for socklen_t.
-
- * unix/configure: generated.
-
-2002-07-29 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclObj.c: fixed a comment
-
- * generic/tcl.h:
- * generic/tclBasic.c:
- * generic/tclInterp.c: added the new flag TCL_EVAL_INVOKE to
- the interface of the Tcl_Eval* functions, removing the
- TCL_EVAL_NO_TRACEBACK added yesterday: alias invocations not only
- require no tracebacks, but also look up the command name in the
- global scope - see new test interp-9.4
- * tests/interp.test: added 9.3 to test for safety of aliases to
- hidden commands, 9.4 to test for correct command lookup scope.
-
-2002-07-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * generic/regc_locale.c (cclass): [[:xdigit:]] is only a defined
- concept on western characters, so should not allow any unicode
- digit, and hence number of ranges in [[:xdigit:]] is fixed.
- * tests/reg.test: Added test to detect the bug.
- * generic/regc_cvec.c (newcvec): Corrected initial size value in
- character vector structure. [Bug 578363] Many thanks to
- pvgoran@users.sf.net for tracking this down.
-
-2002-07-28 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tcl.h:
- * generic/tclBasic.c: added the new flag TCL_EVAL_NO_TRACEBACK to
- the interface of the Tcl_Eval* functions. Modified the error
- message for too many nested evaluations.
- * generic/tclInterp.h: changed the Alias struct to be of variable
- length and store the prefix arguments directly (instead of a
- pointer to a Tcl_Obj list). Made AliasObjCmd call Tcl_EvalObjv
- instead of TclObjInvoke - thus making aliases trigger execution
- traces [Bug 582522].
- * tests/interp.test:
- * tests/stack.test: adapted to the new error message.
- * tests/trace.test: added tests for aliases firing the exec
- traces.
+ * unix/tcl.m4: Update from Tcl.
-2002-07-27 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tkWindow.c (Tk_MainWindow, Tk_GetNumMainWindows):
+ protect against being called before Tcl stubs are init'ed.
+ [Bug #220916] (porter)
+
+2002-02-25 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkText.c (ConfigureText): reenable the blinking cursor
+ on state change where necessary. [Bug #503772]
+
+ * tests/listbox.test:
+ * generic/tkListbox.c: corrected error handling when setting to an
+ invalid listvar value. [Bug #503613]
+
+ * library/scale.tcl: mirror B2 bindings to B3 on Windows to better
+ accomodate two button mice. [Patch #493145]
+
+ * library/panedwindow.tcl: improved proxy sash handling. (boudaillier)
+
+2002-02-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/filebox.test: Reorganised and fixed so that tests are
+ executed fewer times (!) and the automatic extension adding
+ behaviour of tk_getSaveFile is tested.
+
+2002-02-23 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4: Update from Tcl.
+
+2002-02-22 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkPanedWindow.c (PanedWindowWidgetObjCmd): fixed returns
+ that should have been breaks instead. Corrected .pw configure
+ handling for insufficient args. [Patch #521436] (boudaillier)
+
+ * mac/tkMacDefault.h:
+ * unix/tkUnixDefault.h:
+ * win/tkWinDefault.h: changed panedwindow default relief to flat,
+ a more natural outer relief.
+
+ * library/panedwindow.tcl (ReleaseSash): changed to not pass x and
+ y args at all (they aren't used).
+ Added proc comments. Made configuring sash cursor more efficient.
+ Added Cursor timer that restores the default cursor when pointer
+ is no longer over the sash. This is necessary because Leave
+ events won't be seen when moving into a paned child.
+
+2002-02-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/demos/widget: New section "Paned Windows"
+ * library/demos/paned2.tcl, library/demos/paned1.tcl: New files.
+
+ * library/panedwindow.tcl (ReleaseSash): Added missing arguments.
+ * library/tk.tcl: Bindings for paned window were not being loaded
+ by default.
+
+ * unix/tkUnixMenu.c (GetMenuLabelGeometry,DrawMenuEntryLabel):
+ Stop meaningless GCC warnings.
+
+2002-02-21 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/panedwindow.n (new):
+ * generic/tkPanedWindow.c (new):
+ * generic/tkInt.h:
+ * generic/tkWindow.c:
+ * library/panedwindow.tcl (new):
+ * mac/tkMacDefault.h:
+ * tests/panedwindow.test (new):
+ * unix/Makefile.in:
+ * unix/tkUnixDefault.h:
+ * win/Makefile.in:
+ * win/makefile.vc:
+ * win/tkWinDefault.h: added implementation of TIP #41, panedwindow
+ widget. [Patch #512503] (melski)
+
+ * generic/tkOption.c (ReadOptionFile): fixed Tcl_Seek casting to
+ remove warnings (we expect no option files with be > 2GB).
+
+ * unix/configure: regenerated
+ * unix/tcl.m4: updated to sync with Tcl's tcl.m4
+ Added --enable-64bit support for AIX-4 using IBM's xlc (-q64 flag).
+
+2002-02-19 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: First draft of updated changes for 8.4a4 release.
+
+2002-02-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tkImgPhoto.c (MatchFileFormat): Tcl_Seek takes
+ Tcl_WideInt offset (three places.)
+ * generic/tkImgPPM.c (FileReadPPM): Tcl_Seek takes Tcl_WideInt offset.
+ * generic/tkFrame.c (ConfigureFrame): Stop GCC warning.
+
+ * generic/tkImgGIF.c: Made file meet the formatting rules from the
+ Tcl Engineering Manual better; mostly differences in whitespace.
+
+2002-02-18 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure: regen'd
+ * unix/tcl.m4:
+ * unix/configure.in: added macros and calls to SC_TCL_EARLY_FLAGS
+ and SC_TCL_64BIT_FLAGS, part of TIP #72.
+
+2002-02-14 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * library/entry.tcl:
+ * library/text.tcl: Adjust <Double-1> and <Triple-1> bindings
+ so that no anchor point is set and the insertion cursor is
+ set to the last character in the selection. [Bug 220943]
+ * tests/event.test: Add test cases for double click and
+ drag as well as triple click and drag in the text and
+ entry widgets.
+
+2002-02-14 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/event.test (_text_ind_to_x_y, _get_selection): Fix
+ incorrect use of results from bbox invocation so that
+ y center point for a give index is calculated correctly.
+ Add new method to return the selection and use it in
+ test cases. Always lappend to the result list to avoid
+ case where initial result includes a space.
+
+2002-02-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tkMain.c:
+ * mac/tkMacInit.c:
+ * mac/tkMacKeyboard.c:
+ * win/tkWinDialog.c:
+ * win/tkWinTest.c: modified some callers of Tcl routines that
+ were restored to return (char *) pointing into Tcl_DStrings.
+
+2002-02-03 eric melski <ericm@interwoven.com>
+
+ * generic/tkImage.c (Tk_ImageObjCmd): Clean up bogus for loop in
+ [image inuse] subcommand [Bug #485803].
+
+2002-02-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkCmds.c (Tk_TkObjCmd): don't use 'bool' as an arg as it
+ conflicts with the C99 spec. [Bug #511956] (ingham)
+
+2002-02-01 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: unset macro located in the tktest target
+ caused a failure to build. [Bug 511652]
+
+2002-01-30 Don Porter <dgp@users.sourceforge.net>
+
+ * win/stubs.c (XSetCommand): Overlooked CONSTification.
+
+2002-02-01 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/photo.n: Documented transparency subcommand.
+ * tests/imgPhoto.test (imgPhoto-4.40...imgPhoto-4.68): Tests for
+ the transparency subcommand.
+ * generic/tkImgPhoto.c (ImgPhotoCmd): Added transparency
+ subcommand (see TIP #14.)
+
+2002-01-31 Todd Helfter <tmh@users.sourceforge.net>
+ * generic/tkMenu.c (ConfigureMenuCloneEntries)
+ * tests/menu.test (menu3.68)
+ Correct and test for logic error when cloning menus. [Bug #508988]
+
+2002-01-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tk.decls: The POTENTIAL INCOMPATIBILITY in the changing
+ interface of Tk_ParseArgv can now be removed by the -DUSE_NON_CONST
+ compiler flag.
+ * generic/tkDecls.h: make genstubs
+
+2002-01-29 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * win/tkWinInit.c (TkpGetAppName): TIP 27 fixup. The code now does
+ not write into the CONST path returned by "argv0" and
+ Tcl_SplitPath anymore.
+
+2002-01-28 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/configure.in: Don't set TCL_LIB_SPEC and
+ TCL_STUB_LIB_SPEC variables since this breaks
+ the AIX build. This was used in the past to
+ support linking with Tcl from the build dir
+ or the install dir, but it is no longer needed.
- * unix/Makefile.in: Revert fix for Tcl bug 529801
- since it was incorrect and broke the build on
- other systems. Fix Tcl bug 587299.
- Add MAJOR_VERSION, MINOR_VERSION, PATCH_LEVEL,
- SHLIB_LD_FLAGS, SHLIB_LD_LIBS, CC_SEARCH_FLAGS,
- LD_SEARCH_FLAGS, and LIB_FILE variables to support
- more generic library build/install rules.
+2002-01-28 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/Makefile.in: Remove commented out vars.
* unix/configure: Regen.
- * unix/configure.in: Move AC_PROG_RANLIB into
- tcl.m4. Move shared build test and setting
- of MAKE_LIB and MAKE_STUB_LIB into tcl.m4.
- Move subst of a number of variables into
- tcl.m4 where they are defined.
- * unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS):
- Subst vars where they are defined. Add MAKE_LIB,
- MAKE_STUB_LIB, INSTALL_LIB, and INSTALL_STUB_LIB
- rules to deal with the ugly details of running
- ranlib on static libs at build and install time.
- Replace TCL_SHLIB_LD_EXTRAS with SHLIB_LD_FLAGS
- and use it when building a shared library.
- * unix/tclConfig.sh.in: Add TCL_CC_SEARCH_FLAGS.
+ * unix/configure.in: Don't subst vars that are already
+ taken care of in SC_LOAD_TCLCONFIG.
+ * unix/tcl.m4: Update from Tcl.
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
+
+2001-01-27 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tkFileFilter.c:
+ * mac/tkMacInit.c:
+ * mac/tkMacKeyboard.c:
+ * mac/tkMacMenus.c: TIP 27 CONSTification induced changes
+
+2002-01-25 Don Porter <dgp@users.sourceforge.net>
+
+ * All changes below are Patch 505159
+
+ * doc/AddOption.3:
+ * doc/CanvTkWin.3:
+ * doc/GetPixels.3:
+ * doc/Name.3:
+ * doc/ParseArgv.3:
+ * generic/tk.decls (Tk_AddOption,Tk_CanvasGetCoord,Tk_GetPixels,
+ Tk_GetScreenMM,Tk_NameToWindow,Tk_ParseArgv):
+ * generic/tkArgv.c (Tk_ParseArgv):
+ * generic/tkCanvLine.c (ParseArrowShape):
+ * generic/tkCanvUtil.c (Tk_CanvasGetCoord,Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc,Tk_GetDash):
+ * generic/tkCanvas.c (ConfigureCanvas):
+ * generic/tkGet.c (Tk_GetPixels,Tk_GetScreenMM):
+ * generic/tkImgPhoto.c (ImgPhotoCmd):
+ * generic/tkMain.c (Tk_MainEx):
+ * generic/tkOldConfig.c (FormatConfigInfo):
+ * generic/tkOption.c (Tk_AddOption):
+ * generic/tkText.c (TextWidgetCmd,TkTextGetTabs,DumpSegment):
+ * generic/tkText.h (TkTextCreateTag):
+ * generic/tkTextTag.c (TkTextCreateTag):
+ * generic/tkWindow.c (Tk_NameToWindow,Initialize):
+ * mac/tkMacCursor.c (FindCursorByName,TkGetCursorByName):
+ * mac/tkMacWm.c (Tk_WmCmd):
+ * unix/tkUnixCursor.c (TkGetCursorByName):
+ * unix/tkUnixSend.c (ValidateName):
+ * unix/tkUnixWm.c (Tk_WmCmd):
+ * win/tkWinCursor.c (TkGetCursorByName):
+ * win/tkWinWm.c (Tk_WmCmd): Updated callers of Tcl_SplitList and
+ Tcl_Merge.
+ * generic/tkDecls.h: make genstubs
+ ***POTENTIAL INCOMPATIBILITY***
+ Includes a source incompatibility in the argv argument of Tcl_ParseArgv.
+
+ * generic/tkBind.c (DeleteVirtualEvent):
+ * generic/tkCanvas.c (ScrollFractions, CanvasWidgetCmd,
+ CanvasUpdateScrollbars):
+ * generic/tkTestTag.c (TkTextTagCmd): Updated callers of
+ Tcl_GetStringResult. Rewrote PrintScrollFractions to
+ ScrollFractions to stop scribbling directly on interp->result.
+
+ * generic/tkInt.decls (TkGetDefaultScreenName, TkpDisplayWarning,
+ TkpOpenDisplay):
+ * generic/tkCanvPs.c (Tk_PostscriptColor, Tk_PostscriptFont):
+ * generic/tkEntry.c (EntrySetValue, EntryValidateChange, ExpandPercents,
+ EntryValueChanged, Tk_EntryObjCmd, DestroyEntry, ConfigureEntry,
+ EntryComputeGeometry, InsertChars, DeleteChars, EntryFetchSelection,
+ EntryTextVarProc, Tk_SpinBoxObjCmd, SpinboxWidgetObjCmd):
+ * generic/tkMain.c (Prompt):
+ * generic/tkMenu.c (MenuVarProc):
+ * generic/tkMenubutton.c (ConfigureMenuButton, MenuButtonTextVarProc):
+ * generic/tkMessage.c (ConfigureMessage, MessageTextVarProc):
+ * generic/tkWindow.c (GetScreen, Initialize):
+ * mac/tkMacInit.c (TkpInit, TkpDisplayWarning):
+ * mac/tkMacXStubs.c (TkGetDefaultScreenName, TkpOpenDisplay):
+ * unix/tkUnix.c (TkGetDefaultScreenName):
+ * unix/tkUnixEvent.c (TkpOpenDisplay):
+ * unix/tkUnixInit.c (TkpGetAppName, TkpDisplayWarning):
+ * unix/tkUnixSend.c (SendEventProc):
+ * win/tkWinInit.c (TkpGetAppName, TkpDisplayWarning):
+ * win/tkWinX.c (TkGetDefaultScreenName,TkpOpenDisplay): Updated
+ callers of Tcl_GetVar, Tcl_GetVar2
+ * generic/tkIntDecls.h: make genstubs
+
+ * generic/tkCanvPs.c (TkCanvPostscriptCmd):
+ * generic/tkImgBmap.c (TkGetBitmapData):
+ * generic/tkOption.c (ReadOptionFile):
+ * mac/tkMacInit.c (TkpInit, TkpGetAppName):
+ * win/tkWinInit.c (TkpGetAppName): Updated callers of
+ Tcl_SplitPath, Tcl_JoinPath, and Tcl_TranslateFileName.
+
+2002-01-18 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/wm.test: Rewrite stackorder tests that
+ deal with toplevels that have the overrideredirect
+ flag set. [Tk bug 492259]
+
+2002-01-18 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tkWinDialog.c: Overlooked Tcl_GetIndexFromObj callers.
+
+2001-01-18 Daniel Steffen <das@users.sourceforge.net>
+
+ * mac/tkMacDialog.c:
+ * mac/tkMacSend.c: TIP 27 CONSTification broke the mac
+ build in a few places.
+
+2002-01-16 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkListbox.c (ChangeListboxOffset): improved tracking
+ when scrolling on x axis with entry/text. [Bug #225025] (voskuil)
+
+2002-01-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tk3d.c (Tk_GetReliefFromObj):
+ * generic/tkBind.c (Tk_EventObjCmd,HandleEventGenerate):
+ * generic/tkButton.c (ButtonWidgetObjCmd):
+ * generic/tkCanvas.c (CanvasWidgetCmd,FindItems):
+ * generic/tkClipboard.c (Tk_ClipboardObjCmd):
+ * generic/tkCmds.c (Tk_BellObjCmd, Tk_TkObjCmd, Tk_TkwaitObjCmd,
+ Tk_UpdateObjCmd, Tk_WinfoObjCmd, Tk_WmObjCmd):
+ * generic/tkConfig.c (DoObjConfig):
+ * generic/tkEntry.c (EntryWidgetObjCmd, SpinboxWidgetObjCmd):
+ * generic/tkFocus.c (Tk_FocusObjCmd):
+ * generic/tkFont.c (Tk_FocusObjCmd, ConfigAttributesObj):
+ * generic/tkFrame.c (Tk_FrameObjCmd):
+ * generic/tkGet.c (Tk_GetAnchorFromObj, Tk_GetJustifyFromObj):
+ * generic/tkGrab.c (Tk_GrabObjCmd):
+ * generic/tkGrid.c (Tk_GridObjCmd,GridRowColumnConfigureCommand,
+ GridSlavesCommand, ConfigureSlaves):
+ * generic/tkImage.c (Tk_ImageObjCmd):
+ * generic/tkImgBmap.c (ImgBmapCmd):
+ * generic/tkImgGIF.c (FileReadGIF):
+ * generic/tkImgPhoto.c (ImgPhotoCmd):
+ * generic/tkListbox.c (ListboxWidgetObjCmd, ListboxSelectionSubCmd,
+ GetListboxIndex):
+ * generic/tkMenu.c (MenuWidgetObjCmd, MenuAddOrInsert, MenuCmd,
+ ConfigureMenu, CloneMenu):
+ * generic/tkMenubutton.c (MenuButtonWidgetObjCmd):
+ * generic/tkMessage.c (MessageWidgetObjCmd):
+ * generic/tkOption.c (Tk_OptionObjCmd):
+ * generic/tkPack.c (Tk_PackObjCmd, ConfigureSlaves):
+ * generic/tkPlace.c (Tk_PlaceObjCmd):
+ * generic/tkScale.c (ScaleWidgetObjCmd):
+ * generic/tkSelect.c (Tk_SelectionObjCmd):
+ * generic/tkSquare.c (SquareWidgetObjCmd):
+ * generic/tkTest.c (TestobjconfigObjCmd, TrivialConfigObjCmd,
+ TestfontObjCmd): Updates to handle change in type of tablePtr
+ argument of Tcl_GetIndexFromObj(Struct) from (char **) to
+ (CONST char **). [TIP 27] [Patch 504705]
+
+ * generic/tkCanvText.c (GetSelText):
+ * generic/tkEntry.c (Entry{FetchSelection,Setvalue},ExpandPercents):
+ * generic/tkSelect.c (HandleTclCommand):
+ * generic/tkText.c (TextSearchCmd):
+ * generic/tkTextIndex.c (TkTextMakeByteIndex, TkTextIndexBackChars):
+ * mac/tkMacFont.c (Tk_MeasureChars, BreakLine):
+ * unix/tkUnixMenu.c (DrawMenuUnderline):
+ * win/tkWinMenu.c (GetEntryText, DrawMenuUnderline): Updated
+ callers of Tcl_Utf* and Tcl_Regexp* APIs to reflect TIP 27 API
+ changes (see Tcl Patch 471509). [Patch 471513]
+
+2002-01-16 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4: Update from Tcl.
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
+
+2002-01-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tkMain.c (Tk_MainEx): Updated callers of CONSTified
+ Tcl interfaces Tcl_EvalFile and TclGetStartupScriptFileName.
+
+ * generic/tkConsole.c (ConsoleOutputProc, TkConsolePrint):
+ * generic/tkInt.h (TkConsolePrint):
+ * mac/tkMacAppInit.c (TkConsolePrint): Updated Tk's console to
+ CONSTified channel driver interface. [Tcl Patch 503565, Tk Patch
+ 503983]
-2002-07-26 Miguel Sofer <msofer@users.sourceforge.net>
+2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclExecute.c: fixed Tcl_Obj leak in code corresponding
- to the macro NEXT_INST_V(x, 0, 1) [Bug 587495].
+ Use ${libdir} instead of ${exec_prefix}/lib. [Tcl bug 489370]
-2002-07-26 Miguel Sofer <msofer@users.sourceforge.net>
+ * unix/configure: Regen.
+ * unix/configure.in: Define and use libdir.
+ * win/configure: Regen.
+ * win/configure.in: Define libdir.
- * generic/tclVar.c (TclObjLookupVar): leak fix and improved
- comments.
+2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
-2002-07-26 Jeff Hobbs <jeffh@ActiveState.com>
+ * unix/Makefile.in: Burn Tcl and Tk build
+ directories into tktest executable to avoid crashes
+ caused by ld loading a previously installed version
+ of the tcl or tk shared libraries. Remove setting
+ of LD_LIBRARY_PATH, LIBPATH, and SHLIB_PATH
+ before running tktest since it should no
+ longer be required.
- * generic/tclVar.c (TclLookupVar): removed early returns that
- prevented the parens from being restored. also removed goto label
- as it was not necessary.
+2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
-2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
+ Enable use of Tcl stubs when building Tk as
+ a shared library. This should fix the build
+ under AIX. [Bugs 220858, 220955, 220921]
- * generic/tclExecute.c:
- * tests/expr-old.test: fix for erroneous error messages in [expr],
- [Bug 587140] reported by Martin Lemburg.
+ * unix/Makefile.in: Add TCL_STUB_LIB_SPEC and
+ TCL_STUB_LIB_FLAG variables.
+ * unix/configure: Regen.
+ * unix/configure.in: Pass TCL_STUB_LIB_SPEC into
+ Makefile and use it when linking the tk shared library.
+ Define USE_TCL_STUBS when building shared. Subst
+ TCL_STUB_LIB_SPEC and TCL_STUB_LIB_FLAG.
-2002-07-25 Joe English <jenglish@users.sourceforge.net>
- * generic/tclProc.c: fix for Tk Bug #219218 "error handling
- with bgerror in Tk"
+2002-01-08 D. Richard Hipp <drh@hwaci.com>
-2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
+ * win/tkWinMenu.c: Fix the following bug: If you select an entry
+ on a cascade menu then the next time the parent menu is posted, the
+ cascade entry was active. Also, if you traverse to a disabled entry
+ using keystrokes and press ENTER on the disabled entry, then that
+ entry appears active the next time the menu is posted. The same
+ patch fixes both problems.
- * generic/tclExecute.c: restoring full TCL_COMPILE_DEBUG
- functionality.
+2002-01-04 Don Porter <dgp@users.sourceforge.net>
-2002-07-24 Don Porter <dgp@users.sourceforge.net>
+ * generic/tkBind.c (TkBindFree):
+ * generic/tkGrid.c (ResolveConstraints,CheckSlotData,DestroyGrid):
+ * generic/tkSelect.c (Tk_DeleteSelHandler,TkSelDeadWindow): Replaced
+ Tcl_Free calls with ckfree so that memory debugging is fully supported.
- * tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15
- as a valid C encoding. [Bug 575336]
+2001-12-28 Jeff Hobbs <jeffh@ActiveState.com>
-2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
+ * test/winButton.test:
+ * win/tkWinButton.c: added updated patch #463234 which returns the
+ default sizing behavior (not so native), but enables native L&F
+ with negative sizing (-11 for example).
- * generic/tclExecute.c: restoring the tcl_traceCompile
- functionality while I repair tcl_traceExec. The core now compiles
- and runs also under TCL_COMPILE_DEBUG, but execution in the
- bytecode engine can still not be traced.
+ * library/text.tcl (tk::TextButton1): made text receive focus even
+ in disabled state for Windows to show selection and allow
+ mouse-wheel scrolling.
-2002-07-24 Daniel Steffen <das@users.sourceforge.net>
+ * win/tkWinInit.c (TkpDisplayWarning): added Tcl_DStringFree's
+
+ * win/tkWinInt.h:
+ * win/tkWinX.c: added TkWinProcs that represent a function table
+ to switch between unicode and ansi procs on Windows. This is
+ analogous to the TclWinProcs. Using Tcl_WinUtfToTChar, we can
+ easily take advantage of using unicode functions where available
+ without having to switch on the platform id each time.
+
+ * win/tkWinWm.c (InitWindowClass): corrected init routines to
+ allow unicode in window titles on Windows (for Win2K/XP).
+ (TkWmStackorderToplevel): Corrected casts to enable debug compile
+
+ * win/configure: regen'ed
+ * win/tcl.m4: added shell32.lib to link libs, as these are
+ necessary for new directory chooser (when enabled).
+
+ * win/tkWinDialog.c (Tk_MessageBoxObjCmd): use MessageBoxW for
+ proper display of unicode errors.
+ Added patch which uses new OLE based directory chooser. This
+ still has some issues, so is disabled by default. [Patch #468139]
+ (ColorDlgHookProc) Corrected ability to use unicode chars in
+ tk_chooseColor -title.
+
+2001-12-27 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinInit.c (TkpDisplayWarning): Use MessageBoxW in case the
+ error displayed has unicode chars. [Bug #485986]
+
+2001-12-27 Daniel Steffen <das@users.sourceforge.net>
+
+ * mac/tkMacInit.c:
+ * mac/tkMacResource.r: synced up tkInit features to unix/win:
+ use existing tkInit proc if defined. Added spinbox.tcl resource.
+ Used TclGetEnv() instead of Tcl_GetVar2(interp, env)
+ * mac/tkMacApplication.r:
+ * mac/tkMacLibrary.r: minor version resources cleanup
+
+2001-12-27 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkButton.c (ButtonTextVarProc): guard against being
+ called while the *button/label is being deleted. [Bug #490051]
+
+ * library/entry.tcl:
+ * library/spinbox.tcl:
+ * library/text.tcl: added extra checks against bug #220269 and
+ made spinbox reuse more of the entry procedure code.
+
+2001-12-20 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in:
- * unix/configure.in: corrected fix for [Bug 529801]: ranlib
- only needed for static builds on Mac OS X.
* unix/configure: Regen.
- * unix/tclLoadDyld.c: fixed small bugs introduced by Vince,
- implemented library unloading correctly (needs OS X 10.2).
+ * unix/tcl.m4: Update from Tcl.
-2002-07-23 Joe English <jenglish@users.sourceforge.net>
+2001-12-19 Mo DeJong <mdejong@users.sourceforge.net>
- * doc/OpenFileChnl.3: (Updates from Larry Virden)
- * doc/open.n:
- * doc/tclsh.1: Fix section numbers in Unix man page references.
- * doc/lset.n: In EXAMPLES section, include command to set the
- initial value used in subsequent examples.
- * doc/http.n: Package version updated to 2.4.
+ * unix/configure: Regen.
+ * unix/tcl.m4: Update from Tcl.
-2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
+2001-12-18 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Enable 64 bit compilation
- when using the native compiler on a 64 bit version of IRIX.
- [Tcl bug 219220]
+ * unix/configure.in: Move EXP file changes over from
+ Tcl configure script to fix AIX build with gcc. [Bug 220955]
-2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
+2001-12-18 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Combine ranlib tests and
- avoid printing unless ranlib is actually run.
+ * unix/Makefile.in:
+ * win/Makefile.in: Use $(MAKE) instead of make
+ in the tcltest rule.
-2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
+2001-12-18 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/event.test (event-click-drag-1.2): Corrected test that
+ failed on Solaris/CDE due to text scrolling. [Bug 413735]
+
+2001-12-18 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/spinbox.tcl (ButtonDown): added catch to ignore
+ possible error in after cancel when Priv(afterId) isn't defined.
+
+ * doc/spinbox.n: corrected spin(up|down) -> button(up|down)
+
+2001-12-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/getOpenFile.n: Documented change.
+ * library/tkfbox.tcl (SetFilter): Added code to guess the correct
+ default extension from whatever value was selected in the
+ filetypes option menu. Adapted from code by Chris Nelson
+ submitted in Patch #492220.
+
+2001-12-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tkUnixWm.c (TkWmStackorderToplevelWrapperMap): added static
- * unix/tcl.m4 (SC_PATH_X): Set XINCLUDES to "" instead
- of "# no special path needed" or "# no include files found"
- when x headers cannot be located.
+2001-12-05 Jeff Hobbs <jeffh@ActiveState.com>
-2002-07-22 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tkText.c:
+ * generic/tkText.h: changed TkTextEditType enums to be prefaced
+ with TK_EDIT_ to prevent name collision.
- * generic/tclIOUtil.c: made tclNativeFilesystem static
- (since 07-19 changes removed its usage elsewhere), and
- added comments about its usage.
- * generic/tclLoad.c:
- * generic/tcl.h:
- * generic/tcl.decls:
- * doc/FileSystem.3: converted last load-related ClientData
- parameter to Tcl_LoadHandle opaque structure, removing a
- couple of casts in the process.
+2001-12-05 Daniel Steffen <das@users.sourceforge.net>
+
+ * mac/tkMacWm.c: mac implementation of wm stackorder
+ (patch 481148, TIP 74)
+
+2001-12-03 Mo DeJong <mdejong@users.sourceforge.net>
+
+ Add TK patch 481148 to implement TIP 74, the
+ wm stackorder command.
+
+ * doc/winfo.n: Update documentation for the winfo
+ children command to indicate that top-level windows
+ are not returned in stacking order.
+ * doc/wm.n: Add documentation for wm stackorder.
+ * generic/tkInt.decls (TkWmStackorderToplevel):
+ Add decl for new function.
+ * generic/tkIntDecls.h: Regen.
+ * generic/tkStubInit.c: Regen.
+ * tests/unixWm.test: Add stackorder command to test
+ for wm command usage message.
+ * tests/wm.test: Add new set of tests for generic
+ window manager methods.
+ * unix/tkUnixWm.c (Tk_WmCmd,
+ TkWmStackorderToplevelWrapperMap,
+ TkWmStackorderToplevel): Add unix implementation of
+ new wm stackorder command.
+ * win/tkWinWm.c (Tk_WmCmd,
+ TkWmStackorderToplevelEnumProc,
+ TkWmStackorderToplevelWrapperMap,
+ TkWmStackorderToplevel): Add windows implementation
+ of new wm stackorder command.
+
+2001-12-03 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: install target changes by request from
+ Ryan Casey <scfiead@hotmail.com>.
+
+2001-11-30 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/demos/widget: Further overhauling; shrank fonts, made
+ better use of fonts, added an icon, fixed the About box. Prompted
+ by Bug #487442 from Vincent Wartelle.
+
+2001-11-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/palette.tcl (tk_setPalette): Added heuristic to guess
+ from the background whether to use black or white for the
+ foreground when not told specifically. Suggested by Chris Nelson,
+ this makes the command fit the documentation better!
+
+2001-11-27 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: Fixed CAT32 target. cat.c is located in the Tcl
+ source, not the Tk source.
+
+2001-11-27 D. Richard Hipp <drh@hwaci.com>
+
+ * library/menu.tcl: Do not allow keyboard traversal of torn-off
+ menus to visit the (invisible) tearoff bar.
+
+2001-11-26 D. Richard Hipp <drh@hwaci.com>
+
+ * win/tkWinMenu.c: disabled menu items show the activebackground
+ color in their background. This change makes menu behavior
+ consistent with what native windows does.
+
+2001-11-24 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/Makefile.in: Add comments to better describe
+ TCL_EXE and when it should be available. Add
+ rule that prints message about running `make genstubs`
+ when tkStubInit.c is out of date.
+ * win/Makefile.in: Add TCL_TOOL_DIR and TCL_EXE
+ variables to better match the Tcl Makefile. Add
+ genstubs rule so tkSTubInit.c can be regenerated.
+
+2001-11-24 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/configure: Regen.
+ * win/configure.in: Don't AC_SUBST CFLAGS_DEBUG, CFLAGS_OPTIMIZE,
+ or CFLAGS_WARNING since it is now done in SC_CONFIG_CFLAGS.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): AC_SUBST DL_LIBS, CFLAGS_DEBUG,
+ CFLAGS_OPTIMIZE, and CFLAGS_WARNING.
+
+2001-11-23 Daniel Steffen <das@users.sourceforge.net>
+
+ Up-port to 8.4 of mac code changes for 8.3.3 & various new
+ changes for 8.4, some already backported to 8.3.4 (patch #435660)
+
+ * library/tk.tcl: added <Key-F1> binding for <<Undo>> on the mac (TIP26)
+
+ * library/button.tcl: fixed undefined $Priv(repeated) error for button
+ without -repeatdelay support
+
+ * generic/tkConsole.c:
+ * library/console.tcl:
+ * mac/tkMacInit.c:
+ * mac/tkMacResource.r: corrected how mac deals with tcl library
+ files present both in resources and in $tk_library directory.
+
+ * generic/tkConsole.c: crashing bug fix when printing to console
+ at program exit after the console has already been closed.
+ Now setting gStdoutInterp=NULL in ConsoleClose().
+
+ * mac/tkMacInit.c: correct use of Tcl_JoinPath in tk_library
+ initialization
+
+ * mac/tkMacMenu.c: special MDEF_PROC_OFFSET only needed for
+ exactly one specific version of the MWERKS 68k compiler .
+
+ * mac/tkMacShLib.exp: removed file
+
+ * unix/Makefile.in: removed reference to .exp files
+
+ * mac/MWTkBuildLibHeader.h:
+ * mac/MW_TkBuildLibHeader.pch:
+ * mac/MW_TkHeaderCommon.h:
+ * mac/MW_TkOldImgStaticHeader.h:
+ * mac/MW_TkStaticHeader.h:
+ * mac/MW_TkStaticHeader.pch: new precompiled header files
+
+ * mac/MW_TkHeader.pch:
+ * mac/MW_TkOldImgHeader.h:
+ * mac/MW_TkTestHeader.pch: revised precompiled header handling: now
+ include a common header file 'MW_TkHeaderCommon.h' from all .pch files,
+ the .pch files themselves now only setup #defines (e.g. BUILD_tk,
+ STATIC_BUILD, TCL_DEBUG, TCL_THREADS) like in makefiles on other
+ platforms.
+
+ * mac/tkMac.h:
+ * mac/tkMacPort.h:
+ * mac/tkMacInt.h: use of BUILD_tk and TCL_STORAGE_CLASS like on other
+ platforms, standardize #include'd files to what's done on other
+ platforms, removed use of #pragma export, changed extern to EXTERN
+ where appropriate to enable DLL export via the TCL_STORAGE_CLASS
+ mechanism.
+
+ * mac/tkMacAppearanceStubs.c: removed use of #pragma export
+
+ * mac/widget.r: new resource file for 'Widget Demos'
+
+ * mac/tkMacProjects.sea.hqx: updated mac build project files:
+ build support for CodeWarrior Pro6, UnivIntf 3.4 & shared runtime
+ libraries (see Tcl ChangeLog for details).
+ changed weak linking so that CFM68k binaries now work on all OS
+ versions from the free 7.5.5 onwards, with or without AppearanceMgr
+ and/or NavigationMgr installed.
+ added target to automatically build 'Widget Demos'
+ included XML versions of the projects for CW Pro5 or Pro7 users.
+ use compat/strtod.c instead of MSL's strtod()
+
+ * generic/tkInt.decls:
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkStubInit.c:
+
+ * mac/tkMacInt.h: MAC_TCL tk stub support was badly broken due to
+ multiply defined (mac specific) names in tk.decls and tkInt.decls,
+ removed the duplicates from the internal unsupported interfaces
+ "interface tkInt" and "interface tkIntPlat"; moved declaration of
+ TkpIsWindowFloating from tkMacInt.h to tkInt.decls: interface tkIntPlat.
+ - these changes to the stub tables might require you to recompile your
+ Tk extensions if they turn out to reference one of the removed routines
+ in the wrong table (should be unlikely).
+
+ * generic/tkMain.c: MAC_TCL: workaround for broken/non-standard isatty
+ on MW Pro6, #include <unistd.h> instead of defining isatty
- * generic/tclInt.h: removed tclNativeFilesystem declaration
- since it is now static again.
+ * generic/tkPointer.c: MAC_TCL: #include tkMacInt.h
+
+ * generic/tkStubLib.c: MAC_TCL: removed obsolete special casing of mac
+ headers, standardize #include'd files to what's done on other platforms
+
+ * mac/tclets.r:
+ * mac/tkMacWindowMgr.c:
+ * mac/tkMacScrlbr.c:
+ * mac/tkMacMenu.c:
+ * mac/tkMacMenus.c:
+ * mac/tkMacFont.c:
+ * mac/tkMacDialog.c:
+ * mac/tkMacButton.c: renamed obsolete apple API names to modern
+ equivalents; UH3.4 support: added #include <ControlDefinitions.h>;
+ fixed munged non-ASCII chars in sources due to bungled latin1<->mac
+ roman encoding in CVS repository.
+
+ * mac/tkMacDialog.c: added support for -filetypes option (fix for bug
+ tcl #221636); added update event handling for background windows while
+ in a NavigationMgr dialog; fixed nasty bug when calling CustomGetFile
+ (missing addr operator) (fix for bug tk #220911 & tcl #219367); renamed
+ routines conflicting with standard MoreFiles headers (see Tcl ChangeLog
+ for details)
+
+ * mac/tkMacApplication.r:
+ * mac/tkMacLibrary.r:
+ * mac/tkMacResource.r: fixed obsolete copyrights/dates in version
+ strings, updated version strings to standard usage, added support for
+ '(Support Libraries)' subfolder for shared runtime libraries in
+ unmerged binaries, commented out demo setting of "Tcl Environment
+ Variables"; reorganized resources among these files to avoid
+ multiple copies in applications and shared libraries, the script
+ libraries/Xcursors etc are now no longer duplicated in Wish but are
+ only included in the resources of Tk.shlb.
+
+ * mac/tkMacMenu.c:
+ * mac/tkMacMDEF.r: changes to support MW Pro 6 68k (vers 0x2400 only)
+ compiler producing different offset to start of MDEF; fix to static 68k
+ presence testing when calling the custom MDEF
+
+ * mac/tkMacWm.c.c:
+ * mac/tkMacWindowMgr.c: added/fixed AppearanceMgr checks; override
+ AppearanceMgr version detection on static 68k to ensure static 68k Wish
+ runs on PPCs with recent AppearanceMgr
+
+ * mac/tkMacButton.c: fixed misplaced/missing variable initialization.
+
+2001-11-20 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkText.c (TextGetText): reworked to use DString for
+ improved speed. (callewaert, darley)
+ (DestroyText): plugged mem leak when not clearing stack (callewaert)
+ (TextGetText): more efficient string size calculation (darley)
+
+2001-11-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/demos/entry3.tcl: New demo showing off validation and
+ password entry.
+
+ * library/demos/widget: Some reorganization to make the code
+ simpler, plus a new entry demo.
+
+2001-11-17 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinButton.c (TkpComputeButtonGeometry): corrected the
+ default size of Windows buttons to conform to the Windows style.
+ This changes the default size of buttons on Windows.
+ [Patch #463234] (nelson)
+ **** POTENTIAL VISUAL INCOMPATABILITY ****
-2002-07-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+2001-11-16 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/expr.test (expr-22.*): Added tests to help detect the
- corrected handling.
- * generic/tclExecute.c (IllegalExprOperandType): Improved error
- message generated when attempting to manipulate Inf and NaN values.
- * generic/tclParseExpr.c (GetLexeme): Allowed parser to recognise
- 'Inf' as a floating-point number. [Bug 218000]
+ * library/menu.tcl: corrected menu traversal code on Unix to
+ better handle entering cascades. [Patch #481219] (oleinick)
-2002-07-21 Don Porter <dgp@users.sourceforge.net>
+2001-11-16 David Gravereaux <davygrvy@pobox.com>
- * tclIOUtil.c: Silence compiler warning. [Bug 584408].
+ * win/makefile.vc: Install target repaired.
-2002-07-19 Vince Darley <vincentdarley@users.sourceforge.net>
+2001-11-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclIOUtil.c: fix to GetFilesystemRecord
- * win/tclWinFile.c:
- * unix/tclUnixFile.c: fix to subtle problem with links shown
- up by latest tclkit builds.
+ * library/demos/image2.tcl: Many improvements to this
+ image-viewing demo; now uses labelframes and tk_chooseDirectory
-2002-07-19 Mo DeJong <mdejong@users.sourceforge.net>
+ * library/palette.tcl (::tk::RecolorTree): Made this work better
+ with CDE, which does some extremely annoying things with the
+ option database that interact badly with Tk's way of handling
+ options.
+
+ * doc/text.n: Overhauled the documentation of undo to make it
+ easier to understand.
+ * library/tk.tcl (::tk::EventMotifBindings): Added Emacs-like undo
+ binding, but not behaviour (we separate undo and redo.)
+ * library/demos/text.tcl: Show off our undo capability!
+
+2001-11-12 David Gravereaux <davygrvy@pobox.com>
+
+ * win/mkd.bat:
+ * win/rmd.bat: Removed -kb CVS attribute and added changes
+ from Llyod Lim for better stability. [Patch #456761]
+
+ * win/rules.vc(new):
+ * win/buildall.vc.bat(new):
+ * win/makefile.vc: large rewrite following Tcl's makefile.vc as
+ a guide and Patch #456761. Appears BugFree(tm).
+
+2001-11-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/text.n:
+ * generic/tkText.c:
+ * generic/tkText.h:
+ * generic/tkTextTag.c:
+ * library/text.tcl:
+ * library/tk.tcl:
+ * mac/tkMacDefault.h:
+ * tests/text.test:
+ * unix/tkUnixDefault.h:
+ * win/tkWinDefault.h: added TIP #26 implementation of simple
+ built-in undo/redo of text editing in the text widget.
+ [Patch #458879] (callewaert)
+
+2001-11-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/demos/menu.tcl: Show off -compound support in menus.
+
+ * library/demos/radio.tcl: Added some code to both show off the
+ extra capabilities of the buttons and also show what can be done
+ with compound images on the sly.
+
+2001-11-10 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/Makefile.in:
+ * win/Makefile.in: Add "make gdb" target. This target
+ can run wish inside either gdb or insight.
+
+2001-11-09 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/clrpick.tcl: changed a few parameters so that the full
+ 0..255 range could be accessed via the mouse. [Bug #478498]
* unix/configure:
- * unix/configure.in:
+ * unix/tcl.m4: added -lc to AIX libs, fixed path to ldAix
+
* win/configure:
- * win/configure.in: Add AC_PREREQ(2.13) in an attempt
- to make it more clear that the configure scripts
- must be generated with autoconf version 2.13.
- [Bug 583573]
+ * win/tcl.m4:
+ * win/makefile.vc: add comctl32.lib to build libs.
+ * win/tkWinX.c (TkWinXInit): added InitCommonControlsEx call.
+ * win/rc/tk.rc:
+ * win/rc/wish.rc:
+ * win/rc/wish.exe.manifest: added resources that specify using v6
+ of the MS Common Controls library when available (WinXP+). This
+ enables use of the themeable widgets (like scrollbars) to be used
+ in Tk. [Patch #478933]
-2002-07-19 Vince Darley <vincentdarley@users.sourceforge.net>
+2001-11-09 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug
- report and fix from jcw.
+ * unix/configure:
+ * unix/tcl.m4: Update from Tcl.
-2002-07-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+2001-11-08 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tclWinSerial.c (no_timeout): Made this variable static.
+ * unix/Makefile.in:
+ Avoid adding libc to the LIBS and WISH_LIBS
+ variables since it is not needed when linking with CC.
+ If required when linking with LD it should be done
+ on a case by case basis in tcl.m4.
- * generic/tclExecute.c, generic/tclCompile.c, generic/tclBasic.c:
- * generic/tclCompile.h (builtinFuncTable, instructionTable): Added
- prefix to these symbols because they are visible outside the Tcl
- library.
+2001-11-05 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCompExpr.c (operatorTable):
- * unix/tclUnixTime.c (tmKey):
- * generic/tclIOUtil.c (theFilesystemEpoch, filesystemWantToModify,
- filesystemIteratorsInProgress, filesystemOkToModify): Made these
- variables static.
+ * library/demos/dialog2.tcl: Typo-fix.
+ * library/demos/browse, library/demos/ixset, library/demos/rolodex:
+ Installation does version number fixup, so we shouldn't. Thanks
+ to wohnivec@iol.cz for pointing these (thankfully minor) problems
+ out.
- * unix/tclUnixFile.c: Renamed nativeFilesystem to
- * win/tclWinFile.c: tclNativeFilesystem and declared
- * generic/tclIOUtil.c: it properly in tclInt.h
- * generic/tclInt.h:
+2001-10-30 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclUtf.c (totalBytes): Made this array static and const.
+ * library/demos/widget: Integrated labelframe item into the labels
+ section and added a spinbox demo to the (retitled) entry section.
- * generic/tclParse.c (typeTable): Made this array static and const.
- (Tcl_ParseBraces): Simplified error handling case so that scans
- are only performed when needed, and flags are simpler too.
+ * library/demos/labelframe.tcl: Adjusted so as to show off the
+ labelframe widget to better effect and have a better description.
- * license.terms: Added AS to list of copyright holders; it's only
- fair for the current gatekeepers to be listed here!
+ * library/demos/spin.tcl: New demo to show off spinbox capabilities.
- * tests/cmdMZ.test: Renamed constraint for clarity. [Bug#583427]
- Added tests for the [time] command, which was previously only
- indirectly tested!
+ * library/demos/rolodex: Changes up-ported from core-8-3-1-branch
+ to make the script use more 8.*-isms, but not menus due to the way
+ the context help system works.
-2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net>
+ * library/demos/ixset: Changed to use the labelframe widget and
+ the grid geometry manager.
- * generic/tclInt.h:
- * generic/tcl.h:
- * */*Load*.c: added comments on changes of 07/17 and
- replaced clientData with Tcl_LoadHandle in all locations.
+2001-10-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclFCmd.c:
- * tests/fileSystem.test: fixed a 'knownBug' with 'file
- attributes ""'
- * tests/winFCmd.test:
- * tests/winPipe.test:
- * tests/fCmd.test:
- * tessts/winFile.test: added 'pcOnly' constraint to some
- tests to make for more useful 'tests skipped' log from
- running all tests on non-Windows platforms.
-
-2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
+ * library/demos/browse: Changes up-ported from core-8-3-1-branch
+ to make the script much more robust, particularly when neither the
+ current version of wish or the script are on the path.
- * generic/tclBasic.c (CallCommandTraces): delete traces now
- receive the FQ old name of the command.
- [Bug 582532] (Don Porter)
+ * library/demos/hello: Added emacs trailing tag-line.
-2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net>
+ * library/demos/tcolor: Changes up-ported from core-8-3-1-branch
+ to make the script compliant with current good practise, as well
+ as extensive use of the new labelframe widget.
- * tests/ioUtil.test: added constraints to 1.4,2.4 so they
- don't run outside of tcltest. [Bugs 583276,583277]
-
-2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
+ * library/demos/timer: Changes up-ported from core-8-3-1-branch to
+ make the script look and work better.
- * generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported
- by Vince Darley.
+ * library/demos/rmt: Changes up-ported from core-8-3-1-branch to
+ use more 8.* features and make the demo script more generally
+ useful to people.
-2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
+2001-10-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclVar.c (TclPtrIncrVar): missing CONST in declarations,
- inconsistent with tclInt.h. Thanks to Vince Darley for reporting,
- boo to gcc for not complaining.
-
-2002-07-17 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tkCursor.c (Tk_GetCursorFromData): Fixed uninit nextPtr
+ field. [adapted from Patch 473875]
+ (GetCursor): Removed double-assignment to nextPtr field.
- * generic/tclInt.h:
- * generic/tclIOUtil.c:
- * generic/tclLoadNone.c:
- * unix/tclLoadAout.c:
- * unix/tclLoadDl.c:
- * unix/tclLoadDld.c:
- * unix/tclLoadDyld.c:
- * unix/tclLoadNext.c:
- * unix/tclLoadOSF.c:
- * unix/tclLoadShl.c:
- * mac/tclMacLoad.c:
- * win/tclWinLoad.c: modified to move more functionality
- to the generic code and avoid duplication. Partial replacement
- of internal uses of clientData with opaque Tcl_LoadHandle. A
- little further work still needed, but significant changes are done.
+2001-10-19 Jeff Hobbs <jeffh@ActiveState.com>
-2002-07-17 D. Richard Hipp <drh@hwaci.com>
+ * library/console.tcl: removed transpose ability until the console
+ can get a proper rewrite of tag handling.
- * library/msgcat/msgcat.tcl: fix a comment that was causing
- problems for programs (ex: mktclapp) that embed the initialization
- scripts in strings.
+2001-10-18 Jeff Hobbs <jeffh@ActiveState.com>
-2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
+ * tests/defs.tcl: removed threaded build warning under X.
- * generic/tclInt.decls:
- * generic/tclIntDecls.h:
- * generic/tclStubInit.c:
- * generic/tclVar.c: removing the now redundant functions to access
- indexed variables: Tcl(Get|Set|Incr)IndexedScalar() and
- Tcl(Get|Set|Incr)ElementOfIndexedArray().
-
-2002-07-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * library/console.tcl (ConsoleOutput): fixed undefined widget
+ argument.
- * generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make
- this file compile with SunPro CC...
-
-2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
+2001-10-16 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclExecute.c: modified to do variable lookup explicitly,
- and then either inlining the variable access or else calling the new
- TclPtr(Set|Get|Incr)Var functions in tclVar.c
- * generic/tclInt.h: declare some functions previously local to
- tclVar.c for usage by TEBC.
- * generic/tclVar.c: removed local declarations; moved all special
- accessor functions for indexed variables to the end of the file -
- they are unused and ready for removal, but left there for the time
- being as they are in the internal stubs table.
+ * library/xmfbox.tcl: fixed filtering in motif file dialog.
+ [Patch #469670] (nelson)
- ** WARNING FOR BYTECODE MAINTAINERS **
- TCL_COMPILE_DEBUG is currently not functional; will be fixed ASAP.
-
-2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tkWindow.c (OpenIM): Added simple XIM patch to enable
+ basic XIM input on Unix. [Patch #412727] (fabian)
- * unix/Makefile.in:
- * win/Makefile.in: Add a more descriptive warning
- in the event `make genstubs` needs to be rerun.
+2001-10-15 Jeff Hobbs <jeffh@ActiveState.com>
-2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
+ * unix/configure:
+ * unix/configure.in:
+ * win/configure:
+ * win/configure.in:
+ * win/tkConfig.sh.in: reworked to be a little cleaner in
+ comparison to each other, and to AC_SUBST even empty vars for
+ win/tkConfig.sh
+
+2001-10-12 Todd M. Helfter <tmh@purdue.edu>
+
+ * ChangeLog:
+ * doc/menu.n:
+ * generic/tkMenu.c:
+ * generic/tkMenu.h:
+ * generic/tkMenubutton.c:
+ * generic/tkMenubutton.h:
+ * mac/tkMacDefault.h:
+ * mac/tkMacMenu.c:
+ * mac/tkMacMenubutton.c:
+ * tests/menu.test:
+ * unix/tkUnixDefault.h:
+ * unix/tkUnixMenu.c:
+ * win/makefile.vc:
+ * win/tkWinDefault.h:
+ * win/tkWinMenu.c:
+ * win/tkWinWm.c: Implementation of TIP #63, the addition of
+ a -compound option to menu entries allowing text and an image to
+ be displayed at the same time.
- * unix/Makefile.in: Use dltest.marker file
- to keep track of when the dltest package
- is up to date. This fixes [Tcl bug 575768]
- since tcltest is no longer linked every time.
- * unix/dltest/Makefile.in: Create ../dltest.marker
- after a successful `make all` run in dltest.
+2001-10-09 Jeff Hobbs <jeffh@ActiveState.com>
-2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
+ * library/console.tcl: added more smarts extracted from tkcon to
+ the default console.
- * unix/configure: Regen.
- * unix/configure.in: Remove useless subst of TCL_BIN_DIR.
+2001-10-01 Jeff Hobbs <jeffh@ActiveState.com>
-2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
+ * win/tkWinTest.c: better error reporting from testclipboard
- * generic/tclVar.c: inaccurate comment fixed
-
-2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
+ * win/tkWinDialog.c: minor cast changes to support Win64
+
+ * win/tkWinWindow.c: made use of standard Tk_GetHWND instead of
+ older, private TkWinGetHWND.
- * generic/tclBasic.c (Tcl_AddObjErrorInfo):
- * generic/tclExecute.c (TclUpdateReturnInfo):
- * generic/tclInt.h:
- * generic/tclProc.c:
- Added two Tcl_Obj to the ExecEnv structure to hold the fully
- qualified names "::errorInfo" and "::errorCode" to cache the
- addresses of the corresponding variables. The two most frequent
- setters of these variables now profit from the new variable name
- caching.
+ * win/configure: regen'ed
+ * win/tcl.m4:
+ * win/makefile.vc: updated for Win64 SDK RC1 compilation support
-2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
+2001-09-30 Peter Spjuth <peter.spjuth@space.se>
- * generic/tclVar.c: refactorisation to reuse already looked-up Var
- pointers; definition of three new Tcl_Obj types to cache variable
- name parsing and lookup for later reuse; modification of internal
- functions to profit from the caching.
+ * doc/grid.n:
+ * generic/tkGrid.c:
+ * tests/grid.test: Added -uniform option to grid's row/column-
+ configure. [TIP 37] [Patch 459343]
+
+2001-09-26 Peter Spjuth <peter.spjuth@space.se>
+
+ * win/tkWinFont.c (Tk_DrawChars): Added support for clipping text.
+
+ * doc/frame.n:
+ * doc/labelframe.n:
+ * doc/toplevel.n:
+ * generic/tkFrame.c:
+ * generic/tkInt.h:
+ * generic/tkWindow.c:
+ * library/demos/radio.tcl:
+ * library/demos/labelframe.tcl:
+ * library/demos/widget:
+ * mac/tkMacDefault.h:
+ * tests/frame.test:
+ * unix/tkUnixDefault.h:
+ * win/tkWinDefault.h: Added labelframe widget. Added -padx/y
+ options to frame and toplevel.
+
+ * tests/grid.test:
+ * tests/pack.test:
+ * tests/place.test: Used labelframe to test geometry manager changes.
+ [TIP 18] [Patch 429164]
+
+2001-09-26 Peter Spjuth <peter.spjuth@space.se>
+
+ * doc/GeomReq.3:
+ * doc/WindowId.3:
+ * generic/tk.decls:
+ * generic/tk.h:
+ * generic/tkDecls.h:
+ * generic/tkGeometry.c:
+ * generic/tkGrid.c (ArrangeGrid):
+ * generic/tkInt.h:
+ * generic/tkPack.c (ArrangePacking):
+ * generic/tkPlace.c (RecomputePlacement):
+ * generic/tkStubInit.c:
+ * generic/tkUtil.c (TkComputeAnchor):
+ * generic/tkWindow.c (TkAllocWindow):
+ * unix/mkLinks: Geometry manager changes to support TIP#18.
+ Allows a widget to set different internal border widths on
+ different sides, and to set a minimum requested size.
+ POTENTIAL INCOMPATIBILITY. [Patch 429164]
- * generic/tclInt.decls:
- * generic/tclInt.h:
- * generic/tclIntDecls.h:
- * generic/tclNamesp.c: adding CONST qualifiers to variable names
- passed to Tcl_FindNamespaceVar and to variable resolvers; adding
- CONST qualifier to the 'msg' argument to TclLookupVar. Needed to
- avoid code duplication in the new tclVar.c code.
+2001-09-25 Don Porter <dgp@users.sourceforge.net>
- * tests/set-old.test:
- * tests/var.test: slight modification of error messages due to the
- modifications in the tclVar.c code.
+ * generic/tkBind.c:
+ * generic/tkInt.decls (TkpScanWindowId):
+ * unix/tkUnixPort.h (Tkp{Print,Scan}WindowId):
+ * unix/tkUnixXId.c (TkpScanWindowId):
+ * win/tkWinWindow.c (TkpScanWindowId): Corrected definition of
+ TkpScanWindowId to handle situation where types Window and int
+ do not have the same number of bits. CONST-ified too.
-2002-07-15 Don Porter <dgp@users.sourceforge.net>
+ * generic/tkIntPlatDecls.h:
+ * generic/tkStubInit.c: make genstubs
- * tests/unixInit.test: Improved constraints to protect /tmp.
- [Bug 581403]
+2001-09-24 Don Porter <dgp@users.sourceforge.net>
-2002-07-15 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tkMain.c (StdinProc): Update to handle change in
+ return type of Tcl_DStringAppend() from (char *) to (CONST char *).
+ [TIP 27]
- * tests/winFCmd.test: renamed 'win2000' and 'notWin2000' to
- more appropriate constraint names.
- * win/tclWinFile.c: updated comments to reflect 07-11 changes.
- * win/tclWinFCmd.c: made ConvertFileNameFormat static again,
- since no longer used in tclWinFile.c
- * mac/tclMacFile.c: completed TclpObjLink implementation which
- was previously lacking.
- * generic/tclIOUtil.c: comment cleanup and code speedup.
-
-2002-07-14 Don Porter <dgp@users.sourceforge.net>
+2001-09-23 Peter Spjuth <peter.spjuth@space.se>
+ * generic/tkPack.c (ConfigureSlaves):
+ * tests/pack.test:
+ * tests/grid.test: Pack accepted asymmetric values for -ipadx/y.
+ Only -padx/y supports asymmetry. [Bug #462348]
- * generic/tclInt.h: Removed declarations that duplicated entries
- in the (internal) stub table.
-
- * library/tcltest/tcltest.tcl: Corrected errors in handling of
- configuration options -constraints and -limitconstraints.
+2001-09-21 Jeff Hobbs <jeffh@ActiveState.com>
- * README: Bumped HEAD to version 8.4b2 so we can
- * generic/tcl.h: distinguish it from the 8.4b1 release.
- * tools/tcl.wse.in:
- * unix/configure*:
- * unix/tcl.spec:
- * win/README.binary:
- * win/configure*:
+ * win/tkWinWindow.c (TkpPrintWindowId, TkpScanWindowId): fixed to
+ work on Win64 with 64bit XIDs.
-2002-07-11 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tkWindow.c (Tk_CreateAnonymousWindow):
+ * generic/tkEntry.c (GetSpinboxElement): fixed unreachable returns.
- * doc/file.n:
- * win/tclWinFile.c: on Win 95/98/ME the long form of the path
- is used as a normalized form. This is required because short
- forms are not a robust representation. The file normalization
- function has been sped up, but more performance gains might be
- possible, if speed is still an issue on these platforms.
+ * win/tkWinX.c (TkGetServerInfo): added recognition of Win64.
-2002-07-11 Don Porter <dgp@users.sourceforge.net>
+ * xlib/X11/X.h: made XID __int64 type for Win64.
- * library/tcltest/tcltest.tcl: Corrected reaction to existing but
- false ::tcl_interactive.
+ * unix/tkUnixPort.h:
+ * mac/tkMacPort.h: add (int*) cast to TkpScanWindowId.
+ These may need to be changed to Window* (ulong).
- * doc/Hash.3: Overlooked CONST documentation update.
+ * generic/tkCmds.c (Tk_WinfoObjCmd):
+ * generic/tkBind.c (NameToWindow):
+ correct Window id's to be of type Window
-2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkInt.decls (TkpScanWindowId): changed decl to use
+ Window* instead of int*.
- * generic/tclCkalloc.c: ckalloc() and friends take the block size
- as an unsigned, so we should use %ud when reporting it in fprintf()
- and panic().
+ * xlib/xcolors.c:
+ * generic/tkPack.c,tkWindow.c:
+ * win/tkWinFont.c,tkWinMenu.c:
+ * unix/tkUnixScale.c: minor cast fixes to prevent 64bit warnings.
-2002-07-11 Miguel Sofer <msofer@users.sourceforge.net>
+ * tests/scrollbar.test (scrollbar-6.27): marked knownBug because
+ it is skewed by bad dimensions returned by Windows.
- * generic/tclCompile.c: now setting local vars undefined at
- compile time, instead of waiting until the proc is initialized.
- * generic/tclProc.c: use macro TclSetVarUndefined instead of
- directly etting the flag.
+ * tests/textDisp.test (textDisp-4.12): corrected test to work
+ properly on Windows.
-2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * tests/id.test,macFont.test,macMenu.test,macscrollbar.test:
+ * tests/send.test,winClipboard.test,winDialog.test,winFont.test:
+ improved use of test constraints
- * tests/cmdAH.test: [file attr -perm] is Unix-only, so add [catch]
- when not inside a suitably-protected test.
+ * win/tkWinWm.c (WinSetIcon): fixed SetClassLong for 64bit support.
-2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+2001-09-20 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/unixFCmd.test, tests/fileName.test:
- * tests/fCmd.test: Removed [exec] of Unix utilities that have
- equivalents in standard Tcl. [Bug 579268] Also simplified some
- of unixFCmd.test while I was at it.
+ * unix/configure: regen'ed
+ * unix/tcl.m4: added --enable-64bit support for HP-11 with the
+ 64-bit kernel.
-2002-07-10 Don Porter <dgp@users.sourceforge.net>
+2001-09-17 Don Porter <dgp@users.sourceforge.net>
- * tests/tcltest.test: Greatly reduced the number of [exec]s, using
- slave interps instead.
- * library/tcltest/tcltest.tcl: Fixed bug uncovered in the conversion
- where a message was written to stdout instead of [outputChannel].
+ * generic/tkGrid.c (ConfigureSlaves):
+ * generic/tkPack.c (PackAfter): Corrected type definition of
+ argument passed to Tcl_GetStringFromObj() from size_t to int.
+ Incorrect type broke [pack] and [grid] on systems where
+ sizeof(size_t) != sizeof(int). [Bugs 462375, 462342, 462338]
- * tests/basic.test: Cleaned up, constrained, and reduced the
- * tests/compile.test: amount of [exec] usage in the test suite.
- * tests/encoding.test:
- * tests/env.test:
- * tests/event.test:
- * tests/exec.test:
- * tests/io.test:
- * tests/ioCmd.test:
- * tests/regexp.test:
- * tests/regexpComp.test:
- * tests/socket.test:
- * tests/tcltest.test:
- * tests/unixInit.test:
- * tests/winDde.test:
- * tests/winPipe.test:
-
-2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * tests/cmdAH.test: Removed [exec] of Unix utilities. [Bug 579211]
-
- * tests/expr.test: Added tests to make sure that this works.
- * generic/tclExecute.c (ExprCallMathFunc): Functions should also
- be able to return wide-ints. [Bug 579284]
-
-2002-07-08 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * tests/socket.test: Fixed bug #578164. The original reason for
- the was a DNS outage while running the testsuite. Changed [info
- hostname] to 127.0.0.1 to bypass DNS, knowing that we operate on
- the local host.
-
-2002-07-08 Don Porter <dgp@users.sourceforge.net>
-
- * doc/tcltest.n: Fixed incompatibility in [viewFile].
- * library/tcltest/tcltest.tcl: Corrected docs. Bumped to 2.2.1.
- * library/tcltest/pkgIndex.tcl: [Bug 578163]
-
-2002-07-08 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * tests/cmdAH.test:
- * tests/fCmd.test:
- * tests/fileName.test: tests which rely on 'file link' need a
- constraint so they don't run on older Windows OS. [Bug 578158]
- * generic/tclIOUtil.c:
- * generic/tcl.h:
- * generic/tclInt.h:
- * generic/tclTest.c:
- * mac/tclMacChan.c:
- * unix/tclUnixChan.c:
- * win/tclWinChan.c:
- * doc/FileSystem.3: cleaned up internal handling of
- Tcl_FSOpenFileChannel to remove duplicate code, and make
- writing external vfs's clearer and easier. No
- functionality change. Also clarify that objects with refCount
- zero should not be passed in to the Tcl_FS API, and prevent
- segfaults from occuring on such user errors. [Bug 578617]
-
-2002-07-06 Don Porter <dgp@users.sourceforge.net>
-
- * tests/pkgMkIndex.test: Constrained tests of [load] package indexing
- to those platforms where the testing shared libraries have been built.
- [Bug 578166].
-
-2002-07-05 Don Porter <dgp@users.sourceforge.net>
- * changes: added recent changes
-
-2002-07-05 Reinhard Max <max@suse.de>
-
- * generic/tclClock.c (FormatClock): Convert the format string to
- UTF8 before calling TclpStrftime, so that non-ASCII characters
- don't get mangled when the result string is being converted back.
- * tests/clock.test: Added a test for that.
-
-2002-07-05 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to
- allow running the test suite with a read-only current directory,
- running under ddd instead of gdb, and factored out some executable
- names for broken sites (like mine) where gdb and ddd are installed
- with non-standard names...
-
- * tests/httpold.test: Altered test names to httpold-* to avoid
- clashes with http.test, and stopped tests from failing when the
- current directory is not writable...
-
- * tests/event.test: Stop these tests from failing
- * tests/ioUtil.test: when the current directory is
- * tests/regexp.test: not writable...
- * tests/regexpComp.test:
- * tests/source.test:
- * tests/unixFile.test:
- * tests/unixNotfy.test:
-
- * tests/unixFCmd.test: Trying to make these test-files
- * tests/macFCmd.test: not bomb out with an error when
- * tests/http.test: the current directory is not
- * tests/fileName.test: writable...
- * tests/env.test:
+2001-09-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-2002-07-05 Jeff Hobbs <jeffh@ActiveState.com>
+ * library/choosedir.tcl (DblClick):
+ * library/tkfbox.tcl (OkCmd, ListInvoke): Rewrote so as to avoid
+ the highly confusing string "text" and to be consistent about what
+ is and what is not a list. [Bug 459895, reported by fandom]
- *** 8.4b1 TAGGED FOR RELEASE ***
+2001-09-14 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-2002-07-04 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkImgGIF.c:
+ * generic/tkImgPPM.c:
+ * generic/tkImgPhoto.c:
+ * generic/tkMenu.c: Applied patch [461578], provided by Vincent
+ Darley. This fixes several memory leaks in the image code. They
+ happen if there are errors during the initialization of the
+ channel the image is supposed to be read from.
- * tests/cmdMZ.test (cmdMZ-1.4):
- * tests/cmdAH.test: More fixing of writable-current-dir
- assumption. [Bug 575824]
+2001-09-12 Mo DeJong <mdejong@users.sourceforge.net>
-2002-07-04 Miguel Sofer <msofer@users.sourceforge.net>
+ * unix/configure:
+ * unix/tcl.m4: Update from Tcl.
- * tests/basic.test: Same issue as below; fixed [Bug 575817]
-
-2002-07-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-09-12 D. Richard Hipp <drh@hwaci.com>
- * tests/socket.test:
- * tests/winPipe.test:
- * tests/pid.test: Fixed SF Bug #575848. See below for a
- description the general problem.
-
- * All the bugs below are instances of the same problem: The
- testsuite assumes [pwd] = [temporaryDirectory] and writable.
-
- * tests/iogt.test: Fixed bug #575860.
- * tests/io.test: Fixed bug #575862.
- * tests/exec.test:
- * tests/ioCmd.test: Fixed bug #575836.
-
-2002-07-03 Don Porter <dgp@users.sourceforge.net>
-
- * tests/pkg1/direct1.tcl: removed
- * tests/pkg1/pkgIndex.tcl: removed
- * tests/pkgMkIndex.test: Imported auxilliary files from tests/pkg1
- into the test file pkgMkIndex.test itself. Formatting fixes.
-
- * unix/Makefile.in: removed tests/pkg/* from `make dist`
-
- * tests/pkg/circ1.tcl: removed
- * tests/pkg/circ2.tcl: removed
- * tests/pkg/circ3.tcl: removed
- * tests/pkg/global.tcl: removed
- * tests/pkg/import.tcl: removed
- * tests/pkg/pkg1.tcl: removed
- * tests/pkg/pkg2_a.tcl: removed
- * tests/pkg/pkg2_b.tcl: removed
- * tests/pkg/pkg3.tcl: removed
- * tests/pkg/pkg4.tcl: removed
- * tests/pkg/pkg5.tcl: removed
- * tests/pkg/pkga.tcl: removed
- * tests/pkg/samename.tcl: removed
- * tests/pkg/simple.tcl: removed
- * tests/pkg/spacename.tcl: removed
- * tests/pkg/std.tcl: removed
- * tests/pkgMkIndex.test: Fixed [Bug 575857] where this test file
- expected to be able to write to [file join [testsDirectory]
- pkg]. Part of the fix was to import several auxilliary files
- into the test file itself.
-
- * tests/main.test: Cheap fix for [Bugs 575851, 575858]. Avoid
- * tests/tcltest.test: non-writable . by [cd [temporaryDirectory]].
-
- * library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets
- $varName only if a successful library script is found.
- [Bug 577033]
-
-2002-07-03 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclCompCmds.c (TclCompileCatchCmd): return
- TCL_OUT_LINE_COMPILE instead of TCL_ERROR: let the failure
- happen at runtime so that it can be caught [Bug 577015].
-
-2002-07-02 Joe English <jenglish@users.sourceforge.net>
-
- * doc/tcltest.n: Markup fixes, spellcheck.
-
-2002-07-02 Don Porter <dgp@users.sourceforge.net>
-
- * doc/tcltest.n: more refinements of the documentation.
-
- * library/tcltest/tcltest.tcl: Added trace to be sure the stdio
- constraint is updated whenever the [interpreter] changes.
-
- * doc/tcltest.n: Reverted [makeFile] and [viewFile] to
- * library/tcltest/tcltest.tcl: their former behavior, and documented
- * tests/cmdAH.test: it. Corrected misspelling of hook
- * tests/event.test: procedure. Restored tests.
- * tests/http.test:
- * tests/io.test:
-
- * library/tcltest/tcltest.tcl: Simplified logic of
- [GetMatchingFiles] and [GetMatchingDirectories], removing
- special case processing.
-
- * doc/tcltest.n: More documentation updates. Reference sections
- are complete. Only examples need adding.
-
-2002-07-02 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * tests/fCmd.test:
- * generic/tclCmdAH.c: clearer error msgs for 'file link',
- as per the man page.
-
-2002-07-01 Joe English <jenglish@users.sourceforge.net>
-
- * doc/Access.3:
- * doc/AddErrInfo.3:
- * doc/Alloc.3:
- * doc/Backslash.3:
- * doc/CrtChannel.3:
- * doc/CrtSlave.3:
- * doc/Encoding.3:
- * doc/Eval.3:
- * doc/FileSystem.3:
- * doc/Notifier.3:
- * doc/OpenFileChnl.3:
- * doc/ParseCmd.3:
- * doc/RegExp.3:
- * doc/Tcl_Main.3:
- * doc/Thread.3:
- * doc/TraceCmd.3:
- * doc/Utf.3:
- * doc/WrongNumArgs.3:
- * doc/binary.n:
- * doc/clock.n:
- * doc/expr.n:
- * doc/fconfigure.n:
- * doc/glob.n:
- * doc/http.n:
- * doc/interp.n:
- * doc/lsearch.n:
- * doc/lset.n:
- * doc/msgcat.n:
- * doc/packagens.n:
- * doc/pkgMkIndex.n:
- * doc/registry.n:
- * doc/resource.n:
- * doc/safe.n:
- * doc/scan.n:
- * doc/tclvars.n: Spell-check, fixed typos (Updates from Larry Virden).
-
-2002-07-01 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Made Solaris use gcc for linking
- when building with gcc to resolve problems with undefined symbols
- being present when tcl library used with non-gcc linker at later
- stage. Symbols were compiler-generated, so it is the compiler's
- business to define them. [Bug #541181]
-
-2002-07-01 Don Porter <dgp@users.sourceforge.net>
-
- * doc/tcltest.n: more work in progress updating tcltest docs.
-
- * library/tcltest/tcltest.tcl: Change [configure -match] to
- stop treating an empty list as a list of the single pattern "*".
- Changed the default value to [list *] so default operation
- remains the same.
-
- * tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test.
-
- * library/tcltest/tcltest.tcl: restored writeability testing of
- -tmpdir, augmented by a special exception for the deafault value.
-
-2002-07-01 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * doc/concat.n: Documented the *real* behaviour of [concat]!
-
-2002-06-30 Don Porter <dgp@users.sourceforge.net>
-
- * doc/tcltest.n: more work in progress updating tcltest docs.
-
- * tests/README: Updated the instructions on running and
- * tests/cmdMZ.test: adding to the test suite. Also updated
- * tests/encoding.test: several tests, mostly to correctly create
- * tests/fCmd.test: and destroy any temporary files in the
- * tests/info.test: [temporaryDirectory] of tcltest.
- * tests/interp.test:
-
- * library/tcltest/tcltest.tcl: Stopped checking for writeability
- of -tmpdir value because no default directory can be guaranteed to
- be writeable.
-
- * tests/autoMkindex.tcl: removed.
- * tests/pkg/samename.tcl: removed.
- * tests/pkg/magicchar.tcl: removed.
- * tests/pkg/magicchar2.tcl: removed.
- * tests/autoMkindex.test: Updated auto_mkIndex tests to use
- [makeFile] and [removeFile] so tests are done in [temporaryDirecotry]
- where write access is guaranteed.
-
- * library/tcltest/tcltest.tcl: Fixed [makeFile] and [viewFile] to
- * tests/cmdAH.test: accurately reflect a file's contents.
- * tests/event.test: Updated tests that depended on buggy
- * tests/http.test: behavior. Also added warning messages
- * tests/io.test: to "-debug 1" operations to debug test
- * tests/iogt.test: calls to (make|remove)(File|Directory).
-
- * unix/mkLinks: `make mklinks` on 6-27 commits.
-
-2002-06-28 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclCompile.h: modified the macro TclEmitPush to not
- call its first argument repeatedly or pass it to other macros,
- [Bug 575194] reported by Peter Spjuth.
-
-2002-06-28 Don Porter <dgp@users.sourceforge.net>
-
- * docs/tcltest.n: Doc revisions in progress.
- * library/tcltest/tcltest.tcl: Corrected -testdir default value.
- Was not reliable, and disagreed with docs! Thanks to Hemang Lavana.
- [Bug 575150]
+ * library/tkfbox.tcl: fixed error that appeared when you would
+ click on the canvas while viewing an empty directory.
-2002-06-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+2001-09-10 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/tclUnixThrd.c: Renamed the Tcl_Platform* #defines to
- * unix/tclUnixPipe.c: TclOS* because they are only used
- * unix/tclUnixFile.c: internally. Also stopped double-#def
- * unix/tclUnixFCmd.c: of TclOSlstat [Bug #566099, post-rename]
- * unix/tclUnixChan.c:
- * unix/tclUnixPort.h:
+ * unix/configure:
+ * unix/tcl.m4: Update from Tcl.
- * doc/string.n: Improved documentation for [string last] along
- lines described in Bug #574799 so it indicates that the supplied
- index marks the end of the search space.
+2001-09-09 Mo DeJong <mdejong@users.sourceforge.net>
-2002-06-27 Don Porter <dgp@users.sourceforge.net>
+ * win/Makefile.in: Fix Windows Makefile so that
+ tcltest will automatically be compiled if the
+ user tries to build tktest.
- * doc/dde.n: Work in progress updating the documentation
- * doc/http.n: of the packages that come bundled with
- * doc/msgcat.n: the Tcl source distribution, notably tcltest.
- * doc/registry.n:
- * doc/tcltest.n:
+2001-09-09 Mo DeJong <mdejong@users.sourceforge.net>
- * library/tcltest/tcltest.tcl: Made sure that the TCLTEST_OPTIONS
- environment variablle configures tcltest at package load time.
+ * win/Makefile.in: Use TKTEST variable directly
+ instead of depending on the tktest alias.
-2002-06-26 Vince Darley <vincentdarley@users.sourceforge.net>
+2001-09-08 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/fileSystem.test:
- * generic/tclIOUtil.c: fix to handling of empty paths ""
- which are not claimed by any filesystem (Bug #573758).
- Ensure good error messages are given in all cases.
- * tests/cmdAH.test:
- * unix/tclUnixFCmd.c: fix to bug reported as part of
- (Patch #566669). Thanks to Taguchi, Takeshi for the report.
-
-2002-06-26 Reinhard Max <max@suse.de>
+ * win/mkd.bat:
+ * win/rmd.bat:
+ Apply binary property (cvs admin -kb) to files and convert
+ to CRLF linefeed format to fix the VC++ build. [Tcl Bug #219409]
+
+2001-08-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/menu.test:
+ * tests/send.test:
+ * tests/select.test: corrected to use testConfig constraints in
+ the TK_ALT_DISPLAY case
+
+ * tests/unixSend.test: removed test file completely identical to
+ send.test. Removed platform specific named file in case somebody
+ gets send working on Win/Mac in the future.
+
+ * tests/config.test: added config-14.1 to test namespace import
+ evaluation of widgets.
+ * generic/tkButton.c (ButtonCreate):
+ * generic/tkFrame.c (CreateFrame):
+ * generic/tkMenubutton.c (Tk_MenubuttonObjCmd):
+ * generic/tkPlace.c (Tk_PlaceObjCmd):
+ * generic/tkScale.c (Tk_ScaleObjCmd):
+ * generic/tkMessage.c (Tk_MessageObjCmd):
+ * generic/tkEntry.c (Tk_EntryObjCmd, Tk_SpinboxObjCmd):
+ * generic/tkSquare.c (SquareObjCmd): redid the handling of
+ optionTables in widgets to allow them to be imported into other
+ namespaces. [Bug #456632]
+
+2001-08-28 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinDialog.c (ChooseDirectoryHookProc): work-around for MS
+ bug that caused crashing in tk_chooseDirectory on Win95.
+ [Bug #224936] (baker)
- * unix/tclUnixTime.c: Make [clock format] respect locale settings.
- * tests/clock.test: Bug #565880. ***POTENTIAL INCOMPATIBILITY***
+ * unix/tkUnixWm.c (TkWmRestackToplevel): reworked how
+ ConfigureNotify requests were handled in relation to the parent to
+ avoid the problem with potential 'raise' delays on some wms.
+ [Bug #220260] (baker) wms that were affected should notice the
+ difference in tests unixWm-51.* not failing that failed before.
-2002-06-26 Miguel Sofer <msofer@users.sourceforge.net>
+2001-08-26 Don Porter <dgp@users.sourceforge.net>
- * doc/CrtInterp.3:
- * doc/StringObj.3: clarifications by Don Porter, bugs #493995 and
- #500930.
+ * library/text.tcl (<Shift-Up> binding): Corrected TIP 44 typo
+ that broke binding. Thanks to "Michal" for the fix.
+ [Bug 455468]
+
+2001-08-23 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure:
+ * unix/tcl.m4: added QNX-6 build support. [Bug #219410] (loverso)
+
+ * doc/CrtPhImgFmt.3: removed bogus note about including tkPhoto.h
+
+2001-08-22 Peter Spjuth <peter.spjuth@space.se>
+
+ * generics/tkGrid.c (ConfigureSlaves):
+ * tests/grid.test: Fixed a bug where adjacent 'x' and '^' where
+ not handled properly. [Bug #452040]
-2002-06-24 Don Porter <dgp@users.sourceforge.net>
+2001-08-22 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tkPack.c (TkParsePadAmount): added lint init for sepChar.
+
+ * tests/dialog.test (HitReturn): fixed failing dialog-2.1 test
+ because it wasn't always getting focus properly.
+
+2001-08-21 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/unixFont.test (unixFont-2.[234]): fixed to be more
+ sensitive on systems that have more installed fonts.
+
+ * library/dialog.tcl (tk_dialog): changed dialog to show bar on
+ Windows as well and added some y padding between the buttons and
+ the bar. [Patch #442835] (harrismh)
+
+2001-08-20 Peter Spjuth <peter.spjuth@space.se>
+
+ * generic/tkInt.h:
+ * generic/tkWindow.c:
+ * generic/tkGrid.c:
+ * generic/tkPack.c:
+ * tests/grid.test:
+ * tests/oldpack.test:
+ * tests/pack.test: Objectified grid and pack commands.
+
+2001-08-20 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tkObj.c (TkGetWindowFromObj): Rewrote window code to
+ reuse a previously worked-out set of window information exactly
+ when the reference window is the same and no window deletions have
+ occurred since the object was allocated (display has same epoch
+ counter.) Required changing the internal rep of the window quite
+ a bit as now need to save three words-worth of information in the
+ internal rep (this window, reference window, display epoch.)
+ * generic/tkObj.c (SetWindowFromAny, DupWindowInternalRep,
+ FreeWindowInternalRep): Code to support new internal rep for
+ window objects.
+ * generic/tkInt.h: Added epoch counter to TkDisplay structure
+ * generic/tkWindow.c (GetScreen, Tk_DestroyWindow): Epoch counter
+ is incremented every time a window is deleted.
+
+2001-08-18 Peter Spjuth <peter.spjuth@space.se>
+
+ * doc/grid.n:
+ * tests/grid.test:
+ * generic/tkGrid.c: Grid configure rejected initial "x" and "^".
+ [Bug #418664]
+
+2001-08-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * library/tcltest/tcltest.tcl: Corrected suppression of -verbose skip
- * tests/tcltest.test: and start by [test -output]. Also
- corrected test suite errors exposed by corrected code. [Bug 564656]
+ * generic/tkObj.c (TkGetWindowFromObj): Was failing to reuse
+ cached window objects, forcing a call to Tcl_GetStringFromObj and
+ Tk_NameToWindow every time. This fault has been in there for
+ nearly three years...
-2002-06-25 Reinhard Max <max@suse.de>
+2001-08-15 Don Porter <dgp@users.sourceforge.net>
- * unix/tcl.m4: New macro SC_CONFIG_MANPAGES.
- * unix/configure.in: Added support for symlinks and compression
- * unix/Makefile.in: when installing the manpages. [Patch 518052]
- * unix/mkLinks.tcl: Default is still hardlinks and no compression.
+ * changes: Labelled the TIP 44 changes as "POTENTIAL INCOMPATIBILITY".
+ Although technically internal changes are not incompatible, they'll
+ be perceived as such by those who get bitten, and this will help
+ them find the cause of their trouble.
- * unix/mkLinks: generated
+2001-08-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tk{Util,Font,Cursor,Color,Bitmap,3d}.c: Modified
+ objtype declarations so that they can be picked up in tkObj.c and
+ the names are now prefixed with "tk" too.
+ * generic/tkObj.c (TkRegisterObjTypes):
+ * generic/tkWindow.c (Initialize):
+ * generic/tkInt.h: Added code to register Tk's object types with
+ the Tcl runtime. [Tcl Bug 450545]
+
+2001-08-12 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4: Update from Tcl.
+
+2001-08-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/demos/image2.tcl (loadDir): Converted non-portable
+ [glob [file join $dirName *]] to [glob -directory $dirName *]
+ which is both fully portable and more reliable when directory
+ names contain glob-significant characters. [Bug 223313]
+
+2001-08-08 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/dialog.test: New file testing [tk_dialog].
+
+ * library/dialog.tcl:
+ * library/tkfbox.tcl: Corrections to problems introduced by
+ the TIP 44 changes. [Bug 449261]
+
+ * README:
+ * generic/tk.h:
+ * unix/configure:
+ * unix/configure.in:
+ * unix/tk.spec:
+ * win/configure:
+ * win/configure.in: Bumped up patchlevel to 8.4a4 to distinguish
+ CVS snapshots from the 8.4a3 release. This does not necessarily
+ mean there will be an 8.4a4 release. [Bug 448938].
+
+2001-08-07 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in (dist): added {unix,win}/tcl.m4 and
+ library/msgs/*.msg to dist target. [Bug: #448802]
+
+2001-08-06 Jeff Hobbs <jeffh@ActiveState.com>
+
+ 8.4a3 RELEASE
+
+ * changes:
+ * README: updated for 8.4a3 release
+
+ * unix/configure: regenerated
+ * unix/tcl.m4: added GNU (HURD) configuration target. (brinkmann)
+ [Patch: #442974]
+
+2001-08-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tkConsole.c:
+ * generic/tkWindow.c:
+ * library/bgerror.tcl:
+ * library/dialog.tcl:
+ * library/msgbox.tcl:
+ * library/unsupported.tcl:
+ * mac/tclets.tcl:
+ * mac/tkMacHLEvents.c:
+ * mac/tkMacWm.c: TIP 44 changes specific to the Mac and
+ Windows platforms that were overlooked before: tkOpenDocument,
+ tkConsoleExit, tkConsoleOutput, unsupported1 out of namespace :: .
+ Thanks to Vince Darley for prompting another look.
+
+2001-08-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/winMain.c (WishPanic): fixed CONST changes to go with
+ CONST-ification in Tcl.
+
+ * win/configure: regenerated
+ * win/tcl.m4: fixed DLLSUFFIX definition to always be ${DBGX}.dll.
+ This is necessary for TEA compliant builds that build shared
+ against a static-built Tk.
+ * win/Makefile.in ($(WISH)): added $(TK_STUB_LIB_FILE) to build
+ target, otherwise it wouldn't get generated in a static build.
+
+2001-08-01 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/console.n:
+ * doc/menu.n:
+ * doc/text.n:
+ * doc/tkvars.n:
+ * generic/tkBind.c:
+ * generic/tkMenu.c:
+ * library/bgerror.tcl:
+ * library/button.tcl:
+ * library/choosedir.tcl:
+ * library/clrpick.tcl:
+ * library/comdlg.tcl:
+ * library/console.tcl:
+ * library/dialog.tcl:
+ * library/entry.tcl:
+ * library/focus.tcl:
+ * library/listbox.tcl:
+ * library/menu.tcl:
+ * library/msgbox.tcl:
+ * library/optMenu.tcl:
+ * library/palette.tcl:
+ * library/scale.tcl:
+ * library/scrlbar.tcl:
+ * library/spinbox.tcl:
+ * library/tclIndex:
+ * library/tearoff.tcl:
+ * library/text.tcl:
+ * library/tk.tcl:
+ * library/tkfbox.tcl:
+ * library/unsupported.tcl:
+ * library/xmfbox.tcl:
+ * mac/tkMacMenu.c:
+ * tests/clrpick.test:
+ * tests/filebox.test:
+ * tests/macMenu.test:
+ * tests/menu.test:
+ * tests/menuDraw.test:
+ * tests/msgbox.test:
+ * tests/text.test:
+ * tests/unixMenu.test:
+ * tests/winMenu.test:
+ * tests/xmfbox.test:
+ * unix/mkLinks:
+ * unix/tkUnixDialog.c: Merged changes from feature branch
+ dgp-privates-into-namespace, implementing TIP 44. All
+ Tk commands and variables matching tk[A-Z]* are now in the
+ ::tk namespace. See "BRANCH: dgp-privates-into-namespace"
+ entries below for details. [FR 220936]
+
+2001-07-24 Mo DeJong <mdejong@redhat.com>
+
+ * generic/default.h: Include tkWinDefault.h
+ when built with Cygwin or Mingw.
+
+2001-07-18 Don Porter <dgp@users.sourceforge.net>
+
+ BRANCH dgp-privates-into-namespace:
+ * doc/console.n: Updated names of private console commands.
+
+2001-07-16 Don Porter <dgp@users.sourceforge.net>
+
+ BRANCH dgp-privates-into-namespace:
+ * library/console.tcl:
+ * library/unsupported.tcl: Renamed tk::histNum to tk::HistNum
+ as directed by the Tcl Style Guide.
+
+2001-07-10 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Add AR and STLIB_LD variables.
* unix/configure:
+ * unix/configure.in: Use STLIB_LD when defining MAKE_LIB
+ and MAKE_STUB_LIB. Subst STLIB_LD, RANLIB, and AR.
+ * unix/tcl.m4: Update from Tcl.
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
- * unix/README: Added documentation for the new features.
+2001-07-06 Mo DeJong <mdejong@redhat.com>
- * unix/tcl.m4 (SC_PATH_TCLCONFIG): Replaced ${exec_prefix}/lib by
- ${libdir}.
-
-2002-06-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * generic/tclUtil.c (TclGetIntForIndex): Fix of critical bug
- #533364 generated when the index is bad and the result is a shared
- object. The T_ASTO(T_GOR, ...) idiom likely exists elsewhere
- though. Also removed some cruft that just complicated things to
- no advantage.
- (SetEndOffsetFromAny): Same fix, though this wasn't on the path
- excited by the bug.
-
-2002-06-24 Don Porter <dgp@users.sourceforge.net>
-
- * library/tcltest/tcltest.tcl: Implementation of TIP 101. Adds
- * tests/parseOld.test: and exports a [configure] command
- * tests/tcltest.test: from tcltest.
-
-2002-06-22 Don Porter <dgp@users.sourceforge.net>
-
- * changes: updated changes file for 8.4b1 release.
-
- * library/tcltest/tcltest.tcl: Corrections to tcltest and the
- * tests/basic.test: Tcl test suite so that a test
- * tests/cmdInfo.test: with options -constraints knownBug
- * tests/compile.test: -limitConstraints 1 only tests the
- * tests/encoding.test: knownBug tests. Mostly involves
- * tests/env.test: replacing direct access to the
- * tests/event.test: testConstraints array with calls
- * tests/exec.test: to the testConstraint command
- * tests/execute.test: (which requires tcltest version 2)
- * tests/fCmd.test:
- * tests/format.test:
- * tests/http.test:
- * tests/httpold.test:
- * tests/ioUtil.test:
- * tests/link.test:
- * tests/load.test:
- * tests/namespace.test:
- * tests/pkgMkIndex.test:
- * tests/reg.test:
- * tests/result.test:
- * tests/scan.test:
- * tests/stack.test:
-
-2002-06-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * tools/tcl.wse.in (Disk Label), unix/tcl.spec (version):
- * win/README.binary, README, win/configure.in, unix/configure.in:
- * generic/tcl.h (TCL_RELEASE_*, TCL_PATCH_LEVEL): Bump to beta1.
-
-2002-06-21 Joe English <jenglish@users.sourceforge.net>
-
- * generic/tclCompExpr.c:
- * generic/tclParseExpr.c: LogSyntaxError() should reset
- the interpreter result [Bug 550142 "Tcl_ExprObj -> abort"]
-
-2002-06-21 Don Porter <dgp@users.sourceforge.net>
-
- * unix/Makefile.in: Updated all package install directories
- * win/Makefile.in: to match current Major.minor versions
- * win/makefile.bc: of the packages. Added tcltest package
- * win/makefile.vc: to installation on Windows.
-
- * library/init.tcl: Corrected comments and namespace style
- issues. Thanks to Bruce Stephens. [Bug 572025]
-
-2002-06-21 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * tests/cmdAH.test: Added TIP#99 implementation
- * tests/fCmd.test: of 'file link'. Supports creation
- * tests/fileName.test: of symbolic and hard links in the
- * tests/fileSystem.test: native filesystems and in vfs's,
- * generic/tclTest.c: when the individual filesystem
- * generic/tclCmdAH.c: supports the concept.
- * generic/tclIOUtil.c:
- * generic/tcl.h:
- * generic/tcl.decls:
- * doc/FileSystem.3:
- * doc/file.n:
- * mac/tclMacFile.c:
- * unix/tclUnixFile.c:
- * win/tclWinFile.c: Also enhanced speed of 'file normalize' on
- Windows.
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
-2002-06-20 Miguel Sofer <msofer@users.sourceforge.net>
+2001-07-05 Mo DeJong <mdejong@redhat.com>
- * generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385]
- in the implementation of TIP#62 (command tracing). Vince Darley,
- Hemang Lavana & Don Porter: thanks.
+ * win/Makefile.in: Subst DEPARG directly instead
+ of relying on a variable. This will make Cygwin
+ build faster since an extra exec will be avoided.
+ * win/configure: Regen.
+ * win/configure.in: Subst DEPARG.
+ * win/tcl.m4: Update from Tcl.
-2002-06-20 Miguel Sofer <msofer@users.sourceforge.net>
+2001-07-04 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclExecute.c (TclCompEvalObj): clarified and simplified
- the logic for compilation/recompilation.
+ * README:
+ * mac/README:
+ * unix/README:
+ * win/README: updated READMEs with purls
-2002-06-19 Joe English <jenglish@users.sourceforge.net>
- * doc/file.n: Fixed indentation. No substantive changes.
+2001-07-03 Jeff Hobbs <jeffh@ActiveState.com>
-2002-06-19 Jeff Hobbs <jeffh@ActiveState.com>
+ * tests/canvas.test:
+ * generic/tkCanvPoly.c (PolygonToArea): Added patch that respects
+ the polygon difference of including points in the polygon even
+ when fill is empty. [Bug #226357]
- * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again
- as the Tcl_ObjSetVar2 may cause the result to change.
- [Patch #558324] (watson)
+2001-07-03 Mo DeJong <mdejong@redhat.com>
-2002-06-19 Miguel Sofer <msofer@users.sourceforge.net>
+ * win/Makefile.in: Remove PATHTYPE variable.
+ * win/configure: Regen.
+ * win/configure.in: Don't subst PATHTYPE.
+ * win/tcl.m4: Update from Tcl.
- * generic/tclExecute.c (TEBC): removing unused "for(;;)" loop;
- improved comments; re-indentation.
+2001-07-03 Mo DeJong <mdejong@redhat.com>
-2002-06-18 Miguel Sofer <msofer@users.sourceforge.net>
+ * win/Makefile.in: Don't use VPSEP, instead just use :
+ in the VPATH.
+ * win/configure: Regen.
+ * win/configure.in: Don't subst VPSEP.
- * generic/tclExecute.c (TEBC):
- - elimination of duplicated code in the non-immediate INST_INCR
- instructions.
- - elimination of 103 (!) TclDecrRefCount macros. The different
- instructions now jump back to a common "DecrRefCount zone" at
- the top of the loop. The macro "ADJUST_PC" was replaced by two
- macros "NEXT_INST_F" and "NEXT_INST_V" that take three params
- (pcAdjustment, # of stack objects to discard, resultObjPtr
- handling flag). The only instructions that retain a
- TclDecrRefCount are INST_POP (for speed), the common code for
- the non-immediate INST_INCR, INST_FOREACH_STEP and the two
- INST_LSET.
+2001-07-03 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- The object size of tclExecute.o was reduced by approx 20% since
- the start of the consolidation drive, while making room for some
- peep-hole optimisation at runtime.
+ * library/xmfbox.tcl (tkMotifFDialog_ActivateSEnt): Added missing
+ backslash [Bug #438247]
-2002-06-18 Miguel Sofer <msofer@users.sourceforge.net>
+2001-07-02 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic
- code for tcl-stack corruption.
+ * generic/tkWindow.c (Tk_DestroyWindow): changed to use
+ Tcl_EventuallyFree instead of ckfree so that widgets that have
+ references to a tkwin can use them.
-2002-06-17 David Gravereaux <davygrvy@pobox.com>
+ * generic/tkCanvArc.c:
+ * generic/tkCanvBmap.c:
+ * generic/tkCanvLine.c:
+ * generic/tkCanvPoly.c:
+ * generic/tkCanvText.c:
+ * generic/tkCanvWind.c:
+ * generic/tkRectOval.c: corrected argument handling in
+ Create<Item> functions that could lead to ABRs or FMRs and
+ corrected names of argc/argv to objc/objv.
- Trims to support the removal of RESOURCE_INCLUDED from rc
- scripts from FR #565088.
+ * generic/tkImgGIF.c (Mgetc): corrected screwy use of ternary
+ operator and possible FMR.
- * generic/tcl.h: moved the #ifndef RC_INVOKED start block up in
- the file. rc scripts don't need to know thread mutexes.
+ * generic/tkEntry.c: corrected missing Tcl_Release that caused
+ font not freed complaints when trying valid cleanup calls.
+ * generic/tkListbox.c: made use of Tcl_Preserve/Tcl_Release to
+ prevent FMR errors in Display functions.
- * win/tcl.rc:
- * win/tclsh.rc: removed the #define RESOURCE_INCLUDED to let the
- built-in -DRC_INVOKED to the work.
+ * unix/tkUnixScale.c (TkpDisplayScale): corrected FMR when scale
+ was deleted while calling its command.
-2002-06-17 Jeff Hobbs <jeffh@ActiveState.com>
+ * library/console.tcl:
+ * library/entry.tcl:
+ * library/spinbox.tcl:
+ * library/text.tcl:
+ * library/tk.tcl: added private ::tk::GetSelection command to
+ handle requesting selection. This is to support requesting
+ UTF8_STRING before generic STRING on Unix. Changed Text, Spinbox,
+ Entry and Console to use this command.
- * doc/CrtTrace.3: Added TIP#62 implementation of command
- * doc/trace.n: execution tracing [FR #462580] (lavana).
- * generic/tcl.h: This includes enter/leave tracing as well
- * generic/tclBasic.c: as inter-procedure stepping.
- * generic/tclCmdMZ.c:
- * generic/tclCompile.c:
- * generic/tclExecute.c:
- * generic/tclInt.decls:
- * generic/tclInt.h:
- * generic/tclIntDecls.h:
- * generic/tclStubInit.c:
- * generic/tclVar.c:
- * tests/trace.test:
-
-2002-06-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * win/tclWinPipe.c (BuildCommandLine): Fixed bug #554068 ([exec]
- on windows did not treat { in filenames well.). Bug reported by
- Vince Darley <vincentdarley@users.sourceforge.net>, patch
- provided by Vince too.
-
-2002-06-17 Joe English <jenglish@users.sourceforge.net>
-
- * generic/tcl.h: #ifdef logic for K&R C backwards compatibility
- changed to assume modern C by default. See SF FR #565088 for
- full details.
-
-2002-06-17 Don Porter <dgp@users.sourceforge.net>
-
- * doc/msgcat.n: Corrected en_UK references to en_GB. UK is not
- a country designation recognized in ISO 3166.
-
- * library/msgcat/msgcat.tcl: More Windows Registry locale codes
- from Bruno Haible.
-
- * doc/msgcat.n:
- * library/msgcat/msgcat.tcl:
- * library/msgcat/pkgIndex.tcl:
- * tests/msgcat.test: Revised locale initialization to interpret
- environment variable locale values according to XPG4, and to
- recognize the LC_ALL and LC_MESSAGES values over that of LANG.
- Also added many Windows Registry locale values to those
- recognized by msgcat. Revised tests and docs. Bumped to
- version 1.3. Thanks to Bruno Haible for the report and
- assistance crafting the solution. [Bug 525522, 525525]
-
-2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclCompile.c (TclCompileTokens): a better algorithm for
- the previous bug fix.
-
-2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclCompile.c (TclCompileTokens):
- * tests/compile.test: [Bug 569438] in the processing of dollar
- variables; report by Georgios Petasis.
-
-2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c: bug in the consolidation of the
- INCR_..._STK instructions; the bug could not be exercised as the
- (faulty) instruction INST_INCR_ARRAY_STK was never compiled-in
- (related to [Bug 569438]).
-
-2002-06-14 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c (TclExecuteByteCode): runtime peep-hole
- optimisation of variables (INST_STORE, INST_INCR) and commands
- (INST_INVOKE); faster check for the existence of a catch.
- (TclExecuteByteCode): runtime peep-hole optimisation of
- comparisons.
- (TclExecuteByteCode): runtime peep-hole optimisation of
- INST_FOREACH - relies on peculiarities of the code produced by the
- bytecode compiler.
+ * tests/select.test:
+ * generic/tkSelect.c (Tk_CreateSelHandler, Tk_DeleteSelHandler):
+ on Unix, a UTF8_STRING handler will be created when the user
+ requests a STRING handler (in addition to the STRING handler).
+ This provides implicit support for the new UTF8_STRING selection
+ target.
+ * unix/tkUnixSelect.c (TkSelEventProc, ConvertSelection): Added
+ support for UTF8_STRING target. [RFE #418653, Patch #433283]
-2002-06-14 David Gravereaux <davygrvy@pobox.com>
+ * generic/tkInt.h: added utf8Atom to TkDisplay structure.
- * win/rules.vc: The test for compiler optimizations was in error.
- Thanks goes to Roy Terry <royterry@earthlink.net> for his
- assistance with this.
+ * tests/listbox.test: changed 'darkblue' to 'white' in a test
+ because it isn't a portable color name.
-2002-06-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkEntry.c (DestroyEntry): used Tcl_EventuallyFree
+ instead of ckfree for entryPtr to prevent FMRs. [Bug #413904]
- * doc/trace.n, tests/trace.test:
- * generic/tclCmdMZ.c (Tcl_TraceObjCmd,TclTraceCommandObjCmd)
- (TclTraceVariableObjCmd): Changed references to "trace list" to
- "trace info" as mandated by TIP#102.
-
-2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c (TclExecuteByteCode): consolidated code for
- the conditional branch instructions.
-
-2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c (TclExecuteByteCode): fixed the previous
- patch - wouldn't compile with TCL_COMPILE_DEBUG set.
-
-2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c (TclExecuteByteCode): consolidated the
- handling of exception returns to INST_INVOKE and INST_EVAL, as
- well as most of the code for INST_CONTINUE and INST_BREAK, in the
- new jump target "processExceptionReturn".
-
-2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c (TclExecuteByteCode): consolidated variable
- handling opcodes, replaced redundant code with some 'goto'. All
- store/append/lappend opcodes on the same data type now share the
- main code; same with incr opcodes.
- * generic/tclVar.c: added the bit TCL_TRACE_READS to the possible
- flags to Tcl_SetVar2Ex - it causes read traces to be fired prior
- to setting the variable. This is used in the core for [lappend].
-
- ***NOTE*** the usage of TCL_TRACE_READS in Tcl_(Obj)?GetVar.* is
- not documented; there, it causes the call to create the variable
- if it does not exist. The new usage in Tcl_(Obj)?SetVar.* remains
- undocumented too ...
-
-2002-06-13 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * tests/fCmd.test:
- * tests/winFile.test:
- * tests/fileSystem.test:
- * generic/tclTest.c:
- * generic/tclCmdAH.c:
- * generic/tclIOUtil.c:
- * doc/FileSystem.3:
- * mac/tclMacFile.c:
- * unix/tclUnixFile.c:
- * win/tclWinFile.c: fixed up further so both compiles and
- actually works with VC++ 5 or 6.
- * win/tclWinInt.h:
- * win/tclWin32Dll.c: cleaned up code and vfs tests and
- added tests for the internal changes of 2002-06-12, to see
- whether WinTcl on NTFS can coexist peacefully with links
- in the filesystem. Added new test command 'testfilelink'
- to enable the newer code to be tested.
- * tests/fCmd.test: (made certain tests of 'testfilelink' not
- run on unix).
-
-2002-06-12 Miguel Sofer <msofer@users.sourceforge.net>
-
- * tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to
- Hemang Lavana)
-
-2002-06-12 Jeff Hobbs <jeffh@ActiveState.com>
+2001-06-26 Mo DeJong <mdejong@redhat.com>
- * win/tclWinFile.c: corrected the symbolic link handling code to
- allow it to compile. Added real definition of REPARSE_DATA_BUFFER
- (found in winnt.h). Most of the added definitions appear to have
- correct, cross-Win-version equivalents in winnt.h and should be
- removed, but just making things "work" for now.
+ * unix/Makefile.in:
+ * win/Makefile.in: Add `make shell` target. This target
+ will set the proper env vars before invoking wish
+ from the build directory.
-2002-06-12 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * generic/tclIOUtil.c:
- * generic/tcl.decls:
- * generic/tclDecls.h: made code for Tcl_FSNewNativePath
- agree with man pages.
-
- * doc/FileSystem.3: clarified the circumstances under which
- certain functions are called in the presence of symlinks.
-
- * win/tclWinFile.c:
- * win/tclWinPort.h:
- * win/tclWinInt.h:
- * win/tclWinFCmd.c: Fix for Windows to allow 'file lstat',
- 'file type', 'glob -type l', 'file copy', 'file delete',
- 'file normalize', and all VFS code to work correctly in the
- presence of symlinks (previously Tcl's behaviour was not very
- well defined). This also fixes possible serious problems in
- all versions of WinTcl where 'file delete' on a NTFS symlink
- could delete the original, not the symlink.
- Note: symlinks cannot yet be created in pure Tcl.
-
-2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclBasic.c:
- * generic/tclCompCmds.c:
- * generic/tclInt.h: reverted the new compilation functions;
- replaced by a more general approach described below.
-
- * generic/tclCompCmds.c:
- * generic/tclCompile.c: made *all* compiled variable access
- attempts create an indexed variable - even get or incr without
- previous set. This allows indexed access to local variables that
- are created and set at runtime, for example by [global], [upvar],
- [variable], [regexp], [regsub].
-
-2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
-
- * doc/global.n:
- * doc/info.n:
- * test/info.test:
- * generic/tclCmdIL.c: fix for [Bug 567386], [info locals] was
- reporting some linked variables.
-
- * generic/tclBasic.c:
- * generic/tclCompCmds.c:
- * generic/tclInt.h: added compile functions for [global],
- [variable] and [upvar]. They just declare the new local variables,
- the commands themselves are not compiled-in. This gives a notably
- faster read access to these linked variables.
-
-2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c: optimised algorithm for exception range
- lookup; part of [Patch 453709].
-
-2002-06-10 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * unix/tclUnixFCmd.c: fixed [Bug #566669]
- * generic/tclIOUtil.c: improved and sped up handling of
- native paths (duplication and conversion to normalized paths),
- particularly on Windows.
- * modified part of above commit, due to problems on Linux.
- Will re-examine bug report and evaluate more closely.
-
-2002-06-07 Don Porter <dgp@users.sourceforge.net>
-
- * tests/tcltest.test: More corrections to test suite so that tests
- of failing [test]s don't show up themselves as failing tests.
-
-2002-06-07 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * generic/tclExecute.c: Tidied up headers in relation to float.h
- to cut the cruft and ensure DBL_MAX is defined since doubles seem
- to be the same size everywhere; if the assumption isn't true, the
- variant platforms had better have run configure...
-
- * unix/tclUnixPort.h (EOVERFLOW): Added code to define it if it
- wasn't previously defined. Also some other general tidying and
- adding of comments. [Tcl bugs 563122, 564595]
- * compat/tclErrno.h: Added definition for EOVERFLOW copied from
- Solaris headers; I've been unable to find any uses of EFTYPE,
- which was the error code previously occupying the slot, in Tcl, or
- any definition of it in the Solaris headers.
-
-2002-06-06 Mo DeJong <mdejong@users.sourceforge.net>
-
- * unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g
- and add CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and
- CFLAGS_DEFAULT varaibles. [Tcl bug 565488]
-
-2002-06-06 Don Porter <dgp@users.sourceforge.net>
-
- * tests/tcltest.test: Corrections to test suite so that tests
- of failing [test]s don't show up themselves as failing tests.
-
- * tests/io.test: Fixed up namespace variable resolution issues
- revealed by running test suite with "-singleproc 1".
-
- * doc/tcltest.n:
- * library/tcltest/tcltest.tcl:
- * tests/tcltest.test: Several updates to tcltest.
- 1) changed to lazy initialization of test constraints
- 2) deprecated [initConstraintsHook]
- 3) repaired badly broken [limitConstraints].
- 4) deprecated [threadReap] and [mainThread]
- [Patch 512214, Bug 558742, Bug 461000, Bug 534903]
-
-2002-06-06 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/tclUnixThrd.c (TclpReaddir, TclpLocaltime, TclpGmtime):
- added mutex wrapped calls to readdir, localtime & gmtime in
- case their thread-safe *_r counterparts are not available.
- * unix/tcl.m4: added configure check for readdir_r
- * unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on
- MacOSX (where posix file apis expect utf-8, not iso8859-1).
- * unix/configure: regen
- * unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel
- to LD_LIBRARY_PATH for MacOSX dynamic linker.
- * generic/tclEnv.c (TclSetEnv): fix env var setting on
- MacOSX (adapted from patch #524352 by jkbonfield).
+2001-06-26 Mo DeJong <mdejong@redhat.com>
-2002-06-05 Don Porter <dgp@users.sourceforge.net>
+ * win/configure:
+ * win/configure.in: Revert cross compiling change
+ accidently added during last checkin.
- * doc/Tcl_Main.3: Documented $tcl_rcFileName and added more
- clarifications about the intended use of Tcl_Main(). [Bug 505651]
+2001-06-26 Mo DeJong <mdejong@redhat.com>
-2002-06-05 Daniel Steffen <das@users.sourceforge.net>
+ * unix/configure: Regen.
+ * unix/configure.in: Fix last checkin by removing
+ export since that only works in bash.
+ * win/configure: Regen.
+ * win/configure.in: Ditto.
- * generic/tclFileName.c (TclGlob): mac specific fix to
- recent changes in 'glob -tails' handling.
- * mac/tclMacPort.h:
- * mac/tclMacChan.c: fixed TIP#91 bustage.
- * mac/tclMacResource.c (Tcl_MacConvertTextResource): added utf
- conversion of text resource contents.
- * tests/macFCmd.test (macFCmd-1.2): allow CWIE creator.
+2001-06-26 Mo DeJong <mdejong@redhat.com>
-2002-06-04 Don Porter <dgp@users.sourceforge.net>
+ * unix/configure: Regen.
+ * unix/configure.in: Set CFLAGS to "" if the user
+ did not set CFLAGS in the env. This keeps AC_PROG_CC
+ from adding "-g -O2" to the CFLAGS by default.
+ * win/configure: Regen.
+ * win/configure.in: Ditto.
- * library/tcltest/tcltest.tcl:
- * tests/init.test:
- * tests/tcltest.test: Added more TIP 85 tests from Arjen Markus.
- Converted tcltest.test to use a private namespace. Fixed bugs in
- [tcltest::Eval] revealed by calling [tcltest::test] from a non-global
- namespace, and namespace errors in init.test.
+2001-06-22 Mo DeJong <mdejong@redhat.com>
-2002-06-04 Mo DeJong <mdejong@users.sourceforge.net>
+ * win/configure: Regen.
+ * win/configure.in: Use RC_DEFINE flag from tcl.m4.
+ * win/tcl.m4: Update from Tcl.
- * win/README: Update msys+mingw URL.
+2001-06-22 Mo DeJong <mdejong@redhat.com>
-2002-06-03 Don Porter <dgp@users.sourceforge.net>
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
- * doc/tcltest.n:
- * library/tcltest/tcltest.tcl:
- * library/tcltest/pkgIndex.tcl:
- * tests/tcltest.test: Implementation of TIP 85. Allows tcltest
- users to add new legal values of the -match option to [test],
- associating each with a Tcl command that does the matching of
- expected results with actual results of tests. Thanks to
- Arjen Markus. => tcltest 2.1 [Patch 521362]
+2001-06-22 Mo DeJong <mdejong@redhat.com>
-2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Link to the
+ imm32 library when building with mingw gcc.
+ * win/tkWinX.c: Include the imm.h header
+ to fix compiling with mingw gcc.
- * doc/namespace.n: added description of [namepace forget]
- behaviour for unqualified patterns [Bug 559268]
+2001-06-22 Mo DeJong <mdejong@redhat.com>
-2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
+ * win/configure: Regen.
+ * win/configure.in: Add resource compiler fix from
+ 8.3.3 to fix compiling with mingw.
- * generic/tclExecute.c: reverting an accidental modification in
- the last commit.
-
-2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
+2001-06-22 Mo DeJong <mdejong@redhat.com>
- * doc/Tcl.n: clarify the empty variable name issue ([Bug 549285]
- reported by Tom Krehbiel, patch by Don Porter).
+ * win/configure: Regen.
+ * win/tcl.m4: Fix silly typo in last checkin.
-2002-05-31 Don Porter <dgp@users.sourceforge.net>
+2001-06-22 Mo DeJong <mdejong@redhat.com>
- * library/package.tcl: Fixed leak of slave interp in [pkg_mkIndex].
- Thanks to Helmut for report. [Bug 550534]
+ * unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@.
+ Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG
+ and LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works. Use
+ new LDFLAGS variable in the Makefile instead of @LDFLAGS@.
+ * unix/configure: Regen.
+ * unix/configure.in: Don't set CFLAGS to CFLAGS_DEFAULT, instead
+ subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for CFLAGS_DEBUG,
+ CFLAGS_OPTIMIZE, LDFLAGS_DEFAULT, LDFLAGS_DEBUG, and LDFLAGS_OPTIMIZE.
+ Remove unused LD_FLAGS subst.
+ * unix/tcl.m4: Update from Tcl.
+ * win/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@.
+ Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@.
+ * win/configure: Regen.
+ * win/configure.in: Don't set CFLAGS or LDFLAGS, instead subst
+ CFLAGS_DEFAULT and LDFLAGS_DEFAULT into the Makefile.
+ * win/tcl.m4: Update from Tcl.
- * tests/io.test:
- * tests/main.test: Use the "stdio" constraint to control whether
- an [open "|[interpreter]"] is attempted.
+2001-06-22 Mo DeJong <mdejong@redhat.com>
- * generic/tclExecute.c (TclMathInProgress,TclExecuteByteCode
- ExprCallMathFunc):
- * generic/tclInt.h (TclMathInProgress):
- * unix/Makefile.in (tclMtherr.*):
- * unix/configure.in (NEED_MATHERR):
- * unix/tclAppInit.c (matherr):
- * unix/tclMtherr.c (removed file):
- * win/tclWinMtherr.c (_matherr): Removed internal routine
- TclMathInProgress and Unix implementation of matherr(). These
- are now obsolete, dealing with very old versions of the C math
- library. Windows version is retained in case Borland compilers
- require it, but it is inactive. Thanks to Joe English.
- [Bug 474335, Patch 555635].
- * unix/configure: regen
+ * win/configure:
+ * win/tcl.m4: Update From Tcl.
-2002-05-30 Miguel Sofer <msofer@users.sourceforge.net>
+2001-06-21 eric melski <ericm@interwoven.com>
- * generic/tclCompExpr.c:
- * generic/tclCompile.c:
- * generic/tclCompile.h: removed exprIsJustVarRef and
- exprIsComparison from the ExprInfo and CompileEnv structs. These
- were set, but not used since dec 1999 [Bug 562383].
+ * doc/colors.n: Corrected bogus documentation with respect to
+ several shades of blue, all of which were listed as RGB 0 0 0.
+ [Bug #432104].
-2002-05-30 Vince Darley <vincentdarley@users.sourceforge.net>
+2001-06-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclFileName.c (TclGlob): fix to longstanding
- 'knownBug' in fileName tests 15.2-15.4, and fix to a new
- Tcl 8.4 bug in certain uses of 'glob -tails'.
- * tests/fileName.test: removed 'knownBug' flag from some tests,
- added some new tests for above bugs.
-
-2002-05-29 Jeff Hobbs <jeffh@ActiveState.com>
+ * library/demos/floor.tcl, library/demos/filebox.tcl,
+ * library/demos/clrpick.tcl, library/demos/vscale.tcl,
+ * library/demos/twind.tcl, library/demos/ruler.tcl,
+ * library/demos/plot.tcl, library/demos/items.tcl,
+ * library/demos/hscale.tcl, library/demos/ctext.tcl,
+ * library/demos/cscroll.tcl, library/demos/arrow.tcl,
+ * library/xmfbox.tcl, library/msgbox.tcl,
+ * library/clrpick.tcl, library/bgerror.tcl: Braced expressions.
- * unix/configure: regen'ed
- * unix/configure.in: replaced bigendian check with autoconf
- standard AC_C_BIG_ENDIAN, which defined WORDS_BIGENDIAN on
- bigendian systems.
- * generic/tclUtf.c (Tcl_UniCharNcmp):
- * generic/tclInt.h (TclUniCharNcmp): use WORDS_BIGENDIAN instead of
- TCL_OPTIMIZE_UNICODE_COMPARE to enable memcmp alternative.
-
- * generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP):
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed the case for
- choosing the Tcl_UniCharNcmp compare to when both objs are of
- StringType, as benchmarks show that is the optimal check (both
- bigendian and littleendian systems).
-
-2002-05-29 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclMain.c: Removed "dummy" reference to Tcl_LinkVar.
- It is no longer needed since Tcl_Main() now actually calls
- Tcl_LinkVar(). Thanks to Joe English for pointing that out.
-
-2002-05-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * generic/tclExecute.c (TclExecuteByteCode):
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): Use the macro version.
- * generic/tclInt.h (TclUniCharNcmp): Optimised still further with
- a macro for use in sensitive places like tclExecute.c
-
- * generic/tclUtf.c (Tcl_UniCharNcmp): Use new flag to figure out
- when we can use an optimal comparison scheme, and default to the
- old scheme in other cases which is at least safe.
- * unix/configure.in (TCL_OPTIMIZE_UNICODE_COMPARE): New optional
- flag that indicates when we can use memcmp() to compare Unicode
- strings (i.e. when the high-byte of a Tcl_UniChar precedes the
- low-byte.)
-
-2002-05-29 Jeff Hobbs <jeffh@ActiveState.com>
-
- * generic/tclInt.decls:
- * generic/tclIntDecls.h:
- * generic/tclStubInit.c:
- * generic/tclUtf.c: added TclpUtfNcmp2 private command that
- mirrors Tcl_UtfNcmp, but takes n in bytes, not utf-8 chars. This
- provides a faster alternative for comparing utf strings internally.
- (Tcl_UniCharNcmp, Tcl_UniCharNcasecmp): removed the explicit end
- of string check as it wasn't correct for the function (by doc and
- logic).
-
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): reworked the string equal
- comparison code to use TclpUtfNcmp2 as well as short-circuit for
- equal objects or unequal length strings in the equal case.
- Removed the use of goto and streamlined the other parts.
-
- * generic/tclExecute.c (TclExecuteByteCode): added check for
- object equality in the comparison instructions. Added
- short-circuit for != length strings in INST_EQ, INST_NEQ and
- INST_STR_CMP. Reworked INST_STR_CMP to use TclpUtfNcmp2 where
- appropriate, and only use Tcl_UniCharNcmp when at least one of the
- objects is a Unicode obj with no utf bytes.
-
- * generic/tclCompCmds.c (TclCompileStringCmd): removed error
- creation in code that no longer throws an error.
-
- * tests/string.test:
- * tests/stringComp.test: added more string comparison checks.
-
- * tests/clock.test: better qualified 9.1 constraint check for %s.
-
-2002-05-28 Jeff Hobbs <jeffh@ActiveState.com>
-
- * generic/tclThreadAlloc.c (TclpRealloc, TclpFree): protect
- against the case when NULL is based.
-
- * tests/clock.test: added clock-9.1
- * compat/strftime.c:
- * generic/tclClock.c:
- * generic/tclInt.decls:
- * generic/tclIntDecls.h:
- * unix/tclUnixTime.c: fix for Windows msvcrt mem leak caused by
- using an env(TZ) setting trick for in clock format -gmt 1. This
- also makes %s seem to work correctly with -gmt 1 as well as
- making it a lot faster by avoid the env(TZ) hack. TclpStrftime
- now takes useGMT as an arg. [Bug #559376]
-
-2002-05-28 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * generic/tclIOUtil.c: fixes to Tcl_FSLoadFile when called on
- a file inside a vfs. This should avoid leaving temporary
- files sitting around on exit. [Bug #545579]
-
-2002-05-27 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * win/tclWinError.c: Added comment on conversion of
- ERROR_NEGATIVE_SEEK because that is a mapping that really belongs,
- and not a catch-all case.
- * win/tclWinPort.h (EOVERFLOW): Should be either EFBIG or EINVAL
- * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): EOVERFLOW can
- potentially be a synonym for EINVAL.
-
-2002-05-24 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- === Changes due to TIP#91 ===
-
- * win/tclWinPort.h: Added declaration of EOVERFLOW.
- * doc/CrtChannel.3: Added documentation of wideSeekProc.
- * generic/tclIOGT.c (TransformSeekProc, TransformWideSeekProc):
- Adapted to use the new channel mechanism.
- * unix/tclUnixChan.c (FileSeekProc, FileWideSeekProc): Renamed
- FileSeekProc to FileWideSeekProc and created new FileSeekProc
- which has the old-style interface and which errors out with
- EOVERFLOW when the returned file position can't fit into the
- return type (int for historical reasons.)
- * win/tclWinChan.c (FileSeekProc, FileWideSeekProc): Renamed
- FileSeekProc to FileWideSeekProc and created new FileSeekProc
- which has the old-style interface and which errors out with
- EOVERFLOW when the returned file position can't fit into the
- return type (int for historical reasons.)
- * mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs
- lack large-file support because I can't see how to add it.
- * generic/tclIO.c (Tcl_Seek, Tcl_Tell): Given these functions
- knowledge of the new arrangement of channel types.
- (Tcl_ChannelVersion): Added recognition of new version code.
- (HaveVersion): New function to do version checking.
- (Tcl_ChannelBlockModeProc, Tcl_ChannelFlushProc)
- (Tcl_ChannelHandlerProc): Made these functions use HaveVersion for
- ease of future maintainability.
- (Tcl_ChannelBlockModeProc): Obvious lookup function.
- * generic/tcl.h (Tcl_ChannelType): New wideSeekProc field, and
- seekProc type restored to old interpretation.
- (TCL_CHANNEL_VERSION_3): New channel version.
-
-2002-05-24 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * tests/winPipe.test: Applied patch for SF Tcl Bug #549617. Patch
- and bug report by Kevin Kenny <kennykb@users.sourceforge.net>.
-
- * win/tclWinSock.c (TcpWatchProc): Fixed SF Tcl Bug #557878. We
- are not allowed to mess with the watch mask if the socket is a
- server socket. I believe that the original reporter is George
- Peter Staplin.
+2001-06-06 Mo DeJong <mdejong@redhat.com>
-2002-05-21 Mo DeJong <mdejong@users.sourceforge.net>
+ * win/configure: Regen.
+ * win/configure.in: Handle the --prefix option correctly
+ it should default to /usr/local like the unix version.
+
+2001-06-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/selection.n:
+ * doc/clipboard.n: added SEE ALSOs to cross-reference selection
+ and clipboard, with extra note for clipboard command in selection
+ docs. [Patch #422256]
+
+ * unix/tkUnixFont.c: Corrected support for iso10646 (X11 Unicode)
+ fonts on Unix. This adds a ucs-2be (UCS-2 Big Endian) encoding in
+ Tk on Unix that is used for those fonts (X11 requires
+ big-endianness). (welch) [Patch #406411; Bug #220890 #220899]
+ This differs from the 8.3.3 patch by not adding ucs-2be in the
+ preferred encodingList (seems works fine without).
+ Added alias for jisx0201* fonts to jis0201 encoding. [Bug #414033]
+
+2001-05-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinKey.c (TkpSetKeycodeAndState): removed old debug info
+
+2001-05-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tkWinX.c: moved the initialization of tkPlatformId from
+ TkWinXInit to TkWinGetPlatformId because static builds could call
+ it before it was initialized. [Bug #427278]
+
+2001-05-28 Peter Spjuth <peter.spjuth@space.se>
+
+ * generic/tkFrame.c:
+ * generic/tkWindow.c:
+ * tests/frame.test: Upgraded frame to use the newer TK_OPTION
+ style when processing configuration options. Some cleanup of
+ bad comments and bad code. [part of patch #420861]
+
+2001-05-23 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure:
+ * unix/tcl.m4:
+ * win/configure:
+ * win/tcl.m4: Sync from Tcl sources.
+
+2001-05-21 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tcl.m4: sync'ed up wih Tcl tcl.m4. [Bug #419812]
+
+ * doc/TkInitStubs.3:
+ * generic/tk.h:
+ * generic/tkStubLib.c: CONST'ified Tk_InitStubs to match CONST
+ changes to Tcl_PkgRequireEx.
+
+2001-05-21 Todd M. Helfter <tmh@purdue.edu>
+
+ * doc/menubutton.n:
+ * generic/tkMenubutton.c:
+ * generic/tkMenubutton.h:
+ * mac/tkMacMenubutton.c:
+ * tests/menubut.test:
+ * unix/tkUnixMenubu.c: Implementation of TIP #11, the addition of
+ a -compound option to the menubutton allowing text and an image to
+ be displayed at the same time. This behavior is identical to the
+ behavior of the button widget.
+
+2001-05-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/console.n: Added - was erroneously placed in Tcl before...
+
+2001-04-25 Mo DeJong <mdejong@redhat.com>
* unix/configure: Regen.
- * unix/configure.in: Invoke SC_ENABLE_SHARED before
- calling SC_CONFIG_CFLAGS so that the SHARED_BUILD
- variable can be checked inside SC_CONFIG_CFLAGS.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Pass -non_shared
- instead of -shared to ld when configured with
- --disable-shared under OSF. [Tcl bug 540390]
+ * unix/tcl.m4: Update from Tcl.
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
-2002-05-20 Daniel Steffen <das@users.sourceforge.net>
+2001-04-25 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/configure.in: Use $@ in MAKE_LIB and MAKE_STUB_LIB
+ commands instead of using a delayed subst variable. Replace
+ instances of STUB_LIB_FILE with TK_STUB_LIB_FILE.
- * generic/tclInt.h: added prototype for TclpFilesystemPathType().
- * mac/tclMacChan.c: use MSL provided creator type if available
- instead of the default 'MPW '.
+2001-04-25 Mo DeJong <mdejong@redhat.com>
-2002-05-16 Joe English <jenglish@users.sf.net>
+ * unix/Makefile.in: Use TCL_STUB_LIB_FILE instead of STUB_LIB_FILE.
+ * unix/configure: Regen.
+ * unix/configure.in: Don't subst STUB_LIB_FILE, use TCL_STUB_LIB_FILE
+ instead.
- * doc/CrtObjCmd.3:
- Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName
- (Tcl Bug #547987, #414921)
+2001-04-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-2002-05-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkImage.c (Tk_ImageObjCmd,DeleteImage): Better detection
+ of deletion when world is falling apart. [Bug #220819]
- * unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function
- out to stop compiler warnings. Also much general tidying of
- comments in this file and removal of whitespace from blank lines.
+2001-04-04 Jeff Hobbs <jeffh@ActiveState.com>
-2002-05-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * win/tkWinMenu.c (TkWinHandleMenuEvent): corrected reseting of
+ service mode to only occur when it was set. [Bug #220948]
- * unix/tclUnixChan.c (SETBREAK): Solaris thinks ioctl() takes a
- signed second argument, and Linux thinks ioctl() takes an unsigned
- second argument. So need a longer definition of this macro to get
- neither to spew warnings...
+2001-04-03 Jeff Hobbs <jeffh@ActiveState.com>
-2002-05-13 Vince Darley <vincentdarley@users.sourceforge.net>
+ * tests/winClipboard.test: improved results for understanding when
+ tests fail.
- * generic/tclEvent.c:
- * generic/tclIOUtil.c:
- * generic/tclInt.h: clean up all memory allocated by the
- filesystem, via introduction of 'TclFinalizeFilesystem'.
- Move TclFinalizeLoad into TclFinalizeFilesystem so we can
- be sure it is called at just the right time.
- Fix bad comment also. [Bug #555078 and 'fs' part of #543549]
- * win/tclWinChan.c: fix comment referring to wrong function.
-
-2002-05-10 Don Porter <dgp@users.sourceforge.net>
+ * tests/winDialog.test: string totitle'd some results that
+ expected [pwd] to return a capital drive letter.
- * tests/load.test:
- * tests/safe.test:
- * tests/tcltest.test: Corrected some list-quoting issues and
- other matters that cause tests to fail when the patch includes
- special characters. Report from Vince Darley. [Bug 554068].
+ * tests/cursor.test: changed tests to use 'heart' cursor because
+ 'arrow' on windows has a pre-skewed use count.
-2002-05-08 David Gravereaux <davygrvy@pobox.com>
+ * win/tkWinDialog.c (GetFileNameA): initialize multi to 0.
- * doc/file.n:
- * tools/man2tcl.c:
- * tools/man2help2.tcl: Thanks to Peter Spjuth
- <peter.spjuth@space.se>, again. My prior fix for
- single-quote macro mis-understanding was wrong. Reverted to
- reimpliment the 'macro2' proc which handles single-quote macros
- and restored file.n text arrangement to avoid single-quotes on
- the first line. Sorry for all the confusion.
+2001-04-02 Jeff Hobbs <jeffh@ActiveState.com>
-2002-05-08 David Gravereaux <davygrvy@pobox.com>
+ * win/configure:
+ * win/tcl.m4 (SHLIB_LD): added -incremental:no. [Bug #219381]
- * tools/man2tcl.c:
- * tools/man2help2.tcl: Proper source of macro error mis-
- understanding single-quote as the leading macro command found
- and repaired.
+ * generic/tkMenu.c (TkInvokeMenu): checked for menu deletion
+ before calling associated menu entry command. [Bug #220821]
- * doc/file.n: Reverted to prior state before I messed with
- it.
+ * doc/image.n: added warning about names chosen for images.
-2002-05-08 Don Porter <dgp@users.sourceforge.net>
+ * generic/tkImgPhoto.c (ImgPhotoCmd): corrected the src and dest
+ values for $imageName put when -format and -to are used.
+ [Bug #232741]
- * library/tcltest/tcltest.tcl: Corrected [uplevel] quoting when
- [source]-ing test script in subdirectories.
- * tests/fileName.test:
- * tests/load.test:
- * tests/main.test:
- * tests/tcltest.test:
- * tests/unixInit.test: Fixes to test suite when there's a space
- in the working path. Thanks to Kevin Kenny.
-
-2002-05-07 David Gravereaux <davygrvy@pobox.com>
-
- -- Changes from Peter Spjuth <peter.spjuth@space.se>
- * tools/man2tcl.c: Increased line buffer size and a bail-out if
- that should ever be over-run.
- * tools/man2help.tcl: Include Courier New font in rtf header.
- * tools/man2help2.tcl: Improved handling of CS/CE fields. Use
- Courier New for code samples and indent better.
-
- * doc/file.n:
- * doc/TraceCmd.3: winhelp conversion tools where understanding
- a ' as the first character on a line to be an unknown macro.
- Not knowing how to repair tools/man2tcl.c, I decided to rearrange
- the text in the docs instead.
-
-2002-05-07 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * generic/tclFileName.c: fix to similar segfault when using
- 'glob -types nonsense -dir dirname -join * *'. [Bug 553320]
-
- * doc/FileSystem.3: further documentation on vfs.
- * tests/cmdAH.test:
- * tests/fileSystem.test:
- * tests/pkgMkindex.test: Fix to testsuite bugs when running out
- of directory whose name contains '{' or '['.
-
-2002-05-07 Miguel Sofer <msofer@users.sourceforge.net>
-
- * tests/basic.test: Fix for [Bug 549607]
- * tests/encoding.test: Fix for [Bug 549610]
- These are testsuite bugs that caused failures when the filename
- contained spaces. Report & fix by Kevin Kenny.
-
-2002-05-02 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * generic/tclFileName.c: fix to freeing a bad object
- (i.e. segfault) when using 'glob -types nonsense -dir dirname'.
- * generic/tclWinFile.c: fix to [Bug 551306], also wrapped some
- long lines.
- * tests/fileName.test: added several tests for the above bugs.
- * doc/FileSystem.3: clarified documentation on refCount
- requirements of the object returned by the path type function.
- * generic/tclIOUtil.c:
- * win/tclWinFile.c:
- * unix/tclUnixFile.c:
- * mac/tclMacFile.c: moved TclpFilesystemPathType to the
- platform specific directories, so we can add missing platform-
- specific implementations. On Windows, 'file system' now returns
- useful results like "native NTFS", "native FAT" for that system.
- Unix and MacOS still only return "native".
- * doc/file.n: clarified documentation.
- * tests/winFile.test: test for 'file system' returning correct
- values.
- * tests/fileSystem.test: test for 'file system' returning correct
- values. Clean up after failed previous test run.
+ * tests/listbox.test: added test listbox-27.1, delete during
+ scrollbar update
+ * generic/tkListbox.c (DestroyListbox, ListboxEventProc):
+ corrected listbox to make proper use of Tcl_EventuallyFree and
+ protect against unusual listbox deletion.
+
+ * tests/entry.test: added tests entry-20.*, delete during widget
+ activity
+ * generic/tkEntry.c (DestroyEntry, EntryEventProc): fixed the
+ entry widget to survive deletion while processing scrollbar
+ updates and validation.
+
+ * tests/canvas.test: test of canvas delete during event
+ * generic/tkCanvas.c (DestroyCanvas, CanvasEventProc): fixed the
+ canvas to survive deletion during event processing. [Bug #228024]
+
+2001-04-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * README:
+ * mac/README: updated patchlevel to 8.4a3 and corrected links and
+ notes.
+
+ * generic/tk.h:
+ * unix/configure.in (TK_PATCH_LEVEL):
+ * unix/configure:
+ * unix/tk.spec:
+ * win/configure.in (TK_PATCH_LEVEL):
+ * win/configure: updated patchlevel to 8.4a3
+
+2001-03-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/safe.test: added note about correcting failures in
+ safe.test.
+ * library/tk.tcl: moved package require msgcat inside if case to
+ not be used in safe interps.
+
+ * win/makefile.vc:
+ * win/configure:
+ * win/tcl.m4: added imm32.lib to LIBS_GUI for Tk IME support.
+ * win/tkWinInt.h:
+ * win/tkWinKey.c:
+ * win/tkWinX.c: added support for changing IME on the fly in
+ Windows (2000). (lam) [Patch #402993]
-2002-04-26 Jeff Hobbs <jeffh@ActiveState.com>
+ * tests/bind.test (bind-22.18):
+ * generic/tkBind.c (NameToWindow): handled the error case where a
+ valid-looking but invalid identifier could be passed in certain
+ event generate options causing a crash. [Bug #411307]
+
+ * win/tkWinWm.c (UpdateWrapper): ensured that the passed in winPtr
+ had an existent window to operate on. [Bug #409172]
+
+ * win/Makefile.in (install-*): improved install-* targets to use
+ their base build dependency.
+
+ * generic/tkImage.c (Tk_ImageObjCmd, EventuallyDeleteImage):
+ added casts to allow compiling on Windows with debbuging.
+
+2001-03-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/msgs/de.msg: fixed translations. [Patch #403525]
+
+ * doc/canvas.n: Noted ability to specify coords as a list in the
+ docs. (techentin) [Patch #403660]
+
+ * tests/canvas.test: added test case to check obj conversion
+ * generic/tkObj.c (UpdateStringOfMM, SetMMFromAny): better
+ obj-aware screen distances. (pgbaum, hobbs) [Patch #403327]
+
+ * library/bgerror.tcl (bgerror): allow focus into details window
+ for Windows C&P to work. [Bug #220929]
+
+ * library/tk.tcl: put a catch around adding <hpBackTab> to the
+ <<PrevWindow>> virtual event as it doesn't seem to work on all HP
+ systems. [Bug #411669]
+
+ * library/tkfbox.tcl: fixed selecting directories and single files
+ with spaces using tk_getOpenFile -multiple 1. [Bug #411640]
+
+ * win/tkWinDialog.c (GetFileNameA): added support for -multiple to
+ ascii-based tk_getOpenFile (Win9*). (haneef) [Patch #403047]
+ (GetFileNameW): increased number of files that could be returned
+ by tk_getOpenFile -multiple. [Patch #412042]
+
+2001-03-29 Mo DeJong <mdejong@redhat.com>
+
+ * library/entry.tcl (tkEntryMouseSelect):
+ * library/text.tcl (tkTextSelectTo): When
+ the mouse is dragged with the button down,
+ move the insertion cursor to the current
+ mouse position.
+ * tests/event.test: Add a series of tests
+ for event generation. Add tests for selection,
+ check the position of the insertion cursor.
+
+2001-03-28 Jeff Hobbs <jeffh@gimlet.activestate.com>
* unix/configure:
- * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so
- that the .sl knows its dependent libs.
+ * unix/tcl.m4: corrected IRIX-5.x config to not use -n32.
+ (english) [Patch 403626]
+
+2001-03-28 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/focus.test (focus-6.1):
+ * tests/macEmbed.test (unixEmbed-5.1):
+ * tests/macMenu.test (macMenu-21.3):
+ * tests/menu.test (menu-27.1):
+ * tests/unixEmbed.test (unixEmbed-8.2):
+ * tests/unixWm.test (unixWm-50.4): Replaced all [load {} tk]
+ in Tk test suite with [load {} Tk]. [Bug 220940, Patch 411952]
+
+2001-03-12 Don Porter <dgp@users.sourceforge.net>
+
+ BRANCH dgp-privates-into-namespace:
+ * doc/menu.n:
+ * unix/mkLinks: Added documentation for [tk_menuSetFocus].
+
+2001-03-12 Don Porter <dgp@users.sourceforge.net>
+
+ BRANCH dgp-privates-into-namespace:
+ * doc/text.n:
+ * doc/tkvars.n:
+ * unix/mkLinks: Added documentation for commands and variables
+ matching tk_text*.
+
+2001-03-08 Don Porter <dgp@users.sourceforge.net>
+
+ BRANCH dgp-privates-into-namespace:
+ * generic/tkTextDisp.c:
+ * library/unsupported.tcl:
+ * tests/textDisp.test: Restored the global variables tk_textRedraw
+ and tk_textRelayout. Since they match tk_*, they should remain
+ publicly available until at least Tk 9.
+
+2001-03-01 Don Porter <dgp@users.sourceforge.net>
+
+ BRANCH dgp-privates-into-namespace:
+ * library/unsupported.tcl: New file for Tk's unsupported
+ interfaces. Contains [tk::unsupported::ExposePrivateCommand]
+ and [tk::unsupported::ExposePrivateVariable] that restore the
+ availability of an old public name of one of Tk's private
+ commands and variables, respectively, for those applications
+ and extensions that depend on the old names against advice.
+
+2001-02-28 Don Porter <dgp@users.sourceforge.net>
+
+ BRANCH dgp-privates-into-namespace: Feature branch to move all
+ of Tk's private commands and variable into the ::tk namespace
+ and its children.
+
+ * doc/tkvars.n: Documented private variable tkPriv renamed tk::Priv.
+
+ * generic/tkBind.c:
+ * generic/tkMenu.c:
+ * generic/tkTextDisp.c:
+ * library/bgerror.tcl:
+ * library/button.tcl:
+ * library/choosedir.tcl:
+ * library/clrpick.tcl:
+ * library/comdlg.tcl:
+ * library/console.tcl:
+ * library/dialog.tcl:
+ * library/entry.tcl:
+ * library/focus.tcl:
+ * library/listbox.tcl:
+ * library/menu.tcl:
+ * library/msgbox.tcl:
+ * library/optMenu.tcl:
+ * library/palette.tcl:
+ * library/scale.tcl:
+ * library/scrlbar.tcl:
+ * library/spinbox.tcl:
+ * library/tclIndex:
+ * library/tearoff.tcl:
+ * library/text.tcl:
+ * library/tk.tcl:
+ * library/tkfbox.tcl:
+ * library/xmfbox.tcl:
+ * mac/tkMacMenu.c:
+ * tests/clrpick.test:
+ * tests/filebox.test:
+ * tests/macMenu.test:
+ * tests/menu.test:
+ * tests/menuDraw.test:
+ * tests/msgbox.test:
+ * tests/text.test:
+ * tests/textDisp.test:
+ * tests/unixMenu.test:
+ * tests/winMenu.test:
+ * tests/xmfbox.test:
+ * unix/tkUnixDialog.c: All Tk commands matching ::tk[A-Z]* and
+ all Tk private variables in the global namespace were renamed to
+ live in the namespace ::tk or one of its children.
+
+2001-02-13 Eric Melski <ericm@interwoven.com>
+
+ * doc/photo.n: [Bug 132213] Added clarification on interpretation
+ of ranges for "photoName data -from" subcommand.
+
+2001-02-12 D. Richard Hipp <drh@hwaci.com>
+
+ TIP #21: Asymmetric padding in the pack and grid geometry managers.
+ With this changes, you can now say "-padx {10 20}" to put 10 pixels
+ of padding on the left and 20 on the right. Similar rules apply
+ for vertical padding. See the revised documentation for details.
+
+2001-01-02 Andreas Kupries <a.kupries@westend.com>
+
+ * Everything below belongs together and implements TIP #8
+ (SF patch #102833).
+
+ * win/tkWinWm.c (line 56f): Added icon structures.
+ * win/tkWinWm.c (struct WmInfo, line 242): Added reference to
+ optional icon for titlebar.
+ * win/tkWinWm.c (struct ThreadSpecificData, line 335): Added
+ reference to optional default icon for toplevel windows.
+ * win/tkWinWm.c (line 387 ... 1169): All the new functions required
+ to deal with icon specifications, 'InitWm' changed.
+ * win/tkWinWm.c (TkWmNewWindow, UpdateWrapper, TkWmDeadWindow, Tk_WmCmd):
+ Added initialization and handling of the new fields.
+ * doc/wm.n: Documentation updated to explain the newly available
+ functionality.
+
+2000-12-13 jeff hobbs <jhobbs@interwoven.com>
+
+ * generic/tkObj.c (SetMMFromAny): Added ability to recognize
+ double type object to speed up canvas coord calculations.
+ [Patch 403327]
+
+2000-12-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/entry.n: Improved documentation of interplay between the
+ -state and -textvariable options.
+
+2000-11-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/image.test (image-1.10): Improved this test, which
+ previously only worked if the command failed to delete the root
+ window, and caused *major* trouble otherwise...
+ * generic/tkImage.c (EventuallyDeleteImage): Created this function
+ so that images that get deleted during the creation of an image
+ won't cause a nasty core dump. Properly fixes bug #120819.
+
+2000-11-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/image.n:
+ * generic/tkImage.c (Tk_ImageObjCmd): Backed out previous change.
+ Bug #120819 is back again in force. Left the test in there
+ though.
+
+2000-11-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/image.n:
+ * tests/image.test (image-1.10):
+ * generic/tkImage.c (Tk_ImageObjCmd): Prohibited image names that
+ start with "." since they can cause some really obscure
+ crashes. Fixes Bug #120819.
+
+2000-11-21 Eric Melski <ericm@ajubasolutions.com>
+
+ Overall change: Implemented TIP 5, which exports
+ TkClassProcs/TkSetClassProcs as Tk_ClassProcs/Tk_SetClassProcs,
+ adding a size field to Tk_ClassProcs to allow for future
+ expansion, and renaming the geometryProc to worldChangedProc,
+ which is more in keeping with the actual use of the callback.
+
+ * unix/mkLinks: Added link for Tk_SetClassProcs.
+
+ * doc/SetClassProcs.3: Documentation for
+ Tk_ClassProcs/Tk_SetClassProcs.
+
+ * generic/tkCanvas.c:
+ * generic/tkEntry.c:
+ * generic/tkFrame.c:
+ * generic/tkListbox.c:
+ * generic/tkMenu.c:
+ * generic/tkMessage.c:
+ * generic/tkScale.c:
+ * generic/tkText.c: Updated to use Tk_ClassProcs/Tk_SetClassProcs
+ instead of TkClassProcs/TkSetClassProcs.
+
+ * generic/tkMenubutton.c:
+ * generic/tkScrollbar.c:
+ * generic/tkButton.c: Updated to use Tk_SetClassProcs instead of
+ TkSetClassProcs.
+
+ * generic/tkMenubutton.h:
+ * generic/tkScrollbar.h:
+ * generic/tkButton.h:
+ * win/tkWinButton.c:
+ * win/tkWinScrlbr.c:
+ * mac/tkMacButton.c:
+ * mac/tkMacMenubutton.c:
+ * mac/tkMacScrlbr.c:
+ * unix/tkUnixButton.c:
+ * unix/tkUnixMenubu.c:
+ * unix/tkUnixScrlbr.c: Updated to use Tk_ClassProcs instead of
+ TkClassProcs.
+
+ * generic/tkDecls.h:
+ * generic/tkStubInit.c:
+ * generic/tkIntDecls.h: Regenned from tk.decls, tkInt.decls.
+
+ * generic/tk.h: Added declaration of Tk_ClassProcs, with size
+ field. Added typedef's for Tk_ClassCreateProc,
+ Tk_ClassWorldChangedProc, Tk_ClassModalProc. Added definition of
+ Tk_GetClassProc macro, shorthand for extracting a member of the
+ Tk_ClassProcs structure.
-2002-04-26 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkInt.h: Removed declaration of TkClassProcs,
+ TkClassGeometryProc, etc.
- * tests/obj.test (obj-11.[56]): Test conversion to boolean more
- thoroughly.
- * generic/tclObj.c (SetBooleanFromAny): Was not calling an integer
- parsing function on native 64-bit platforms! [Bug 548686]
+ * generic/tkBind.c (Tk_BindEvent): Updated to use Tk_GetClassProc
+ macro to extract modalProc; added check that the modalProc is non-NULL.
-2002-04-24 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tkFont.c (RecomputeWidgets): Updated to use
+ Tk_GetClassProc macro to extract worldChangedProc; added comment
+ about the choice of a recursive versus iterative algorithm for
+ propagating world changed messages.
- * generic/tclInt.h: corrected TclRememberJoinableThread decl to
- use VOID instead of void.
- * generic/tclThreadJoin.c: noted that this code isn't needed on Unix.
+ * generic/tkWindow.c (Tk_MakeWindowExist): Updated to use
+ Tk_GetClassProc macro to extract createProc from Tk_ClassProcs.
-2002-04-23 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tk.decls: Added declaration for Tk_SetClassProcs.
- * doc/exec.n:
- * doc/tclvars.n: doc updates [Patch #509426] (gravereaux)
+ * generic/tkInt.decls: Commented out declaration for
+ TkSetClassProcs, which is made public by this change. The entry
+ is left in place, but commented, so that future developers will
+ know not to reuse it's stub number.
-2002-04-24 Daniel Steffen <das@users.sourceforge.net>
+2000-11-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * mac/tclMacResource.r: added check of
- TCLTK_NO_LIBRARY_TEXT_RESOURCES #define to allow disabling the
- inclusion of the tcl library code in the resource fork of Tcl
- executables and shared libraries.
+ * doc/ConfigWidg.3: Added deprecation note from Bug #120944 - use
+ Tk_SetOption() instead.
-2002-04-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkImgPhoto.c (TkPhotoGetValidRegion): Applied patch to
+ create this function and add it to tkInt stubs. Should now be
+ possible to write an extension that accesses the transparency data
+ in a photo image. Bug #120930
- * doc/TraceCmd.3: New file that documents Tcl_CommandTraceInfo,
- Tcl_TraceCommand and Tcl_UntraceCommand [Bug 414927]
+2000-11-03 Jeff Hobbs <hobbs@ajubasolutions.com>
-2002-04-22 Jeff Hobbs <jeffh@ActiveState.com>
+ 8.4a2 RELEASE
- * generic/tclAlloc.c:
- * generic/tclInt.h:
- * generic/tclThreadAlloc.c (new):
- * unix/Makefile.in:
- * unix/tclUnixThrd.c:
+ * generic/tkWindow.c (Initialize): added call to Tcl_SetMainLoop.
+ This only has effect when tclsh is run (not wish), and then Tk is
+ loaded in interactively.
+
+2000-11-02 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * win/tkWinButton.c:
+ * win/tkWinDialog.c:
+ * win/tkWinScrlbr.c:
+ * win/tkWinWm.c: fixed up code for Win64 support. This mostly
+ remains in _WIN64 #ifdef's, until updated compilers are standard.
+
+ * win/tcl.m4:
+ * win/makefile.vc: updated for Win64 compile support
+
+ * unix/configure:
+ * win/configure: checked in configure scripts so people doing
+ CVS checkouts aren't required to have autoconf. Changes to
+ configure.in in the future will require the corresponding
+ configure script to also be re-autoconf'ed and checked in.
+
+ * doc/event.n: added note that key events require window focus.
+
+2000-11-01 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * win/tkWinDialog.c (GetFileNameW, GetFileNameA,
+ Tk_ChooseDirectoryObjCmd): created
+ work-around for change in NT5.0/98 that caused no initialdir
+ setting to open the browser up in the user's documents dir.
+
+ * tests/color.test: marked color-2.6 nonPortable as we can't
+ reliably assume what 'red' maps to.
+
+2000-11-01 Eric Melski <ericm@ajubasolutions.com>
+
+ * tests/winDialog.test: Corrected expected results for bad option
+ tests (5.2, 5.5) to include -multiple option.
+
+ * win/tkWinDialog.c: Added branch for 0 return from
+ CommDlgExtendedError() switches; this was formerly treated as an
+ error, but it actually is not, since it just means the user hit
+ cancel or closed the dialog. (GetFileNameW): Added better smarts
+ such that -multiple is not considered a valid option for
+ tk_getSaveFile.
+ Removed CommDlgExtendedError() checks for color and choosedir
+ dialogs, and removed all except the explicit invalid filename
+ checks for the file dialogs.
+
+2000-10-30 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * win/configure.in:
* win/Makefile.in:
- * win/tclWinInt.h:
- * win/tclWinThrd.c: added new threaded allocator contributed by
- AOL that significantly reduces lock contention when multiple
- threads are in use. Only Windows and Unix implementations are
- ready, and the Windows one may need work. It is only used by
- default on Unix for now, and requires that USE_THREAD_ALLOC be
- defined (--enable-threads on Unix will define this).
+ * win/makefile.vc:
+ * win/rc/tk.rc:
+ * win/rc/tk_base.rc (new):
+ * win/rc/wish.rc: Added logic to derive filenames better in the
+ resource scripts based on compile options along with better
+ support for building a static wish shell with cursor resources.
+
+2000-10-27 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * unix/tcl.m4: added support for AIX-5.
+
+ * tests/tk.test:
+ * doc/tk.n: updated to reflect default on status of useinputmethods.
+ * library/tk.tcl: tk useinputmethods is set to 1 by default. This
+ enables Kanji and dead-char input by default. Intro'd in
+ 1999-12-16 with default off to avoid some problems with older X
+ servers that would slow down widget creation over time.
+
+ * win/Makefile.in (test, winhelp, tktest): corrected the
+ TCL_LIBRARY path specification.
+
+2000-10-18 Eric Melski <ericm@ajubasolutions.com>
+
+ * win/tkWinDraw.c (RenderObject): Applied patch from [Bug: 6368],
+ which corrects rendering of 1-pixel wide stippled lines on Windows.
+
+ * generic/tkCanvLine.c (DisplayLine): Applied patch from
+ [Bug: 6368], corrects bugs relating to use of active- and
+ disabledwidth values for displaying lines (disabledwidth was never
+ used, and activewidth/disablewidths would only possibly be used
+ when greater than default width, rather than when simply not equal
+ to default width).
+
+ * library/tkfbox.tcl (OkCmd): Applied patch from [Bug: 6365],
+ which adds safety for directory names containing spaces or which
+ are non-lists.
+
+ * win/tkWinDialog.c (GetFileNameW, GetFileNameA,
+ Tk_ChooseColorObjCmd, Tk_ChooseDirectoryObjCmd): Added error
+ checking for the return value from the common dialog functions, so
+ that the commands will not silently fail if the common dialog
+ returns an error. [Bug: 6369].
+
+2000-10-10 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tkConfig.c (Tk_InitOptions): Added
+ Tcl_IncrRefCount/Tcl_DecrRefCount calls on valuePtr, to prevent
+ memory leaks when the value object comes from the option
+ database. [Bug: 6275].
+
+2000-10-06 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * win/Makefile.in (cat32.${OBJEXT}): add win/ subdirectory to
+ cat32 target to correctly find the source file.
+
+2000-10-05 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tkCmds.c (Tk_WinfoObjCmd): Added check for
+ TK_ANONYMOUS_WINDOW flag in the [winfo children] subcommand; if
+ set, the window will not be printed in the list of children.
+
+ * doc/CrtWindow.3: Added entry for Tk_CreateAnonymousWindow.
+
+ * generic/tkWindow.c
+ (Tk_CreateAnonymousWindow): New API for creating anonymous
+ windows. These windows are manipulable from C, but not from Tcl,
+ because they have no pathname associated with them. They are used
+ initially by widgets that do rubber-band resizing (panedwindow,
+ multi-column listbox, etc.), and may be useful for other widgets
+ as well (dropbox, combobox).
+ (Tk_DestroyWindow): Added check for TK_ANONYMOUS_WINDOW flag when
+ determining whether to generate a DestroyNotify event.
+
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h: Regen'd from tk.decls.
+
+ * generic/tk.decls: Added Tk_CreateAnonymousWindow declaration.
+
+ * generic/tk.h: Added TK_ANONYMOUS_WINDOW flag for Tk_Window's.
+
+2000-10-04 Eric Melski <ericm@ajubasolutions.com>
+
+ * doc/MaintGeom.3: Noted that Tk_MaintainGeometry handles direct
+ descendants properly.
+
+ * generic/tkGeometry.c (Tk_MaintainGeometry): Added a check for
+ the case in which the slave window is a direct descendant of the
+ master window. In this case, we need not set up the additional
+ infrastructure normally provide by Tk_MaintainGeometry, because we
+ can rely on the parent/child relationship to handle it for us
+ implicitly. In this case, Tk_MaintainGeometry just calls directly
+ to Tk_MoveResizeWindow. This allows geometry managers to simply
+ always use Tk_MaintainGeometry to maintain geometry for slaves,
+ and avoid doing the direct descendant check themselves.
+ (Tk_UnmaintainGeometry): Added a matching check for the direct
+ descendant case; in this case, Tk_UnmaintainGeometry simply
+ returns immediately.
+
+2000-10-01 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tkButton.c (ConfigureButton): Added tests for -compound
+ option, so that when there is a textvariable and an image, and
+ -compound is not none, the button will display both the
+ textvariable and the image.
+
+ * doc/SetOptions.3: Added note that restoreProc and freeProc may
+ be NULL.
+
+ * generic/tkConfig.c (Tk_RestoreSavedOptions): For custom options,
+ added test that the restoreProc is not NULL, to allow for custom
+ options that don't care about supporting Tk_RestoreSavedOptions.
+
+2000-09-29 D. Richard Hipp <drh@hwaci.com>
+
+ * generic/tkBitmap.c: Changes to prevent a BadMatch error from the
+ Xserver when the same bitmap is used on two or more screens of the
+ same display.
+
+ * tests/menu.test: Print a warning if the TK_ALT_DISPLAY environment
+ variable is not configured so as to test for the bug fix above.
+
+ * library/tk.tcl (::tk::SetGrabFocus): "Catch" the grab in case
+ another application already holds the grab and the "grab" command
+ fails.
+
+2000-09-29 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/Makefile.in: commented use of TESTFLAGS
+ * unix/Makefile.in: added TESTFLAGS to test and testlang targets to
+ conform with Windows makefile and TEA style.
+
+2000-09-29 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tkTest.c: Fixed tests to use updated API.
+
+ * doc/SetOptions.3:
+ * generic/tk.h:
+ * generic/tkConfig.c: Changed interface for Tk_CustomOptionSetProc
+ and Tk_CustomOptionGetProc; these now take a pointer to the start
+ of the widget record, and an integer offset to the slot for the
+ option value, instead of just a pointer to the slot. This allows
+ more sophisticated options to do interesting things based on other
+ data in the widget record.
+
+2000-09-17 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tk.h: Added declaration of Tk_ObjCustomOption structure,
+ used for TK_OPTION_CUSTOM, and typedef's of the functions
+ Tk_CustomOptionSetProc, Tk_CustomOptionGetProc,
+ Tk_CustomOptionRestoreProc, and Tk_CustomOptionFreeProc, used for
+ TK_OPTION_CUSTOM.
+
+ * doc/SetOptions.3: Added documentation of TK_OPTION_CUSTOM, and
+ section "CUSTOM OPTION TYPES" explaining how to create and use
+ custom options.
+
+ * tests/config.test: Added tests for custom option type.
+
+ * generic/tkTest.c: Added test support for TK_OPTION_CUSTOM to
+ TestobjconfigObjCmd. Added CustomOption* functions to implement a
+ test custom option.
+
+ * generic/tkConfig.c: Added new option type TK_OPTION_CUSTOM,
+ which allows the definition of custom option types by creating
+ parsing, printing, freeing, and restoring procedures for a custom
+ option. This is needed by the text and canvas widgets if they are
+ to be fully objectified.
+
+2000-09-07 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/Tk_Init.3:
+ * doc/bell.n:
+ * doc/loadTk.n: minor doc cleanup
+
+2000-09-06 Eric Melski <ericm@ajubasolutions.com>
+
+ * doc/HWNDToWindow.3:
+ * doc/GetHWND.3: Changed synopsis to indicate the tkPlatDecls.h
+ should be included, not tk.h.
+
+ * generic/tkPlatDecls.h: Removed #include <windows.h> for Windows,
+ a better solution for now is to update the docs and have extension
+ authors #include <tkPlatDecls.h>.
+
+ * generic/tk.h: Removed '#include "tkPlatDecls.h"', as the
+ incorrect inclusion order between windows.h/tkPlatDecls.h causes
+ build conflicts on Windows.
+
+ * generic/tkPlatDecls.h: Added #include <windows.h> for Windows,
+ so that HWND, etc., are defined properly.
+
+2000-09-06 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/canvas.n: fixed doc bug (ellson). [Bug: 6218]
+
+ * README:
+ * generic/tk.h:
+ * unix/configure.in:
+ * unix/tk.spec:
+ * win/configure.in: updated to patchlevel 8.4a2
+
+ * generic/tkMessage.c (MessageWidgetObjCmd): initialized result to
+ avoid pedantic warning.
+
+ * generic/tkGrab.c (Tk_GrabObjCmd): changed len arg from size_t to
+ int to fix pedantic warning.
+
+2000-09-01 Eric Melski <ericm@ajubasolutions.com>
+
+ * win/makefile.vc (install-libraries):
+ * win/Makefile.in (install-libraries):
+ * unix/Makefile.in (install-libraries): Added tkPlatDecls.h to
+ list of header files to install.
+
+ * generic/tk.h: Added #include "tkPlatDecls.h", which declares the
+ platform specific component of the public Tk stubs API's.
- * generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister):
- corrected calling of Tcl_ConditionWait to ensure that there would
- be a condition to wait upon.
+2000-08-29 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclCmdAH.c (Tcl_FileObjCmd): added cast in FILE_SIZE.
+ * win/tkWinMenu.c (DrawWindowsSystemBitmap): Use scratchDC
+ for determining the source's logical coordinates. Patch from
+ [Bug: 6134 (Markus Oberhumer)].
- * win/tclWinFCmd.c (DoDeleteFile): check return of setattr API
- calls in file deletion for correct Win32 API handling.
+ * win/tkWinMenu.c (SetDefaults): Compute the indicatorDimensions[]
+ under Windows NT/2000 in the same way as under Windows 95/98.
+ Patch from [Bug: 6134 (Markus Oberhumer)].
- * win/Makefile.in: correct dependencies for shell, gdb, runtest
- targets.
+ * win/tkWinFont.c (GetScreenFont): Added a memset() to
+ pacify memory checkers. Patch from [Bug: 6134 (Markus Oberhumer)].
- * doc/clock.n:
- * compat/strftime.c (_fmt): change strftime to correctly handle
- localized %c, %x and %X on Windows. Added some notes about how
- the other values could be further localized.
+ * library/tkfbox.tcl (::tk::dialog::file::Update): Corrected
+ handling of multi-pattern filters (eg, "* *.*"), which was broken
+ by the getOpenFile performance patches applied earlier.
-2002-04-19 Don Porter <dgp@users.sourceforge.net>
+2000-08-24 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclMain.c (Tcl_Main): Free the memory allocated for the
- startup script path. [Bug 543549]
+ * doc/toplevel.n:
+ * doc/spinbox.n:
+ * doc/scrollbar.n:
+ * doc/scale.n:
+ * doc/menubutton.n:
+ * doc/menu.n:
+ * doc/listbox.n:
+ * doc/entry.n:
+ * doc/frame.n:
+ * doc/message.n:
+ * doc/checkbutton.n:
+ * doc/radiobutton.n:
+ * doc/button.n:
+ * doc/label.n:
+ * doc/canvas.n:
+ * doc/text.n: Fixed Standard Options section to make best use of
+ new tab settings in man.macros.
- * library/msgcat/msgcat.tcl: [mcmax] wasn't using the caller's
- namespace when determining the max translated length. Also
- made revisions for better use of namespace variables and more
- efficient [uplevel]s.
+2000-08-24 Mo DeJong <mdejong@redhat.com>
- * doc/msgcat.n:
- * library/msgcat/msgcat.tcl:
- * library/msgcat/pkgIndex.tcl: Added [mcload] to the export list
- of msgcat; bumped to 1.2.3. [Bug 544727]
+ * unix/README: Update to account for removal of --enable-gcc.
+ * unix/configure.in:
+ * unix/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option.
+ * win/configure.in:
+ * win/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option.
+ Remove quick hack that provided cross compile support for
+ windows builds.
+
+2000-08-23 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkButton.c (ButtonTextVarProc): reversed change below,
+ it was not correct.
+
+2000-08-22 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkButton.c (ButtonTextVarProc): changed order of
+ incr/decr of new value object, in case they are equal.
+
+2000-08-18 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tkImgPhoto.c (ImgPhotoGet): Removed redundant call to
+ DitherInstance; this call was formerly being made from
+ ImgPhotoGet->ImgPhotoConfigureInstance->DitherInstance, and
+ ImgPhotoGet->DitherInstance. The second call was removed.
+
+2000-08-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/SetOptions.3: added missing ')'.
+
+2000-08-09 Eric Melski <ericm@ajubasolutions.com>
+
+ * doc/SetOptions.3: Updated documentation to reflect support for
+ TK_OPTION_NULL_OK for TK_OPTION_DOUBLE and TK_OPTION_PIXELS.
-2002-04-20 Daniel Steffen <das@users.sourceforge.net>
+ * generic/tkConfig.c: Added for TK_OPTION_NULL_OK support for
+ TK_OPTION_DOUBLE and TK_OPTION_PIXELS.
- * generic/tclInt.decls:
- * generic/tclIntPlatDecls.h:
- * generic/tclStubInit.c:
- * mac/tclMacFCmd.c:
- * mac/tclMacFile.c:
- * mac/tclMacUtil.c: Modified TclpObjNormalizePath to be alias
- file aware, and replaced various calls to FSpLocationFrom*Path
- by calls to new alias file aware versions FSpLLocationFrom*Path.
- The alias file aware routines don't resolve the last component of
- a path if it is an alias. This allows [file copy/delete] etc. to
- act correctly on alias files. (c.f. discussion in Bug #511666)
+ * doc/place.n: Updated, reformatted manual entry.
-2002-04-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * tests/place.test: Added many tests.
- * tests/lindex.test (lindex-3.7):
- * generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from
- hitting wide ints. [Bug #526717]
+ * generic/tkPlace.c (Tk_PlaceObjCmd): Updated to use Tk
+ widget-option management facilities to manage place options (-x,
+ -y, etc.), which simplifies the placer code. Added support for
+ [place configure pathName] and [place configure pathName -option],
+ similar to the behavior of the configure subcommand supported by
+ widgets.
-2002-04-18 Miguel Sofer <msofer@users.sourceforge.net>
+2000-08-08 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclNamesp.c:
- * tests/info.test: [Bug 545325] info level didn't report
- namespace eval, bug report by Richard Suchenwirth.
+ * tests/place.test: Extended test suite to test error returns from
+ [place].
-2002-04-18 Don Porter <dgp@users.sourceforge.net>
+ * generic/tkInt.h: Replaced Tk_PlaceCmd prototype with
+ Tk_PlaceObjCmd prototype.
- * doc/subst.n: Clarified documentation on handling unusual return
- codes during substitution, and on variable substitutions implied
- by command substitution, and vice versa. [Bug 536838]
+ * generic/tkWindow.c: Updated [place] command entry to use new
+ Tcl_Obj interface.
-2002-04-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkPlace.c (Tk_PlaceObjCmd): Tcl_Obj'ified [place] command.
- * generic/tclCmdIL.c (InfoBodyCmd):
- * tests/info.test (info-2.6): Proc bodies without string reps
- would report as empty [Bug #545644]
+2000-08-07 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for
- comment on behaviour when substitutions are not well-formed,
- prompted by [Bug #536831]; alas, removing the ill-defined
- behaviour is a lot of work.
+ * generic/tkWindow.c: Updated [selection] command entry to use
+ new Tcl_Obj interface.
-2002-04-18 Miguel Sofer <msofer@users.sourceforge.net>
+ * generic/tkInt.h: Replaced Tk_SelectionCmd prototype with
+ Tk_SelectionObjCmd prototype.
- * generic/tclExecute.c:
- * tests/expr-old.test: fix for [Bug #542588] (Phil Ehrens), where
- "too large integers" were reported as "floating-point value" in
- [expr] error messages.
+ * tests/select.test: Updated test suite to recognize standardized
+ error messages.
-2002-04-17 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tkSelect.c (Tk_SelectionObjCmd): Tcl_Obj'ified
+ [selection] command.
- * generic/tclEncoding.c (EscapeFromUtfProc):
- * generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling
- of outputting end escapes for escape-based encodings.
- [Bug #526524] (yamamoto)
+2000-08-07 Jeff Hobbs <hobbs@scriptics.com>
-2002-04-17 Don Porter <dgp@users.sourceforge.net>
+ * doc/cursors.n: changed .SS to more compatible macros.
- * doc/tcltest.n: Removed [saveState] and [restoreState] from
- tcltest 2 documentation, effectively deprecating them. [Bug 495660]
- * library/tcltest/tcltest.tcl: Made separate export for commands
- kept only for tcltest 1 compatibility.
+2000-08-05 Jeff Hobbs <hobbs@scriptics.com>
- * tests/iogt.test: Revised to run tests in a namespace, rather than
- use the useless and buggy [saveState] and [restoreState] commands
- of tcltest. Updated to use tcltest 2 as well. [Patch 544911]
+ * library/safetk.tcl: rationalized the setting of tk_library when
+ initialized Tk in a safe interpreter.
-2002-04-16 Don Porter <dgp@users.sourceforge.net>
+2000-08-03 Eric Melski <ericm@ajubasolutions.com>
- * tests/io.test: Revised to run tests in a namespace, rather than
- use the useless and buggy [saveState] and [restoreState] commands
- of tcltest. Updated to use tcltest 2 as well. [Patch 544546]
+ * generic/tkWindow.c: Updated "grab" command entry to use
+ Tcl_Obj'ified command.
-2002-04-15 Miguel Sofer <msofer@users.sourceforge.net>
+ * generic/tkInt.h: Replaced Tk_GrabCmd prototype with
+ Tk_GrabObjCmd prototype.
- * generic/tclProc.c:
- * tests/proc-old.test: Improved stack trace for TCL_BREAK and
- TCL_CONTINUE returns from procs. Patch by Don Porter
- [Bug 536955].
+ * tests/grab.test: Initial suite of tests for [grab] command.
+
+ * generic/tkGrab.c (Tk_GrabObjCmd): Tcl_Obj'ified [grab] command.
+
+ * generic/tkInt.h: Removed Tk_AfterCmd function prototype; the
+ function does not exist (since 4.0p3). Cleaned up some line
+ wrapping.
- * generic/tclExecute.c:
- * tests/compile.test: made bytecodes check for a catch before
- returning; the compiled [return] is otherwise non-catchable.
- [Bug 542142] reported by Andreas Kupries.
+ * generic/tk.h: Removed "#define Tk_AfterCmd Tcl_AfterCmd";
+ nothing in the core uses Tk_AfterCmd, and Tcl_AfterCmd doesn't exist
+ anymore anyway.
-2002-04-15 Don Porter <dgp@users.sourceforge.net>
+ * generic/tkInt.h: Replace Tk_BindCmd prototype with
+ Tk_BindObjCmd prototype.
- * tests/socket.test: Increased timeout values so that tests have
- time to successfully complete even on slow/busy machines. [Bug 523470]
+ * generic/tkWindow.c: Updated "bind" command entry to use
+ Tcl_Obj'ified command.
- * doc/tcltest.n:
- * library/tcltest/tcltest.tcl:
- * tests/tcltest.test: Revised [tcltest::test] to return errors
- when called with invalid syntax and to accept exactly two arguments
- as documented. Improved error messages. [Bug 497446, Patch 513983]
- ***POTENTIAL INCOMPATIBILITY***: Incompatible with previous
- tcltest 2.* releases, found only in alpha releases of Tcl 8.4.
+ * generic/tkCmds.c (Tk_BindObjCmd): Tcl_Obj'ified [bind] command.
-2002-04-11 Jeff Hobbs <jeffh@ActiveState.com>
+ * tests/bind.test: Tweaked expected error messages for [bindtags]
+ to comply with updated error messages.
- * generic/tclNotify.c (TclFinalizeNotifier): remove remaining
- unserviced events on finalization.
+ * generic/tkMenu.c (CloneMenu): Replaced calls to Tk_BindtagsCmd
+ with equivalent calls to Tk_BindtagsObjCmd.
- * win/tcl.m4: Enabled COFF as well as CV style debug info with
- --enable-symbols to allow Dr. Watson users to see function info.
- More info on debugging levels can be obtained at:
- http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp
+ * generic/tkInt.h: Replace Tk_BindtagsCmd prototype with
+ Tk_BindtagsObjCmd prototype.
- * tests/ioCmd.test: fixed iocmd-8.15 to have mac and unixPc variants.
+ * generic/tkWindow.c: Updated "bindtags" command entry to use
+ Tcl_Obj'ified command.
- * generic/tclParse.c (Tcl_ParseVar): conditionally incr obj
- refcount to prevent possible mem leak.
+ * generic/tkCmds.c (Tk_BindtagsObjCmd): Tcl_Obj'ified [bindtags]
+ command.
-2002-04-08 Daniel Steffen <das@users.sourceforge.net>
+2000-08-02 Eric Melski <ericm@ajubasolutions.com>
- * generic/tcl.h: no <sys/types.h> on mac.
- * mac/tclMacFile.c: minor fixes to Vince's changes from 03-24.
- * mac/tclMacOSA.c:
- * mac/tclMacResource.c: added missing Tcl_UtfToExternalDString
- conversions of resource file names.
- * mac/tclMacSock.c (TcpGetOptionProc): fixed bug introduced
- by Andreas on 02-25; changed strcmp's to strncmp's so that
- option comparison behaves like on other platforms.
- * mac/tcltkMacBuildSupport.sea.hqx (CW Pro6 changes): added
- support to allow Tk to hookup C library stderr/stdout to TkConsole.
- * tests/basic.test:
- * tests/cmdAH.test:
- * tests/encoding.test:
- * tests/fileSystem.test:
- * tests/ioCmd.test: fixed tests failing on mac: check for
- existence of [exec], changed some result strings.
-
-2002-04-06 Jeff Hobbs <jeffh@ActiveState.com>
-
- * unix/tclUnixFCmd.c (Realpath): added a little extra code to
- initialize a realpath arg when compiling in PURIFY mode in order
- to prevent spurious purify warnings. We should really create our
- own realpath implementation, but this will at least quiet purify
- for now.
-
-2002-04-05 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclCmdMZ.c (Tcl_SubstObj):
- * tests/subst.test: Corrected [subst] so that return codes
- TCL_BREAK and TCL_CONTINUE returned by variable substitution
- have the same effect as when those codes are returned by command
- substitution. [Bug 536879]
-
-2002-04-03 Jeff Hobbs <jeffh@ActiveState.com>
-
- * library/tcltest/tcltest.tcl: added getMatchingFiles back (alias
- to GetMatchingFiles), which was a public function in tcltest 1.0.
-
-2002-04-01 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * generic/tclEnv.c:
- * generic/tclIOUtil.c: invalidate filesystem cache when the
- user changes env(HOME). Fixes [Bug #535621]. Also cleaned up
- some of the documentation.
- * tests/fileSystem.test: added test for bug just fixed.
-
-2002-04-01 Kevin Kenny <kennykb@acm.org>
-
- * win/tclWinTime.c (Tcl_GetTime): made the checks of clock
- frequency more permissive to cope with the fact that Win98SE
- is observed to return 1.19318 in place of 1.193182 for the
- performance counter frequency.
-
-2002-03-29 Jeff Hobbs <jeffh@ActiveState.com>
-
- * generic/tclCmdMZ.c (Tcl_TraceObjCmd, TraceVarProc)
- (TraceCommandProc, TclTraceCommandObjCmd): corrected
- potential double-free of traces on variables by flagging in
- Trace*Proc that it will free the var in case the eval wants to
- delete the var trace as well. [Bug #536937]
- Also converted Tcl_UntraceVar -> Tcl_UntraceVar2 and Tcl_Eval to
- Tcl_EvalEx in Trace*Proc for slight efficiency improvement.
-
-2002-03-29 Don Porter <dgp@users.sourceforge.net>
-
- * doc/AllowExc.3:
- * generic/tclBasic.c (Tcl_EvalObjv,Tcl_EvalEx,Tcl_EvalObjEx):
- * generic/tclCompile.h (TclCompEvalObj):
- * generic/tclExecute.c (TclCompEvalObj,TclExecuteByteCode):
- * tests/basic.test: Corrected problems with Tcl_AllowExceptions
- having influence over the wrong scope of Tcl_*Eval* calls. Patch
- from Miguel Sofer. Report from Jean-Claude Wippler. [Bug 219181]
-
-2002-03-28 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclVar.c: Refactored CallTraces to collect repeated
- handling of its returned value into CallTraces itself.
+ * generic/tkCmds.c (Tk_TkwaitObjCmd): Tcl_Obj'ified [tkwait] command.
-2002-03-28 David Gravereaux <davygrvy@pobox.com>
+ * generic/tkWindow.c: Updated "tkwait" command entry to use
+ Tcl_Obj'ified command.
- * tools/feather.bmp:
- * tools/man2help.tcl:
- * tools/man2help2.tcl:
- * win/makefile.vc: More winhelp target fixups. Added a feather
- bitmap to the non-scrollable area and changed the color to be
- yellow from a plain white. The colors can be whatever we want
- them to be, but thought I would start with something bold.
- [Bug 527941]
-
- * doc/SetVar.3:
- * doc/TraceVar.3:
- * doc/UpVar.3: .AP macro syntax repair.
-
-2002-03-27 David Gravereaux <davygrvy@pobox.com>
-
- * tools/man2help.tcl:
- * win/makefile.vc: winhelp target now copies all needed files
- from tools/ to a workarea under $(OUT_DIR) and builds it from
- there. No build cruft is left in tools/ anymore. All paths
- used in man2help.tcl are now relative to where the script is.
- [Bug 527941]
-
-2002-03-27 David Gravereaux <davygrvy@pobox.com>
-
- * win/.cvsignore:
- * win/buildall.vc.bat:
- * win/coffbase.txt:
- * win/makefile.vc:
- * win/nmakehlp.c (new):
- * win/rules.vc: First draft fix for [Bug 527941]. More changes
- need to done to the makehelp target to get to stop leaving build
- files in the tools/ directory. This does not address the syntax
- errors in the man files. Having the contents of tcl.hpj(.in)
- inside makefile.vc allows for version numbers to be replaced with
- macros.
-
- The new nmakehlp.c is built by rules.vc in preprocessing and removes
- the need to use tricky shell syntax that wasn't compatible on Win9x
- systems. Clean targets made Win9x complient. This is a first draft
- repair for [Bug 533862].
-
-2002-03-28 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclBasic.c (Tcl_EvalEx): passing the correct commandSize
- to TclEvalObjvInternal. [Bug 219362], fix by David Knoll.
-
-2002-03-28 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclBasic.c (Tcl_EvalEx):
- * tests/basic.test: avoid exceptional returns at level 0
- [Bug 219181]
-
-2002-03-27 Don Porter <dgp@users.sourceforge.net>
-
- * doc/tcltest.n ([mainThread]):
- * library/tcltest/tcltest.tcl:
- * tests/tcltest.test: Major code cleanup to deal with whitespace,
- coding conventions, and namespace issues, with several minor bugs
- fixed in the process.
-
- * tests/main.test: Added missing [after cancel]s.
-
-2002-03-25 Don Porter <dgp@users.sourceforge.net>
-
- * tests/main.test: Removed workarounds for Bug 495977.
-
- * library/tcltest/tcltest.tcl: Keep the value of $::auto_path
- unchanged, so that the tcltest package can test code that depends
- on auto-loading. If a testing application needs $::auto_path pruned,
- it should do that itself. [Bug 495726]
- Improve the processing of the -constraints option to [test] so that
- constraint lists can have arbitrary whitespace, and non-lists don't
- blow things up. [Bug 495977]
- Corrected faulty variable initialization. [Bug 534845]
-
-2002-03-25 Miguel Sofer <msofer@users.sourceforge.net>
-
- * doc/CrtTrace.3: small doc correction
- * generic/tclBasic.c (Tcl_DeleteTrace): Allow NULL callback on
- trace deletions [Bug 534728] (Hemang Lavana).
-
-2002-03-24 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclBasic.c (Tcl_EvalObjv): replaced obscure, incorrect
- code as described in [Bug 533907] (Don Porter).
-
-2002-03-24 Don Porter <dgp@users.sourceforge.net>
-
- * library/tcltest/tcltest.tcl: Use [interpreter] to set/query the
- executable currently running the tcltest package. [Bug 454050]
-
- * library/tcltest/tcltest.tcl: Allow non-proc commands to be used
- as the customization hooks. [Bug 495662]
-
-2002-03-24 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * generic/tclFilename.c:
- * generic/tclFCmd.c:
- * generic/tclTest.c:
- * generic/tcl.h:
- * generic/tclIOUtil.c:
- * win/tclWinFile.c:
- * win/tclWinFCmd.c:
- * win/tclWinPipe.c:
- * unix/tclUnixFile.c:
- * unix/tclUnixFCmd.c:
- * mac/tclMacFile.c:
- * doc/FileSystem.3:
- * doc/file.n:
- * tests/cmdAH.test:
- * tests/fileName.test:
- * tests/fileSystem.test: (new file)
- * tests/winFCmd.test: fix [Bug 511666] and [Bug 511658],
- and improved documentation of some aspects of the filesystem,
- particularly 'Tcl_FSMatchInDirectory' which now might match
- a single file/directory only, and 'file normalize' which
- wasn't very clear before. Removed inconsistency betweens
- docs and the Tcl_Filesystem structure. Also fixed
- [Bug 523217] and corrected file normalization on Unix so that
- it expands symbolic links. Added some new tests of the
- filesystem code (in the new file 'fileSystem.test'), and
- some extra tests for correct handling of symbolic links.
- Fix to [Bug 530960] which shows up on Win98. Made comparison
- with ".com" case insensitive in tclWinPipe.c
-
- ***POTENTIAL INCOMPATIBILITY***: But only between alpha
- releases (users of the new Tcl_Filesystem lookup table in Tcl
- 8.4a4 need to handle the new way in which Tcl may call
- Tcl_FSMatchInDirectory, and 'file normalize' on unix now
- behaves correctly). Only known impact is with the 'tclvfs'
+ * generic/tkInt.h: Replace Tk_TkwaitCmd prototype with
+ Tk_TkwaitObjCmd prototype.
+
+ * generic/tkGrid.c (Tk_GridCmd): Split [grid] subcommands into
+ separate functions instead of inlining them all in Tk_GridCmd.
+
+2000-08-01 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tkInt.h: Replaced prototype for Tk_MessageCmd with
+ prototype for Tk_MessageObjCmd.
+
+ * generic/tkWindow.c: Marked message command as using the new
+ MessageObjCmd instead of the old MessageCmd.
+
+ * tests/message.test: Added tests for the message widget.
+
+ * generic/tkMessage.c: Obj'ified the message widget.
+
+ * generic/tkInt.h: Removed prototype for Tk_ClipboardCmd, added
+ prototype for Tk_ClipboardObjCmd.
+
+ * generic/tkWindow.c: Updated function pointers for clipboard
+ command to use Tcl_Obj version.
+
+ * tests/clipboard.test: Updated tests to expect standard error
+ messages.
+
+ * generic/tkClipboard.c (Tk_ClipboardObjCmd): Obj'ified
+ Tk_ClipboardCmd -> Tk_ClipboardObjCmd.
+
+2000-07-28 Eric Melski <ericm@ajubasolutions.com>
+
+ * unix/tkUnixButton.c (TkpDisplayButton): Added bits to change
+ the indicator color when radio-/check-buttons are disabled. This
+ reduces the visual incongruity when a group of these controls are
+ disabled together.
+
+ * win/tkWinMenu.c (ReconfigureWindowsMenu): Added MF_GRAYED bit
+ for disabled menu entries, to ensure that those which are drawn by
+ the system are shown grayed (such as entries on menubars) [Bug: 4372].
+
+ * doc/label.n: Added -disabledforeground to list of options [Bug:
+ 6053].
+
+ * mac/tkMacDefault.h:
+ * unix/tkUnixDefault.h: Added default values for listbox
+ disabledforeground and state.
+
+ * win/tkWinDefault.h: Changed default listbox background color to
+ white and listbox selection borderwidth to 0, in keeping with the
+ "Microsoft Windows User Experience"; added default values for
+ listbox disabledforeground and listbox state.
+
+ * doc/listbox.n: Added documentation for -state option.
+
+ * generic/tkListbox.c: Added support for -state to listbox. [RFE:
+ 6052].
+
+ * tests/listbox.test: Tests for listbox disabled state.
+
+2000-07-27 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure.in: TCL_STUB_LIB_FLAG and
+ TK_STUB_LIB_FLAG should not include ${TCL_DBGX}
+ in win/tkConfig.sh, fix that.
+
+2000-07-25 Joe English <jenglish@flightlab.com>
+ * doc: CanvPsY.3, ConfigWidg.3, CrtImgType.3, CrtItemType.3,
+ FontId.3, GetFont.3, canvas.n, font.n, options.n, text.n:
+ Documentation fix: Replaced references to XFontStruct *
+ and Tk_FontStruct with Tk_Font.
+
+2000-07-24 Eric Melski <ericm@ajubasolutions.com>
+
+ * tests/text.test: Added tests for -regexp -nocase searches with
+ backslash character classes.
+
+ * generic/tkText.c (TextSearchCmd): Text search did not work
+ properly when -regexp and -nocase were used, in combination with
+ backslash character classes represented by capital letters (ie,
+ \W, \M); altered implementation of -regexp -nocase searches to use
+ new regexp interfaces to fix this problem. [Bug: 5988].
+
+2000-07-21 Eric Melski <ericm@ajubasolutions.com>
+
+ * tests/text.test: Added tests for searching when text is elided.
+
+ * generic/tkText.c (TextSearchCmd): Text search was not returning
+ the correct index when the search covered (but did not search)
+ elided characters; corrected this by adjusting the match index by
+ the number of elided characters preceeding the start of the match,
+ just as is done with embedded windows, etc. [Bug: 5470].
+
+2000-07-21 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure.in: Add TK_STUB_LIB_FLAG and
+ TK_BUILD_STUB_LIB_SPEC. These are needed to build a stub enabled
extension.
-2002-03-22 Miguel Sofer <msofer@users.sourceforge.net>
+2000-07-20 Eric Melski <ericm@ajubasolutions.com>
+
+ * unix/tkUnixDraw.c (TkScrollWindow): Replaced a use of a trinary
+ operator with an if/else, to avoid build problems on some
+ platforms [Bug: 5819].
+
+ * win/makefile.vc: Applied patch from Don Porter to enhance nmake
+ support on NT/Alpha [RFE: 5939].
+
+2000-07-19 Eric Melski <ericm@ajubasolutions.com>
- * tests/basic.test (basic-46.1): adding test for [Bug 533758],
- fixed earlier today.
+ * library/text.tcl: Enhanced <Tab> binding to behave like normal
+ <Tab> bindings when the text widget is disabled (ie, it advances
+ focus to the next widget).
+
+ * generic/tkText.c (TextSearchCmd): Added a test for a NULL
+ segment pointer when doing backwards searches for "" on an empty
+ text widget. [Bug: 6007].
+
+2000-07-18 Mo DeJong <mdejong@redhat.com>
+
+ * unix/aclocal.m4: Use tcl.m4.
+
+ * unix/configure.in: Properly quote LOCALES variable. Properly quote
+ argument to m4 macro.
+
+ * unix/tcl.m4: Add updated file from tcl.
-2002-03-22 Jeff Hobbs <jeffh@ActiveState.com>
+ * win/tcl.m4: Updated file from tcl.
- * win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug #478579]
+2000-07-18 Eric Melski <ericm@ajubasolutions.com>
-2002-03-22 Miguel Sofer <msofer@users.sourceforge.net>
+ * library/tkfbox.tcl: Fixed keyboard navigation in the iconlist.
- * generic/tclBasic.c (Tcl_EvalObjEx):
- * generic/tclExecute.c (TclCompEvalObj): fixed the errorInfo for
- return codes other than (TCL_OK, TCL_ERROR) to runLevel 0
- [Bug 533758]. Removed the static RecordTracebackInfo(), as its
- functionality is easily replicated by Tcl_LogCommandInfo. Bug
- and redundancy noted by Don Porter.
+ * unix/configure.in (MAKE_LIB): Corrected definition of MAKE_LIB
+ for shared builds, with patch from Mike Hopkirk.
+
+2000-07-18 Mo DeJong <mdejong@redhat.com>
-2002-03-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * win/Makefile.in: Fix TCL_GENERIC_DIR variable
+ so that it uses the TK_SRC_DIR in the same way
+ as the unix version.
- * doc/expr.n: Improved documentation for ceil and floor [Bug 530535]
+2000-07-17 David Gravereaux <davygrvy@ajubasolutions.com>
-2002-03-20 Don Porter <dgp@users.sourceforge.net>
+ * generic/tkConsole.c: Added comments for a Win2K OS bug with
+ GetStdHandle(STD_OUTPUT_HANDLE). No change was done to the code
+ as the resulting behaviour of ShouldUseConsoleChannel() was
+ correct, anyways. [BUG: 5971]
- * doc/SetVar.3:
- * doc/TraceVar.3:
- * doc/UpVar.3:
- * generic/tcl.h (Tcl_VarTraceProc):
- * generic/tcl.decls (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2,
- Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2,
- Tcl_GetVar2Ex, TclSetVar2Ex):
- * generic/tclCmdMZ.c (TraceVarProc):
- * generic/tclEnv.c (EnvTraceProc):
- * generic/tclEvent.c (VwaitVarProc):
- * generic/tclInt.decls (TclLookupVar,TclPrecTraceProc):
- * generic/tclLink.c (LinkTraceProc):
- * generic/tclUtil.c (TclPrecTraceProc):
- * generic/tclVar.c (CallTraces, MakeUpvar, VarErrMsg, TclLookupVar,
- Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2,
- Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex,
- TclSetVar2Ex): Updated interfaces of generic/tclVar.c according
- to TIP 27. In particular, the "part2" arguments were CONSTified.
- [Patch 532642]
- * generic/tclDecls.h:
- * generic/tclIntDecls.h: make genstubs
-
-2002-03-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * tests/compile.test (compile-12.3): Test to detect bug 530320.
- * generic/tclCompile.c (TclCompileTokens): Fixed buffer overrun
- reported in bug 530320.
-
-2002-03-14 Mo DeJong <mdejong@users.sourceforge.net>
+2000-07-17 Eric Melski <ericm@scriptics.com>
- * win/configure: Regen.
- * win/configure.in: Add configure time test for SEH
- support in the compiler.
- * win/tclWin32Dll.c (ESP, EBP, TclpCheckStackSpace,
- _except_checkstackspace_handler):
- * win/tclWinChan.c (ESP, EBP, Tcl_MakeFileChannel,
- _except_makefilechannel_handler):
- * win/tclWinFCmd.c (ESP, EBP, DoRenameFile,
- _except_dorenamefile_handler,
- DoCopyFile, _except_docopyfile_handler):
- Implement SEH support under gcc using inline asm.
- Tcl and Tk should now compile with Mingw 1.1. [Patch 525746]
+ * generic/tkStubImg.c (Tk_InitImageArgs): Applied patch from [Bug:
+ 5990], from Anselm Lingnau, which correctly sets the value of
+ useNewImage to 0 when the new image system is not to be used,
+ instead of leaving it at -1, which causes the check to be
+ performed more times than is really necessary.
+
+ * library/bgerror.tcl: Fixed a typo in one of the bgerror dialog
+ label.
-2002-03-14 Mo DeJong <mdejong@users.sourceforge.net>
+ * library/msgs/it.msg: Italian message catalog, from Paolo
+ Brutti. [RFE: 6012].
- * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Handle
- an SEH exception with EXCEPTION_EXECUTE_HANDLER instead
- of restarting the faulting instruction with
- EXCEPTION_CONTINUE_EXECUTION. Bug 466102 provides an
- example of how restarting could send Tcl into an
- infinite loop. [Patch 525746]
+2000-07-07 Eric Melski <ericm@ajubasolutions.com>
-2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
+ * library/msgs/el.msg: Greek message catalog, from George Petasis.
- * win/tclWinFCmd.c (DoRenameFile, DoCopyFile, DoDeleteFile,
- DoRemoveJustDirectory): Make sure we don't pass NULL or ""
- as a path name to Win32 API functions since this was
- crashing under Windows 98.
+2000-07-07 Mo DeJong <mdejong@redhat.com>
-2002-03-11 Don Porter <dgp@users.sourceforge.net>
+ * win/configure.in: Fix subst of TK_SHARED_BUILD
+ variable in tkConfig.sh.in. Fix definition of
+ TK_SRC_DIR variable so that it matches the
+ unix version.
- * library/tcltest/tcltest.tcl:
- * library/tcltest/pkgIndex.tcl: Bumped tcltest package to 2.0.2.
+2000-07-05 Mo DeJong <mdejong@redhat.com>
-2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tkFileFilter.c (AddClause): Cast to match function prototype.
+ * win/stubs.c (_XInitImageFuncPtrs): Add return value for function.
+ * win/tkWinButton.c (buttonStyles, ButtonBindProc, ComputeStyle):
+ Remove unused declarations.
+ * win/tkWinColor.c (GetColorByName, GetColorByValue): Remove unused
+ function declarations.
+ * win/tkWinDialog.c (TrySetDirectory): Remove unused function
+ declaration.
+ * win/tkWinEmbed.c (TkWinEmbeddedEventProc): Cast to match function
+ prototype.
+ * win/tkWinMenu.c (winMenuMutex, MenuExitProc): Remove unused
+ declaration.
+ * win/tkWinWindow.c (StackWindow): Remove unused declaration.
+ * win/tkWinWm.c (ConfigureEvent): Remove unused declaration.
+ * win/tkWinX.c (winXMutex): Remove unused declaration.
+ * xlib/ximage.c (XCreateBitmapFromData): Cast to match function
+ prototype.
- * library/tcltest/tcltest.tcl (getMatchingFiles): Pass
- a proper list to foreach to avoid munging a Windows
- patch like D:\Foo\Bar into D:FooBar before the glob.
+2000-07-05 Eric Melski <ericm@ajubasolutions.com>
-2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
+ * tests/imgPhoto.test: Added test for GIF writing code [Bug: 5823].
- * generic/tclEncoding.c: Fix typo in comment.
- * generic/tclIO.c (DoReadChars, ReadBytes, ReadChars):
- Use NULL value instead of pointer set to NULL to make
- things more clear. Reorder arguments so that they
- match the function signatures. Cleanup little typos
- and add more descriptive comment.
+ * generic/tkImgGIF.c: Applied patch from Jan Nijtmans to fix a
+ problem with the GIF writing code [Bug: 5823].
-2002-03-08 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tkCursor.c: Added initialization for nextPtr field of
+ TkCursor, patch from Nijtmans/Howlett.
- * win/README: Update to indicate that Mingw 1.1 is
- required to build Tcl. Add section describing new
- msys based build process. Update Cygwin build
- instructions so users know where to find Mingw 1.1.
+2000-07-05 Eric Melski <ericm@ajubasolutions.com>
-2002-03-08 Jeff Hobbs <jeffh@ActiveState.com>
+ * library/msgs/nl.msg: Dutch message catalog for dialogs, from Jan
+ Nijtmans.
- * win/tclWinFCmd.c (DoCopyFile): correctly set retval to TCL_OK.
+2000-06-30 Eric Melski <ericm@scriptics.com>
-2002-03-07 Mo DeJong <mdejong@users.sourceforge.net>
+ * doc/keysyms.n:
+ * doc/colors.n: Added extra .CE/.CS pairs to break up the large
+ text block, so that the generated Windows help file could
+ accomodate the manual entry. [Bug: 5862]
- * win/tclWin32Dll.c (TclpCheckStackSpace):
- * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Replace
- hard coded constants with Win32 symbolic names.
- Move control flow statements out of __try blocks
- since the documentation indicates it is frowned upon.
+ * tests/filebox.test: Adjusted tests to accomodate -multiple.
-2002-03-07 Don Porter <dgp@users.sourceforge.net>
+ * library/xmfbox.tcl: Adjusted arguments list construction such
+ that -multiple is not presented as an option for tk_getSaveFile.
- * doc/interp.n:
- * generic/tclInterp.c(Tcl_InterpObjCmd,SlaveObjCmd,SlaveRecursionLimit):
- * generic/tclTest.c:
- * tests/interp.test: Added the [interp recursionlimit] command to
- set/query the recursion limit of an interpreter. Proposal and
- implementation from Stephen Trier. [TIP 87, Patch 522849]
+ * library/tk.tcl: Added test for safe interpreter status before
+ attempting to load message catalogs (which is impossible in a
+ standard safe interpreter). This means that SafeTk will not have
+ localized dialogs, unless a means is found for loading the message
+ catalog files.
-2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+2000-06-29 Eric Melski <ericm@scriptics.com>
- * generic/tcl.h, tools/tcl.wse.in, unix/configure.in,
- * unix/tcl.spec, win/README.binary, win/configure.in, README:
- Bumped patchlevel; this might need to change in the future, but it
- will help us distinguish between the CVS version and the most
- recent released version.
+ * library/msgs/de.msg: German message catalog.
+
+ * library/msgs/en.msg: English message catalog.
-2002-03-06 Miguel Sofer <msofer@users.sourceforge.net>
+ * library/msgs/es.msg: Spanish message catalog.
- * generic/tclInt.h: for unshared objects, TclDecrRefCount now
- frees the internal rep before the string rep - just like the
- non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802].
+ * library/msgs/fr.msg: French message catalog.
-2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * library/tk.tcl:
+ * library/clrpick.tcl:
+ * library/choosedir.tcl:
+ * library/console.tcl:
+ * library/msgbox.tcl:
+ * library/tkfbox.tcl:
+ * library/xmfbox.tcl:
+ * library/bgerror.tcl: Applied patches from Laurent Duperval to
+ provide localization of Tk dialogs. [RFE: 2671].
- * doc/lsearch.n: Documentation of new features, plus examples.
- * tests/lsearch.test: Tests of new features.
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd): TIP#80 support. See
- http://purl.org/tcl/tip/80 for details.
+2000-06-27 Eric Melski <ericm@scriptics.com>
-2002-03-05 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tkMenu.c (DeleteMenuCloneEntries): Applied fix from
+ [Bug: 5275], which corrected a segfault-causing indexing problem
+ when deleting entries from torn-off menus.
- *** 8.4a4 TAGGED FOR RELEASE ***
+2000-06-22 Eric Melski <ericm@ajubasolutions.com>
- * unix/tclUnixChan.c: initial remedy for [Bug #525783] flush
- problem introduced by TIP #35. This may not satisfy true serial
- channels, but it restores the correct flushing of std* channels on
- exit.
+ * doc/getOpenFile.n: Updated with information about -multiple.
- * unix/README: added --enable-langinfo doc.
+ * library/choosedir.tcl: Tweaked to handle modified tkIconList API's.
- * unix/tcl.spec:
- * tools/tcl.wse.in: fixed URL refs to use www.tcl.tk or SF.
+ * library/tkfbox.tcl: Preliminary implementation of multiple
+ selection; based on patch from [RFE: 604]. Some of the tkIconList
+ functions changed to support this and to make the dialog faster.
-2002-03-04 Jeff Hobbs <jeffh@ActiveState.com>
+ * library/xmfbox.tcl: Added support for multiple selection, from
+ patch in [RFE: 4999].
+
+2000-06-21 Eric Melski <ericm@scriptics.com>
+
+ * library/text.tcl: Corrected behavior of text widget with respect
+ to this sequence of events: click, shift-click. Previously, the
+ shift-click just moved the cursor and anchor; now, the shift-click
+ will select the text between the click and the shift-click, which
+ is the behavior most users expect. [Bug: 5929].
+
+2000-06-19 Eric Melski <ericm@scriptics.com>
+
+ * library/bgerror.tcl: Added auto-truncation for long error
+ messages (more than 30 characters wide, or more than 4 lines
+ long), so that the dialog remains a manageable size. [RFE: 5782]
+
+2000-06-15 Eric Melski <ericm@scriptics.com>
+
+ * win/tkWinDialog.c: Patched to support tk_getOpenFile
+ -multiple. [RFE: 604].
+
+2000-06-13 Eric Melski <ericm@scriptics.com>
+
+ * win/aclocal.m4:
+ * win/configure.in:
+ * win/Makefile.in: Applied patch from [RFE: 5844], to provide
+ support for the mingw compile environment for Windows.
+
+2000-06-06 Jeff Hobbs <hobbs@scriptics.com>
+
+ 8.4a1 RELEASE
+
+2000-06-03 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/CrtCmHdlr.3: new doc for ClientMessage handler procs
+ * generic/tk.h: added typdef for Tk_ClientMessageProc
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h:
+ * generic/tk.decls: Added Tk_CreateClientMessageHandler and
+ Tk_DeleteClientMessageHandler declarations.
+ * generic/tkEvent.c (Tk_HandleEvent): Added
+ Tk_CreateClientMessageHandler and Tk_DeleteClientMessageHandler to
+ allow adding event handlers that invoke for ClientMessage events.
+ This is necessary to support unix dnd protocols.
+
+2000-06-02 Jeff Hobbs <hobbs@scriptics.com>
+
+ * canvas.test: added test for 5783.
+ * generic/tkCanvPoly.c (DisplayPolygon): added checks for the
+ polygon fillGC not being empty to prevent segfault. [Bug: 5783]
+
+2000-05-31 Eric Melski <ericm@scriptics.com>
+
+ * library/bgerror.tcl: Improved bgerror based on work by Donal
+ K. Fellows; no longer dependant on tk_dialog; features a
+ Windows-esque "Details" button, and a customizable extra function
+ button that allows the user to (for example) save the stack trace
+ to a file.
+
+2000-05-30 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkImgGIF.c: Changed defines for GIF87a/GIF89a to be
+ static char arrays with integer initialization, to address EBCIDIC
+ vs. ASCII encoding issues and to handle compilers that don't deal
+ with "\xAB" syntax for specifying hex values in strings.
+
+2000-05-28 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/spinbox.n: (new file) docs for spinbox widget
+ * generic/tkInt.h: added Tk_SpinboxObjCmd declaration
+ * generic/tkEntry.c: added 'spinbox' widget - an extension of the
+ entry widget type.
+ * generic/tkWindow.c: added 'spinbox' to core Tk commands
+ * library/spinbox.tcl: (new file) binding and helper procs for spinbox
+ * library/tk.tcl: added spinbox.tcl to list of files to source
+ * tests/entry.test: updated changed error messages
+ * tests/spinbox.test: (new file) test suite for spinbox
+
+ * generic/tkPlace.c (Tk_PlaceCmd): reworked place master/slave
+ table init'n to prevent seg fault when using place on multiple
+ displays.
+
+ * generic/tk.h: added comments ot Tk_FakeWin structure
+
+2000-05-26 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkOption.c (Tk_GetOption): Extended Tk_GetOption to
+ support a new syntax for option names in option tables. If the
+ option name has an embedded ".", it indicates that the name field
+ contains both an option name and an overriding widget class, in
+ the form "class.option". The lookup for the option value will be
+ performed as though the widget class is that specified, rather
+ than the actual widget class.
+ (SetupStacks): Replaced several lines of array element copying
+ with a for loop for conciseness.
+
+2000-05-25 Eric Melski <ericm@scriptics.com>
+
+ * library/button.tcl: Tweaks for -overrelief handling on Windows.
+
+ * doc/radiobutton.n: Added documentation for -overrelief option.
+
+ * doc/checkbutton.n: Added documentation for -overrelief option.
+
+ * doc/label.n: Added documentation for -state option.
+
+ * generic/tkButton.c: Added -overrelief option for checkbuttons,
+ and radiobuttons.
+
+ * library/button.tcl (tkButtonDown, macintosh version): Added
+ protection against querying the -repeatdelay option from a widget
+ that doesn't support it (ie, checkbuttons, radiobuttons, etc).
+ Other platforms use a different binding script for checkbuttons
+ and radiobuttons, so they don't have this issue.
+ (tkCheckRadioEnter, windows version): Added code to handle
+ -overrelief for check/radiobuttons on windows.
+
+2000-05-22 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkButton.c: Added -activeforeground, -activebackground
+ for labels, for the -state option.
+
+ * doc/label.n: Added documentation for -state option,
+ -activeforeground, -activebackground.
+
+2000-05-22 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/Makefile.in (install-libraries): corrected to install X
+ headers [Bug: 5516]
+
+ * doc/bind.n:
+ * doc/canvas.n:
+ * doc/entry.n:
+ * doc/listbox.n:
+ * doc/photo.n: doc fix-ups [Bug: 5396]
+
+2000-05-17 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/bell.n:
+ * tests/bell.test:
+ * generic/tkCmds.c (Tk_BellObjCmd): added -nice option to
+ optionally avoid resetting screen saver [Bug: 4279]
+
+2000-05-15 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinWm.c (Tk_WmCmd): changed wm deiconify from using idle
+ callback to calling restack and focus code immediately.
+
+2000-05-17 Eric Melski <ericm@scriptics.com>
+
+ Overall change: Added "-readonlybackground" option for entries,
+ to enable a visual change when state goes to readonly.
+
+ * mac/tkMacDefault.h (DEF_ENTRY_READONLY_BG_COLOR,
+ DEF_ENTRY_READONLY_BG_COLOR):
+ * win/tkWinDefault.h (DEF_ENTRY_READONLY_BG_COLOR,
+ DEF_ENTRY_READONLY_BG_COLOR):
+ * unix/tkUnixDefault.h (DEF_ENTRY_READONLY_BG_COLOR,
+ DEF_ENTRY_READONLY_BG_COLOR): Added default values for entry
+ -readonlybackground option.
+
+ * generic/tkEntry.c: Added -readonlybackground option, cleaned up
+ excessive use of graphics contexts.
+
+ * tests/entry.test: Added configuration test for
+ -readonlybackground option.
+
+ * doc/entry.n: Added documentation for -readonlybackground option.
+
+ Overall change: changed implementation of "link" relief for
+ buttons. Instead of a new relief style (-relief link), there is a
+ new option, -overrelief, which if set is used when the mouse is
+ over the button.
+
+ * doc/SetOptions.3: Added information about TK_OPTION_NULL_OK with
+ TK_OPTION_RELIEF.
+
+ * win/tkWinButton.c: Removed bits about TK_RELIEF_LINK.
+
+ * tests/button.test: Added tests for -overrelief; removed tests
+ for -relief link.
+
+ * mac/tkMacButton.c: Removed bits about TK_RELIEF_LINK.
+
+ * generic/tkOldConfig.c: Removed bits about TK_RELIEF_LINK.
+
+ * generic/tkConfig.c: Removed bits about TK_RELIEF_LINK; added
+ support for TK_OPTION_NULL_OK for TK_OPTION_RELIEF.
+
+ * library/button.tcl: Added binding support for -overrelief.
+
+ * generic/tk3d.c (Tk_GetRelief): Added branch for TK_RELIEF_NULL.
+
+ * generic/tkButton.c: Added -overrelief option; removed
+ Enter/Leave EventProc masks and handlers.
+
+ * generic/tk.h: Added TK_RELIEF_NULL definition, removed
+ TK_RELIEF_LINK.
+
+ * mac/tkMacDefault.h (DEF_BUTTON_OVER_RELIEF):
+ * win/tkWinDefault.h (DEF_BUTTON_OVER_RELIEF):
+ * unix/tkUnixDefault.h (DEF_BUTTON_OVER_RELIEF): Added default
+ value for the -overrelief option.
+
+2000-05-16 Eric Melski <ericm@scriptics.com>
+
+ * win/tkWinMenu.c (ReconfigureWindowsMenu): Added code to add the
+ MF_SEPARATOR bit for SEPARATOR_ENTRY menu items. This causes
+ separator entries on the system menu to be drawn correctly [Bug: 5451].
+
+2000-05-15 Eric Melski <ericm@scriptics.com>
+
+ * doc/image.n: Added documentation for [image inuse] command.
+
+ * tests/image.test: Added tests for [image inuse] command.
+
+ * generic/tkImage.c (Tk_ImageObjCmd): Added [image inuse] command,
+ which provides a means for programmers to determine if a given
+ image is in use by any widgets. [RFE: 3327].
+
+2000-05-14 Eric Melski <ericm@scriptics.com>
+
+ * doc/clipboard.n: Added documentation for "clipboard get".
+
+ * generic/tkClipboard.c (Tk_ClipboardCmd): Added "clipboard get"
+ subcommand [RFE: 4628].
+
+ * tests/clipboard.test: Updated to use "clipboard get" instead of
+ "selection get -s CLIPBOARD".
+
+ * library/entry.tcl: Adjusted Button-1 binding to set focus to the
+ entry when it is readonly or normal.
+
+ * doc/entry.n: Added documentation for readonly state,
+ -disabledforeground, -disabledbackground.
+
+ * tests/entry.test: Added tests for readonly state.
+
+ * generic/tkEntry.c: Added support for "readonly" state, and
+ redefined "disabled" state. A disabled entry will display its
+ text in a dimmed color and possibly with a different background,
+ and will be completely unusable (no selection, no editing). A
+ readonly entry will look like a normal entry, but it will not be
+ editable; selection is still allowed. [RFE: 4239]. To support the
+ new disabled state properly, "-disabledforeground" and
+ "-disabledbackground" options were added.
+ *** THIS IS A BACKWARDS INCOMPATIBLE BEHAVIOR CHANGE ***
+
+ * win/tkWinDefault.h:
+ * mac/tkMacDefault.h:
+ * unix/tkUnixDefault.h: Added DEF_ENTRY_DISABLED_FG,
+ DEF_ENTRY_DISABLED_BG_COLOR, DEF_ENTRY_DISABLED_BG_MONO.
+
+2000-05-12 Eric Melski <ericm@scriptics.com>
+
+ * unix/tkUnixButton.c (TkpDisplayButton, TkpComputeButtonGeometry):
+ * mac/tkMacButton.c (TkpDisplayButton, TkpComputeButtonGeometry):
+ * win/tkWinButton.c (TkpDisplayButton, TkpComputeButtonGeometry):
+ Added code for drawing compound buttons.
+
+ * tests/button.test: Added configuration tests for -repeatdelay,
+ -repeatinterval, -compound.
+
+ * library/button.tcl: Added support for -repeatedelay,
+ -repeatinterval options.
+
+ * generic/tkOldConfig.c: Changed handling of link relief so that
+ proper error messages are used.
+
+ * generic/tkButton.h: Added -compound, -repeatdelay,
+ -repeatinterval options.
+
+ * generic/tkButton.c: Added event watchers for enter/leave events,
+ for link relief support.
+
+ * generic/tk3d.c: Changed handling of link relief so that proper
+ error messages are used.
+
+ * generic/tk.h: Changed values of
+ TK_OPTION_LINK_OK/TK_CONFIG_LINK_OK for link relief support.
+
+2000-05-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinFont.c (LoadFontRanges): improved support for all chars
+ in 0-255 range for bitmap ANSI fonts. May be improved to handle
+ bitmap non-ANSI fonts in the future. [Bug: 2172]
+
+ * win/tkWinWm.c (RaiseWinWhenIdle): added TK_DONT_DESTROY_WINDOW
+ to flag check to prevent timing related core dump. [Bug: 5438]
+
+2000-05-11 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinTest.c (TestclipboardObjCmd): ensured CloseClipboard
+ would always get called for each OpenClipboard.
+
+ * tests/focus.test (focusSetupAlt): removed wm withdraw from proc
+ as it would cause a hang for tkwait visibility
+
+ * tests/menu.test:
+ * generic/tk3d.c:
+ * generic/tkColor.c:
+ * generic/tkCursor.c: corrected handling of 3DBorder, Cursor and
+ Color objects on multiple screens. [Bug: 5454]
+
+2000-05-09 Eric Melski <ericm@scriptics.com>
+
+ * doc/button.n: Added documentation for link relief.
+
+ * tests/button.test: Added tests for link relief for buttons.
+
+ * generic/tk.h (TK_CONFIG_LINK_OK): Added definition of
+ TK_RELIEF_LINK, TK_OPTION_LINK_OK and TK_CONFIG_LINK_OK. [RFE: 4348]
+
+ * generic/tk3d.c: Added support for link relief. [RFE: 4348]
+
+ * mac/tkMacButton.c (TkpDisplayButton):
+ * unix/tkUnixButton.c (TkpDisplayButton): Added support for link
+ relief. [RFE: 4348]
+
+ * generic/tkOldConfig.c (Tk_ConfigureWidget):
+ * generic/tkConfig.c (DoObjConfig): Added understanding of link
+ relief, which is allowed only for widgets that have
+ TK_OPTION_LINK_OK or TK_CONFIG_LINK_OK set for the "-relief"
+ option. [RFE: 4348]
+
+ * generic/tkButton.c: Added TK_OPTION_LINK_OK to "-relief" option
+ for buttons. [RFE: 4348]
+
+ * win/tkWinWm.c (EX_TRANSIENT_STYLE): Removed WS_EX_TOOLWINDOW
+ style bit, so that transient windows have full-size titlebars
+ (like the tk_getOpenFile dialog).
+
+ * win/tkWinMenu.c (GetMenuSeparatorGeometry): Tweaked height
+ requested for separator bars to be (linespace - (2*descent))
+ instead of just (linespace); this makes the separator occupy a
+ more correct amount of vertical space. [Bug: 5303].
+
+2000-05-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/focus.tcl: fixed calling of takeFocus proc [Bug: 5372]
+
+2000-05-02 Jeff Hobbs <hobbs@scriptics.com>
* README:
+ * generic/tk.h:
+ * library/tk.tcl:
* mac/README:
- * unix/Makefile.in:
* unix/README:
+ * unix/configure.in:
+ * unix/tk.spec:
* win/README:
- * win/README.binary: updated to use www.tcl.tk URL.
+ * win/aclocal.m4:
+ * win/configure.in:
+ * win/makefile.vc: updated patchlevel to 8.4a1
- * unix/Makefile.in: added older ChangeLogs to dist target.
+ * unix/Makefile.in: added tk.spec to dist target
- * tests/io.test:
- * tests/encoding.test: corrected iso2022 encoding results.
- added encoding-24.*
- * generic/tclEncoding.c (EscapeFromUtfProc): corrected output of
- escape codes as per RFC 1468. [Patch #474358] (taguchi)
- (TclFinalizeEncodingSubsystem): corrected potential double-free
- when encodings were finalized on exit. [Bug #219314, #524674]
+2000-04-27 Eric Melski <ericm@scriptics.com>
-2002-03-01 Jeff Hobbs <jeffh@ActiveState.com>
+ * doc/Tk_Init.3: Added Tk_SafeInit information [Bug: 1884].
- * library/encoding/iso2022-jp.enc:
- * library/encoding/iso2022.enc:
- * tools/encoding/iso2022-jp.esc:
- * tools/encoding/iso2022.esc: gave <ESC>$B precedence over <ESC>$@,
- based on comments (point 1) in [Bug #219283] (rfc 1468)
+ * doc/keysyms.n: Man page enumerating keysyms [RFE: 1645].
- * tests/encoding.test: added encoding-23.* tests
- * generic/tclIO.c (FilterInputBytes): reset the TCL_ENCODING_START
- flags in the ChannelState when using 'gets'. [Bug #523988]
- Also reduced the value of ENCODING_LINESIZE from 30 to 20 as this
- seems to improve the performance of 'gets' according to tclbench.
+ * doc/colors.n: Man page enumerating valid color names [RFE: 1645].
-2002-02-28 Jeff Hobbs <jeffh@ActiveState.com>
+ * doc/cursors.n: Man page enumerating valid cursor values [RFE: 1645].
- * generic/tclCmdMZ.c (TraceCommandProc): ensure that TraceCommandInfo
- structure was also deleted when a command was deleted to prevent a
- mem leak.
+ * library/msgbox.tcl: Corrected Unix tk_messageBox implementation
+ to make the first button the default when no default is specified
+ [Bug: 2218].
- * generic/tclBasic.c (Tcl_CreateObjTrace): set tracePtr->flags
- correctly.
+ * doc/messageBox.n: Updated documentation with regards to
+ selection of default button when none is specified (now it will
+ use the first button as the default in that case) [Bug: 2218].
- * generic/tclTimer.c (TimerExitProc): remove remaining events in
- tls on thread exit.
+2000-04-26 Jeff Hobbs <hobbs@scriptics.com>
-2002-02-28 Miguel Sofer <msofer@users.sourceforge.net>
+ 8.3.1 RELEASE
- * generic/tclNamesp.c: allow cached fully-qualified namespace
- names to be usable from different namespaces within the same
- interpreter without forcing a new lookup [Patch 458872].
+ * README:
+ * mac/README:
+ * unix/README:
+ * unix/tk.spec:
+ * win/README: Updating URLs to reference dev.scriptics.com
-2002-02-28 Miguel Sofer <msofer@users.sourceforge.net>
+2000-04-25 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclExecute.c: Replaced a few direct stack accesses
- with the POP_OBJECT() macro [Bug 507181] (Don Porter).
+ * unix/Makefile.in:
+ * win/Makefile.in: makefile cleanup
-2002-02-27 Don Porter <dgp@users.sourceforge.net>
+2000-04-25 Eric Melski <ericm@scriptics.com>
- * doc/GetIndex.3:
- * generic/tcl.decls (Tcl_GetIndexFromObjStruct):
- * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Revised the
- prototype of the Tcl_GetIndexFromObjStruct to take its struct
- table as a (CONST VOID *) argument, better describing what it is,
- maintaining source compatibility, and adding CONST correctness
- according to TIP 27. Thanks to Joe English for an elegant
- solution. [Bug 520304]
+ * generic/tkMain.c: Fixed function header comment for Tk_MainEx.
- * generic/tclDecls.h: make genstubs
+ * unix/mkLinks:
+ * doc/GetScroll.3: Added information about Tk_GetScrollInfoObj
+ [Bug: 1866].
- * generic/tclMain.c (Tcl_Main,StdinProc): Corrected some reference
- count management errors on the interactive command Tcl_Obj found by
- Purify. Thanks to Jeff Hobbs for the report and assistance.
+2000-04-24 Eric Melski <ericm@scriptics.com>
-2002-02-27 Jeff Hobbs <jeffh@ActiveState.com>
+ * unix/mkLinks:
+ * doc/Grab.3: Man page for Tk_Grab and Tk_Ungrab [Bug: 1868, 1889]
- * generic/tclBasic.c (Tcl_EvalTokensStandard): corrected mem leak
- in error case.
+ * unix/mkLinks:
+ * doc/MainWin.3: Added entry for Tk_GetNumMainWindows [Bug: 1865].
- * generic/tclTest.c (TestStatProc[123]): correct harmless UMRs.
+ * unix/mkLinks:
+ * doc/GetHINSTANCE.3: Man page for Tk_GetHINSTANCE [Bug: 1862].
- * generic/tclLink.c (Tcl_LinkVar): correct mem leak in error case.
+2000-04-24 Jeff Hobbs <hobbs@scriptics.com>
-2002-02-27 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ * generic/tkImage.c (Tk_PostscriptImage): added check to create
+ necessary prolog for photos
+ * generic/tkCanvPs.c: added Tk_PostscriptPhoto that outputs PS for
+ photo images
+ * generic/tkImgPhoto.c: new func ImgPhotoPostscript and added that
+ in as ps proc in tkPhotoImageType.
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h:
+ * generic/tk.decls: added Tk_PostscriptPhoto
- * tests/socket.test (2.7): Accepted and applied patch for Tcl SF
- bug #523470 provided by Don Porter <dgp@users.sourceforge.net>
- to avoid timing problems in that test.
+ * generic/tkConfig.c (DoObjConfig): removed direct setting of
+ interp->result.
- * unix/tclUnixChan.c (TclpOpenFileChannel): Added code to regonize
- "/dev/tty" (by name) and to not handle it as tty / serial
- line. This is the controlling terminal and is special. Setting
- it into raw mode as is done for other tty's is a bad idea. This
- is a hackish fix for expect SGF Bug #520624. The fix has
- limitation: Tcl_MakeFileChannel handles tty's specially too, but
- is unable to recognize /dev/tty as it only gets a file
- descriptor, and no name for it.
+ * mac/tkMacWm.c (Tk_WmCmd): initialized gotToplevel in
+ colormapwindows case (bug found by Reasoning, Inc's automated code
+ testing).
-2002-02-26 Jeff Hobbs <jeffh@ActiveState.com>
+2000-04-24 Eric Melski <ericm@scriptics.com>
- * generic/tclCmdAH.c (StoreStatData): corrected mem leak.
+ * unix/mkLinks:
+ * doc/GetHWND.3: Man page for Tk_GetHWND [Bug: 1863].
- * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): prevent obj leak in
- remedial regsub case.
+ * unix/mkLinks:
+ * doc/HWNDToWindow.3: Man page for Tk_HWNDToWindow [Bug: 1869].
- * generic/tclFileName.c (Tcl_TranslateFileName): decr refcount for
- error case to prevent mem leak.
+ * unix/mkLinks:
+ * doc/AddOption.3: Man page for Tk_AddOption [Bug: 1854]
- * generic/tclVar.c (Tcl_ArrayObjCmd): removed extra obj allocation.
+2000-04-22 Jim Ingham <jingham@cygnus.com>
- * unix/tclUnixSock.c (Tcl_GetHostName): added an extra
- gethostbyname check to guard against failure with truncated
- names returned by uname.
+ * mac/tkMacDialog.c (Tk_MacGetOpenFile): Add empty bodies for the
+ "-initialfile" and "-defaultextension" options.
- * unix/configure:
- * unix/tcl.m4 (SC_SERIAL_PORT): added sys/modem.h check and defined
- _XOPEN_SOURCE_EXTENDED for HP-11 to get updated header decls.
+ * mac/tkMacDialog.c (NavServicesGetFile): Only cons the result up
+ into a list if multiple is true.
- * unix/tclUnixChan.c: added Unix implementation of TIP #35, serial
- port support. [Patch #438509] (schroedter)
+ * mac/tkMacMenus.c (SourceDialog): Use the "tk_getOpenFile"
+ instead of hand-coding the dialog with StandardGetFile. This way
+ we get the Navigation dialogs for free.
-2002-02-26 Miguel Sofer <msofer@users.sourceforge.net>
+ * doc/getOpenFile.n: Document the -multiple and -message flags
+ which are only implemented on the Mac. Also note that the -title
+ works on the Mac with Nav Services installed.
- * generic/tclCmpCmds.c: (bugfix to the bugfix, hopefully the last)
- Bugfix to the new [for] compiling code: was setting a
- exceptArray parameter using another param which wasn't yet
- initialised, thus filling it with noise.
+2000-04-19 Eric Melski <ericm@scriptics.com>
-2002-02-25 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ * doc/WinViewable.3:
+ * unix/mkLinks: Removed docs for Tk_IsViewable.
- * mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the
- option "-error". Essentially ignores the option, always
- returning an empty string.
+ * win/tkWinDialog.c: Removed calls to Tk_IsViewable.
-2002-02-25 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tkUtil.c:
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h:
+ * generic/tkCmds.c:
+ * generic/tk.decls: Removed Tk_IsViewable function (it was not
+ actually needed).
- * doc/Alloc.3:
- * doc/LinkVar.3:
- * doc/ObjectType.3:
- * doc/PkgRequire.3:
- * doc/Preserve.3:
- * doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc,
- ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and
- to accurately describe when and how they are used. [Bug #497459] (dgp)
+2000-04-19 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclHash.c (AllocArrayEntry, AllocStringEntry):
- Before invoking ckalloc when creating a Tcl_HashEntry,
- check that the amount of memory being allocated is
- at least as large as sizeof(Tcl_HashEntry). The previous
- code was allocating memory regions that were one
- or two bytes short. [Bug #521950] (dejong)
+ * win/aclocal.m4: made SC_PROG_TCLSH search specifically for
+ tclsh*.exe type files to find an executable.
+
+ * win/Makefile.in: fixed up cleanup, winhelp, cat32 targets
+
+ * library/console.tcl: made console use systemfixed font on Win
+
+ * generic/tkEntry.c: removed unnecessary ENTRY_VALIDATE #define
+
+2000-04-19 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkRectOval.c (ConfigureRectOval): Added checks for valid
+ outline settings before creating of outline GC; this means that it
+ is really possible now to have an oval or rectangle with no
+ outline. [Bug: 5029].
+
+2000-04-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/choosedir.tcl (::tk::dialog::file::chooseDir::Config):
+ * library/tkfbox.tcl (::tk::dialog::file::Config): removed the
+ extraneous glob on -initialdir after file isdir already returned 1
+ and moved cd trick into this case as the else already uses [pwd].
+ [Bug: 5181]
+
+ * win/winMain.c: moved extern call out of WinMain func
+
+ * README:
+ * generic/tk.h:
+ * unix/configure.in:
+ * unix/tk.spec:
+ * win/configure.in: bumped to version 8.3.1
-2002-02-25 Miguel Sofer <msofer@users.sourceforge.net>
+ * library/msgbox.tcl (tkMessageBox): changed to use grid in some
+ places, realign icon to anchor nw.
- * generic/tclBasic.c (Tcl_EvalEx): avoiding a buffer overrun
- reported by Joe English, and restoring tcl7.6 behaviour for
- [subst]: badly terminated nested scripts will raise an error
- and not be evaluated. [Bug #495207]
+ * mac/tkMacScale.c: reverted tkMacScale.c to 1.5 equivalent (it
+ was accidentally bumped forward).
-2002-02-25 Don Porter <dgp@users.sourceforge.net>
+2000-04-18 Eric Melski <ericm@scriptics.com>
- * unix/tclUnixPort.h: corrected strtoll prototype mismatch on Tru64.
- * compat/strtod.c (strtod): simplified #includes
- * compat/strtol.c (strtol): gather result in a long before returning
- as a long: necessary on platforms where sizeof(int) != sizeof(long).
+ * win/tkWinPointer.c: Changed Mod2Mask in TkWinGetModifierState to
+ ALT_MASK, to fix some event problems [Bugs: 1160, 5088].
-2002-02-25 Daniel Steffen <das@users.sourceforge.net>
+ * win/tkWinX.c: Changed Mod2Mask in GetState to ALT_MASK, to fix
+ some event problems [Bugs: 1160, 5088].
- * unix/tclLoadDyld.c: updated to use Mac OS X 10.1 dyld APIs that
- have more libdl-like semantics. (bug #514392)
+ * generic/tkInt.h: Moved definition of ALT_MASK and META_MASK here
+ so that it would be accessible from other modules than tkBind.c.
-2002-02-25 Miguel Sofer <msofer@users.sourceforge.net>
+ * generic/tkBind.c: Added code in BindEvent to check for ALT_MASK
+ and META_MASK in the event state field, as this field may not be
+ set up with the correct display modifier mask bits if the XEvent
+ structure was created by [event generate] or by the Windows X
+ emulation. [Bugs: 1160, 5088].
- * generic/tclCompCmds: fixing a bug in patch dated 2002-02-22, in
- the code for [for] and [while]. Under certain conditions, for long
- bodies, the exception range parameters were badly computed. Tests
- forthcoming: I still can't reproduce the conditions in the
- testsuite (!), although the bug (with assorted segfault or panic!)
- can be triggered from the console or with the new parse.bench in
- tclbench.
+2000-04-18 Scott Redman <redman@HILO>
+
+ * win/tk.rc:
+ * win/wish.rc:
+ * win/wish.ico: Modified copyright dates in Windows resource
+ files. Updated the icon for wish.exe.
+
+2000-04-17 Eric Melski <ericm@scriptics.com>
+
+ * win/tkWinDialog.c: Added checks for visibility of parent window
+ before creating MessageBox and ChooseColor dialogs; this prevents
+ the application from locking when the parent is withdrawn and the
+ message box is created. In these cases, the window will be
+ created without a parent.
+
+ * unix/mkLinks: Added WinViewable.3.
+
+ * tests/msgbox.test: Added tests for patch from [Bug: 4997].
+
+ * library/msgbox.tcl:
+ * library/dialog.tcl: Applied patch from [Bug: 4997]; detaches
+ dialog window from parent if parent is not viewable.
+
+ * library/bgerror.tcl: Removed workaround from [Bug: 4370]; this
+ is superceeded by patches to dialog.tcl.
+
+ * generic/tkCmds.c: Changed WinfoObjCmd to use Tk_IsViewable
+ function to determine visibility of windows instead of inlining
+ the code.
+
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h:
+ * generic/tk.decls: Added Tk_IsViewable declaration.
+
+2000-04-17 Eric Melski <ericm@scriptics.com>
+
+ * library/text.tcl: Tweaked double-/triple-click selection;
+ previously, anchor and insert marks were placed in unexpected
+ locations following a double or triple click. Now they are placed
+ logically. Also tweaked the extension of selection via
+ shift-double-clicks so that it no longer selects the contiguous
+ whitespace on the side of the selection opposite the
+ double-click. [RFE: 4253].
+
+ * doc/menu.n: Added note regarding rendering of
+ checkbuttons/radiobuttons in menubars on different platforms --
+ some systems do not draw indicators for check/radiobuttons in
+ menubars.
+
+ * library/menu.tcl: Corrected behavior of
+ checkbuttons/commands/radiobuttons in menubars [Bug: 630].
+
+ * tests/grid.test: Added test for [grid propagate . 0] to not toggle.
-2002-02-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkGrid.c: Fixed bogus logic in [grid propagate] that
+ caused [grid propagate . 0] to act as a toggle instead of an
+ absolute set. [Bug: 2286].
- * compat/strtoul.c, compat/strtol.c, compat/strtod.c: Added UCHAR,
- CONST and #includes to clean up GCC output.
+2000-04-16 Jeff Hobbs <hobbs@scriptics.com>
-2002-02-23 Don Porter <dgp@users.sourceforge.net>
+ * win/tkWinColor.c (FindSystemColor): correct calculation of
+ colors when shifting value. [Bug: 4919]
- * compat/strtoull.c (strtoull):
- * compat/strtoll.c (strtoll):
- * compat/strtoul.c (strtoul): Fixed failure to handle leading
- sign symbols '+' and '-' and '0X' and raise overflow errors.
- [Bug 440916] Also corrects prototype and errno problems.
+2000-04-16 Jim Ingham <jingham@cygnus.com>
-2002-02-23 Mo DeJong <mdejong@users.sourceforge.net>
+ * mac/tkMacPort.h: protect against strncasecmp already defined -
+ it is in the Pro5 version of MSL.
- * configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32
- instead of -32 when building on IRIX64-6.* system.
- [Tcl bug 521707]
+ * mac/tkMacWindowMgr.c (GenerateKeyEvent): Check for a null tkWin.
+ If the hidden window we use for double-buffering controls manages
+ to percolate to the top (should never happen, but...) this will
+ keep us from crashing.
-2002-02-22 Don Porter <dgp@users.sourceforge.net>
+ * mac/tkMacButton.c (InitSampleControls): Hide the
+ double-buffering window BEHIND the first "." window you can find.
+ This will keep it from ever being the front window, and thus a
+ black hole for events. * mac/tkMacButton.c (ButtonEventProc):
+ Disable the controls when the window is in the background. This
+ is required by the MacOS HIG. This doesn't always get called when
+ it should, it still needs more work.
- * generic/tclInt.h:
- * generic/tclObj.c: renamed global variable emptyString ->
- tclEmptyString because it is no longer static.
- * generic/tclPkg.c: Fix for panic when library is loaded on a
- platform without backlinking without proper use of stubs. [Bug 476537]
+ * mac/tkMacDialog.c: Pretty substantial rewrite to include
+ Navigation Services support for systems which have it.
-2002-02-22 Jeff Hobbs <jeffh@ActiveState.com>
+2000-04-14 Eric Melski <ericm@scriptics.com>
- * tests/regexpComp.test: updated regexp-11.[1-4] to match changes
- in regexp.test for new regsub syntax
+ * win/tkWinKey.c: Added check for ASCII delete character in
+ KeycodeToKeysym, to fix [Bug: 5090]. See comment in code for more
+ information.
- * unix/configure:
- * unix/tcl.m4: added --enable-64bit support for AIX-4 (using -q64
- flag) when using IBM's xlc compiler.
+ * generic/ks_names.h: Added Scroll_Lock and Sys_Req definitions.
- * tests/safe.test: updated safe-8.5 and safe-8.7
- * library/safe.tcl (CheckFileName): removed the limit on
- sourceable file names (was only *.tcl or tclIndex files with no
- more than one dot and 14 chars). There is enough internal
- protection in a safe interpreter already. Fixes [Tk Bug #521560].
+ * win/tkWinKey.c: Changed implementation of KeycodeToKeysym,
+ et. al., to use a keycode table for lookups; this will result in
+ faster keycode -> keysym translations for non-ASCII keys like
+ Control, Alt, etc.
-2002-02-22 Miguel Sofer <msofer@users.sourceforge.net>
+2000-04-14 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclCompCmds: [FR 465811]. Optimising [if], [for] and
- [while] for constant conditions; in addition, [for] and [while]
- are now compiled with the "loop rotation" optimisation (thanks to
- Kevin Kenny).
+ * win/tkWinWm.c (WmProc): added check in WM_MOUSEACTIVATE so we
+ correctly activate native menus when clicking in when we didn't
+ have focus [Bug: 2272]
-2002-02-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+ * generic/tkCanvas.c (CanvasEventProc:2451): corrected cast
- --- TIP#76 CHANGES ---
- * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): Final-argument-less
- [regsub] returns the modified string.
- * doc/regsub.n: Updated docs.
- * tests/regexp.test: Updated and added tests.
+ * generic/tkEntry.c (Tk_EntryObjCmd): adjusted finishing error
+ cases and changed TK_CONFIG_NULL_OK to TK_OPTION_NULL_OK
- * compat/strtoll.c (strtoll):
- * compat/strtoull.c (strtoull):
- * unix/tclUnixPort.h:
- * win/tclWinPort.h: Const-ing 64-bit compatability declarations.
- Note that the return pointer is non-const because it is entirely
- legal for the functions to be called from somewhere that owns the
- string being passed. Fixes problem reported by Larry Virden.
+ * tests/scale.test:
+ * generic/tkScale.c:
+ * generic/tkScale.h:
+ * unix/tkUnixScale.c:
+ * mac/tkMacScale.c: moved (PixelToValue|ValueToPixel|SetScaleValue)
+ to tkScale.c. Caused an associated variable to be immediately set
+ [Bug: 4833]
-2002-02-21 David Gravereaux <davygrvy@pobox.com>
+ * library/scale.tcl (tkScaleActivate): reduced number of scale
+ redisplays by checking current value of state before setting it
+ again. [Bug: 4191]
- * win/mkd.bat (removed):
- * win/coffbase.txt (new):
- * win/makefile.bc:
- * win/makefile.vc: Changed the 'setup' target to stop using
- the mkd.bat file and just make the directory right in the rule.
- Same change to makefile.bc. configure.in nor Makefile.in use
- it.
+ * tests/winDialog.test: tk_chooseDirectory seems to get a noop
+ from GetOpenFileName in the static build, hanging some tests.
+ The tests were fixed to timeout (noop cause unknown).
+
+ * unix/aclocal.m4 (SC_ENABLE_THREADS): enhanced the detection of
+ pthread_mutex_init [Bug: 4359] and (SC_CONFIG_CFLAGS) added
+ --enable-64bit-vis switch for Sparc VIS compilation [Bug: 4995]
+
+2000-04-13 Eric Melski <ericm@scriptics.com>
+
+ * win/tkWinKey.c: Added smarts to check whether the left or right
+ Control, Shift, or Alt key was pressed. [Bug: 870].
+
+ * win/tkWinMenu.c: Corrected code that created separator items on
+ menus; originally, it requested that the system be responsible for
+ drawing those items, so it would ignore configuration items like
+ the widget background. Now, we draw the separators ourselves (as
+ we do with every other kind of menu item already). [Bug: 1166].
+
+ * win/tkWin3d.c:
+ * unix/tkUnix3d.c: Applied patch from [RFE: 2501]: adds more
+ sophisticated smarts to TkpGetShadows, so that the highlight of a
+ very bright color is actually distinguishable from the color, and
+ the shadow of a very dark color is similarly distinguishable from
+ the color.
+
+ * generic/tkCanvas.c: Applied patch from [Bug: 4202]; adds a check
+ for NULL tkwin in Tk_CanvasEventuallyRedraw.
+
+2000-04-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * test/winClipboard.test:
+ * win/tkWinInt.h:
+ * win/tkWinClipboard.c (UpdateClipboard):
+ * win/tkWinX.c (GenerateXEvent): added updatingClipboard tsd and
+ TkWinUpdatingClipboard accessor function to allow us to flag
+ ourselves when we are the ones updating the clipboard. This
+ corrected inability to create our own clipboard types within a Tk
+ application. [Bug: 2338 4318]
+ * win/tkWinTest.c (TestclipboardCmd): improved TestclipboardCmd
+ with better error handling and obj'ification
+
+2000-04-11 Eric Melski <ericm@scriptics.com>
+
+ * msgcat.n: Added docs for new behavior from patch in [Bug: 4158].
+
+ * msgcat.test: Added tests for new behavior from patch in [Bug:
+ 4158].
+
+ * msgcat.tcl: Applied patch from [Bug: 4158], which enables
+ msgcat::mc to search the entire namespace ancestry chain for
+ message translations (ie, first it checks the current namespace,
+ then the parent, then the parent's parent, etc). Also allows the
+ specification of additional args for msgcat::mc; if extra args are
+ given, the [format] command is used to substitute the additional
+ args in the translated message.
+
+ * library/bgerror.tcl: Moved check for withdrawn state after check
+ for tkerror; this was causing problems when tkerror was used.
+
+2000-04-10 Eric Melski <ericm@scriptics.com>
+
+ * library/bgerror.tcl: Added check for withdrawn state of . and
+ unsetting of transient bit for .bgerrorDialog if . is not
+ viewable; this protects against the application hanging on systems
+ like Windows, where transient windows are withdrawn with their
+ parents. [Bug: 4370].
+
+ * tests/event.test: Added test for [event generate $widget
+ <Alt-z>] [Bug: 4611].
+
+ * tests/choosedir.test: Changed "namespace import ::tcltest" to
+ "namespace import -force ::tcltest".
+
+ * win/tkWinKey.c:
+ * unix/tkUnixKey.c:
+ * mac/tkMacKeyboard.c: Changed InitKeymapInfo to
+ TkpInitKeymapInfo. [Bug: 4611].
+
+ * generic/tkStubInit.c:
+ * generic/tkIntDecls.h: Re-gen'd from tkInt.decls.
+
+ * generic/tkInt.decls: Added TkpInitKeymapInfo to list of function
+ decls.
+
+ * generic/tkBind.c (HandleEventGenerate): Added code to initialize
+ keymap info if necessary, and to correctly set modifier bits in
+ XEvent structure create to handle [event generate] calls.
+ Previously, the alt/meta bits were not set correctly, so [event
+ generate $widget <Alt-z>] would always fail. [Bug: 4611]
+
+2000-04-07 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkGrid.c (InitMasterData): fixed uninit'd data in
+ GridMaster struct [Bug: 4387]
+
+ * library/safetk.tcl (disallowTk): made disallowTk work in the
+ simple case.
+
+ * library/comdlg.tcl (tkFocusGroup_In): fixed key navigation
+ problems in dialogs under CDE [Bug: 2960]
+
+ * tests/winDialog.test: removed knownBug constraint from 5.16
+
+ * win/tkWinFont.c (GetScreenFont): corrected adjustment against
+ LC_FACESIZE limitation for NT [Bug: 4931]
+
+ * win/makefile.vc (TKTEST_OBJS):
+ * win/Makefile.in (TKTEST_OBJS): moved tkWinTest.c from normal
+ objs to TKTEST_OBJS where it belonged.
+
+2000-04-03 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkTest.c: fixed incorrect platform inclusion for
+ TkplatformtestInit (it would never get called).
+
+ * unix/Makefile.in (MAN_INSTALL_DIR): patch to accept --mandir
+ correctly [Bug: 4085]
+
+ * library/clrpick.tcl (tkColorDialog_Config): error now thrown
+ when -initialcolor "" specified. [Bug: 4198]
+
+2000-03-31 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/DrawFocHlt.3: doc name correction
+
+ * generic/tkEntry.c: set TK_OPTION_NULL_OK bit on -invcmd option
+ and removed #ifdef ENTRY_VALIDATE expressions
+
+ * library/menu.tcl (tkMenuInvoke): corrected naming of tearoffs
+ [Bug: 4506]
+
+ * library/tkfbox.tcl (tkIconList_Goto): caused browsecmd to be
+ called in tkIconList_Select. This causes the entry to be set
+ properly when using the type-in-name-in-listbox bindings.
+
+ * win/tkWinDialog.c: added unicode-aware open/save file dialogs
+
+ * win/tkWinFont.c (TkpFontPkgInit): move private ref to platformId
+ to TkWinGetPlatformId
+
+ * win/tkWinMenu.c (SetDefaults): moved private use of versionInfo
+ to TkWinGetPlatformId and removed all code for
+ (versionInfo.dwMajorVersion < 4) (== Win32s)
+
+ * win/tkWinX.c:
+ * win/tkWin32Dll.c: moved TkWinGetPlatformId to tkWinX.c
+ * win/tkWinInit.c: added TkWinXInit to TkpInit to ensure that its
+ called for static Windows shells. [Bug: 3647]
+
+ * win/tkWinInt.h:
+ * win/tkWinX.c:
+ * win/tkWinDraw.c (SetUpGraphicsPort):
+ * win/tkWinScrlbr.c (UpdateScrollbar): removed use of tkpIsWin32s
+
+ * win/tkWinInt.h (TkWinDCState struct): added bkmode value
+ * win/tkWinDraw.c (TkWinGetDrawableDC, et al): added support for
+ properly transparent dashed lines on Windows. [Bug: 4617]
+
+2000-03-30 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkImgGIF.c: Fixed some ANSI specific bits to avoid
+ compile problems with non-ANSI compilers (ie, replace const with
+ CONST, etc). [Bug: 4223].
+
+ * unix/configure.in: Applied patch from [Bug: 4237]; ensures that
+ srcdir is fully qualified.
+
+ * unix/Makefile.in: Applied patch from [Bug: 4237]; if tcltest was
+ not compiled, make test/tktest failed. Now it has a rule to build
+ tcltest if it has not been built.
+
+2000-03-28 Eric Melski <ericm@scriptics.com>
+
+ * library/tkfbox.tcl: Moved an overlooked tkFDialog* function in
+ ::tk::dialog::file namespace.
+
+ * tests/unixWm.test: Added tests for memory leak conditions in
+ tkUnixWm.c.
+
+ * tests/canvas.test: Added test for bad configuration options on
+ empty and non-empty canvas.
+
+ * generic/tkCanvas.c: Removed bad code in CANV_CONFIGURE block of
+ CanvasWidgetCmd; this was causing non-empty canvases to improperly
+ handle bad configuration options [Bug: 4456].
+
+2000-03-27 Eric Melski <ericm@scriptics.com>
+
+ * unix/tkUnixWm.c: Applied patch from [Bug: 4405]; fixes memory
+ leak in Unix wm command.
+
+2000-03-24 Eric Melski <ericm@scriptics.com>
+
+ * tests/filebox.test:
+ * tests/choosedir.test: Updated tests.
+
+ * library/xmfbox.tcl: Updated to stash data array in
+ ::tk::dialog::file namespace instead of in global namespace.
+
+ * library/tkfbox.tcl: Extended some functions to support creation
+ of a choosedir dialog, to allow greater code reuse between the two
+ dialogs. Moved tkFDialog* functions into a namespace
+ (::tk::dialog::file). Because these are private Tk functions (and
+ should thus not be used directly by users), this should not impact
+ anybody (the tk_getOpenFile and tk_getSaveFile commands still
+ exist at the global scope).
+
+ * library/tk.tcl:
+ * library/tclIndex: Updated function names for tkFDialog*
+ functions and choosedir functions.
+
+ * library/choosedir.tcl: New and improved implementation of
+ tk_chooseDirectory dialog. Based on tk_getOpenFile dialog.
+
+2000-03-23 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkWindow.c:
+ * generic/tkInt.h: Updated Tcl_OptionCmd -> Tcl_OptionObjCmd
+
+ * generic/tkOption.c: Tcl_Obj'ectified the "option" command.
+
+2000-03-22 Eric Melski <ericm@scriptics.com>
+
+ * library/listbox.tcl (tkListboxCancel): Added a check for empty
+ string value for tkPriv(listboxPrev). Without this check, it's
+ possible to get a stack trace under certain conditions. [Bug: 4373].
+
+2000-03-15 Sven Delmas <sven@scriptics.com>
+
+ * win/tkWinDialog.c: Changed the behavior for the
+ tk_chooseDirectory dialog under Windows. Instead of trying to
+ return the currently selected listbox entry (which didn't work in
+ case the user selected the initial directory anyway), we now
+ return the value shown in the entry. This seems to be in
+ accordance with the expected behavior for this dialog.
+
+2000-03-14 Eric Melski <ericm@scriptics.com>
+
+ * tests/choosedir.test: Marked test 3.1 and 3.2 as bad until the
+ issue with those tests on IRIX can be determined.
+
+2000-03-10 Eric Melski <ericm@scriptics.com>
+
+ * library/menu.tcl: Applied patch from [Bug: 4155]; protects
+ against grabs on non-viewable windows.
+
+2000-03-08 Eric Melski <ericm@scriptics.com>
+
+ * tests/choosedir.test: Modified test 3.1 (-mustexist works) to be
+ more careful about cleaning up its potentially troublesome after
+ events.
+
+2000-03-07 Eric Melski <ericm@scriptics.com>
+
+ * tests/button.test:
+ * generic/tkButton.c: Added -disabledforeground/-state to labels.
+
+2000-03-07 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/entry.test:
+ * generic/tkEntry.c (EntrySetValue): malloc the value when
+ validating because validation could cause the pointer to become
+ invalid. Also fixed configure to not trigger focus-based
+ validation. Improved use of Tcl_WrongNumArgs. [Bug: 4320]
+
+2000-03-06 Eric Melski <ericm@scriptics.com>
+
+ * library/menu.tcl: Added a check in tkMenuFirstEntry that changes
+ menu behavior to only auto-post an immediate child cascade if we
+ are currently on a menubar menu. This prevents massive
+ auto-cascading in cases where the first entry of the cascade is
+ itself a cascade, and the first entry of that cascade is a
+ cascade, and the first entry of that cascade is a cascade
+ ... [Bug: 676].
+
+ * generic/tkOldConfig.c: Added check for NULL tkwin value in
+ Tk_ConfigureWidget [Bug: 4079]
+
+ * generic/tkWindow.c: Added check for NULL tkwin value in
+ Tk_NameToWindow [Bug: 4079]
+
+2000-03-02 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/color.test:
+ * xlib/xcolors.c (XParseColor FindColor):
+ * win/tkWinColor.c (XAllocColor): Fixed bit fiddling for colors to
+ return "correct" values for color mapping. [Bug: 4282]
+
+ * unix/Makefile.in (SCRIPT_INSTALL_DIR): removed extraneous '/'
+ * unix/aclocal.m4: corrected TCL_NEEDS_EXP_FILE to be 1 for AIX
+
+ * win/tkWinInt.h: change extern to EXTERN for TkWinChildProc
+ declaration with extra #defs. [Bug: 4240]
+
+ * library/focus.tcl: fixed tkFocusOK to protect $w in
+ uplevel with list. [Bug: 4208]
+
+ * doc/CrtItemType.3: fixed docs for Tk_CreateItemType to reflect
+ changes made in 8.3.0 (but old style would still work as well).
+ [Bug: 4252]
+
+ * tests/config.test: extra test to check object cleanup when
+ destroying the widget
+ * generic/tkListbox.c (DestroyListbox): fixed crash in
+ DestroyListbox due to null tkwin. [Bug: 4207]
+
+ * tests/entry.test: added test suite for entry validation
+ * doc/entry.n: improved docs discussing caveats and gotchas when
+ mixing textvar with widget validation
+ * generic/tkEntry.c (EntryValidateChange): improved handling of
+ validation with relation to -textvariable. Previously, it would
+ turn off whenever the textvar was set. Now it will it will turn
+ off only when the textvar is set and validation returns 0. Added
+ %V (type of validation occuring) to %-subs to help work with
+ trickier validation.
+
+2000-03-01 Eric Melski <ericm@scriptics.com>
+
+ * tests/clrpick.test:
+ * library/clrpick.tcl: Added code to make color chooser dialog
+ inherit screen setting from parent (bug #2334)
+
+2000-02-25 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinWm.c (RaiseWinWhenIdle): Checked for the possibility
+ that the window could be destroyed (can occur with
+ wm deiconify .toplevel; destroy .toplevel).
+
+2000-02-25 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkImgGIF.c: Applied "spirit of" the patch in 1605 (the
+ submitted patch was more complicated than necessary and did not
+ extend to writing GIF's, only reading), to allow reading/writing
+ of GIF files on EBCDIC and other non-ASCII based systems.
+
+2000-02-14 Eric Melski <ericm@scriptics.com>
+
+ * unix/tk.spec: RPM specification for producing a binary Tk RPM
+ for Linux.
+
+ * unix/Makefile.in: Added rpm target to generate Tk
+ binary RPM.
+
+2000-02-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ 8.3.0 RELEASE
+
+ * changes: updated for 8.3.0 release
+
+ * generic/tkImgGIF.c (FileReadGIF): added cast for trashBuffer
+
+ * generic/tkIntXlibDecls.h:
+ * generic/tkInt.decls: declared some Xlib emulation calls for
+ the Mac
+
+ * generic/tkFrame.c (TkInstallFrameMenu): added extra panic to
+ inform user of bad call when framePtr is NULL [Bug: 2530]
+
+ * generic/tkMenu.c (DestroyMenuInstance): Placed checks around
+ menu name objects before trying to incr the ref. [Bug: 3402]
+
+ * generic/tkTest.c: removed USE_OLD_IMAGE def for Mac
+
+ * library/listbox.tcl:
+ * library/text.tcl: added support for <4> and <5> for mousewheel
+ style scrolling on Unix for mice that map to these buttons.
+
+ * tests/scrollbar.test: fixed check of testmetrics command to
+ allow unix tests to run (testmetrics is mac/pc only)
+
+ * unix/tkUnixWm.c (Tk_CoordsToWindow): qualified delete of error
+ handler as the goto label is reached from above and below.
+
+ * unix/configure.in:
+ * unix/aclocal.m4: cleaned up macros to coincide with tcl.m4,
+ added -export-dynamic to LDFLAGS for FreeBSD-3+ [Bug: 2998]
+
+ * unix/README:
+ * unix/Makefile.in (dist): removed porting.notes and porting.old
+ from distribution and CVS. The information was very outdated. Now
+ refer to http://dev.scriptics.com/services/support/platforms.html
+
+ * xlib/xgc.c: #def'd out XDrawSegments for the Mac, and added
+ some extra include info for the Mac
+
+2000-02-09 Jim Ingham <jingham@cygnus.com>
+
+ * mac/tkMacButton.c: Stop removing the appearance window from the
+ Window List. It is not clear why Ray did this, and it causes the
+ Appearance manager to crash at random times.
+
+ * mac/tkMacWM.c: Add support in unsupported1 style for the Appearance
+ specification of window styles, including floating window support.
+ * mac/tkMacWindowMgr.c: Operate on the front non-floating window,
+ unless the mouse is directly over the floating window. Also,
+ keystrokes go to the front non-floating window.
+ * mac/tkMacAppInit.c: Initialize floating window support.
+ * mac/tkMacScrlbr.c:
+ * mac/tkMacmenu.c: Fixes for floating windows - operate on the
+ FrontNonFloatingWindow.
+ * mac/tkMacLibrary.r: Fix typo in File info string.
+ * mac/tkMacApplication.r: Fix typo in file info string. Add
+ Finder balloon help for no apparent reason.
+
+ * mac/tkMacSubwindows.c: Change panic in tkMacGetDrawablePort to
+ Debugger. This is only a temporary fix. The panic is only
+ triggered when a safeTk interpreter is torn down, and ignoring it
+ does no harm. I haven't figured out how to avoid it yet, however.
+ Also use the Appearance MoveWindowStructure call when available.
+
+ New Files:
+ * MW_TkOldImageHeader.h: Handle #defining USE_OLD_IMAGE for tkImgPPM.c.
+ * MW_TkTestHeader.h:
+ * MW_TkTestHeader.pch:
+ * MW_TkHeader.h: Add separate prefix files for test & release
+ versions of Tk, so we can just have separate targets w/o having to
+ edit files.
+
+ * tclets.r: The D&D Tclets icon in rez form so we can have a
+ target for this.
+
+ The above are curtesy of Daniel Steffen (steffen@math.mq.edu.au)
+
+ * tkMacAppearanceStubs.c: Stubs of the Mac Appearance calls I use
+ so I can link the static 68K Shell without putting ifdef's all
+ over the code.
+
+2000-02-08 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tk.decls:
+ * generic/tkBind.c:
+ * generic/tkInt.decls:
+ * generic/tkIntDecls.h:
+ * generic/tkStubInit.c:
+ * mac/tkMacKeyboard.c:
+ * unix/tkUnixKey.c:
+ * win/tkWinKey.c: Fix for keyboard handling of "dead" keys and
+ caps lock from Peter Spjuth. [Bug: 4105 3359 2493]
+ Split functions into platform specific files:
+ Static functions GetKeySym(), SetKeycodeAndState() and InitKeymapInfo()
+ from tkBind.c moved into platform files tkWinKey.c tkUnixKey.c and
+ tkMacKeyboard.c. GetKeySym() and SetKeycodeAndState() renamed to
+ Tkp* and made public (as private functions) in tkInt.decls.
+
+ Step 2, fixes in tkWinKey.c
+ New static function: KeycodeToKeysym(), based on XKeycodeToKeysym()
+ but with different arguments, and a lot of improvements.
+ TkpGetString() changed to use KeycodeToKeysym() + other fixes.
+ TkpGetKeySym() changed to use KeycodeToKeysym() + other fixes.
+ InitKeymapInfo() changed to use KeycodeToKeysym().
+ TkpSetKeycodeAndState() rewritten, mostly by copying code from
+ XKeysymToKeycode().
+ XKeycodeToKeysym() rewritten. Preferably it should be removed.
+
+ EXPLANATION: The main problem is ToAscii() which has a lot of side
+ effects, and also that XKeycodeToKeysym() is not provided enough
+ input to do a proper job. The changes' main goal is to avoid
+ calling ToAscii() if not necessary, and to provide it with as
+ correct information as possible when called. Also some attempts
+ to clean up what ToAscii() did are done. See the code for details.
+
+ BUGS FIXED: Typing shifted (and AltGr) dead keys did not work.
+ Keyboard lock lamps did not work on Win98.
+ Events regarding AltGr-keys behaved badly.
+ Example: On a Swedish keyboard, $ is typed with AltGr-4.
+ That keyboard event would get the keysym '4' not 'dollar'.
+ Also, doing [event generete . <Key-dollar>] would send keysym '4'.
+ Translation to ascii in TkpGetString did not handle return and
+ tab correctly. I.e. [event generate . <Key-Return>] gave wrong %A
+
+ * generic/tkDecls.h:
+ * generic/tk.decls:
+ * generic/tk.h: moved new public functions created in dash patch
+ to the stubs interface [Bug: 4062]
+
+ * generic/tk.h:
+ * doc/CrtImgType.3:
+ * doc/CrtPhImgFmt.3:
+ * generic/tk.h:
+ * generic/tkImgGIF.c:
+ * generic/tkImgPhoto.c:
+ * generic/tkStubImg.c (new file):
+ * generic/tkTest.c:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: improved support for moving from the old style
+ image C API to the new obj'ified one with new Tk_InitImageArgs
+ command and stub'ing of image code. See docs for how to make the
+ transition. [Bug: 4060]
+
+ * library/tk.tcl: wrapped check for tcl_platform(os) around info
+ exists because it won't in safe interpreters
+
+ * win/tkWinFont.c: corrected symbol font use to only work on 8-bit
+ characters [Bug: 2406]
+
+ * unix/aclocal.m4: changed all -fpic to -fPIC
+
+ * README:
+ * unix/configure.in:
+ * win/configure.in:
+ * generic/tk.h (TK_RELEASE_SERIAL): Moved to 8.3.0 patchlevel
+
+2000-02-07 Eric Melski <ericm@scriptics.com>
+
+ * library/tkfbox.tcl: Applied patch from bug #4117,
+ tk_getOpenFile/getSaveFile doesn't do the right thing when user
+ types a directory name in the entry and a default extension is
+ specified.
+
+2000-02-05 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/tkUnixScale.c (TkpDestroyScale): changed ckfree to
+ Tcl_EventuallyFree to behave with Tcl_Preserve in TkpDisplayScale
+ (prevents possible segfault).
+
+2000-02-03 Eric Melski <ericm@scriptics.com>
+
+ * tests/canvText.test: test for fix for bug #2525.
+
+ * generic/tkFont.c (Tk_ComputeTextLayout): Was erroneously setting
+ the width of newline-only text display chunks to some arbitrary
+ huge number, instead of 0; this was interfering with things like
+ the canvas find enclosed feature. (bug #2525).
+
+ * tests/text.test:
+ * generic/tkText.c (DumpLine/DumpSegment): Changed DumpSegment to
+ take a TkTextIndex instead of two integer offsets, so that it
+ could use TkTextPrintIndex to format the offsets into an index,
+ which makes it UTF smart (bug #2582).
+
+2000-02-01 Eric Melski <ericm@scriptics.com>
+
+ * library/tk.tcl:
+ * library/tclIndex:
+ * library/choosedir.tcl: Moved choosedir functions into the
+ ::tk::dialog::chooseDir namespace instead of a toplevel
+ ::tkChooseDirectory namespace. Additional cleanup on the
+ chooseDir dialog.
+
+2000-02-01 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/text.n: clarified docs on what happens during a search with
+ -count when images/windows are embedded
+
+ * win/Makefile.in (install-*): reduced verbosity of install
+
+ * win/tkWinPixmap.c (XGetGeometry): added support for windows in
+ XGetGeometry [Bug: 4069]
+
+ * win/tkWinFont.c (GetScreenFont): fixed possible mem overrun with
+ long font names [Bug: 4108]
+
+ * win/tkWinDialog.c: added EnableWindow calls to dialogs to
+ correct for possible loss of control in parent Tk toplevel
+ [Bug: 1212 et al]
+
+ * generic/tkRectOval.c (ConfigureRectOval):
+ * generic/tkCanvLine.c (ConfigureLine):
+ * generic/tkCanvPoly.c (ConfigurePoly):
+ * generic/tkCanvArc.c (Configure/DisplayArc): fixed handling for
+ negative dash values [Bug: 4104]
+
+ * generic/tkScale.c (TkRoundToResolution): fixed incorrect
+ assumption that (N+1)*delta = N*delta + delta with floating point
+ math [Bug: 3689, 4099]
+ (DestroyScale) Fixed check for cancelling TkpDisplayScale (was
+ REDRAW_ALL, is now REDRAW_PENDING)
+
+ * tests/listbox.test: corrected test case for listbox itemconfigure
+
+ * unix/aclocal.m4: added *BSD ELF recognition for
+ SHARED_LIB_SUFFIX determination (from Tcl's tcl.m4)
+
+2000-01-27 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkImgPhoto.c: Removed unneccesary object translation in
+ MatchStringFormat (bug #4103).
+
+2000-01-27 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkImgGIF.c: Additional code cleanup (now we only have
+ one decoder! neat!)
+
+2000-01-26 Eric Melski <ericm@scriptics.com>
+
+ * doc/getOpenFile.n:
+ * doc/chooseDirectory.n: Man page/cross links for
+ tk_chooseDirectory (bug #1786).
+
+ * library/tk.tcl:
+ * library/tclIndex: Added hooks for tk_chooseDirectory. (bug #1786)
+
+ * library/choosedir.tcl: tk_chooseDirectory implementation for
+ Unix/Mac (bug #1786).
+
+ * generic/tkImgPhoto.c: Added some comments regarding slow
+ processing of transparent images.
+
+ * generic/tkImgGIF.c: Improved GIF decoder for ~60% speed
+ increase. Added some comments on how to further improve the
+ implementation, time permitting.
+
+ * doc/photo.n: Added a description of what the -data string can
+ contain (base64 or binary data).
+
+ * generic/tkImgPhoto.c: Fixed bug with use of binary data for
+ "-data" option to "image create" command.
+
+2000-01-21 Eric Melski <ericm@scriptics.com>
+
+ * library/tkfbox.tcl: Fixed bug relating to incorrect parent
+ values for error message boxes displayed by the file dialog (bug
+ #3616).
+
+ * tests/text.test:
+ * generic/tkText.c: Fixed bug relating to regexp searching for
+ empty lines; previously, the starting line was ignored. (bug #1643).
+
+2000-01-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/text.tcl: fixed double-click selection behavior where
+ there were embedded windows/widgets in the same line. [Bug: 3989]
+
+ * win/tkWinWm.c (TkWmProtocolEventProc): cached atom name as the
+ window could get destroyed during eval [Bug: 2513]
+
+ * generic/tkCanvLine.c (LineCoords): fixed segfault when too few
+ coords were passed to a line with certain options set (it should
+ always have thrown an error anyway). [Bug: 4042]
+
+ * tests/text.test:
+ * generic/tkText.c: fixed missing " in error case and missing
+ 'dump' in subcommand listing [Bug: 4036]
+
+ * generic/tkListbox.c: adjusted use of basic string concatenation
+ in (non-K&R behavior) [Bug: 4027]
+ Swapped bg/fg class for -select(bg|fg) for listbox and their
+ items [Bug: 4039]
+
+ * unix/mkLinks:
+ * doc/WindowId.3: added docs for Tk_IsContainer and Tk_IsEmbedded
+
+ * doc/text.n: clarified mark gravity definition and usage of
+ ``word'' in binding definitions. [Bug: 2004 2277 1388]
+
+ * generic/tkInt.h: moved new TkDisplay useInputMethods structure
+ element to end to not disturb position of previous elements in
+ the structure (as compared to Tk <=8.2).
+
+2000-01-20 Eric Melski <ericm@scriptics.com>
+
+ * tests/grid.test: Added a test for the consecutive ^ and multiple
+ widget case (bug #1386).
+
+ * generic/tkGrid.c: Fixed interpretation of consecutive ^
+ characters in grid command. Previously, ^ ^ was interpreted as
+ meaning that there must be a 2-column widget above to extend,
+ neglecting the case where there was actually 2 1-column widgets
+ above. Now, ^ ^ is interpreted as a possible width; the gridder
+ will consume as many ^'s as there are columns in the widget, and
+ leave the rest for the extension of other widgets. (bug #1386).
+
+2000-01-19 Eric Melski <ericm@scriptics.com>
+
+ * library/tk.tcl: Created a virtual event <<PrevWindow>> for
+ reverse tab traversals, with one default binding <Shift-Tab>, and
+ OS specific bindings for Linux, HP-UX, and IRIX. (bug #3163)
+
+2000-01-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * changes: updated changes file to reflect 8.3b2 mods
+ * README:
+ * generic/tk.h:
+ * unix/configure.in:
+ * win/configure.in: updated to patchlevel 8.3b2
+
+ * win/tkWinWm.c: added visibility event handler to make sure
+ that transient window wrappers would be updated when the master
+ was initially mapped.
+
+2000-01-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/text.test: changed test to reflect change of -hidden
+ to -elide in search options.
+
+ * win/tkWinScrlbr.c: added check for valid hwnd in ModalLoopProc
+ to avoid crash when building statically
+
+ * doc/event.n:
+ * generic/tkBind.c: prevented core with event -warp on Windows
+ when window wasn't mapped [Bug: 4004] and added docs stating
+ the requirement for mapped windows.
+
+ * generic/tkCanvas.c: fixed mem leak with TagSearchExprInit
+ [Bug: 3977]
+
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h: remove non-existent
+ Tk_(Get|Create)CanvasVisitor prototypes
+
+ * generic/tkText.c:
+ * generic/tkEntry.c: fixed cursor to not blink when widget was
+ disabled [Bug: 1807]
+
+ * generic/tkRectOval.c: added note about change to bloat for
+ RectOval bounds calculation for WIN32 only
+
+ * library/dialog.tcl: improved handling of $default arg to allow
+ for name of given button, as well as bounds checking
+
+ * doc/wm.n:
+ * tests/winWm.test:
+ * tests/unixWm.test:
+ * mac/tkMacWm.c:
+ * unix/tkUnixWm.c: fixed possible X error being raised [Bug: 3377]
+ * win/tkWinWm.c: wm deiconify in zoom state [Bug: 2077],
+ fixed possible flashing of unmapped toplevel in deiconify [Bug: 3338]
+ and fixed mapping of transient window [Bug: 572]
+ Also, for all wm's, extended 'wm state' command to allow setting
+ of the state, and added official support of 'zoomed' state on Win.
+
+ * unix/aclocal.m4: strtod bug on Tru64 [Bug: 3378]
+
+ * unix/Makefile.in: added tests to prevent unnecessary chmod +x
+ in source dirs while installing [Bug: 3367]
+
+ * unix/configure.in: properly sub'ed in TK_SHARED_BUILD [Bug: 3385]
+
+2000-01-05 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/text.n:
+ * generic/tkText.c:
+ * generic/tkText.h:
+ * generic/tkTextBTree.c:
+ * generic/tkTextDisp.c:
+ * generic/tkTextTag.c: removed the -state option for text tags,
+ and reoriented it around -elide, as -state disabled was never
+ implemented, and -state hidden is better as -elide.
+
+ * mac/tkMacClipboard.c: fixed i18n problems with clipboard [Bug: 3544]
+
+ * library/entry.tcl:
+ * library/focus.tcl:
+ * library/listbox.tcl:
+ * library/scale.tcl:
+ * library/scrlbar.tcl:
+ * library/tearoff.tcl:
+ * library/text.tcl:
+ * library/tkfbox.tcl:
+ * library/xmfbox.tcl: fixed unprotected arg parsing through eval/after
+ [Bug: 3943]
+
+ * unix/Makefile.in: added unix/aclocal.m4 to distribution [Bug: 3938]
+ * unix/aclocal.m4: changed NetBSD SHLIB_CFLAGS from -fpic to -fPIC
+
+ * win/tkWinImage.c: added static declaration to function
+
+1999-12-22 Jeff Hobbs <hobbs@scriptics.com>
+
+ * changes: updated changes file
+
+ * generic/tkScale.c:
+ * generic/tkScale.h:
+ * mac/tkMacScale.c:
+ * unix/tkUnixScale.c: fixed potential segv from patch in 3897
+
+ * tests/unixWm.test: nonPOrtable -> nonPortable
+
+1999-12-21 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tk.h:
+ * unix/configure.in:
+ * win/configure.in:
+ * win/aclocal.m4:
+ * README: updated for patch level 8.3b1
+
+ * unix/tkUnixWm.c: fixed panic in Tk_CoordsToWindow to print error
+ and continue instead (for Tix) [Bug: 716 et al]
+
+ * scale.test:
+ * generic/tkScale.c:
+ * generic/tkScale.h: fixed possible core when freeing options
+ (cursor) associated with scale widget [Bug: 3897]
- coffbase.txt will be the master list for our "prefered base
- addresses" set by the linker. This should improve load-time
- (NT only) by avoiding relocations. Submissions to the list
- by extension authors are encouraged.
+ * doc/MeasureChar.3: fixed docs for Tk_MeasureChars to reflect code
+ * doc/listbox.n: fixed formatting problem
- Added a 'tidy' target to compliment 'clean' and 'hose' to remove
- just the outputs. Also removed the $(winlibs) macro as it wasn't
- being used.
+ * generic/tk3d.c: added extra calculations to ensure that thin
+ frames get refreshed too [Bug: 3596]
- Stuff left to do:
- 1) get the winhelp target to stop building in the tools/
- directory.
- 2) stop using rmd.bat
- 3) add more dependacy rules.
+ * unix/tkUnixMenu.c:
+ * unix/tkUnixFont.c:
+ * generic/tkCanvText.c:
+ * generic/tkEntry.c:
+ * generic/tkFont.c:
+ * generic/tkImgPPM.c: removed extranneous vars that were set but
+ never used.
- * win/tclAppInit.c: Reverted back to -r1.6, as the header file
- change to tclPort.h won't allow for easy embedded support
- outside of the source dist. Thanks to Don Porter for pointing
- this out to me.
+ * mac/tclMacHLEvents.c: fixed applescript for I18N [Bug: 3644]
-2002-02-21 David Gravereaux <davygrvy@pobox.com>
+ * unix/aclocal.m4: removed -O flag for AIX when using the IBM
+ compiler (several versions have a bug that crops up in the text
+ widget). [Bug: 2316]
+ * unix/Makefile.in: removed extra slash in SCRIPT_INSTALL_DIR
+ [Bug: 3896]
+
+ * library/listbox.tcl: added extra checks for existence of
+ tkPriv(listboxSelection) before it was used. [Bug: 3892]
+
+1999-12-16 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/GetCursor.3:
+ * win/tkWinCursor.c: added support for Windows cursors to
+ TkGetCursorByName (.ani, .cur) using -cursor @<filename>
+ (Ascher) [Bug: 1350]
+
+ * win/tkWinWm.c: fixed 'wm deiconify' to update position of the
+ toplevel if event is waiting before mapping. (Mao) [Bug: 3687]
+ This removes the need for 'update idle' before 'wm deiconify' on
+ Windows.
+
+ * doc/listbox.n: added doc for <<ListboxSelect>> [Bug: 3500]
+
+ * doc/getOpenFile.n: removed note that -initialfile didn't work
+ for tk_getOpenFile
+ * library/tkfbox.tcl: updated tk_get*File to better match the
+ Windows file box it emulates, give proper support to -initialfile,
+ and fixes lack of global tkPriv call. [Bug: 3735 3882]
+
+ * doc/tk.n: added doc for 'tk useinputmethods ...'
+ * tests/tk.test:
+ * unix/tkUnixKey.c:
+ * generic/tkCmds.c:
+ * generic/tkEvent.c:
+ * generic/tkWindow.c:
+ * generic/tkInt.h: add 'tk useinputmethods ?-display win? ?bool?'
+ call to provide support for disabling/enabling the use of XIM on
+ X. This was previously all done at compile time, and always on.
+ Now it is turned off by default, even when available, and the user
+ must turn it on to use XIM (per display).
+
+ * generic/tkCanvUtil.c: fixed bug in Tk_CanvasPsOutline that freed
+ mem it shouldn't.
+
+ * generic/tkFont.c: added "bitstream cyberbit" (popular Windows
+ CJK font) to list of font fallbacks. (kenny) [Bug: 2407]
+
+ * mac/tkMacMenu.c: finished bug 3075 by changing the char values of
+ what was checked (verified correctness on Mac).
+
+1999-12-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/canvas.n: added docs for items added by dash patch (-*dash*,
+ -state, -active*, -disabled*, -offset, essentially rewrote the
+ man patch for completely updated 8.3 canvas widget.
+ * doc/entry.n: added docs for entry widget validation
+ * doc/event.n: added docs for -warp
+ * doc/text.n: doc'ed new -state value 'hidden'
+ * doc/GetDash.3: (new file) man page explaining Tk_GetDash
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h:
+ * generic/tkIntXlibDecls.h:
+ * generic/tkInt.decls: added XSetDashes and XWarpPointer
+ * generic/tk.decls: added Tk_CreateSmoothMethod, and reserved
+ two spots
+ * generic/tk.h: added Tk_SmoothMethod struct,
+ state item to canvas record, #defines for item state,
+ support for using old char*-based canvas item C creation
+ procedures with -DUSE_OLD_CANVAS,
+ Tk_Dash, Tk_TSOffset (-offsets) & Tk_Outline structs and #defs,
+ decls for dash, outline and postscript routines
+ * generic/tkBind.c: added support for Quadruple clicks, and added
+ the -warp option to 'event' with pointer warping routines
+ * xlib/xgc.c:
+ * generic/tkRectOval.c:
+ * generic/tkCanvArc.c:
+ * generic/tkCanvBmap.c:
+ * generic/tkCanvImg.c:
+ * generic/tkCanvLine.c:
+ * generic/tkCanvPoly.c:
+ * generic/tkCanvPs.c:
+ * generic/tkCanvText.c:
+ * generic/tkCanvUtil.c:
+ * generic/tkCanvWind.c:
+ * generic/tkCanvas.c:
+ * generic/tkCanvas.h: Canvas and items received overhaul to with
+ the addition of the dash patch (Nijtmans, et al) This includes
+ objectification of the 'canvas' command, as well as support for
+ (where appropriate) dashes in items, extended stipple support,
+ state for all items, and postscript generation of images and
+ windows. See the new canvas man page for related docs.
+ * generic/tkEntry.c: added entry widget validation, see entry.n
+ * generic/tkEvent.c: on simulated events, ButtonPress should
+ be matched with ButtonRelease to be correct
+ * generic/tkFont.c: corrected possible null reference
+ * generic/tkFrame.c: made frame a Tcl_Obj based command
+ * generic/tkGet.c: added TkGetDoublePixels
+ * generic/tkImage.c: bug fixes from Img patch and new
+ Tk_PostscriptImage and Tk_SetTSOrigin functions
+ * generic/tkImgBmap.c: new ImgBmapPostscript function
+ * generic/tkImgPhoto.c: new Tk_CreatePhotoOption, Tk_DitherPhoto
+ * generic/tkInt.h: declarations for some new functions
+ * generic/tkMessage.c: reworked relief drawing
+ * generic/tkOldConfig.c: added TK_CONFIG_OBJS so old style
+ ConfigureWidget calls can pass in Tcl_Obj arrays
+ * generic/tkScrollbar.c:
+ * generic/tkScrollbar.h: made -orient use an option table
+ * generic/tkText.c:
+ * generic/tkText.h: made -wrap and -state use option tables
+ * generic/tkTextBTree.c:
+ * generic/tkTextDisp.c:
+ * generic/tkTextImage.c:
+ * generic/tkTextMark.c:
+ * generic/tkTextTag.c:
+ * generic/tkTextWind.c: added support for -elide and -state hidden
+ * generic/tkTrig.c: changed TkMakeBezierCurve to support returning
+ the upper limit of points needed for spline
+ * generic/tkUtil.c: new option table parsing routines
+ * generic/tkWindow.c: init'ing of warp stuff, mouseButtonState
+
+ related bug ids for the fixes:
+ [Bug: 648 1541 1540 1779 2168 2311 2297 2340 2348 2578 3386]
+
+ * tests/bind.test:
+ * tests/canvImg.test:
+ * tests/canvPsArc.tcl:
+ * tests/canvPsImg.tcl: (new file)
+ * tests/canvRect.test:
+ * tests/canvText.test:
+ * tests/canvas.test:
+ * tests/defs.tcl:
+ * tests/entry.test:
+ * tests/event.test:
+ * tests/font.test:
+ * tests/frame.test:
+ * tests/imgPhoto.test:
+ * tests/safe.test:
+ * tests/scale.test:
+ * tests/scrollbar.test:
+ * tests/select.test:
+ * tests/text.test:
+ * tests/textDisp.test:
+ * tests/textTag.test:
+ * tests/unixFont.test:
+ * tests/unixWm.test:
+ * tests/visual_bb.test:
+ * tests/winClipboard.test: tests for the dash patch changes
+
+ * unix/mkLinks: added GetDash.3 into the mkLink step
+
+ * mac/tkMacDraw.c: mac still needs pointer warping routine
+ * mac/tkMacXStubs.c:
+ * win/tkWinDraw.c:
+ * win/tkWinPointer.c: added support for pointer warping and
+ platform specific support for dash patch items
+
+1999-12-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkText.c: fixed bug in TextSearchCmd for multibyte chars
+ (Darley) [Bug: 3839]
+
+ * unix/aclocal.m4: added warning when configuring with
+ --enable-threads that Tk may have problems
+
+1999-12-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkImgGIF.c: updated casting
+
+ * win/makefile.vc: removed 16bit stuff, simplified makefile.
+
+1999-12-06 Scott Redman <redman@scriptics.com>
+
+ * generic/tkMain.c: need to include tclInt.h for new hook
+ functions that are internal-use-only.
+
+1999-12-06 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/comdlg.tcl: removed tclVerifyInteger and tclSortNoCase,
+ they weren't used, and were not actually correct
+
+ * mac/tkMacFont.c:
+ * mac/tkMacMenu.c:
+ * mac/tkMacWindowMgr.c: fixed greyed out menu items, handling of
+ ... elipsis, font mapping problem, and enabled generated menu
+ posting [Bug: 3705]
+
+1999-12-02 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkInt.h:
+ * generic/tkWindow.c:
+ * generic/tkCmds.c: converted Tk_DestroyCmd, Tk_LowerCmd and
+ Tk_RaiseCmd to their ObjCmd equivalent.
+
+ * library/msgbox.tcl: added color icons for tk_messageBox on Unix
+ and Mac when tk_strictMotif isn't set. (Hipp)
+ * library/tk.tcl: added window bounds checking to ::tk::PlaceWindow
+
+ * tests/imgPPM.test: fixed test 2.2 to use -format ppm (since
+ we know have GIF write capability)
+
+1999-12-01 Scott Redman <redman@scriptics.com>
+
+ * generic/tkMain.c :
+ * unix/tkAppInit.c:
+ * win/winMain.c: Added added hooks into the main() code for
+ supporting TclPro and other "big" shells more easily without
+ requiring a copy of the main() code.
+
+1999-11-29 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkImgGIF.c: added GIF writing that uses miGIF RLE
+ [Bug: 2039, new patch]
+
+ * library/entry.tcl: fixed up tkEntrySeeInsert (Nemthi)
+
+ * generic/tkListbox.c: fixed 'get' of listbox to return a string
+ when only one item is requested.
+
+ * tests/clrpick.test:
+ * tests/filebox.test: minor whitespace cleanup
+
+ * library/tk.tcl: fixed missing $w in ::tk::PlaceWindow
+
+1999-11-24 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/clrpick.tcl:
+ * library/msgbox.tcl:
+ * library/tk.tcl:
+ * library/tkfbox.tcl:
+ * library/xmfbox.tcl: fixed dialogs to center over -parent,
+ added utility functions ::tk::PlaceWindow, ::tk::SetFocusGrab,
+ ::tk::RestoreFocusGrab to tk.tcl to help
+
+1999-11-23 Eric Melski <ericm@scriptics.com>
+
+ * tests/listbox.test: Added a test to check that the topIndex is
+ update when items are removed from the listvar variable.
+
+ * generic/tkListbox.c: Added a check the updates the topIndex when
+ items are removed from the listvar variable.
+
+ * tests/listbox.test: Added a test to check that the vertical
+ scrollbar is updated when the listvar changes.
+
+ * generic/tkListbox.c (ListboxListVarProc): added a check that
+ sets the UPDATE_V_SCROLLBAR flag if the length of the listvar has
+ changed.
+
+1999-11-23 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tk.h:
+ * generic/tkConfig.c: added support for TK_OPTION_DONT_SET_DEFAULT
+ as equiv for TK_CONFIG_DONT_SET_DEFAULT
+ * generic/tkListbox.c: added TK_OPTION_DONT_SET_DEFAULT to the
+ item specs
+
+1999-11-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkColor.c:
+ * generic/tkColor.h: fixed Tk_NameOfColor to work correctly,
+ with minor change to TkColor struct.
+
+ * generic/tkConsole.c: added static declaration to
+ ConsoleDeleteProc function (proto already had it)
+
+ * win/tkWinInt.h: removed TkFontAttributes typedef (was
+ redundant with tkFont.h).
+ * win/tkWinPort.h: put #ifndef __GNUC__ around redefinition
+ of str[n]casecmp, as cygwin uses the originals.
+ * win/tkWinX.c: changed GetCurrentTime to GetTickCount (the
+ former is deprecated). [Bug: 2053]
+
+1999-11-19 Eric Melski <ericm@scriptics.com>
+
+ * tests/listbox.test: Added tests for itemcget and itemconfigure.
+
+ * doc/listbox.n: Added documentation for -listvar option and for
+ itemconfigure and itemcget commands.
+
+ * generic/tkListbox.c: Added support for itemconfigure/itemcget
+ listbox subcommands (addresses rfe #936)
+
+1999-11-17 Eric Melski <ericm@scriptics.com>
+
+ * tests/listbox.test: Updated tests for new error messages.
+
+ * generic/tkListbox.c: Improved error messages for bad -listvar's.
+
+ * tests/listbox.test: Added tests for bad -listvar's.
+
+ * generic/tkListbox.c: Added handlers for bad -listvar's (ie, bad
+ lists)
+
+ * tests/listbox.test: Added tests for ListboxUpdateHScrollbar.
+
+ * generic/tkListbox.c: Changed some old static buffers to base
+ size on TCL_DOUBLLE_SPACE instead of (completely) hardcoding the size.
+
+ * tests/listbox.test: New tests for -listvar functionality, and an
+ odd extra case that wasn't covered before.
+
+ * generic/tkListbox.c: Tests exposed some bugs, now fixed.
+
+1999-11-16 Eric Melski <ericm@scriptics.com>
+
+ * tests/listbox.test: Fixed tests to comply with new objectified
+ error messages. No -listvar specific tests yet.
+
+ * win/tkWinDefault.h:
+ * unix/tkUnixDefault.h:
+ * mac/tkMacDefault.h: Added default value for -listvar option.
+
+ * generic/tkWindow.c: Changed "listbox" mapping from old-school to
+ new-school objectified command.
+
+ * generic/tkListbox.c: Objectified listbox; added support for
+ -listvar option. Converted internal structure to use a Tcl list
+ object to store the data.
+
+ * generic/tkInt.h: Changed reference to Tk_ListboxCmd to
+ Tk_ListboxObjCmd.
+
+1999-11-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkGrid.c: changed Tcl_Alloc to ckalloc
+
+ * generic/tkEntry.c: fixed C expr error in destroy of entry
+ that could lead to 'malformed bucket chain' error
+
+ * win/winMain.c: corrected winMain to not do a DebugBreak when
+ returning an error message from the top level
+
+1999-10-30 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinKey.c: fixed XKeysymToKeycode to handle mapping of
+ symbolic keysyms (Left, Home, ...) with event generate
+
+ * library/entry.tcl: change tkEntrySeeInsert to avoid the use
+ of a while loop that could eat CPU tremendously. Behavior of
+ moving the cursor at the right edge changes slightly (previously
+ it tried to keep the cursor at the right edge, now it moves the
+ cursor to a "central right" location - better IMHO).
+
+1999-10-28 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/CrtImgType.3:
+ * doc/CrtPhImgFmt.3:
+ * doc/FindPhoto.3:
+ * doc/photo.n:
+ * generic/tk.h:
+ * generic/tkCmds.c:
+ * generic/tkImage.c:
+ * generic/tkImgBmap.c:
+ * generic/tkImgGIF.c:
+ * generic/tkImgPPM.c:
+ * generic/tkImgPhoto.c:
+ * generic/tkInt.h:
+ * generic/tkTest.c:
+ * generic/tkWindow.c:
+ * tests/imgPhoto.test: added Img patch (Nijtmans) with docs,
+ headers #def'd with USE_OLD_IMAGE. Upgrades image stuff to
+ Tcl_Obj API, adds alpha channel (images are now 32 bpp)
+
+ * makefile.vc: changed 'c:/program files' to c:/progra~1
+
+1999-10-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/scrlbar.tcl: changed tkScrollButtonUp to check for
+ existence of tkPriv(relief) in order to avoid spurious release
+ events
+
+ * unix/Makefile.in: added ChangeLog to dist archive
+
+1999-09-24 Jeff Hobbs <hobbs@scriptics.com>
+
+ * */README:
* win/makefile.vc:
- * win/rules.vc: Added a new "loimpact" option that sets the
- -ws:aggressive linker option. Off by default. It's said to
- keep the heap use low at the expense of alloc speed.
+ * */configure.in:
+ * generic/tk.h:
+ * library/tk.tcl: up'd to 8.3a1
+
+ * unix/Makefile.in: changed 'mkdir' to 'mkdir -p'
+
+ * library/dialog.tcl: changed {Times 18} to {Times 12} for
+ dialog font.
+
+1999-09-16 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkFont.c: fixed processing of font options and error
+ returned [Bug: 2075]
+
+ * win/tkWinWm.c: fixed bug in 'wm deiconify' that raised the
+ wrong toplevel, and changed it to not set focus on overridden
+ toplevels
+
+1999-09-15 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition [Bug: 2070]
+ and fix to AIX-* to get ldAix right [Bug: 2624], fixed AIX
+ version check (readjust from 8-21 fix) and several other config
+ fixes for AIX
+ * mac/tkMacMenubutton.c:
+ * unix/tkUnixMenubu.c: fixed permanently stippled menubutton image
+ * win/tkWinButton.c: fixed possible pointer smash [Bug: 2733]
+
+1999-09-14 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinMenu.c: fix for stack overrun in GetTextFace [Bug: 909]
+
+1999-09-01 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinDraw.c:
+ * unix/tkUnixDraw.c: fixed header style for TkpDrawHighlightBorder
+ * generic/tkCanvas.c: fixed GC error (bg <> fg) in tkCanvas.c
+ (from code added to support TkpDrawHighlightBorder) [Bug: 2676]
+ * unix/aclocal.m4: added -bnoentry to the AIX-* flags
+ * library/msgbox.tcl: changed the behavior of tk_messageBox on
+ Unix to be more Windows like in handling of <Return> and the
+ default button
+ * library/button.tcl:
+ * library/clrpick.tcl:
+ * library/comdlg.tcl:
+ * library/console.tcl:
+ * library/dialog.tcl:
+ * library/entry.tcl:
+ * library/focus.tcl:
+ * library/listbox.tcl:
+ * library/menu.tcl:
+ * library/msgbox.tcl:
+ * library/palette.tcl:
+ * library/safetk.tcl:
+ * library/scale.tcl:
+ * library/scrlbar.tcl:
+ * library/tearoff.tcl:
+ * library/text.tcl:
+ * library/tk.tcl:
+ * library/tkfbox.tcl:
+ * library/xmfbox.tcl: updated commands to use [string] ops
+ instead of expr equality operators
+
+1999-08-21 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/aclocal.m4: Changed AIX-4.[2-9] check to AIX-4.[1-9]
+ [Bug: 1909]
+
+1999-08-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkCursor.c: fixed bug in GetCursorFromObj that caused
+ panic [Bug: 2562]
+
+ * TK 8.2.0 RELEASED
+
+1999-08-13 Jim Ingham <jingham@cygnus.com>
+
+ * mac/tkMacMenu.c: Tk_DrawChars ends up setting the menu background
+ wrong. There is no clean way to stop it, so I use lower level routines
+ here to draw the text.
+ * mac/tkMacProjects.sea.hqx: Rearrange the projects so that the build
+ directory is separate from the sources. Much more convenient!
+
+1999-08-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinWm.c: changed "wm deiconify" on Windows to raise and
+ force the focus on the deiconified window (behavioral change from
+ 8.1 to comply better with Windows style) [Bug: 1609]
+ * doc/wm.n: clarified behavior of "wm deiconify".
+ * generic/tkInt.decls: added TkSetFocusWin
+ * generic/tkFocus.c: changed static SetFocus to TkSetFocusWin
+
+ * library/clrpick.tcl:
+ * library/console.tcl:
+ * library/tk.tcl: fixed code where abbreviations where used
+ in calling widget methods (confuses iWidgets) [Bug: 2422]
+
+1999-08-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/button.tcl: cleaned up programming (config -> configure)
+ and fixed Windows relief bug [Bug: 664]
+ * library/entry.tcl: changed Entry C/C/P to not use global data
+ (now uses tkPriv(data)) [Bug: 1475]
+ * library/listbox.tcl: fixed extended mode script error [Bug: 866]
+ * doc/options.n: clarified that -troughcolor doesn't work on Windows
+ * doc/wm.n: fixed wm positionfrom docs [Bug: 2284]
+
+1999-08-01 Jeff Hobbs <hobbs@scriptics.com>
+
+ * mac/tkMacPort.h: wrapped panic in #ifndef panic to avoid
+ compiler errors when used with stubs-#defines, from Vince Darley.
+ [Bug: 2389]
+
+1999-07-31 Scott Redman <redman@scriptics.com>
+
+ * xlib/X11/Xlib.h: Remove XFillRectangle since it is now in the
+ stub tables.
+
+1999-07-30 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tkInt.decls: Added stub entry for XFillRectangle [Bug: 2446]
+
+1999-07-30 <redman@scriptics.com>
- * win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to
- remove the raw windows.h include. tclPort.h brings in windows.h
- already and lessens the pre-compiled-header mush and the randomly
- useless #pragma comment (lib,...) references throughout the big
- windows.h tree (as observed at high linker warning levels).
+ * win/makefile.vc: Corrected building threaded tktest.exe on
+ Windows. Needed to link in .obj files from Tcl, needs to change
+ later so that code is in Tk and doesn't require a Tcl build.
+ Also added runtest target.
-2002-02-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+1999-07-29 <redman@scriptics.com>
- * generic/tcl.h: Better guessing of LP64/ILP32 architecture, but
- now sensitive to presence of (suitable) <limits.h>
+ * generic/tkConsole.c: Allow tcl to open CON and NUL, even for std
+ channels. Checking for bad/unusable std channels was moved to Tk
+ since its only purpose was to check whether to use the Tk Console
+ Window for the std channels. [Bug: 2393 2392 2209 2458]
-2002-02-20 Don Porter <dgp@users.sourceforge.net>
+ * win/Makefile.in: Corrected building threaded tktest.exe on
+ Windows. Needed to link in .obj files from Tcl, needs to change
+ later so that code is in Tk and doesn't require a Tcl build.
- * generic/tcl.decls (Tcl_RegExpRange,Tcl_GetIndexFromObjStruct):
- Overlooked a few source incompatibilities. Now using CONST84.
- * generic/tclDecls.h: make genstubs
- * generic/tcl.h (Tcl_CmdObjTraceProc): silence warning from Sun
- Workshop compiler.
+1999-07-22 <redman@scriptics.com>
-2002-02-20 David Gravereaux <davygrvy@pobox.com>
+ * Changed version to 8.2b2
- * win/buildall.vc.bat:
+ * win/tkWinPort.h: Block out include of sys/stat.h in order to
+ build extensions with MetroWerks compiler for Win32. [Bug: 2385]
+
+ * unix/Makefile.in: Need to make install-sh executable before
+ calling (with chmod +x). [Bug: 2413]
+
+ * library/menu.tcl: Applied patch from Jeff Hobbs to fix typo.
+ [Bug: 2425]
+
+1999-07-21 <redman@scriptics.com>
+
+ * unix/Makefile.in: Add Windows configure script to distribution.
+
+1999-07-16 <redman@scriptics.com>
+
+ * unix/Makefile.in:
+ * win/Makefile.in: Copy the prolog.ps from the generic directory
+ for install-libraries.
+
+ * unix/aclocal.m4: Check for Alpha/Linux to set the IEEE flag to
+ the compiler to be -mieee. Patch from Don Porter.
+
+1999-07-08 <stanton@scriptics.com>
+
+ * tests/unixSelect.test: Fixed broken test.
+
+ * win/makefile.vc: Added special case target to ensure that
+ tkStubLib.obj is built with -DSTATIC_BUILD.
+
+ * win/tkWinX.c (TkWinChildProc): Changed to pass
+ WM_WINDOWPOSCHANGED through to DefWindowProc to make OpenGL
+ sub-windows happy. This allows Windows to generate the WM_SIZE
+ and WM_MOVE messages.
+
+1999-07-08 <redman@scriptics.com>
+
+ * unix/configure.in: Fix Tk stub lib file names and flags.
+
+1999-06-30 <redman@scriptics.com>
+
+ * generic/tkGrid.c: removed deprecated functions (applied patch
+ from Jan Nijtmans). [Bug: 2080]
+
+ * generic/tkImgGIF.c:
+ * generic/tkImgPPM.c:
+ * generic/tkImgPhoto.c: Applied patch to allow Img extension to
+ work with 8.2, from Jan Nijtmans. [Bug: 2068]
+
+ * win/tkWinWm.c: Applied patch from Don Porter to prevent the
+ windows code from calling the Tcl functions when the stub table
+ has not been initialized in TkWinWmCleanup. [Bug: 2269]
+
+1999-06-16 <wart@scriptics.com>
+
+ * unix/configure.in:
+ * unix/Makefile.in:
+ * unix/aclocal.m4: Numerous build changes to make Tk conform to
+ the proposed TEA spec
+
+ * tkConsole.c: changed some variable types from (int) to (size_t)
+ to prevent compiler warnings. Cast return value from strlen()
+ to (int) in one place for the same reason.
+
+1999-06-03 <stanton@scriptics.com>
+
+ * unix/tkUnixSelect.c:
+ * tests/unixSelect.test:
+ * generic/tkSelect.c: Fixed selection code to handle Unicode data
+ in COMPOUND_TEXT and STRING selections. [Bug: 1791]
+
+1999-06-02 <stanton@scriptics.com>
+
+ * generic/tkIntXlibDecls.h:
+ * xlib/X11/Xlib.h: Added Mac specific defines to help with
+ compilation.
+
+ * generic/tkFont.c: lint
+
+1999-06-01 <stanton@scriptics.com>
+
+ * unix/tkUnixSelect.c: Improved I18N selection support.
+ COMPOUND_TEXT is converted to/from iso2022, and STRING is
+ converted to/from iso8859-1. There are still a few loose ends to
+ tie up before this is completely done.
+
+ * unix/tkUnixFont.c: Eliminated redundant case folding code.
+
+ * generic/tkFont.c: Eliminated use of isupper/tolower in favor of
+ Unicode variants.
+
+1999-05-24 <stanton@scriptics.com>
+
+ * generic/tkStubLib.c:
+ * generic/tkStubInit.c:
+ * generic/tkIntXlibDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkIntDecls.h:
+ * generic/tkInt.decls:
+ * generic/tkConsole.c: Various changes to try to get the Mac
+ builds working.
+
+1999-05-21 <stanton@scriptics.com>
+
+ * win/tkWinClipboard.c: Fixed clipboard code to handle lack of
+ CF_LOCALE information (e.g. from command.com).
+
+1999-05-20 <redman@scriptics.com>
+
+ * library/console.tcl: Changed copyright string to read 1999
+ Scriptics Corp. in wish console about box.
+
+1999-05-19 <redman@scriptics.com>
+
+ * generic/tk.h: Add extern "C" block around entire header file for
+ C++ compilers to fix linkage issues. Submitted by Don Porter and
+ Paul Duffin.
+
+1999-05-18 <stanton@scriptics.com>
+
+ * tests/winClipboard.test:
+ * win/tkWinClipboard.c: Fixed clipboard code so it handles Unicode
+ data properly on Windows NT and 95. [Bug: 1791]
+
+1999-05-07 <stanton@scriptics.com>
+
+ * library/menu.tcl: Fixed bug where tk_popup fails when called too
+ quickly. [Bug: 2009]
+
+1999-04-30 <stanton@scriptics.com>
+
+ * Changed version number to 8.1.1.
+
+1999-04-30 <stanton@scriptics.com>
+
+ * Merged changes from 8.1.0 branch:
+
+ * generic/tkDecls.h:
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkIntXlibDecls.h:
+ * generic/tkPlatDecls.h:
+ * generic/tkStubInit.c: Changed to avoid the need for forward
+ declarations in stub initializers. Added extern "C" blocks around
+ stub table pointer declarations so the stubs can be used from C++
+ code. [Bug: 1934]
+
+ * generic/tkInt.decls: Added TkClipBox, XDrawSegments, and
+ XForceScreenSaver to stubs.
+
+ * generic/tkStubLib.c: Reordered declarations to avoid
+ circularities and forward references.
+
+ * generic/tkStubInit.c: Added includes for Mac.
+
+ * generic/tkMenubutton.c: lint
+
+ * generic/tkEntry.c: Fixed bad option table entry.
+
+ * generic/tkImgBmap.c:
+ * generic/tkImgPPM.c:
+ * generic/tkImgPhoto.c: Set the -translation and -encoding options
+ to binary for image files. (reported by Marco Gazzetta)
+
+1999-04-23 <stanton@scriptics.com>
+
+ * generic/tkInt.decls: Added TkClipBox, XDrawSegments, and
+ XForceScreenSaver to stubs.
+
+ * generic/tkStubLib.c: Reordered declarations to avoid
+ circularities and forward references.
+
+ * generic/tkStubInit.c: Added includes for Mac.
+
+ * generic/tkMenubutton.c: lint
+
+ * generic/tkEntry.c: Fixed bad option table entry.
+
+1999-04-22 <redman@scriptics.com>
+
+ * generic/tkImgBmap.c:
+ * generic/tkImgPPM.c:
+ * generic/tkImgPhoto.c: Set the -translation and -encoding options
+ to binary for image files. (reported by Marco Gazzetta)
+
+1999-04-20 <redman@scriptics.com>
+
+ * xlib/X11/Xlib.h: changed definition of Status type to use a
+ typedef instead of a #define to avoid conflicting with the cygwin
+ win32 headers [Bug 1804]
+
+1999-04-15 <stanton@scriptics.com>
+
+ * Merged 8.1 branch into the main trunk
+
+1999-04-09 <redman@scriptics.com>
+
+ * generic/tkWindow.c: Fixed deadlock situation when the Initialize()
+ function returns without releasing the mutex. Found while testing
+ Bug 1700, during safe.test (tk).
+
+1999-04-06 <stanton@scriptics.com>
+
+ * generic/tkMain.c (Tk_MainEx): Changed to reset result before
+ calling Tcl_EvalFile. The ensures that error messages will be
+ generated cleanly.
+
+ * tests/winfo.test: Enabled tests that previously failed.
+
+1999-04-05 <stanton@scriptics.com>
+
+ * library/bgerror.tcl:
+ * library/button.tcl:
+ * library/clrpick.tcl:
+ * library/console.tcl:
+ * library/dialog.tcl:
+ * library/entry.tcl:
+ * library/focus.tcl:
+ * library/listbox.tcl:
+ * library/menu.tcl:
+ * library/msgbox.tcl:
+ * library/palette.tcl:
+ * library/scale.tcl:
+ * library/scrlbar.tcl:
+ * library/tearoff.tcl:
+ * library/text.tcl:
+ * library/tk.tcl: Lots of minor performance improvements
+ contributed by Jeffrey Hobbs. [Bug: 1118]
+
+ * win/tkWinWm.c (Tk_WmCmd): Fixed bad code in tracing
+ suboption. [Bug: 1519]
+
+ * library/tkfbox.tcl: Change to restore button text after an
+ action to avoid the sticky "Open" button in a save dialog.
+ [Bug: 1640]
+
+ * library/entry.tcl: Fixed so selection is returned using the
+ -show character during cut and paste operations. [Bug: 1687]
+
+1999-04-5 <redman@scriptics.com>
+
+ * generic/tkInt.decls:
+ * generic/tkIntXlibDecls.h:
+ * generic/tkStubInit.c:
+ * xlib/xgc.c:
+ * xlib/X11/Xlib.h:
+ * xlib/X11/Xutil.h: Added more X functions to the Win & Mac stubs
+ tables.
+
+1999-04-05 <stanton@scriptics.com>
+
+ * unix/configure.in:
+ * generic/tkCanvPs.c: Added configure test for pw_gecos field in
+ pwd to support OS/390. [Bug: 1724]
+
+1999-04-02 <stanton@scriptics.com>
+
+ * tests/text.test:
+ * generic/tkText.c: Fixed handling of Unicode in text searches.
+ The -count option was returning byte counts instead of character
+ counts. [Bug: 1056, 1148, 1666]
+
+1999-04-01 <redman@scriptics.com>
+
+ * generic/tk.decls:
+ * generic/tk.h:
+ * generic/tkStubInit.c:
+ * generic/tkWindow.c:
+ * unix/Makefile.in:
+ * win/makefile.vc: Tk now uses its own stub library to store
+ pointers to its own stubs table.
+
+ * doc/dde.n: (removed)
+ * doc/send.n:
+ * generic/tk.decls:
+ * tests/winSend.test:
+ * generic/tkPlatDecls.h:
+ * win/tkWinSend.c: Removed the DDE-based send and dde commands,
+ they were causing Tk to lock up when any window on the system was
+ not processing its message queue (more importantly, windows in Tcl
+ and Tk). The send command needs to be rewritten to prevent the
+ deadlock situation (soon). The dde command is being pushed into
+ its own package and will provide almost all of the capabilities
+ that send did before (using a "dde eval" command), not yet
+ completed.
+
+1999-03-31 <redman@scriptics.com>
+
+ * win/tkWinSend.c: Modified dde/send code to work properly on
+ Win95/Win98. String lengths are not returned properly by DDE, so
+ NULL terminate all strings going in and ignore the string length
+ coming back out. Do not destroy handles until all necessary work
+ on those handles (and child handles) is done.
+
+1999-03-30 <stanton@scriptics.com>
+
+ * generic/tkWindow.c (Tk_DestroyWindow): Image handlers are now
+ finalized before the font subsystem since complex image handlers
+ may contain references to fonts (e.g. Tix compound images).
+ [Bug: 1603]
+
+1999-03-29 <stanton@scriptics.com>
+
+ * doc/MeasureChar.3:
+ * doc/TextLayout.3:
+ * generic/tk.decls:
+ * generic/tkCanvText.c:
+ * generic/tkEntry.c:
+ * generic/tkFont.c:
+ * generic/tkListbox.c:
+ * generic/tkMessage.c:
+ * mac/tkMacFont.c:
+ * unix/tkUnixButton.c:
+ * unix/tkUnixFont.c:
+ * unix/tkUnixMenu.c:
+ * win/tkWinFont.c:
+ * win/tkWinMenu.c: Standardized text layout and font interfaces
+ so they are consistent with respect to byte versus character
+ oriented indices. The layout functions all manipulate character
+ oriented values while the lower level measurement functions all
+ operate on byte oriented values. This distinction was not clear
+ and so the functions were being used improperly in a number of
+ places. [Bug: 1053, 747, 749, 1646]
+
+ * generic/tk.decls: Eliminated uses of C++ STL types string and
+ list from declarations.
+
+ * generic/tkFont.c: Changes to named fonts were not being
+ propagated in some cases. [Bug: 1144]
+
+ * xlib/X11/Xlib.h:
+ * generic/tkInt.decls: Added XParseColor to xlib stub
+ tables. [Bug: 1574]
+
+ * doc/GetBitmap.3:
+ * generic/tkBitmap.c (BitmapInit): Eliminated use of Tk_Uid's in
+ bitmaps. Added a few CONST declarations.
+
+1999-03-29 <redman@scriptics.com>
+
+ * unix/configure.in:
+ * unix/Makefile.in:
* win/makefile.vc:
- * win/rules.vc: General clean-ups. Added compiler and linker tests
- for a) the pentium 0x0F errata, b) optimizing (not all have this),
- and c) linker v6 section alignment confusion. All these are tested
- first to make sure any D4002 or LNK1117 warnings aren't displayed.
- The pentium 0x0F errata is a recommended switch. The v5 linker's
- section alignment default is 512, but the v6 linker was changed
- to 4096 in an attempt to speed loading on Win98. I changed the
- default to always be 512 across both linkers, unless linking
- statically, then 4096 is used for the claimed speed effect. Using
- a 512 alignment saves 12k bytes of dead space in the DLL.
+ * generic/tkDecls.h:
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkPlatDecls.h:
+ * generic/tkIntXlibDecls.h: Removed stub functions. Always use the
+ Tcl stubs when building with --enable-shared.
+
- Added IA64 B-stepping errata switch when the compiler supports it.
+1999-03-26 <redman@scriptics.com>
- Added profiling to $(lflags) when requested and also removed the
- explict -entry option as the default works fine as is.
+ * generic/tkTextIndex.c:
+ * tests/testIndex.test: Avoid looking past the beginning of the
+ array storing data for the text widget (.t index end-2c). Added
+ test case to check for the bug. [Bug 991]
+
+ * generic/tkConsole.c: Copy static strings into a Tcl_DString
+ before passing to Tcl_Eval, in case the compiler puts static
+ strings into read-only memory.
- Removed win/tclWinInit.c from the special case section to let it
- use the common implicit rule as the $(EXTFLAGS) macro it had was
- never referenced anywhere.
+1999-03-26 <suresh@scriptics.com>
+
+ * unix/configure.in:
+ --nameble-shared is now the default and builds Tk as a shared
+ library; specify --disable-shared to build a static Tk library
+ and shell.
-2002-02-20 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+1999-03-26 <surles@scriptics.com>
- * generic/tcl.h: Added code to guess the correct settings for
- TCL_WIDE_INT_IS_LONG and TCL_WIDE_INT_TYPE when configure doesn't
- tell us them, as can happen with extensions.
+ * library/menu.tcl: Fixed bug reported by Bryan Oakley in the
+ menubutton bindings. There was a false assumption that there was
+ always a menu attached to the button. [Bug 1116]
-2002-02-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+1999-03-26 <redman@scriptics.com>
- * doc/format.n: Updated docs to list the specification.
- * generic/tclCmdAH.c (Tcl_FormatObjCmd): Made behaviour on 64-bit
- platforms correctly meet the specification, that %d works with the
- native word-sized integer, instead of trying to guess (wrongly)
- from the value being passed.
+ * unix/configure.in: Removed --enable-tcl-stub. Linking Tk to Tcl
+ stubs is causing too many problems when linking executables like wish.
+ Until the Tk is a fully loadable extension, linking against the Tcl
+ stubs is not supported in Tk.
-2002-02-19 Don Porter <dgp@users.sourceforge.net>
+1999-03-19 <redman@scriptics.com>
- * changes: First draft of updated changes for 8.4a4 release.
+ * generic/tkBitmap.c:
+ * generic/tkCursor.c:
+ * generic/tkGC.c: When creating hash tables that key off of XID
+ handles, make sure to pass TCL_ONE_WORD_KEYS. XIDs are guaranteed
+ to be 32bit numbers, although on some 64bit systems (including 64bit
+ Solaris 7) they are packed into a 64bit value where the upper 32bits
+ are zero. The normal method of sizeof(XID)/sizeof(int) causes the
+ hash table code to assume that the XID is a pointer to an array of
+ two ints, which it is not. Tk now supports 64bit Solaris 7.
-2002-02-15 Jeff Hobbs <jeffh@ActiveState.com>
-
- * unix/tclUnixPort.h: add strtoll/strtoull declarations for
- platforms that do not define them.
-
- * generic/tclIndexObj.c (STRING_AT): removed ptrdiff_t cast and
- use of VOID* in default case (GNU-ism).
-
-2002-02-15 Kevin Kenny <kennykb@acm.org>
-
- * compat/strtoll.c:
- * compat/strtoul.c:
- * compat/strtoull.c:
- * generic/tclIOUtil.c:
- * generic/tclPosixStr.c:
- * generic/tclTest.c:
- * generic/tclTestObj.c:
- * tests/get.test:
- * win/Makefile.vc: Further tweaks to the TIP 72 patch to make it
- compile under VC++.
-
-2002-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * tclExecute.c:
- * tclIOGT.c:
- * tclIndexObj.c: Touchups to the TIP 72 patch to make it
- compileable under Windows again. The changes are not complete,
- there is one nasty regarding _stati64
-
-2002-02-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- +----------------------+
- | TIP #72 IMPLEMENTED. |
- +----------------------+
-
- There are a lot of changes from this TIP, so please see
- http://purl.org/tcl/tip/72.html for discussion of
- backward-compatability issues, but the main ones modifications are
- in:
-
- * generic/tcl.h: New types.
- * generic/tcl.decls: New public functions.
- * generic/tclExecute.c: 64-bit aware bytecode engine.
- * generic/tclBinary.c: 64-bit handling in [binary] command.
- * generic/tclScan.c: 64-bit handling in [scan] command.
- * generic/tclCmdAH.c: 64-bit handling in [file] and [format]
- commands.
- * generic/tclBasic.c: New "wordSize" entry in ::tcl_platform.
- * generic/tclFCmd.c: Large-file support (with many consequences.)
- * generic/tclIO.c: Large-file support (with many consequences.)
- * compat/strtoll.c, compat/strtoull.c: New support functions.
- * unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced
- cacheing.
-
- Most other changes, including all those in doc/* and test/* as
- well as the majority in the platform directories, follow on from
- these.
-
- Also coming out of the woodwork:
- * generic/tclIndex.c: Better support for Cray PVP.
- * win/tclWinMtherr.c: Better Borland support.
-
- Note that, in a number of places through the Unix part of the
- platform support, there are Tcl_Platform* references. These are
- expanded into the correct way to call that particular underlying
- function, i.e. with or without a '64' suffix, and should be used
- by people working on the core in preference to the API functions
- they overlay so that the code remains portable depending on the
- presence or absence of 64-bit support on the underlying platform.
-
- ***POTENTIAL INCOMPATIBILITY***: Extracted from the TIP
-
- SUMMARY OF INCOMPATIBILITIES AND FIXES
- ======================================
-
- The behaviour of expressions containing constants that appear
- positive but which have a negative internal representation will
- change, as these will now usually be interpreted as wide
- integers. This is always fixable by replacing the constant with
- int(constant).
-
- Extensions creating new channel types will need to be altered as
- different types are now in use in those areas. The change to the
- declaration of Tcl_FSStat and Tcl_FSLstat (which are the new
- preferred API in any case) are less serious as no non-alpha
- releases have been made yet with those API functions.
-
- Scripts that are lax about the use of the l modifier in format and
- scan will probably need to be rewritten. This should be very
- uncommon though as previously it had absolutely no effect.
-
- Extensions that create new math functions that take more than one
- argument will need to be recompiled (the size of Tcl_Value
- changes), and functions that accept arguments of any type
- (TCL_EITHER) will need to be rewritten to handle wide integer
- values. (I do not expect this to affect many extensions at all.)
-
-2002-02-14 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for bug
- #517503, a memory leak reported by Miguel Sofer
- <msofer@users.sourceforge.net>. The leak happens if an error
- occurs for "set var [gets $chan]" and leak one empty object.
-
-2002-02-12 David Gravereaux <davygrvy@pobox.com>
-
- * djgpp/ (new directory)
- * djgpp/Makefile (new):
- * unix/tclAppInit.c:
- * unix/tclMtherr.c:
- * unix/tclUnixFCmd.c:
- * unix/tclUnixFile.c:
- * unix/tclUnixInit.c:
- * unix/tclUnixPort.h: Early stage of DJGPP support for building
- Tcl on DOS. Dynamic loading isn't working, yet. Requires watt32
- for the TCP/IP stack. No autoconf, yet. Barely tested, but
- makes a working exe that runs Tcl in protected-mode, flat memory.
- [exec] and pipes will need the most work as multi-tasking on DOS
- has to be carefully.
-
-2002-02-10 Kevin Kenny <kennykb@acm.org>
-
- * doc/CrtObjCmd.3:
- * doc/CrtTrace.3:
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclBasic.c:
- * generic/tclInt.h:
- * generic/tclTest.c:
- * tests/basic.test: Added Tcl_CreateObjTrace,
- Tcl_GetCommandInfoFromToken and Tcl_SetCommandInfoFromToken.
- (TIPs #32 and #79.)
-
- * generic/tclDecls.h:
- * generic/tclStubInit.c: Regenerated Stubs tables.
-
-2002-02-08 Jeff Hobbs <jeffh@ActiveState.com>
+1999-03-17 <stanton@scriptics.com>
- * unix/configure:
- * unix/tcl.m4: added -pthread for FreeBSD to EXTRA_CFLAGS and
- LDFLAGS. Also triggered nodots only for FreeBSD-3.
- Added AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) for Solaris.
-
- * unix/tclUnixPort.h:
- * unix/tclUnixThrd.c: added thread-safe versions of readdir,
- localtime, gmtime and inet_ntoa for threaded build. (jgdavidson)
-
- * generic/tclScan.c (Tcl_ScanObjCmd): prevented ckfree being
- called on a pointer to NULL.
-
-2002-02-07 Don Porter <dgp@users.sourceforge.net>
-
- * doc/DString.3:
- * doc/Encoding.3:
- * doc/GetCwd.3:
- * doc/SplitPath.3:
- * doc/Translate.3:
- * doc/Utf.3:
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclEncoding.c:
- * generic/tclEnv.c:
- * generic/tclFileName.c:
- * generic/tclIOUtil.c:
- * generic/tclUtf.c:
- * generic/tclUtil.c:
- * mac/tclMacInit.c:
- * unix/tclUnixFile.c:
- * unix/tclUnixInit.c:
- * unix/tclUnixPipe.c:
- * win/tclWin32Dll.c:
- * win/tclWinFCmd.c:
- * win/tclWinFile.c:
- * win/tclWinInit.c: Partial TIP 27 rollback. Following routines
- restored to return (char *): Tcl_DStringAppend,
- Tcl_DStringAppendElement, Tcl_JoinPath, Tcl_TranslateFileName,
- Tcl_ExternalToUtfDString, Tcl_UtfToExternalDString,
- Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf. Also
- restored Tcl_WinUtfToTChar to return (TCHAR *) and
- Tcl_UtfToUniCharDString to return (Tcl_UniChar *). Modified
- some callers. This change recognizes that Tcl_DStrings are
- de-facto white-box objects.
-
- * generic/tclDecls.h:
- * generic/tclPlatDecls.h: make genstubs
-
- * generic/tclCmdMZ.c: corrected use of C++-style comment.
-
-2002-02-06 Jeff Hobbs <jeffh@ActiveState.com>
-
- * tests/scan.test:
- * generic/tclScan.c (Tcl_ScanObjCmd): corrected scan 0x... %x
- handling that didn't accept the 0x as a prelude to a base 16
- number. [Bug #495213]
-
- * generic/tclCompCmds.c (TclCompileRegexpCmd): made early check
- for bad RE to stop checking further.
-
- * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): added special case to
- search for simple 'string map' style regsub calls.
- Delayed creation of resultPtr object until an initial match is
- made, as the input string object can then be reused for no matches.
- (Tcl_StringObjCmd): optimization improvements to the STR_MAP
- algorithm for zero-length and nocase cases.
-
- * tests/regexp.test:
- * tests/regexpComp.test: extra code coverage tests.
-
- * tests/string.test: added 10.18 and 10.19 extra tests.
-
- * generic/regc_locale.c (casecmp): slight performance improvement.
-
-2002-02-05 Don Porter <dgp@users.sourceforge.net>
-
- * library/http/http.tcl:
- * library/http/pkgIndex.tcl: Corrected use of http::error when
- ::error was intended. Bump to http 2.4.2.
-
-2002-02-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * unix/tclUnixChan.c (FileOutputProc): Fixed [bug 465765] reported
- by Dale Talcott <daletalcott@users.sourceforge.net>. Avoid
- writing nothing into a file as STREAM based implementations will
- consider this a EOF (if the file is a pipe). Not done in the
- generic layer as this type of writing is actually useful to
- check the state of a socket.
-
- * doc/open.n: Fixed [Bug 511540], added cross-reference to 'pid'
- as the command to use to retrieve the pid of a command pipeline
- created via 'open'.
+ * win/makefile.vc:
+ * generic/tk.h: Changed to use TCL_BETA_RELEASE macro, and fixed
+ so this works in rc files.
+
+ * win/makefile.vc:
+ * win/makefile.bc:
+ * win/README:
+ * unix/configure.in:
+ * generic/tk.h:
+ * README: Updated version to 8.1b3.
-2002-02-01 Jeff Hobbs <jeffh@ActiveState.com>
+1999-03-14 <stanton@GASPODE>
- * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): handle quirky about case
- earlier to avoid shimmering problem.
+ * unix/configure.in: Added missing stub related definitions.
-2002-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ * unix/Makefile.in: Install tkDecls.h in addition to tk.h.
- * tests/io.test: io-39.22 split into two tests, one platform
- dependent, the other not. -eofchar is not empty on the windows
- platform.
+ * generic/tkStubLib.c: Added flags to ensure we are using Tcl
+ stub macros.
-2002-02-01 Vince Darley <vincentdarley@users.sourceforge.net>
+1999-03-11 <stanton@GASPODE>
- * generic/tclTest.c: fix to picky windows compiler problem
- with the 'MainLoop' function declaration.
+ * generic/tkInt.decls: Added reserved slot for XSetDashes for use
+ by the dash patch.
-2002-01-31 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+1999-03-10 <redman@scriptics.com>
- * win/tclWinFCmd.c: TIP 27: Applied patch fixing CONST warnings on
- behalf of Don Porter <dgp@users.sourceforge.net>.
+ * xlib/xdraw.c:
+ * xlib/X11/Xlib.h:
+ * mac/tkMac.h:
+ * mac/tkMacInt.h:
+ * mac/tkMacPort.h:
+ * mac/tkMacXStubs.c:
+ * mac/tkMacAppInit.c:
+ * mac/tkMacCursor.c:
+ * win/makefile.vc:
+ * win/tkWin.h:
+ * win/tkWinInt.h:
+ * win/tkWinPort.h:
+ * win/winMain.c:
+ * generic/tk.h:
+ * generic/tkInt.h:
+ * generic/tk.decls:
+ * generic/tkInt.decls:
+ * generic/tkDecls.h:
+ * generic/tkPlatDecls.h:
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkIntXlibDecls.h:
+ * generic/tkStubs.c:
+ * generic/tkPlatStubs.c:
+ * generic/tkIntStubs.c:
+ * generic/tkIntPlatStubs.c:
+ * generic/tkIntXlibStubs.c:
+ * generic/tkStubInit.c:
+ * generic/tkStubLib.c:
+ * generic/tkBind.c:
+ * generic/tkCmds.c:
+ * generic/tkConfig.c:
+ * generic/tkConsole.c:
+ * generic/tkCursor.c:
+ * generic/tkGrab.c:
+ * generic/tkImgPhoto.c:
+ * generic/tkMain.c:
+ * generic/tkMenu.c:
+ * generic/tkPointer.c:
+ * generic/tkTextDisp.c:
+ * generic/tkWindow.c:
+ * unix/tkUnixInt.h:
+ * unix/tkUnixPort.h:
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * unix/tkConfig.sh.in:
+ * unix/tkUnix.c:
+ * unix/tkUnix3d.c:
+ * unix/tkUnixDraw.c:
+ * unix/tkUnixFont.c:
+ * unix/tkUnixMenubu.c: Stubs implementation for 8.1. Tk_Main() is
+ replaced with a macro which calls Tk_MainEx(). Tk can link to the Tcl
+ stubs library, wish links directly to Tcl and Tk. Use
+ --enable-tcl-stubs to link Tk to the Tcl stubs library (Unix), on
+ by default on Windows. Exported all public functions through the
+ stubs mechanism (see the *.decls files) and many of the internal
+ functions. Most of the changes dealt with shifting around the
+ function declarations in the header files. Mac code may not
+ compile, but it shouldn't take much work to fix this.
+
+ * mac/tkMacMenu.c: Added dummy TkpMenuThreadInit for Mac to be
+ consistent with Unix and Windows versions.
+
+1999-03-08 <lfb@scriptics.com>
-2002-01-30 Don Porter <dgp@users.sourceforge.net>
+ * win/tkWinWm.c: Toplevel class no longer shared between
+ threads.
+
+ * win/tkWinX.c: Multiple threads no longer share the same
+ TkDisplay structure. Required because TkDisplay stores much
+ thread-specific data for a given thread.
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclInt.h: For each interface identified in the TIP 27
- changes below as a POTENTIAL INCOMPATIBILITY, the source of the
- incompatibility has been parameterized so that it can be
- removed. When compiling extension code against the Tcl header
- files, use the compiler flag -DUSE_NON_CONST to remove the
- irresolvable source incompatibilities introduced by the TIP 27
- changes. Resolvable changes are left for extension authors to
- resolve.
- * generic/tclDecls.h: make genstubs
+ * win/tkWinSend.c: Moved application instance handle out
+ out thread-local storage. DDE was failing to initialize
+ when the instance handles were different between threads.
+
+ * win/makefile.vc: Added THREADDEFINES for building with
+ threads enabled.
+
+ * generic/tkMenu.c:
+ * win/tkWinMenu.c:
+ * unix/tkUnixMenu.c: Added TkpMenuThreadInit for initializing
+ thread-specific Menu state.
-2002-01-30 Vince Darley <vincentdarley@users.sourceforge.net>
+1999-03-01 <redman@scriptics.com>
- * doc/FileSystem.3: added documentation for 3 public
- functions which had been overlooked. Fixes [Bug 507701].
- * unix/mkLinks: make mklinks
+ * win/tkWinWm.c:
+ * win/tkWinPointer.c:
+ * win/tkWinInt.h: Fix "focus -force" for Windows. The Win32 API
+ function SetForegroundWindow() does not work unless the window
+ handle is a toplevel window (a Windows toplevel). The handle
+ being passed was a Tk toplevel, which is a child of the Windows
+ toplevel.
-2002-01-29 Jeff Hobbs <jeffh@ActiveState.com>
+1999-02-26 <redman@scriptics.com>
- * tests/regexpComp.test:
- * generic/tclCompCmds.c (TclCompileRegexpCmd): enhanced to support
- -nocase and -- options.
+ * win/cat.c: Remove this file, use the one in the Tcl source directory.
-2002-01-28 Mo DeJong <mdejong@users.sourceforge.net>
+ * win/makefile.vc: Remove the wishc.exe from the default targets. Add
+ a separate console-wish target to build it. The need for a
+ console-wish will go away soon, so we don't want to encourage its
+ use.
- * unix/tcl.m4 (SC_LOAD_TCLCONFIG):
- * win/tcl.m4 (SC_LOAD_TCLCONFIG): Set TCL_LIB_SPEC,
- TCL_STUB_LIB_SPEC, and TCL_STUB_LIB_PATH to the
- values of TCL_BUILD_LIB_SPEC, TCL_BUILD_STUB_LIB_SPEC,
- and TCL_BUILD_STUB_LIB_PATH when tclConfig.sh is loaded
- from the build directory. A Tcl extension should
- make use of the non-build versions of these variables
- since they will work in both cases. This modification
- was described in TIP 34.
-
-2002-01-28 Jeff Hobbs <jeffh@ActiveState.com>
-
- * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey)
- (DeleteKey,GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
- redid the CONSTification as previous changes caused failing tests.
-
- * tests/regexpComp.test (new):
- * generic/tclInt.h:
- * generic/tclBasic.c: added TclCompileRegexpCmd entry
- * generic/tclCompCmds.c (TclCompileStringCmd): corrected to return
- TCL_OUT_LINE_COMPILE instead of TCL_ERROR for parsing errors, so
- it only throws the error for runtime compile, in case the user
- modifies 'string'.
- (TclCompileRegexpCmd): first try at a byte-compiled regexp
- command. It handles static strings and ^$ bounded static strings.
- (TclCompileAppendCmd): made TclPushVarName call always use
- TCL_CREATE_VAR as numWords is always > 2 at that point.
-
- * generic/tclExecute.c (TclExecuteByteCode:INST_LIST): correct
- possibly dangerous decr in macro call.
-
- * win/tclWinInit.c (TclpFindVariable): CONSTification touch-up
-
- * win/tclWinReg.c (OpenSubKey): corrected bug introduced in
- CONSTification that dropped pointer reference.
-
- * ChangeLog.2000 (new file):
- * ChangeLog: broke changes from 2000 into ChangeLog.2000 to reduce
- size of the main ChangeLog.
-
-2002-01-28 David Gravereaux <davygrvy@pobox.com>
-
- * generic/tclPlatDecls.h: Added preprocessor logic to force a
- typedef of TCHAR when __STDC__ is defined when using the uncommon
- -Za compiler switch with the microsoft compiler.
-
-2002-01-27 Don Porter <dgp@users.sourceforge.net>
-
- * doc/package.n: Documented global namespace context for script
- evaluation by [package require].
-
-2002-01-27 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclInt.decls:
- * generic/tclIntPlatDecls.h:
- * mac/tclMacChan.c:
- * mac/tclMacFCmd.c:
- * mac/tclMacFile.c:
- * mac/tclMacInit.c:
- * mac/tclMacLoad.c:
- * mac/tclMacResource.c:
- * mac/tclMacSock.c: TIP 27 CONSTification induced changes
+1999-02-25 <redman@scriptics.com>
- * tests/event.test:
- * tests/main.test: added catches/constraints to test that
- use features that don't exist on the mac.
-
-2002-01-25 Mo DeJong <mdejong@users.sourceforge.net>
-
- Make -eofchar and -translation options read only for
- server sockets. [Bug 496733]
-
- * generic/tclIO.c (Tcl_GetChannelOption, Tcl_SetChannelOption):
- Instead of returning nothing for the -translation option
- on a server socket, always return "auto". Return the empty
- string enclosed in quotes for the -eofchar option on
- a server socket. Fixup -eofchar usage message so that
- it matches the implementation.
- * tests/io.test: Add -eofchar tests and -translation tests
- to ensure options are read only on server sockets.
- * tests/socket.test: Update tests to account for -eofchar
- and -translation option changes.
-
-2002-01-25 Don Porter <dgp@users.sourceforge.net>
-
- * compat/strstr.c (strstr):
- * generic/tclCmdAH.c (Tcl_FormatObjCmd):
- * generic/tclCmdIL.c (InfoNameOfExecutableCmd):
- * generic/tclEnv.c (ReplaceString):
- * generic/tclFileName.c (ExtractWinRoot):
- * generic/tclIO.c (FlushChannel,Tcl_BadChannelOption):
- * generic/tclStringObj.c (AppendUnicodeToUtfRep):
- * generic/tclThreadTest.c (TclCreateThread):
- * generic/tclUtf.c (Tcl_UtfPrev):
- * mac/tclMacFCmd.c (TclpObjListVolumes):
- * mac/tclMacResource.c (TclMacRegisterResourceFork,
- BuildResourceForkList):
- * win/tclWinInit.c (AppendEnvironment): Sought out and eliminated
- instances of CONST-casting that are no longer needed after the
- TIP 27 effort.
-
- * Following is [Patch 501006]
- * generic/tclInt.decls (Tcl_AddInterpResolvers, Tcl_Export,
- Tcl_FindNamespace, Tcl_GetInterpResolvers, Tcl_ForgetImport,
- Tcl_Import, Tcl_RemoveInterpResolvers):
- * generic/tclNamesp.c (Tcl_Export, Tcl_Import, Tcl_ForgetImport,
- Tcl_FindNamespace):
- * generic/tclResolve.c (Tcl_AddInterpResolvers,Tcl_GetInterpResolvers,
- Tcl_RemoveInterpResolvers): Updated APIs in generic/tclResolve.c
- and generic/tclNamesp.c according to the guidelines of TIP 27.
- * generic/tclIntDecls.h: make genstubs
-
- * Following is [Patch 505630]
- * doc/AddErrorInfo.3:
- * generic/tcl.decls (Tcl_LogCommandInfo):
- * generic/tclBasic.c (Tcl_LogCommandInfo): Updated interfaces
- of generic/tclBasic.cc according to TIP 27.
- * generic/tclDecls.h: make genstubs
-
- * Following is [Patch 506818]
- * doc/Hash.3:
- * generic/tcl.decls (Tcl_HashStats):
- * generic/tclHash.c (Tcl_HashStats): Updated APIs of generic/tclHash.c
- according to guidelines of TIP 27.
- * generic/tclDecls.h: make genstubs
- * generic/tclVar.c (Tcl_ArrayObjCmd): Updated callers.
-
- * Following is [Patch 506807]
- * doc/ObjectType.3:
- * generic/tcl.decls (Tcl_GetObjType):
- * generic/tclObj.c (Tcl_GetObjType): Updated APIs of generic/tclObj.c
- according to guidelines of TIP 27.
- * generic/tclDecls.h: make genstubs
-
- * Following is [Patch 507304]
- * doc/Encoding.3:
- * generic/tcl.decls (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf):
- * win/tclWin32Dll.c (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf):
- Updated interfaces in win/tclWin32Dll.c according to TIP 27.
- * generic/tclPlatDecls.h: make genstubs
- * generic/tclIOUtil.c (TclpNativeToNormalized):
- * win/tclWinFCmd.c (TclpObjNormalizePath):
- * win/tclWinFile.c (TclpFindExecutable,TclpMatchInDirectory,
- NativeIsExec,NativeStat):
- * win/tclWinLoad.c (TclpLoadFile):
- * win/tclWinPipe.c (TclpOpenFile,ApplicationType):
- * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey,DeleteKey,
- GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
- * win/tclWinSerial.c (SerialSetOptionProc): Update callers.
-
- * Following is [Patch 505072]
- * doc/Concat.3:
- * doc/Encoding.3:
- * doc/Filesystem.3:
- * doc/Macintosh.3:
- * doc/OpenFileChnl.3
- * doc/SetResult.3:
- * doc/SetVar.3:
- * doc/SplitList.3:
- * doc/SplitPath.3:
- * doc/Translate.3:
- * generic/tcl.h (Tcl_FSMatchInDirectoryProc):
- * generic/tclInt.h (TclpMatchInDirectory):
- * generic/tcl.decls (Tcl_Concat,Tcl_GetStringResult,Tcl_GetVar,
- Tcl_GetVar2,Tcl_JoinPath,Tcl_Merge,Tcl_OpenCommandChannel,Tcl_SetVar,
- Tcl_SetVar2,Tcl_SplitList,Tcl_SplitPath,Tcl_TranslateFileName,
- Tcl_ExternalToUtfDString,Tcl_GetEncodingName,Tcl_UtfToExternalDString,
- Tcl_GetDefaultEncodingDir,Tcl_SetDefaultEncodingDir,
- Tcl_FSMatchInDirectory,Tcl_MacEvalResource,Tcl_MacFindResource):
- * generic/tclInt.decls (TclCreatePipeline,TclGetEnv,TclpGetCwd,
- TclpCreateProcess):
- * mac/tclMacFile.c (TclpGetCwd):
- * generic/tclEncoding.c (Tcl_GetDefaultEncodingDir,
- Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName,
- Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile,
- LoadEscapeEncoding):
- * generic/tclFileName.c (DoTildeSubst,Tcl_JoinPath,Tcl_SplitPath,
- Tcl_TranslateFileName):
- * generic/tclIOUtil.c (Tcl_FSMatchInDirectory):
- * generic/tclPipe.c (FileForRedirect,TclCreatePipeline,
- Tcl_OpenCommandChannel):
- * generic/tclResult.c (Tcl_GetStringResult):
- * generic/tclUtil.c (Tcl_Concat,Tcl_SplitList,Tcl_Merge):
- * generic/tclVar.c (Tcl_GetVar,Tcl_GetVar2,Tcl_SetVar,Tcl_SetVar2):
- * mac/tclMacResource.c (Tcl_MacEvalResource,Tcl_MacFindResource):
- Updated interfaces of generic/tclEncoding, generic/tclFilename.c,
- generic/tclIOUtil.c, generic/tclPipe.c, generic/tclResult.c,
- generic/tclUtil.c, generic/tclVar.c and mac/tclMacResource.c according
- to TIP 27. Tcl_TranslateFileName rewritten as wrapper around
- VFS-aware version.
- ***POTENTIAL INCOMPATIBILITY***
- Includes source incompatibilities: argv arguments of Tcl_Concat,
- Tcl_JoinPath, Tcl_OpenCommandChannel, Tcl_Merge; argvPtr arguments of
- Tcl_SplitList and Tcl_SplitPath.
- * generic/tclDecls.h:
- * generic/tclIntDecls.h: make genstubs
-
- * generic/tclCkalloc.c (MemoryCmd):
- * generic/tclClock.c (FormatClock):
- * generic/tclCmdAH.c (Tcl_CaseObjCmd,Tcl_EncodingObjCmd,Tcl_FileObjCmd):
- * generic/tclCmdIL.c (InfoLibraryCmd,InfoPatchLevelCmd,
- InfoTclVersionCmd):
- * generic/tclCompCmds.c (TclCompileForeachCmd):
- * generic/tclCompCmds.h (TclCompileForeachCmd):
- * generic/tclCompile.c (TclFindCompiledLocal):
- * generic/tclEnv.c (TclSetupEnv,TclSetEnv,Tcl_PutEnv,TclGetEnv,
- EnvTraceProc):
- * generic/tclEvent.c (Tcl_BackgroundError):
- * generic/tclIO.c (Tcl_BadChannelOption,Tcl_SetChannelOption):
- * generic/tclIOCmd.c (Tcl_ExecObjCmd,Tcl_OpenObjCmd):
- * generic/tclIOSock.c (TclSockGetPort):
- * generic/tclIOUtil.c (SetFsPathFromAny):
- * generic/tclLink.c (LinkTraceProc):
- * generic/tclMain.c (Tcl_Main):
- * generic/tclNamesp.c (TclTeardownNamespace):
- * generic/tclProc.c (TclCreateProc):
- * generic/tclTest.c (TestregexpObjCmd,TesttranslatefilenameCmd,
- TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1,
- TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc,
- TestpanicCmd):
- * generic/tclThreadTest.c (ThreadErrorProc,ThreadEventProc):
- * generic/tclUtil.c (TclPrecTraceProc):
- * mac/tclMacFCmd.c (GetFileSpecs):
- * mac/tclMacFile.c (TclpMatchInDirectory):
- * mac/tclMacInit.c (TclpInitLibraryPath,Tcl_SourceRCFile):
- * mac/tclMacOSA.c (tclOSAStore,tclOSALoad):
- * mac/tclMacResource.c (Tcl_MacEvalResource):
- * unix/tclUnixFCmd.c (TclpObjNormalizePath):
- * unix/tclUnixFile.c (TclpMatchInDirectory,TclpGetUserHome,TclpGetCwd,
- TclpReadLink):
- * unix/tclUnixInit.c (TclpInitLibraryPath,TclpSetVariables,
- Tcl_SourceRCFile):
- * unix/tclUnixPipe.c (TclpOpenFile,TclpCreateTempFile,
- TclpCreateProcess):
- * win/tclWinFile.c (TclpGetCwd,TclpMatchInDirectory):
- * win/tclWinInit.c (TclpInitLibraryPath,Tcl_SourceRCFile,
- TclpSetVariables):
- * win/tclWinPipe.c (TclpCreateProcess): Updated callers.
-
-2002-01-24 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclIOUtil.c (SetFsPathFromAny): Corrected tilde-substitution
- of pathnames where > 1 separator follows the ~. [Bug 504950]
-
-2002-01-24 Jeff Hobbs <jeffh@ActiveState.com>
-
- * library/http/pkgIndex.tcl:
- * library/http/http.tcl: don't add port in default case to handle
- broken servers. http bumped to 2.4.1 [Bug #504508]
-
-2002-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * unix/mkLinks: Regenerated.
- * doc/CrtChannel.3:
- * doc/ChnlStack.3: Moved documentation for 'Tcl_GetTopChannel'
- from 'CrtChannel' to 'ChnlStack'. Added documentation of
- 'Tcl_GetStackedChannel'. Bug #506147 reported by Mark Patton
- <msp@users.sourceforge.net>.
-
-2002-01-23 Don Porter <dgp@users.sourceforge.net>
-
- * win/tclWinFile.c (NativeAccess,NativeStat,NativeIsExec,
- TclpGetUserHome):
- * win/tclWinPort.h (TclWinSerialReopen):
- * win/tclWinSerial.c (TclWinSerialReopen):
- * win/tclWinSock.c (Tcl_OpenTcpServer): Corrections to earlier
- TIP 27 changes. Thanks to Andreas Kupries for the feedback.
- * generic/tclPlatDecls.h: make genstubs
-
- * doc/GetHostName.3:
- * doc/GetOpnFl.3:
- * doc/OpenTcp.3:
- * tcl.decls (Tcl_GetHostName,Tcl_GetOpenFile,Tcl_OpenTcpClient,
- Tcl_OpenTclServer):
- * mac/tclMacSock.c (CreateSocket,Tcl_OpenTcpClient,Tcl_OpenTcpServer,
- Tcl_GetHostName,GetHostFromString):
- * unix/tclUnixChan.c (CreateSocket,CreateSocketAddress,
- Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile):
- * unix/tclUnixSock.c (Tcl_GetHostName):
- * win/tclWinSock.c (CreateSocket,CreateSocketAddress,
- Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetHostName):
- Updated socket interfaces according to TIP 27.
- * generic/tclCmdIL.c (InfoHostnameCmd): Updated callers.
- * generic/tclDecls.h: make genstubs
-
-2002-01-21 David Gravereaux <davygrvy@pobox.com>
-
- * generic/tclLoadNone.c: TclpLoadFile() didn't match proto of
- typedef Tcl_FSLoadFileProc. OK'd by vincentdarley.
- [Patch #502488]
-
-2002-01-21 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * generic/tclIO.c (WriteChars): Fix for SF #506297, reported by
- Martin Forssen <ruric@users.sourceforge.net>. The encoding
- chosen in the script exposing the bug writes out three intro
- characters when TCL_ENCODING_START is set, but does not consume
- any input as TCL_ENCODING_END is cleared. As some output was
- generated the enclosing loop calls UtfToExternal again, again
- with START set. Three more characters in the out and still no
- use of input ... To break this infinite loop we remove
- TCL_ENCODING_START from the set of flags after the first call
- (no condition is required, the later calls remove an unset flag,
- which is a no-op). This causes the subsequent calls to
- UtfToExternal to consume and convert the actual input.
-
-2002-01-21 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclTest.c: Converted declarations of TestReport file system
- to more portable form. [Bug 501417].
-
- * generic/tcl.decls (Tcl_TraceCommand,Tcl_UntraceCommand,
- Tcl_CommandTraceInfo):
- * generic/tclCmdMZ.c (Tcl_TraceCommand,Tcl_UntraceCommand,
- Tcl_CommandTraceInfo): Updated APIs in generic/tclCmdMZ.c
- according to the guidelines of TIP 27.
- * generic/tclDecls.h: make genstubs
-
-2002-01-18 Don Porter <dgp@users.sourceforge.net>
-
- * win/tclWinChan.c:
- * win/tclWinFCmd.c:
- * win/tclWinFile.c: Overlooked callers of Tcl_FSGetNativePath
-
- * win/tclWinDde.c:
- * win/tclWinReg.c: Overlooked callers of Tcl_GetIndexFromObj
-
-2002-01-18 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclThreadTest.c:
- * mac/tclMacChan.c:
- * mac/tclMacFCmd.c:
- * mac/tclMacFile.c:
- * mac/tclMacLoad.c:
- * mac/tclMacResource.c: TIP 27 CONSTification broke the mac
- build in a number of places.
-
-2002-01-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * generic/tclIOCmd.c (Tcl_GetsObjCmd): Fixed bug #504642 as
- reported by Brian Griffin <bgriffin@users.sourceforge.net>,
- using his patch. Before the patch the generic I/O layer held an
- unannounced reference to the interp result to store the read
- line into. This unfortunately has disastrous results if the
- channel driver executes a tcl script to perform its operation,
- this freeing the interp result. In that case we are
- dereferencing essentially a dangling reference. It is not truly
- dangling because the object is in the free list, but this only
- causes us to smash the free list and have the error occur later
- somewhere else. The patch simply creates a new object for the
- line and later sets it into the interp result when we are done
- with reading.
+ * win/tkWinWm.c: Properly initialize the tsdPtr->firstWindow field.
+
+ * win/cat.c: Code for cat32.exe, copied from the Tcl sources. Required
+ in order to run the test suite from the makefile
-2002-01-16 Mo DeJong <mdejong@users.sourceforge.net>
+ * win/winMain.c: Add main() for a console-based wishc.exe, which meant
+ adding code to disable the call to Tk_ConsoleInit().
+
+ * generic/tkConsole.c: Check the standard handles before creating the
+ new standard channels. This allows a windows app that has stdin,
+ stdout, or stderr to correctly connect to them.
+
+ * generic/tkMain.c: Add a proper check for the interactive mode, since
+ the standard channels may actually be connected in windows mode or
+ even in the console-based wish.
+
+ * win/makefile.vc: Add targets for wishc.exe (console-based wish) and
+ cat32.exe (for testing). Fix the test suite target so it can be run
+ from the makefile (which can happen since the standard handles have
+ been fixed).
+
+1999-02-12 <lfb@scriptics.com>
+
+ * generic/tkMenuButton.h:
+ * generic/tkMenuButton.c:
+ * mac/tkMacMenubutton.c:
+ * mac/tkMacDefault.h
+ * unix/tkUnixMenubu.c: Eliminated Tk_Uids used by -state option.
+ * unix/tkUnixDefault.h
+ * win/tkWinDefault.h
+
- * unix/tcl.m4 (SC_LOAD_TCLCONFIG):
- * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst TCL_DBGX
- into TCL_STUB_LIB_FILE and TCL_STUB_LIB_FLAG
- variables so that an extension does not need
- to subst TCL_DBGX into its makefile. [Tk Bug 504356]
-
-2002-01-16 Don Porter <dgp@users.sourceforge.net>
-
- * doc/FileSystem.3:
- * doc/GetCwd.3:
- * doc/GetIndex.3:
- * generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
- Tcl_GetCwd, Tcl_FSFileAttrStrings, Tcl_FSGetNativePath,
- Tcl_FSGetTranslatedStringPath):
- * generic/tcl.h (Tcl_FSFileAttrStringsProc):
- * generic/tclFCmd.c (TclFileAttrsCmd):
- * generic/tclIOUtil.c (Tcl_GetCwd,NativeFileAttrStrings,
- Tcl_FSFileAttrStrings,Tcl_FSGetTranslatedStringPath,
- Tcl_FSGetNativePath):
- * generic/tclIndexObj.c (Tcl_GetIndexFromObj,Tcl_GetIndexFromObjStruct):
- More TIP 27 updates in tclIOUtil.c and tclIndexObj.c that were
- overlooked before. [Patch 504671]
- ***POTENTIAL INCOMPATIBILITY***
- Includes a source incompatibility in the tablePtr arguments of
- the Tcl_GetIndexFromObj* routines.
- * generic/tclDecls.h: make genstubs
-
- * generic/tclBinary.c (Tcl_BinaryObjCmd):
- * generic/tclClock.c (Tcl_ClockObjCmd):
- * generic/tclCmdAH.c (Tcl_EncodingObjCmd, Tcl_FileObjCmd):
- * generic/tclCmdIL.c (Tcl_InfoObjCmd,Tcl_LsearchObjCmd,Tcl_LsortObjCmd):
- * generic/tclCmdMZ.c (Tcl_TraceObjCmd,Tcl_RegexpObjCmd,Tcl_RegsubObjCmd,
- Tcl_StringObjCmd,Tcl_SubstObjCmd,Tcl_SwitchObjCmd,
- TclTraceCommandObjCmd,TclTraceVariableObjCmd):
- * generic/tclCompCmds.c (TclCompileStringCmd):
- * generic/tclEvent.c (Tcl_UpdateObjCmd):
- * generic/tclFileName.c (Tcl_GlobObjCmd):
- * generic/tclIO.c (Tcl_FileEventObjCmd):
- * generic/tclIOCmd.c (Tcl_SeekObjCmd,Tcl_ExecObjCmd,Tcl_SocketObjCmd,
- Tcl_FcopyObjCmd):
- * generic/tclInterp.c (Tcl_InterpObjCmd,SlaveObjCmd):
- * generic/tclNamesp.c (Tcl_NamespaceObjCmd):
- * generic/tclPkg.c (Tcl_PackageObjCmd):
- * generic/tclTest.c (Tcltest_Init,TestencodingObjCmd,TestgetplatformCmd,
- TestlocaleCmd,TestregexpObjCmd,TestsaveresultCmd,
- TestGetIndexFromObjStructObjCmd,TestReportFileAttrStrings):
- * generic/tclTestObj.c (TestindexObjCmd,TeststringObjCmd):
- * generic/tclTimer.c (Tcl_AfterObjCmd):
- * generic/tclVar.c (Tcl_ArrayObjCmd):
- * mac/tclMacFCmd.c (SetFileFinderAttributes):
- * unix/tclUnixChan.c (TclpOpenFileChannel):
- * unix/tclUnixFCmd.c (tclpFileAttrStrings):
- * unix/tclUnixFile.c (TclpObjAccess,TclpObjChdir,TclpObjStat,
- TclpObjLstat):
- * win/tclWinFCmd.c (tclpFileAttrStrings): Updated callers.
-
- * doc/RegExp.3:
- * doc/Utf.3:
- * generic/tcl.decls:
- * generic/tclInt.decls:
- * generic/tclRegexp.c:
- * generic/tclUtf.c: Updated APIs in generic/tclUtf.c and
- generic/tclRegexp.c according to the guidelines of TIP 27.
- [Patch 471509]
-
- * generic/regc_locale.c (element,cclass):
- * generic/tclCmdMZ.c (Tcl_StringObjCmd):
- * generic/tclFileName.c (TclpGetNativePathType,SplitMacPath):
- * generic/tclIO.c (ReadChars):
- * mac/tclMacLoad.c (TclpLoadFile):
- * win/tclWinFile.c (TclpGetUserHome): Updated callers.
-
- * generic/tclDecls.h:
- * generic/tclIntDecls.h: make genstubs
-
- * doc/ParseCmd.3 (Tcl_ParseVar):
- * generic/tcl.decls (Tcl_ParseVar):
- * generic/tclParse.c (Tcl_ParseVar):
- * generic/tclTest.c (TestparsevarObjCmd): Updated APIs in
- generic/tclParse.c according to the guidelines of TIP 27. Updated
- callers. [Patch 501046]
- * generic/tclDecls.h: make genstubs
-
- * generic/tcl.decls (Tcl_RecordAndEval):
- * generic/tclDecls.h: make genstubs
- * generic/tclHistory.c (Tcl_RecordAndEval): Updated APIs in
- generic/tclHistory.c according to the guidelines of TIP 27.
- [Patch 504091]
-
- * doc/CrtSlave.3:
- * generic/tcl.decls (Tcl_CreateAlias, Tcl_CreateAliasObj,
- Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
- * generic/tclInterp.c (Tcl_CreateAlias, Tcl_CreateAliasObj,
- Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
- Updated APIs in the file generic/tclInterp.c according to the
- guidelines of TIP 27. [Patch 501371]
- ***POTENTIAL INCOMPATIBILITY***
- Includes a source incompatibility in the targetCmdPtr arguments of
- the Tcl_GetAlias* routines.
-
- * generic/tclDecls.h: make genstubs
-
-2002-01-15 Don Porter <dgp@users.sourceforge.net>
-
- * doc/SetErrno.3 (Tcl_ErrnoMsg): Corrected documentation for
- Tcl_ErrnoMsg; it takes an integer argument. Thanks to Georgios
- Petasis. [Bug 468183]
-
- * doc/AddErrInfo.3 (Tcl_PosixError):
- * doc/Eval.3 (Tcl_EvalFile):
- * doc/FileSystem.c (Tcl_FSOpenFileChannel,Tcl_FSOpenFileChannelProc):
- * doc/OpenFileChnl.3 (Tcl_OpenFileChannel):
- * doc/SetErrno.3 (Tcl_ErrnoId,Tcl_ErrnoMsg):
- * doc/Signal.3 (Tcl_SignalId,Tcl_SignalMsg):
- * generic/tcl.decls (Tcl_ErrnoId,TclErrnoMsg,Tcl_EvalFile,
- Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg,
- Tcl_FSOpenFileChannel):
- * generic/tcl.h (Tcl_FSOpenFileChannelProc):
- * generic/tclIO.c (FlushChannel):
- * generic/tclIOUtil.c (Tcl_OpenFileChannel,Tcl_EvalFile,TclGetOpenMode,
- Tcl_PosixError,Tcl_FSOpenFileChannel):
- * generic/tclInt.decls (TclGetOpenMode):
- * generic/tclInt.h (TclOpenFileChannelProc_,TclGetOpenMode,
- TclpOpenFileChannel):
- * generic/tclPipe.c (TclCleanupChildren):
- * generic/tclPosixStr.c (Tcl_ErrnoId,Tcl_ErrnoMsg,Tcl_SignalId,
- Tcl_SignalMsg):
- * generic.tclTest.c (PretendTclpOpenFileChannel,
- TestOpenFileChannelProc1,TestOpenFileChannelProc2,
- TestOpenFileChannelProc3,TestReportOpenFileChannel):
- * mac/tclMacChan.c (TclpOpenFileChannel):
- * unix/tclUnixChan.c (TclpOpenFileChannel):
- * win/tclWinChan.c (TclpOpenFileChannel): Updated APIs in
- generic/tclIOUtil.c and generic/tclPosixStr.c according to the
- guidelines of TIP 27. Updated callers. [Patch 499196]
-
- * generic/tclDecls.h:
- * generic/tclIntDecls.h: make genstubs
-
- * doc/CrtChannel.3:
- * doc/OpenFileChnl.3:
- * generic/tcl.decls:
- * generic/tclIO.h:
- * generic/tclIO.c (DoWrite, Tcl_RegisterChannel, Tcl_GetChannel,
- Tcl_CreateChannel, Tcl_GetChannelName, CloseChannel, Tcl_Write,
- Tcl_WriteRaw, Tcl_Ungets, Tcl_BadChannelOption, Tcl_GetChannelOption,
- Tcl_SetChannelOption, Tcl_GetChannelNamesEx, Tcl_ChannelName):
- Updated APIs in the file generic/tclIO.c according to the guidelines
- of TIP 27. Several minor documentation corrections as well.
- [Patch 503565]
- * generic/tclDecls.h: make genstubs
-
- * generic/tcl.h (Tcl_DriverOutputProc, Tcl_DriverGetOptionProc,
- Tcl_DriverSetOptionProc):
- * generic/tclIOGT.c (TransformOutputProc, TransformGetOptionProc,
- TransformSetOptionProc):
- * mac/tclMacChan.c (FileOutput, StdIOOutput):
- * man/tclMacSock.c (TcpGetOptionProc, TcpOutput):
- * unix/tclUnixChan.c (FileOutputProc, TcpGetOptionProc, TcpOutputProc,
- TtyGetOptionProc, TtySetOptionProc):
- * unix/tclUnixPipe.c (PipeOuputProc):
- * win/tclWinChan.c (FileOutputProc):
- * win/tclWinConsole.c (ConsleOutputProc):
- * win/tclWinPipe.c (PipeOuputProc):
- * win/tclWinSerial.c (SerialOutputProc, SerialGetOptionProc,
- SerialSetOptionProc):
- * win/tclWinSock.c (TcpGetOptionProc, TcpOutput): Updated channel
- driver interface according to the guidelines of TIP 27. See also
- [Bug 500348].
-
- * doc/CrtChannel.3:
- * generic/tcl.h:
- * generic/tclIO.c:
- * generic/tclIO.h:
- * generic/tclInt.h:
- * tools/checkLibraryDoc.tcl:
- Moved Tcl_EolTranslation enum declaration from generic/tcl.h to
- generic/tclInt.h (renamed to TclEolTranslation). It is not used
- anywhere in Tcl's public interface.
-
-2002-01-14 Don Porter <dgp@users.sourceforge.net>
-
- * doc/GetIndex.3:
- * doc/WrongNumArgs.3:
- * generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
- Tcl_WrongNumArgs):
- * generic/tclIndexObj.c (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
- Tcl_WrongNumArgs): Updated APIs in the file generic/tclIndexObj.c
- according to the guidelines of TIP 27. [Patch 501491]
- * generic/tclDecls.h: make genstubs
+ * generic/tk.h:
+ * generic/tkScale.h:
+ * generic/tkScale.c:
+ * generic/tkWindow.c:
+ * unix/tkUnixScale.c:
+ * unix/tkUnixDefault.h:
+ * unix/tkWinDefault.h:
+ * mac/tkMacDefault.h: Objectified scale widget.
-2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
+ * win/tkWinX.c: Removed Thread-specific data from process
+ initialization code that was stopping the Tk Dll from
+ loading.
- * unix/configure: Regen.
+1999-02-11 <stanton@GASPODE>
+
+ * README:
+ * generic/tk.h:
* unix/configure.in:
- * win/configure: Regen.
- * win/configure.in: Use ${libdir} instead of ${exec_prefix}/lib
- to properly support the --libdir option to configure. [Bug 489370]
+ * win/README:
+ * win/makefile.bc:
+ * win/makefile.vc: Updated version to 8.1b2.
+
+ * unix/tkUnixSend.c: Fixed one more Tcl_*ObjVar instance.
+
+1999-02-04 <stanton@GASPODE>
-2002-01-11 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ * Various cleanup related to the Tcl_Eval and Tcl_ObjSetVar
+ changes in Tcl.
+
+ INTEGRATED PATCHES FROM 8.0.5b2:
+
+ * win/tkWinMenu.c (TkpDestroyMenu): Changed so modalMenuPtr is
+ cleared when it is being destroyed.
- * win/tclWinSerial.c (SerialSetOptionProc): Applied patch for SF
- bug #500348 supplied by Rolf Schroedter
- <schroedter@users.sourceforge.net>. The function modified the
- contents of the the 'value' string and now does not do this
- anymore. This is a followup to the change made on 2001-12-17.
+ * generic/tkImgPhoto.c: Changed so color tables are freed
+ immediately instead of being delayed. This ensures that color
+ tables are properly disposed at process exit.
-2002-01-11 David Gravereaux <davygrvy@pobox.com>
+ * library/prolog.ps: Changed string that determines font height to
+ include European character with an umlaut.
- * win/makefile.vc: Removed -GD compiler option. It was intended
- for future use, but MS is again changing the future at their whim.
- The D4002 warning was harmless though, but someone using VC .NET
- logged it as a concern. [Bug #501565]
+ * generic/tkImgBmap.c (ImgBmapConfigureInstance): If an image
+ mask changed but ended up with the same XID, the GC failed to be
+ updated and so the new mask was not used. [Bug: 970]
-2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tkFocus.c (SetFocus): Changed so focus window is always
+ set if -force is specified. This fixes the problem on Windows
+ where Tk does not activate the window if it already has focus.
+
+ * generic/tkConsole.c: Fixed so errors in console eval are
+ reported properly. Eliminated duplicate result messages. [Bug: 973]
+
+ * win/tkWinWm.c: Changed so windows that aren't resizable don't
+ have resize handles and the zoom box is disabled.
+
+ * win/tkWinInt.h:
+ * win/tkWinPointer.c: Changed to cancel the mouse timer when a
+ user initiated move/resize loop begins.
+
+ * unix/configure.in: TK_LD_SEARCH_FLAGS was set incorrectly if
+ SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through
+ the C compiler. Systems affected are Linux, MP-RAS and NEXTSTEP,
+ but also with gcc on many more systems. [Bug: 908]
+
+ * win/makefile.vc: First stab at install target. Fixed quoting so
+ paths with spaces work.
+
+ * tests/main.test:
+ * tests/unixWm.test: Better cleanup of temporary files.
+
+ * mac/tkMacAppInit.c:
+ * generic/tkTest.c:
+ * generic/tkAppInit.c:
+ * win/winMain.c: Changed some EXTERN declarations to extern
+ since they are not defining exported interfaces. This avoids
+ generating useless declspec() attributes and makes the windows
+ makefile simpler.
+
+ * library/menu.tcl (tkMenuFind): Changed so keyboard shortcuts
+ will only be found in the current toplevel. Previously, they
+ might be found in menus attached to other toplevels that might not
+ even be mapped. [Bug: 924]
+
+ * generic/tkCanvLine.c: Changed to treat zero width lines like
+ they have width 1 for purposes of selection. [Bug: 925]
+
+ * win/tkWinFont.c (Tk_MeasureChars): Added a workaround for a bug
+ in GetTextExtentExPoint on Win NT 4.0/Japanese. [Bug: 1006]
+
+ * unix/tkUnixSend.c (Tk_SetAppName): Fixed uninitialized memory
+ access bug. [Bug: 919]
+
+1999-1-28 <stanton@GASPODE>
+
+ * generic/tkGrid.c: Fixed bug in "grid forget" that failed to cancel
+ pending idle handlers, resulting in a crash in a few odd cases.
+
+1999-01-06 <lfb@JUSTICE>
+
+ * generic/tk.h, generic/tkGet.c, generic/tkConfig.c,
+ * generic/tkOldConfig.c, generic/tkEntry.c, generic/tkMenubutton.c,
+ * generic/tkMenubutton.h, generic/tkScale.c, generic/tkScale.h,
+ * generic/tkTextDisplay.c, generic/tkText.c, unix/tkUnixMenubu.c,
+ * unix/tkUnixScale.c, mac/tkMacMenu.c, mac/tkMacMenubutton.c,
+
+ Removed global Tk_Uids dealing with "-state" configuration option
+ and added new TK_CONFIG_STATE configSpec that doesn't use
+ Tk_Uids.
+
+1998-12-11 === Tk 8.1b1 Release ===
+
+1998-12-11 <stanton@GASPODE>
+
+ * generic/tkMain.c (Tk_Main): Fixed improper command line encoding
+ handling.
+
+1998-12-08 <stanton@GASPODE>
+
+ * win/tkWinClipboard.c (TkSelGetSelection, TkWinClipboardRender):
+ Changed to handle multibyte characters properly. [Bug: 935]
+
+1998-12-07 <stanton@GASPODE>
+
+ * library/xmfbox.tcl (tkMotifFDialog_Create): In the cached case,
+ the data array was not being initialized with the correct set of
+ widgets.
+
+1998-12-4 <welch@SAGE>
+
+ * Changed patchLevel to 8.1b1
+
+ * generic/tkMenu.c (ConfigureMenuCloneEntries): The -menu configuration
+ option was being incorrectly specified as just "menu".
+
+1998-11-30 <stanton@GASPODE>
+
+ * generic/tkButton.c (ConfigureButton): The error result was
+ getting lost when restoring configuration options. [Bug: 619]
+
+1998-11-25 <stanton@GASPODE>
+
+ * unix/tkUnixFont.c (GetFontAttributes): Initialize an unspecified
+ family to an empty string.
+ (FontMapLoadPage): if the font included characters below 32, the
+ index computation was incorrect because the range was shifted up
+ to 32.
+ (CreateClosestFont): check for empty locale as well as NULL.
+
+ * generic/tkFont.c (TkFontParseXLFD): initialize charset to
+ iso8859-1 if no charset is specified.
+
+ * mac/tkMacHLEvents.c (OdocHandler): added conversion from
+ external string to UTF [Bug: 869]
+
+ * integrated tk8.0.4 changes.
+
+ * generic/tkBind.c: fixed deletion order bug where a crash would
+ result if a binding deleted "."
+
+ * generic/tkMenu.c (MenuWidgetObjCmd): disabled menu entries were
+ getting reenabled whenever the mouse passed over the entry [Bug: 860]
+
+ * unix/tkUnixMenu.c (TkpComputeStandardMenuGeometry): hidemargin
+ option was not honored properly in menus [Bug: 859]
+
+1998-11-24 <stanton@GASPODE>
+
+ * tkMacMenu.c, tkUnixMenu.c, tkWinMenu.c, tkMenuDraw.c, tkMenu.h,
+ * tkMenu.c: Backed out the previous fix for bug 620 and
+ eliminated a bunch of code that created unnecessary objects.
+ Changed back to using internal types instead of objects for many
+ configuration options. There are many more fixes like this that
+ could be made, but some require a little restructuring of the
+ code. In any case the leaks are fixed and there is a lot less
+ allocation happening. [Bug: 620]
+
+1998-11-19 <stanton@GASPODE>
+
+ * tkMenu.c (DestroyMenuEntry): fixed memory leaks [Bug: 620]
+
+ * tkWinX.c (GetTranslatedKey): fixed bad code merge
- * unix/Makefile.in: Burn Tcl build directory
- into tcltest executable to avoid crashes caused
- by ld loading a previously installed version
- of the tcl shared library. [Bug 218110]
-
-2002-01-10 Don Porter <dgp@users.sourceforge.net>,
- Kevin Kenny <kennykb@users.sourceforge.net>
-
- * unix/tclLoadDld.c (TclpLoadFile): syntax error: unbalanced
- parens. Kevin notes that it's far from clear that this file is
- ever included in an actual build; Linux without dlopen appears to
- be a nonexistent configuration.
-
-2002-01-08 Don Porter <dgp@users.sourceforge.net>,
- Kevin Kenny <kennykb@users.sourceforge.net>
-
- * doc/StaticPkg.3 (Tcl_StaticPackage):
- * generic/tcl.decls (Tcl_StaticPackage):
- * generic/tclDecls.h (Tcl_StaticPackage):
- * generic/tclInt.decls (TclGuessPackageName):
- * generic/tclInt.h (TclGuessPackageName):
- * generic/tclLoad.c (Tcl_StaticPackage):
- * generic/tclLoadNone.c (TclGuessPackageName):
- * mac/tclMacLoad.c (TclGuessPackageName):
- * unix/tclLoadAout.c (TclGuessPackageName):
- * unix/tclLoadDl.c (TclGuessPackageName):
- * unix/tclLoadDld.c (TclGuessPackageName):
- * unix/tclLoadDyld.c (TclGuessPackageName):
- * unix/tclLoadNext.c (TclGuessPackageName):
- * unix/tclLoadOSF.c (TclGuessPackageName):
- * unix/tclLoadShl.c (TclGuessPackageName):
- * win/tclWinLoad.c (TclGuessPackageName): Updated APIs in
- the files */tcl*Load*.c according to the guidelines of TIP 27.
- [Patch 501096]
-
-2002-01-09 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclTest.c (MainLoop):
- * tests/main.test (Tcl_Main-1.{3,4,5,6}): Corrected some non-portable
- tests from the new Tcl_Main changes. Thanks to Kevin Kenny.
-
-2002-01-07 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclEvent.c (TclInExit):
- * generic/tclIOUtil.c (SetFsPathFromAbsoluteNormalized,
- SetFsPathFromAny,Tcl_FSNewNativePath,DupFsPathInternalRep):
- * generic/tclListObj.c (TclLsetList,TclLsetFlat): Added some type
- casts to satisfy picky compilers.
-
- * generic/tclMain.c: Bug fix: neglected the NULL case in
- TclGetStartupScriptFileName(). Broke Tk/wish.
-
-2002-01-05 Don Porter <dgp@users.sourceforge.net>
-
- * doc/Tcl_Main.3:
- * generic/tclMain.c: Substantial rewrite and expanded documentation
- of Tcl_Main to correct a number of bugs and flaws:
-
- * Interactive Tcl_Main can now enter a main loop, exit
- that loop and continue interactive operations. The loop
- may even exit in the midst of interactive command typing
- without loss of the partial command. [Bugs 486453, 474131]
- * Tcl_Main now gracefully handles deletion of its master
- interpreter.
- * Interactive Tcl_Main can now operate with non-blocking stdin
- * Interactive Tcl_Main can now detect EOF on stdin even in
- mid-command. [Bug 491341]
- * Added VFS-aware internal routines for managing the
- startup script selection.
- * Tcl variable 'tcl_interactive' is now linked to C variable
- 'tty' so that one can disable/enable interactive prompts
- at the script level when there is no startup script. This
- is meant for use by the test suite.
- * Consistent use of the Tcl libraries standard channels as
- returned by Tcl_GetStdChannel(); as opposed to the channels
- named 'stdin', 'stdout', and 'stderr' in the master interp,
- which can be different or unavailable.
- * Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the
- master interpreter returns, assuring Tcl_Main does not return.
- * Documented Tcl_Main's absence from public stub table
- * Documented that Tcl_Main does not return.
- * Documented Tcl variables set by Tcl_Main.
- * All prompts are done from a single procedure, Prompt.
- * Use of Tcl_Obj-enabled interfaces everywhere.
-
- * generic/tclInt.decls (TclGetStartupScriptPath,
- TclSetStartupScriptPath): New internal VFS-aware routines for
- managing the startup script of Tcl_Main.
- * generic/tclIntDecls.h:
- * generic/tclStubInit.c: make genstubs
-
- * generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd,
- Tcltest_Init,TestinterpdeleteCmd):
- * tests/main.test (new): Added new file to test suite that
- thoroughly tests generic/tclMain.c; added some new test commands
- for testing Tcl_SetMainLoop().
-
-2002-01-04 Don Porter <dgp@users.sourceforge.net>
-
- * doc/Alloc.3:
- * doc/Concat.3:
- * doc/CrtMathFnc.3:
- * doc/Hash.3:
- * doc/Interp.3:
- * doc/LinkVar.3:
- * doc/ObjectType.3:
- * doc/PkgRequire.3:
- * doc/Preserve.3:
- * doc/SetResult.3:
- * doc/SplitList.3:
- * doc/SplitPath.3:
- * doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc,
- ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and
- to accurately describe when and how they are used. [Bug 497459]
-
- * generic/tclThreadJoin.c (TclRememberJoinableThread,TclJoinThread):
- Replaced Tcl_Alloc and Tcl_Free calls with ckalloc and ckfree so that
- memory debugging is supported.
-
-2002-01-04 Daniel Steffen <das@users.sourceforge.net>
-
- * mac/tclMacTime.c (TclpGetTZName): fix for daylight savings TZName bug
-
-2002-01-03 Don Porter <dgp@users.sourceforge.net>
-
- * doc/FileSystem.3:
- * generic/tclIOUtil.c: Updated some old uses of "fileName" to
- new VFS terminology, "pathPtr".
-
-2002-01-03 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * tests/basic.test (basic-39.4): Greatly simplified test while
- still leaving it so that it crashes when run without the fix to
- the [foreach] implementation.
- * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stopped Bug #494348 from
- happening by not trying to be so clever with cacheing; if nothing
- untoward is happening anyway, the less efficient technique will
- only add a few instruction cycles (one function call and a few
- derefs/assigns per list per iteration, with no change in the
- number of tests) and if something odd *is* going on, the code is
- now far more robust.
-
- * tests/basic.test (basic-39.4): Reproducable script from Bug #494348
-
-2002-01-02 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-
- * tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so
- the test is performed with the right internal function since
- [string match] no longer uses Tcl_StringCaseMatch internally.
-
- * tests/string.test (string-11.51):
- * generic/tclUtf.c (Tcl_UniCharCaseMatch):
- * generic/tclUtil.c (Tcl_StringCaseMatch): Fault with matching
- case-insensitive non-ASCII patterns containing upper case
- characters. [Bug #233257]
-
- ******************************************************************
- *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" ***
- *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" ***
- *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
- ******************************************************************
+ * tkWinWm.c, tkWinMenu.c: fixed titles and menus so they properly
+ display Unicode [Bug: 819]
diff --git a/tcl/README b/tcl/README
index e48983c5566..45c0ea1d2d7 100644
--- a/tcl/README
+++ b/tcl/README
@@ -1,5 +1,5 @@
-README: Tcl
- This is the Tcl 8.4.0 source distribution.
+README: Tk
+ This is the Tk 8.4.0 source distribution.
Tcl/Tk is also available through NetCVS:
http://tcl.sourceforge.net/
You can get any source release of Tcl from the file distributions
@@ -7,180 +7,39 @@ README: Tcl
RCS: @(#) $Id$
-Contents
---------
- 1. Introduction
- 2. Documentation
- 3. Compiling and installing Tcl
- 4. Development tools
- 5. Tcl newsgroup
- 6. Tcl contributed archive
- 7. Tcl Resource Center
- 8. Mailing lists
- 9. Support and Training
- 10. Thank You
-
1. Introduction
---------------
-Tcl provides a powerful platform for creating integration applications that
-tie together diverse applications, protocols, devices, and frameworks.
-When paired with the Tk toolkit, Tcl provides the fastest and most powerful
-way to create GUI applications that run on PCs, Unix, and the Macintosh.
-Tcl can also be used for a variety of web-related tasks and for creating
-powerful command languages for applications.
-
-Tcl is maintained, enhanced, and distributed freely by the Tcl community.
-The home for Tcl/Tk sources and bug/patch database is on SourceForge:
-
- http://tcl.sourceforge.net/
-with the Tcl Developer Xchange hosted at:
+This directory contains the sources and documentation for Tk, an X11
+toolkit implemented with the Tcl scripting language.
- http://www.tcl.tk/
+For details on features, incompatibilities, and potential problems with
+this release, see the Tcl/Tk 8.4 Web page at
-Tcl is a freely available open source package. You can do virtually
-anything you like with it, such as modifying it, redistributing it,
-and selling it either in whole or in part. See the file
-"license.terms" for complete information.
-
-2. Documentation
-----------------
-
-Extensive documentation is available at our website.
-The home page for this release, including new features, is
http://www.tcl.tk/software/tcltk/8.4.html
-Detailed release notes can be found at the file distributions page
-by clicking on the relevant version.
- http://sourceforge.net/project/showfiles.php?group_id=10894
-
-Information about Tcl itself can be found at
- http://www.tcl.tk/scripting/
-
-There are many Tcl books on the market. Most are listed at
- http://www.tcl.tk/resource/doc/books/
-
-2a. Unix Documentation
-----------------------
-
-The "doc" subdirectory in this release contains a complete set of
-reference manual entries for Tcl. Files with extension ".1" are for
-programs (for example, tclsh.1); files with extension ".3" are for C
-library procedures; and files with extension ".n" describe Tcl
-commands. The file "doc/Tcl.n" gives a quick summary of the Tcl
-language syntax. To print any of the man pages on Unix, cd to the
-"doc" directory and invoke your favorite variant of troff using the
-normal -man macros, for example
-
- ditroff -man Tcl.n
-
-to print Tcl.n. If Tcl 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 Tcl
-
-2b. Windows Documentation
--------------------------
-
-The "doc" subdirectory in this release contains a complete set of Windows
-help files for Tcl. Once you install this Tcl release, a shortcut to the
-Windows help Tcl documentation will appear in the "Start" menu:
-
- Start | Programs | Tcl | Tcl Help
-
-3. Compiling and installing Tcl
--------------------------------
+or refer to the "changes" file in this directory, which contains a
+historical record of all changes to Tk.
-There are brief notes in the unix/README, win/README, and mac/README about
-compiling on these different platforms. There is additional information
-about building Tcl from sources at
-
- http://www.tcl.tk/doc/howto/compile.html
-
-4. TclPro Development tools
----------------------------
-
-A high quality set of commercial quality development tools is available to
-accelerate your Tcl application development. The TclPro product provides a
-debugger, static code checker, packaging utility, and bytecode compiler.
-TclPro was open-sourced when Scriptics/Ajuba was acquired by Interwoven.
-Visit its home at SourceForge for more information and source/binaries:
-
- http://tclpro.sourceforge.net/
-
-5. Tcl newsgroup
-----------------
-
-There is a network news group "comp.lang.tcl" intended for the exchange of
-information about Tcl, Tk, and related applications. The newsgroup is a
-great place to ask general information questions. For bug reports, please
-see the "Support and bug fixes" section below.
-
-6. Tcl contributed archive
---------------------------
-
-Many people have created exciting packages and applications based on Tcl
-and/or Tk and made them freely available to the Tcl community. An archive
-of these contributions is kept on the machine ftp.neosoft.com. You
-can access the archive using anonymous FTP; the Tcl contributed archive is
-in the directory "/pub/tcl". The archive also contains several FAQ
-("frequently asked questions") documents that provide solutions to problems
-that are commonly encountered by TCL newcomers.
-
-7. Tcl Resource Center
-----------------------
-
-Visit http://www.tcl.tk/resource/ to see an annotated index of
-many Tcl resources available on the World Wide Web. This includes
-papers, books, and FAQs, as well as development tools, extensions,
-applications, binary releases, and patches. You can also recommend
-additional URLs for the resource center using the forms labeled "Add a
-Resource".
-
-8. Mailing lists
-----------------
-
-Several mailing lists are hosted at SourceForge to discuss development or
-use issues (like Macintosh and Windows topics). For more information and
-to subscribe, visit:
-
- http://sourceforge.net/projects/tcl/
-
-and go to the Mailing Lists page.
-
-9. Support and Training
-------------------------
-
-We are very interested in receiving bug reports, patches, and suggestions
-for improvements. We prefer that you send this information to us via the
-bug form at SourceForge, rather than emailing us directly. The bug
-database is at:
+Tk is maintained, enhanced, and distributed freely by members of the
+Tcl community. The home for Tcl/Tk sources and bug database is on
+SourceForge at:
http://tcl.sourceforge.net/
-The bug form was designed to give uniform structure to bug reports as
-well as to solicit enough information to minimize followup questions.
+with the Tcl Developer Xchange at:
-We will log and follow-up on each bug, although we cannot promise a
-specific turn-around time. Enhancements may take longer and may not happen
-at all unless there is widespread support for them (we're trying to slow
-the rate at which Tcl/Tk turns into a kitchen sink). It's very difficult
-to make incompatible changes to Tcl/Tk at this point, due to the size of
-the installed base.
-
-The Tcl community is too large for us to provide much individual support
-for users. If you need help we suggest that you post questions to
-comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric
-questions for which no-one else is likely to know the answer. In addition,
-see the following Web site for links to other organizations that offer
-Tcl/Tk training:
+ http://www.tcl.tk/
- http://www.tcl.tk/resource/community/commercial/training
+Tk is a freely available open source package. You can do virtually
+anything you like with it, such as modifying it, redistributing it,
+and selling it either in whole or in part. See the file
+"license.terms" for complete information.
-10. Thank You
--------------
+2. See Tcl README
+-----------------
-We'd like to express our thanks to the Tcl community for all the
-helpful suggestions, bug reports, and patches we have received.
-Tcl/Tk has improved vastly and will continue to do so with your help.
+Please see the README file that comes with the associated Tcl release
+for more information. There are pointers there to extensive
+documentation. In addition, there are additional README files
+in the subdirectories of this distribution.
diff --git a/tcl/bitmaps/error.bmp b/tcl/bitmaps/error.bmp
new file mode 100644
index 00000000000..5a1331f436e
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/gray12.bmp b/tcl/bitmaps/gray12.bmp
new file mode 100644
index 00000000000..a0eafa14526
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/gray25.bmp b/tcl/bitmaps/gray25.bmp
new file mode 100644
index 00000000000..fdaef49c71c
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/gray50.bmp b/tcl/bitmaps/gray50.bmp
new file mode 100644
index 00000000000..1f9fbc0e51f
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/gray75.bmp b/tcl/bitmaps/gray75.bmp
new file mode 100644
index 00000000000..f700b2cd028
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/hourglass.bmp b/tcl/bitmaps/hourglass.bmp
new file mode 100644
index 00000000000..bb1d8ad0e7c
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/info.bmp b/tcl/bitmaps/info.bmp
new file mode 100644
index 00000000000..801476e48e6
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/questhead.bmp b/tcl/bitmaps/questhead.bmp
new file mode 100644
index 00000000000..17b2929326a
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/question.bmp b/tcl/bitmaps/question.bmp
new file mode 100644
index 00000000000..ceba2ab60fe
--- /dev/null
+++ b/tcl/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/tcl/bitmaps/warning.bmp b/tcl/bitmaps/warning.bmp
new file mode 100644
index 00000000000..79254403f21
--- /dev/null
+++ b/tcl/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/tcl/changes b/tcl/changes
index d24add87332..8d8da5bf953 100644
--- a/tcl/changes
+++ b/tcl/changes
@@ -1,5602 +1,5313 @@
-Recent user-visible changes to Tcl:
+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$
-1. No more [command1] [command2] construct for grouping multiple
-commands on a single command line.
+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).
-2. Semi-colon now available for grouping commands on a line.
+3/16/91 (bug fix) Modified tkColor.c not to free black or white colors:
+some X servers get upset at this.
-3. For a command to span multiple lines, must now use backslash-return
-at the end of each line but the last.
+3/18/91 (bug fix) Modified tkShare.c to fix bug causing "DeleteGroup
+couldn't find group on shareList" panic.
-4. "Var" command has been changed to "set".
+3/18/91 (bug fix) Several changes to tkListbox.c and tkScrollbar.c to
+handle listboxes (and scrollbars) with zero total entries in them.
-5. Double-quotes now available as an argument grouping character.
+3/22/91 (bug fix) Fixed a few ='s in tkListbox.c that should be ==.
-6. "Return" may be used at top-level.
+3/22/91 (bug fix) Fixed error in main.c that caused BadWindow errors
+in some cases where wish scripts invoke "destroy .".
-7. More backslash sequences available now. In particular, backslash-newline
-may be used to join lines in command files.
+3/23/91 (new feature) Added Tk_CancelIdleCall to remove Tk_DoWhenIdle
+handler.
-8. New or modified built-in commands: case, return, for, glob, info,
-print, return, set, source, string, uplevel.
+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).
-9. After an error, the variable "errorInfo" is filled with a stack
-trace showing what was being executed when the error occurred.
+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.
-10. Command abbreviations are accepted when parsing commands, but
-are not recommended except for purely-interactive commands.
+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.
-11. $, set, and expr all complain now if a non-existent variable is
-referenced.
+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).
-12. History facilities exist now. See Tcl.man and Tcl_RecordAndEval.man.
+4/5/91 (new feature) Added "invoke" option to widget command for buttons,
+check buttons, and radio buttons.
-13. Changed to distinguish between empty variables and those that don't
-exist at all. Interfaces to Tcl_GetVar and Tcl_ParseVar have changed
-(NULL return value is now possible). *** POTENTIAL INCOMPATIBILITY ***
+4/5/91 (new feature) Added "unpack" option to "pack" command.
-14. Changed meaning of "level" argument to "uplevel" command (1 now means
-"go up one level", not "go to level 1"; "#1" means "go to level 1").
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-15. 3/19/90 Added "info exists" option to see if variable exists.
+4/6/91 (bug fix) Major overhaul of deletion code in all widgets to use
+Tk_Preserve and Tk_Release. Should fix many problems.
-16. 3/19/90 Added "noAbbrev" variable to prohibit command abbreviations.
+4/6/91 (bug fix) Changed "winfo children" to generate correct lists
+when child names have embedded spaces.
-17. 3/19/90 Added extra errorInfo option to "error" command.
+4/6/91 (new feature) Added "screenheight" and "screenwidth" options to
+"winfo".
-18. 3/21/90 Double-quotes now only affect space: command, variable,
-and backslash substitutions still occur inside double-quotes.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-19. 3/21/90 Added support for \r.
+---------------------- Release 1.1, 4/18/91 -------------------------
-20. 3/21/90 List, concat, eval, and glob commands all expect at least
-one argument now. *** POTENTIAL INCOMPATIBILITY ***
+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.
-21. 3/22/90 Added "?:" operators to expressions.
+---------------------- Release 1.2, 4/24/91 -------------------------
-22. 3/25/90 Fixed bug in Tcl_Result that caused memory to get trashed.
+4/26/91 (new feature) Added -geometry and -display switches to wish.
+Also wrote wish manual entry.
-------------------- Released version 3.1 ---------------------
+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.
-23. 3/29/90 Fixed bug that caused "file a.b/c ext" to return ".b/c".
+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.
-24. 3/29/90 Semi-colon is not treated specially when enclosed in
-double-quotes.
+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).
-------------------- Released version 3.2 ---------------------
+5/16/91 (bug fix) Fixed main.c to allow stdin to be redirected.
-25. 4/16/90 Rewrote "exec" not to use select or signals anymore.
-Should be more Sys-V compatible, and no slower in the normal case.
+6/1/91 (bug fix) Make sure that pointers are never used after being
+freed.
-26. 4/18/90 Rewrote "glob" to eliminate GNU code (there's no GNU code
-left in Tcl, now), and added Tcl_TildeSubst procedure. Added automatic
-tilde-substitution in many commands, including "glob".
+6/15/91 (bug fix) Fixed bug in tkBind.c that caused current binding
+values to not always be printed correctly.
-------------------- Released version 3.3 ---------------------
+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.
-27. 7/11/90 Added "Tcl_AppendResult" procedure.
+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".
-28. 7/20/90 "History" with no options now defaults to "history info"
-rather than to "history redo". Although this is a backward incompatibility,
-it should only be used interactively and thus shouldn't present any
-compatibility problems with scripts.
+9/5/91 (bug fix) Modified option code to accept '#' as a comment
+character in .Xdefaults files, in addition to '!'.
-29. 7/20/90 Added "Tcl_GetInteger", "Tcl_GetDouble", and "Tcl_GetBoolean"
-procedures.
+9/10/91 (misfeature correction) Changed binding mechanism so that
+numeric %-sequences are output in decimal instead of hex.
-30. 7/22/90 Removed "Tcl_WatchInterp" procedure: doesn't seem to be
-necessary, since the same effect can be achieved with the deletion
-callbacks on individual commands. *** POTENTIAL INCOMPATIBILITY ***
+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.
-31. 7/23/90 Added variable tracing: Tcl_TraceVar, Tcl_UnTraceVar,
-and Tcl_VarTraceInfo procedures, "trace" command.
+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.
-32. 8/9/90 Mailed out list of all bug fixes since 3.3 release.
+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.
-33. 8/29/90 Fixed bugs in Tcl_Merge relating to backslashes and
-semi-colons. Mailed out patch.
+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.
-34. 9/3/90 Fixed bug in tclBasic.c: quotes weren't quoting ]'s.
-Mailed out patch.
+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.
-35. 9/19/90 Rewrote exec to always use files both for input and
-output to the process. The old pipe-based version didn't work if
-the exec'ed process forked a child and then exited: Tcl waited
-around for stdout to get closed, which didn't happen until the
-grandchild exited.
+10/31/91 (reorganization) Renamed manual entries so that they are no
+more than 14 characters in length.
-36. 11/5/90 ERR_IN_PROGRESS flag wasn't being cleared soon enough
-in Tcl_Eval, allowing error messages from different commands to
-pile up in $errorInfo. Fixed by re-arranging code in Tcl_Eval that
-re-initializes result and ERR_IN_PROGRESS flag. Didn't mail out
-patch: changes too complicated to describe.
+10/31/91 (reorganization) Changed tk.h and tkInt.h so that tkInt.h
+doesn't needed to be included by tk.h.
-37. 12/19/90 Added Tcl_VarEval procedure as a convenience for
-assembling and executing Tcl commands.
+11/3/91 (portability improvement) Eliminated use of "class" as a variable
+name, since it's a reserved word in C++.
-38. 1/29/91 Fixed core leak in Tcl_AddErrorInfo. Also changed procedure
-and Tcl_Eval so that first call to Tcl_AddErrorInfo need not come from
-Tcl_Eval.
+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.
------------------ Released version 5.0 with Tk ------------------
+---------------------- Release 1.3, 11/7/91 -------------------------
-39. 4/3/91 Removed change bars from manual entries, leaving only those
-that came after version 3.3 was released.
+11/24/91 (bug fix) Fixed bug causing occasional errors if existing bindings
+are modified (FindSequence in tkBind.c forget to set *maskPtr).
-40. 5/17/91 Changed tests to conform to Mary Ann May-Pumphrey's approach.
-
-41. 5/23/91 Massive revision to Tcl parser to simplify the implementation
-of string and floating-point support in expressions. Newlines inside
-[] are now treated as command separators rather than word separators
-(this makes newline treatment consistent throughout Tcl).
-*** POTENTIAL INCOMPATIBILITY ***
+11/24/91 (bug fix) Used wrong hash table in Tk_GetColorByValue. Could
+cause new entries to get created unnecessarily.
-42. 5/23/91 Massive rewrite of expression code to support floating-point
-values and simple string comparisons. The C interfaces to expression
-routines have changed (Tcl_Expr is replaced by Tcl_ExprLong, Tcl_ExprDouble,
-etc.), but all old Tcl expression strings should be accepted by the new
-expression code.
-*** POTENTIAL INCOMPATIBILITY ***
-
-43. 5/23/91 Modified tclHistory.c to check for negative "keep" value.
+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.
-44. 5/23/91 Modified Tcl_Backslash to handle backslash-newline. It now
-returns 0 to indicate that a backslash sequence should be replaced by
-no character at all.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-45. 5/29/91 Modified to use ANSI C function prototypes. Must set
-"USE_ANSI" switch when compiling to get prototypes.
+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.
-46. 5/29/91 Completed test suite by providing tests for all of the
-built-in Tcl commands.
+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.
-47. 5/29/91 Changed Tcl_Concat to eliminate leading and trailing
-white-space in each of the things it concatenates and to ignore
-elements that are empty or have only white space in them. This
-produces cleaner output from the "concat" command.
-*** POTENTIAL INCOMPATIBILITY ***
+1/2/92 (bug fix) Fixed bug in TkMeasureChars occurring when maxChars
+is 0. Occasionally affected things like message window geometry.
-48. 5/31/91 Changed "set" command and Tcl_SetVar procedure to return
-new value of variable.
+1/3/92 (new feature) Added procedures Tk_GetJustify, Tk_GetAnchor,
+Tk_GetCapStyle, and Tk_GetJoinStyle, plus support for these things
+in Tk_ConfigureWidget.
-49. 6/1/91 Added "while" and "cd" commands.
+---------------------- Release 1.4, 1/10/92 -------------------------
-50. 6/1/91 Changed "exec" to delete the last character of program
-output if it is a newline. In most cases this makes it easier to
-process program-generated output.
-*** POTENTIAL INCOMPATIBILITY ***
+1/12/92 (bug fix) TkMenubutton.c wasn't cleaning up mbPtr->varName
+properly during menubutton cleanup if an error occurred during
+menubutton creation.
-51. 6/1/91 Made sure that pointers are never used after freeing them.
+1/19/92 (bug fix) Fixed off-by-one bug in tkListbox.c that caused
+scrollbars to display a slider that was too large.
-52. 6/1/91 Fixed bug in TclWordEnd where it wasn't dealing with
-[] inside quotes correctly.
+2/10/92 (bug fix) Tk_CreateFileHandler didn't correctly handle case
+where new mask was specified for existing handler.
-53. 6/8/91 Fixed exec.test to accept return values of either 1 or
-255 from "false" command.
+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.
-54. 7/6/91 Massive overhaul of variable management. Associative
-arrays now available, along with "unset" command (and Tcl_UnsetVar
-procedure). Variable traces have been completely reworked:
-interfaces different both from Tcl and C, and multiple traces may
-exist on same variable. Can no longer redefine existing local
-variable to be global. Calling sequences have changed slightly
-for Tcl_GetVar and Tcl_SetVar ("global" is now "flags"). Tcl_SetVar
-can fail and return a NULL result. New forms of variable-manipulation
-procedures: Tcl_GetVar2, Tcl_SetVar2, etc. Syntax of variable
-$-notation changed to support array indexing.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-55. 7/6/91 Added new list-manipulation procedures: Tcl_ScanElement,
-Tcl_ConvertElement, Tcl_AppendElement.
+2/15/92 (new feature) Added "curselection" and "select clear" options
+to widget command for listboxes.
-56. 7/12/91 Created new procedure Tcl_EvalFile, which does most of the
-work of the "source" command.
+2/15/92 (new feature) Added Tk_3DBorderColor procedure.
-57. 7/20/91 Major reworking of "exec" command to allow pipelines,
-more redirection, background. Added new procedures Tcl_Fork,
-Tcl_WaitPids, Tcl_DetachPids, and Tcl_CreatePipeline. The old
-"< input" notation has been replaced by "<< input" ("<" is for
-redirection from a file). Also handles error returns and abnormal
-terminations (e.g. signals) differently.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-58. 7/21/91 Added "append" and "lappend" commands.
+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.
-59. 7/22/91 Reworked error messages and manual entries to use
-?x? as the notation for an optional argument x, instead of [x]. The
-bracket notation was often confused with the use of brackets for
-command substitution. Also modified error messages to be more
-consistent.
+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.
-60. 7/23/91 Tcl_DeleteCommand now returns an indication of whether
-or not the command actually existed, and the "rename" command uses
-this information to return an error if an attempt is made to delete
-a non-existent command.
-*** POTENTIAL INCOMPATIBILITY ***
+2/22/92 (new feature) Changed menus to support bitmaps in menu entries:
+added new -bitmap option for entries.
-61. 7/25/91 Added new "errorCode" mechanism, along with procedures
-Tcl_SetErrorCode, Tcl_UnixError, and Tcl_ResetResult. Renamed
-Tcl_Return to Tcl_SetResult, but left a #define for Tcl_Return to
-avoid compatibility problems.
+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.
-62. 7/26/91 Extended "case" command with alternate syntax where all
-patterns and commands are together in a single list argument: makes
-it easier to write multi-line case statements.
+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".
-63. 7/27/91 Changed "print" command to perform tilde-substitution on
-the file name.
+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.
-64. 7/27/91 Added "tolower", "toupper", "trim", "trimleft", and "trimright"
-options to "string" command.
+2/29/92 (new feature) Can use "focus none" to clear input focus.
-65. 7/29/91 Added "atime", "mtime", "size", and "stat" options to "file"
-command.
+2/29/92 (bug fix) Fixed tkEvent.c to generate SubstructureNotify events
+properly. These weren't being generated previously.
-66. 8/1/91 Added "split" and "join" commands.
+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).
-67. 8/11/91 Added commands for file I/O, including "open", "close",
-"read", "gets", "puts", "flush", "eof", "seek", and "tell".
+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.
-68. 8/14/91 Switched to use a hash table for command lookups. Command
-abbreviations no longer have direct support in the Tcl interpreter, but
-it should be possible to simulate them with the auto-load features
-described below. The "noAbbrev" variable is no longer used by Tcl.
+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 ***
-68.5 8/15/91 Added support for "unknown" command, which can be used to
-complete abbreviations, auto-load library files, auto-exec shell
-commands, etc.
+4/12/92 (bug fix) Fixed core dump that occurred in tkError.c when
+removing the first error record from the error list.
-69. 8/15/91 Added -nocomplain switch to "glob" command.
+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.
-70. 8/20/91 Added "info library" option and TCL_LIBRARY #define. Also
-added "info script" option.
+4/18/92 (new feature) Added Tk_DefineCursor and Tk_UndefineCursor
+procedures.
-71. 8/20/91 Changed "file" command to take "option" argument as first
-argument (before file name), for consistency with other Tcl commands.
+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 ***
-72. 8/20/91 Changed format of information in $errorInfo variable:
-comments such as
- ("while" body line 1)
-are now on separate lines from commands being executed.
-*** 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.
-73. 8/20/91 Changed Tcl_AppendResult so that it (eventually) frees
-large buffers that it allocates.
+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.
-74. 8/21/91 Added "linsert", "lreplace", "lsearch", and "lsort"
-commands.
+4/29/92 (bug fix) Changed "-selector" default for menus to have separate
+values for mono and color.
-75. 8/28/91 Added "incr" and "exit" commands.
+4/30/92 (bug fix) Fixed bug in tkListbox.c where it occasionally generated
+bogus scroll commands (last index less than first).
-76. 8/30/91 Added "regexp" and "regsub" commands.
+4/30/92 (reorganization) Moved demos directory to "library/demos".
-77. 9/4/91 Changed "dynamic" field in interpreters to "freeProc" (procedure
-address). This allows for alternative storage managers.
-*** POTENTIAL INCOMPATIBILITY ***
+---------------------- Release 2.0, 5/1/92 -------------------------
-78. 9/6/91 Added "index", "length", and "range" options to "string"
-command. Added "lindex", "llength", and "lrange" commands.
+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.
-79. 9/8/91 Removed "index", "length", "print" and "range" commands.
-"Print" is redundant with "puts", but less general, and the other
-commands are replaced with the new commands described in change 78
-above.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-80. 9/8/91 Changed history revision to occur even when history command
-is nested; needed in order to allow "history" to be invoked from
-"unknown" procedure.
+5/9/92 (bug fix) Plugged core leaks in tkListbox.c and tkBind.c
-81. 9/13/91 Changed "panic" not to use vfprintf (it's uglier and less
-general now, but makes it easier to run Tcl on systems that don't
-have vfprintf). Also changed "strerror" not to redeclare sys_errlist.
+5/9/92 (bug fix) TkBind.c was accidentally deleting bindings during
+attempts to print non-existent bindings.
-82. 9/19/91 Lots of changes to improve portability to different UNIX
-systems, including addition of "config" script to adapt Tcl to the
-configuration of the system it's being compiled on.
+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.
-83. 9/22/91 Added "pwd" command.
+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.
-84. 9/22/91 Renamed manual pages so that their filenames are no more
-than 14 characters in length, moved to "doc" subdirectory.
+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.
-85. 9/24/91 Redid manual entries so they contain the supplemental
-macros that they need; can just print with "troff -man" or "man"
-now.
+5/13/92 (bug fix) Empty entries could be scanned off the left edge,
+displaying a garbage character.
-86. 9/26/91 Created initial version of script library, including
-a version of "unknown" that does auto-loading, auto-execution, and
-abbreviation expansion. This library is used by tclTest
-automatically. See the "library" manual entry for details.
+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.
------------------ Released version 6.0, 9/26/91 ------------------
+5/13/92 (performance optimization) Changed Tk_GeometryRequest not to
+invoke geometry manager unless requested size has changed.
-87. 9/30/91 Made "string tolower" and "string toupper" check case
-before converting: on some systems, "tolower" and "toupper" assume
-that character already has particular case.
+---------------------- Release 2.1, 5/14/92 -------------------------
-88. 9/30/91 Fixed bug in Tcl_SetResult: wasn't always setting freeProc
-correctly when called with NULL value. This tended to cause memory
-allocation errors later.
+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.
-89. 10/3/91 Added "upvar" command.
+5/17/92 (new feature/bug fix) Added support for VisibilityNotify events
+to the "bind" command. For some reason they weren't supported previously.
-90. 10/4/91 Changed "format" so that internally it converts %D to %ld,
-%U to %lu, %O to %lo, and %F to %f. This eliminates some compatibility
-problems on some machines without affecting behavior.
+5/17/92 (new feature) Added "tkwait" command.
-91. 10/10/91 Fixed bug in "regsub" that caused core dumps with the -all
-option when the last match wasn't at the end of the string.
+5/17/92 (new feature) Added "grab" command.
-92. 10/17/91 Fixed problems with backslash sequences: \r support was
-incomplete and \f and \v weren't supported at all.
+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.
-93. 10/24/91 Added Tcl_InitHistory procedure.
+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.
-94. 10/24/91 Changed "regexp" to store "-1 -1" in subMatchVars that
-don't match, rather than returning an error.
+5/17/92 (bug fix) Arrowheads on canvas lines weren't being translated
+or scaled correctly.
-95. 10/27/91 Modified "regexp" to return actual strings in matchVar
-and subMatchVars instead of indices. Added "-indices" switch to cause
-indices to be returned.
-*** POTENTIAL INCOMPATIBILITY ***
+5/20/92 (bug fix) Page-mode scrolling didn't work correctly for canvases
+(wrong windowUnits was passed to scrollbars).
-96. 10/27/91 Fixed bug in "scan" where it used hardwired constants for
-sizes of floats and doubles instead of using "sizeof".
+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.
-97. 10/31/91 Fixed bug in tclParse.c where parse-related error messages
-weren't being storage-managed correctly, causing spurious free's.
+5/21/92 (new feature) Added "gray50" and "gray25" as predefined bitmaps.
-98. 10/31/91 Form feed and vertical tab characters are now considered
-to be space characters by the parser.
+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.
-99. 10/31/91 Added TCL_LEAVE_ERR_MSG flag to procedures like Tcl_SetVar.
+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.
-100. 11/7/91 Fixed bug in "case" where "in" argument couldn't be omitted
-if all case branches were embedded in a single list.
+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.
-101. 11/7/91 Switched to use "pid_t" and "uid_t" and other official
-POSIC types and function prototypes.
+5/27/92 (new feature) Added "-textvariable" and "-anchor" options to
+messages.
------------------ Released version 6.1, 11/7/91 ------------------
+5/28/92 (new feature) Added "-padx" and "-pady" and "-underline" options
+to menubuttons.
-102. 12/2/91 Modified Tcl_ScanElement and Tcl_ConvertElement in several
-ways. First, allowed caller to request that only backslashes be used
-(no braces). Second, made Tcl_ConvertElement more aggressive in using
-backslashes for braces and quotes.
+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.
-103. 12/5/91 Added "type", "lstat", and "readlink" options to "file"
-command, plus added new "type" element to output of "stat" and "lstat"
-options.
+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).
-104. 12/10/91 Manual entries had first lines that caused "man" program
-to try weird preprocessor. Added blank comment lines to fix problem.
+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.
-105. 12/16/91 Fixed a few bugs in auto_mkindex proc: wasn't handling
-errors properly, and hadn't been upgraded for new "regexp" syntax.
+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.
-106. 1/2/92 Fixed bug in "file" command where it didn't properly handle
-a file names containing tildes where the indicated user doesn't exist.
+6/1/92 (new feature) Added new modifier names "Meta" and "Alt" for
+"bind" command.
-107. 1/2/92 Fixed lots of cases in tclUnixStr.c where two different
-errno symbols (e.g. EWOULDBLOCK and EAGAIN) have the same number; Tcl
-will only use one of them.
+6/3/92 (new feature) Added "winfo toplevel" command.
-108. 1/2/92 Lots of changes to configuration script to handle many more
-systems more gracefully. E.g. should now detect the bogus strtoul that
-comes with AIX and substitute Tcl's own version instead.
+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
------------------ Released version 6.2, 1/10/92 ------------------
+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).
-109. 1/20/92 Config didn't have code to actually use "uid_t" variable
-to set TCL_UIT_T #define.
+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.
-110. 2/10/92 Tcl_Eval didn't properly reset "numLevels" variable when
-too-deep recursion occurred.
+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.
-111. 2/29/92 Added "on" and "off" to keywords accepted by Tcl_GetBoolean.
+7/14/92 (bug fix) Changed tkColor.c not to free colors for visual types
+StaticGray or StaticColor.
-112. 3/19/92 Config wasn't installing default version of strtod.c for
-systems that don't have one in libc.a.
+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.
-113. 3/23/92 Fixed bug in tclExpr.c where numbers with leading "."s,
-like 0.75, couldn't be properly substituted into expressions with
-variable or command substitution.
+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.
-114. 3/25/92 Fixed bug in tclUnixAZ.c where "gets" command wasn't
-checking to make sure that it was able to write the variable OK.
+7/29/92 (bug fix) Don't permit rectangles or ovals to have zero-sized
+dimensions. Round up to at least one pixel.
-115. 4/16/92 Fixed bug in tclUnixAZ.c where "read" command didn't
-compute file size right for device files.
+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.
-116. 4/23/92 Fixed but in tclCmdMZ.c where "trace vinfo" was overwriting
-the trace command.
+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.
------------------ Released version 6.3, 5/1/92 ------------------
+8/7/92 (bug fix) Error messages in Tk_ParseArgv were sometimes including
+the option name where they should have included its value.
-117. 5/1/92 Added Tcl_GlobalEval.
+---------------------- Release 2.2, 8/7/92 -------------------------
-118. 6/1/92 Changed auto-load facility to source files at global level.
+8/7/92 (bug fix) Changed tkCanvas.c to be more conservative in the area
+it passes to XCopyArea.
-119. 6/8/92 Tcl_ParseVar wasn't always setting termPtr after errors, which
-sometimes caused core dumps.
+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).
-120. 6/21/92 Fixed bug in initialization of regexp pattern cache. This
-bug caused segmentation violations in regexp commands under some conditions.
+8/8/92 (bug fix) Fixed bug in menu.tcl that caused errors when using
+keyboard to traverse over separator menu entries.
-121. 6/22/92 Changed implementation of "glob" command to eliminate
-trailing slashes on directory names: they confuse some systems. There
-shouldn't be any user-visible changes in functionality except for names
-in error messages not having trailing slashes.
+8/10/92 (bug fix) Changed to use OPEN_MAX instead of MAX_FD to compute
+maximum # of open files.
-122. 7/2/92 Fixed bug that caused 'string match ** ""' to return 0.
+8/10/92 (bug fix) Canvases weren't updating scrollbars on window size
+changes. They also weren't recentering canvases on window size changes.
-123. 7/2/92 Fixed bug in Tcl_CreateCmdBuf where it wasn't initializing
-the buffer to an empty string.
+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).
-124. 7/6/92 Fixed bug in "case" command where it used NULL pattern string
-after errors in the "default" clause.
+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>.
-125. 7/25/92 Speeded up auto_load procedure: don't reread all the index
-files unless the path has changed.
+8/13/92 (feature change) Changed default fonts to request "Adobe" fonts
+explicitly.
-126. 8/3/92 Changed tclUnix.h to define MAXPATHLEN from PATH_MAX, not
-_POSIX_PATH_MAX.
+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).
------------------ Released version 6.4, 8/7/92 ------------------
+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.
-127. 8/10/92 Changed tclBasic.c so that comment lines can be continued by
-putting a backslash before the newline.
+8/19/92 (bug fix) Canvases that were taller than wide were not being
+redisplayed properly.
-128. 8/21/92 Modified "unknown" to allow the source-ing of a file for
-an auto-load to trigger other nested auto-loads, as long as there isn't
-any recursion on the same command name.
+8/20/92 (new feature) Added Tk_CreateGenericHandler procedure for trapping
+all X events (useful for tracing, watching non-Tk windows, etc.).
-129. 8/25/92 Modified "format" command to allow " " and "+" flags, and
-allow flags in any order.
+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).
-130. 9/14/92 Modified Tcl_ParseVar so that it doesn't actually attempt
-to look up the variable if "noEval" mode is in effect in the interpreter
-(it just parses the name). This avoids the errors that used to occur
-in statements like "expr {[info exists foo] && $foo}".
+8/21/92 (new feature) Added "-state" option to scale widgets.
-131. 9/14/92 Fixed bug in "uplevel" command where it didn't output the
-correct error message if a level was specified but no command.
+8/22/92 (new feature) Changed tkBitmap.c to allow tilde-substitution
+to occur in bitmap file names.
-132. 9/14/92 Renamed manual entries to have extensions like .3 and .n,
-and added "install" target to Makefile.
+---------------------- Release 2.3, 8/24/92 -------------------------
-133. 9/18/92 Modified "unknown" command to emulate !!, !<num>, and
-^<old>^<new> csh history substitutions.
+8/27/92 (bug fix) Changes to -activebackground and -activeforeground options
+for menubuttons were being lost.
-134. 9/21/92 Made the config script cleverer about figuring out which
-switches to pass to "nm".
+8/27/92 (bug fix) Entries were selecting last character when a B1-drag
+occurred past the right edge of the text.
-135. 9/23/92 Fixed tclVar.c to be sure to copy flags when growing variables.
-Used to forget about traces in progress and make extra recursive calls
-on trace procs.
+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.
-136. 9/28/92 Fixed bug in auto_reset where it was unsetting variables
-that might not exist.
+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.
-137. 10/7/92 Changed "parray" library procedure to print any array
-accessible to caller, local or global.
+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.
-138. 10/15/92 Fixed bug where propagation of new environment variable
-values among interpreters took N! time if there exist N interpreters.
+9/11/92 (bug fix) Fixed bug in tkTextDisp.c that caused core dumps
+when adding tags to non-existent lines.
-139. 10/16/92 Changed auto_reset procedure so that it also deletes any
-existing procedures that are in the auto_load index (the assumption is
-that they should be re-loaded to get the latest versions).
+9/11/92 (bug fix) Line items in canvases didn't permit an empty fill
+color (i.e. couldn't make them transparent).
-140. 10/21/92 Fixed bug that caused lists to be incorrectly generated
-for elements that contained backslash-newline sequences.
+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.
-141. 12/9/92 Added support for TCL_LIBRARY environment variable: use
-it as library location if it's present.
+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.
-142. 12/9/92 Added "info complete" command, Tcl_CommandComplete procedure.
+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.
-143. 12/16/92 Changed the Makefile to check to make sure "config" has been
-run (can't run config directly from the Makefile because it modifies the
-Makefile; thus make has to be run again after running config).
+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.
------------------ Released version 6.5, 12/17/92 ------------------
+10/1/92 (bug fixes) Fixed two bugs in tkTextBTree.c that caused core dumps
+during text deletion.
-144. 12/21/92 Changed config to look in several places for libc file.
+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 ***
-145. 12/23/92 Added "elseif" support to if. Also, "then", "else", and
-"elseif" may no longer be abbreviated.
+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 ***
-146. 12/28/92 Changed "puts" and "read" to support initial "-nonewline"
-switch instead of additional "nonewline" argument. The old form is
-still supported, but it is discouraged and is no longer documented.
-Also changed "puts" to make the file argument default to stdout: e.g.
-"puts foo" will print foo on standard output.
+11/10/92 (new feature) Added Postscript output to canvases.
-147. 1/6/93 Fixed bug whereby backslash-newline wasn't working when
-typed interactively, or in "info complete".
+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.
-148. 1/22/93 Fixed bugs in "lreplace" and "linsert" where close
-quotes were being lost from last element before replacement or
-insertion.
+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 ***
-149. 1/29/93 Fixed bug in Tcl_AssembleCmd where it wasn't requiring
-a newline at the end of a line before considering a command to be
-complete. The bug caused some very long lines in script files to
-be processed as multiple separate commands.
+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.
-150. 1/29/93 Various changes in Makefile to add more configuration
-options, simplify installation, fix bugs (e.g. don't use -f switch
-for cp), etc.
+11/25/92 (bug fix) "wm grid" command was using wrong window.
-151. 1/29/93 Changed "name1" and "name2" identifiers to "part1" and
-"part2" to avoid name conflicts with stupid C++ implementations that
-use "name1" and "name2" in a reserved way.
+11/29/92 (bug fix) Fixed core dump that occurred when trying to use
+placer on top-level windows: return error instead.
-152. 2/1/93 Added "putenv" procedure to replace the standard system
-version so that it will work correctly with Tcl's environment handling.
+11/29/92 (bug fix) Selection retrieval wasn't making sure that the window
+on whose behalf selection is being retrieved actually exists.
------------------ Released version 6.6, 2/5/93 ------------------
+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.
-153. 2/10/93 Fixed bugs in config script: missing "endif" in libc loop,
-and tried to use strncasecmp.c instead of strcasecmp.c.
+12/6/92 (bug fix) Ignore recursive attempts to destroy window.
-154. 2/10/93 Makefile improvements: added RANLIB variable for easier
-Sys-V configuration, added SHELL variable for SGI systems.
+12/9/92 (new demos) Added "tcolor" and "rmt" demos.
------------------ Released version 6.7, 2/11/93 ------------------
+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 ***
-153. 2/6/93 Changes in backslash processing:
- - \Cx, \Mx, \CMx, \e sequences no longer special
- - \<newline> also eats up any space after the newline, replacing
- the whole sequence with a single space character
- - Hex sequences like \x24 are now supported, along with ANSI C's \a.
- - "format" no longer does backslash processing on its format string
- - there is no longer any special meaning to a 0 return value from
- Tcl_Backslash
- - unknown backslash sequences, like (e.g. \*), are replaced with
- the following character (e.g. *), instead of just treating the
- backslash as an ordinary character.
+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 ***
-154. 2/6/93 Updated all copyright notices. The meaning hasn't changed
-at all but the wording does a better job of protecting U.C. from
-liability (according to U.C. lawyers, anyway).
+12/12/92 (new feature) Started creating a test suite. Right now it
+only has a few tests.
-155. 2/6/93 Changed "regsub" so that it overwrites the result variable
-in all cases, even if there is no match.
+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 ***
-156. 2/8/93 Added support for XPG3 %n$ conversion specifiers to "format"
-command.
+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 ***
-157. 2/17/93 Fixed bug in Tcl_Eval where errors due to infinite
-recursion could result in core dumps.
+12/16/92 (new feature) Added -setgrid option to listboxes.
-158. 2/17/93 Improved the auto-load mechanism to deal gracefully (i.e.
-return an error) with a situation where a library file that supposedly
-defines a procedure doesn't actually define it.
+12/16/92 (new feature) The "destroy" command, and the "delete" widget
+command for canvases, now accept any number of arguments, including
+zero.
-159. 2/17/93 Renamed Tcl_UnixError procedure to Tcl_PosixError, and
-changed errorCode variable usage to use POSIX as keyword instead of
-UNIX.
+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 ***
-160. 2/19/93 Changes to exec and process control:
- - Added support for >>, >&, >>&, |&, <@, >@, and >&@ forms of redirection.
- - When exec puts processes into background, it returns a list of
- their pids as result.
- - Added support for <file, >file, etc. (i.e. no space between
- ">" and file name.
- - Added -keepnewline option.
- - Deleted Tcl_Fork and Tcl_WaitPids procedures (just use fork and
- waitpid instead).
- - Added waitpid compatibility procedure for systems that don't have
- it.
- - Added Tcl_ReapDetachedProcs procedure.
- - Changed "exec" to return an error if there is stderr output, even
- if the command returns a 0 exit status (it's always been documented
- this way, but the implementation wasn't correct).
- - If a process returns a non-zero exit status but doesn't generate
- any diagnostic output, then Tcl generates an error message for it.
+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 ***
-161. 2/25/93 Fixed two memory-management problems having to do with
-managing the old result during variable trace callbacks.
+---------------------- Release 3.0, 12/17/92 -------------------------
-162. 3/1/93 Added dynamic string library: Tcl_DStringInit, Tcl_DStringAppend,
-Tcl_DStringFree, Tcl_DStringResult, etc.
+12/17/92 (bug fix) Fixed dangling-pointer bug in canvases that occurred
+if a <LeaveNotify> binding deleted the current item.
-163. 3/1/93 Modified glob command to only return the names of files that
-exist, and to only return names ending in "/" if the file is a directory.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-164. 3/19/93 Modified not to use system calls like "read" directly,
-but instead to use special Tcl procedures that retry automatically
-if interrupted by signals.
+12/18/92 (incorrect documentation) Updated manual entries for Tk_FreeGC,
+Tk_FreeCursor, and Tk_FreeBitmap to reflect new interface that requires
+"display" argument.
-165. 4/3/93 Eliminated "noSep" argument to Tcl_AppendElement, plus
-TCL_NO_SPACE flag for Tcl_SetVar and Tcl_SetVar2.
-*** POTENTIAL INCOMPATIBILITY ***
+12/18/92 (missing documentation) Added documentation for the canvas
+"postscript" command, which was missing in the 3.0 release.
-166. 4/3/93 Eliminated "flags" and "termPtr" arguments to Tcl_Eval.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-167. 4/3/93 Changes to expressions:
- - The "expr" command now accepts multiple arguments, which are
- concatenated together with space separators.
- - Integers aren't automatically promoted to floating-point if they
- overflow the word size: errors are generated instead.
- - Tcl can now handle "NaN" and other special values if the underlying
- library procedures handle them.
- - When printing floating-point numbers, Tcl ensures that there is a "."
- or "e" in the number, so it can't be treated as an integer accidentally.
- The procedure Tcl_PrintDouble is available to provide this function
- in other contexts. Also, the variable "tcl_precision" can be used
- to set the precision for printing (must be a decimal number giving
- digits of precision).
- - Expressions now support transcendental and other functions, e.g. sin,
- acos, hypot, ceil, and round. Can add new math functions with
- Tcl_CreateMathFunc().
- - Boolean expressions can now have any of the string values accepted
- by Tcl_GetBoolean, such as "yes" or "no".
-*** POTENTIAL INCOMPATIBILITY ***
+12/21/92 (bug fix) Arrowheads on canvas line items weren't moving properly
+after coordinate changes made with the "coords" widget command.
-168. 4/5/93 Changed Tcl_UnsetVar and Tcl_UnsetVar2 to return TCL_OK
-or TCL_ERROR instead of 0 or -1.
-*** POTENTIAL INCOMPATIBILITY ***
+12/21/92 (bug fix) If top-level window was initially withdrawn, couldn't
+ever deiconify it again.
-169. 4/5/93 Eliminated Tcl_CmdBuf structure and associated procedures;
-can use Tcl_DStrings instead.
-*** POTENTIAL INCOMPATIBILITY ***
+12/21/92 (bug fix) Double-button event sequences didn't always trigger
+properly when grabs were in effect.
-170. 4/8/93 Changed interface to Tcl_TildeSubst to use a dynamic
-string for buffer space. This makes the procedure re-entrant and
-thread-safe, whereas it wasn't before.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-171. 4/14/93 Eliminated tclHash.h, and moved everything from it to
-tcl.h
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-172. 4/15/93 Eliminated Tcl_InitHistory, made "history" command always
-be part of interpreter.
-*** POTENTIAL INCOMPATIBILITY ***
+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".
-173. 4/16/93 Modified "file" command so that "readable" option always
-exists, even on machines that don't support symbolic links (always returns
-same error as if the file wasn't a symbolic link).
-
-174. 4/26/93 Fixed bugs in "regsub" where ^ patterns didn't get handled
-right (pretended not to match when it really did, and looped infinitely
-if -all was specified).
-
-175. 4/29/93 Various improvements in the handling of variables:
- - Can create variables and array elements during a read trace.
- - Can delete variables during traces (note: unset traces will be
- invoked when this happens).
- - Can upvar to array elements.
- - Can retarget an upvar to another variable by re-issuing the
- upvar command with a different "other" variable.
-
-176. 5/3/93 Added Tcl_GetCommandInfo, which returns info about a Tcl
-command such as whether it exists and its ClientData. Also added
-Tcl_SetCommandInfo, which allows any of this information to be modified
-and also allows a command's delete procedure to have a different
-ClientData value than its command procedure.
-
-177. 5/5/93 Added Tcl_RegExpMatch procedure.
-
-178. 5/6/93 Fixed bug in "scan" where it didn't properly handle
-%% conversion specifiers. Also changed "scan" to use Tcl_PrintDouble
-for printing real values.
-
-179. 5/7/93 Added "-exact", "-glob", and "-regexp" options to "lsearch"
-command to allow different kinds of pattern matching.
-
-180. 5/7/93 Added many new switches to "lsort" to control the sorting
-process: "-ascii", "-integer", "-real", "-command", "-increasing",
-and "-decreasing".
-
-181. 5/10/93 Changes to file I/O:
- - Modified "open" command to support a list of POSIX access flags
- like {WRONLY CREAT TRUNC} in addition to current fopen-style
- access modes. Also added "permissions" argument to set permissions
- of newly-created files.
- - Fixed Scott Bolte's bug (can close stdin etc. in application and
- then re-open them with Tcl commands).
- - Exported access to Tcl's file table with new procedures Tcl_EnterFile
- and Tcl_GetOpenFile.
-
-182. 5/15/93 Added new "pid" command, which can be used to retrieve
-either the current process id or a list of the process ids in a
-pipeline opened with "open |..."
-
-183. 6/3/93 Changed to use GNU autoconfig for configuration instead of
-the home-brew "config" script. Also made many other configuration-related
-changes, such as using <unistd.h> instead of explicitly declaring system
-calls in tclUnix.h.
-
-184. 6/4/93 Fixed bug where core-dumps could occur if a procedure
-redefined itself (the memory for the procedure's body could get
-reallocated in the middle of evaluating the body); implemented
-simple reference count mechanism.
-
-185. 6/5/93 Changed tclIndex file format in two ways: (a) it's now
-eval-ed instead of parsed, which makes it 3-4x faster; (b) the entries
-in auto_index are now commands to evaluate, which allows commands to
-be loaded in different ways such as dynamic-loading of C code. The
-old tclIndex file format is still supported.
-
-186. 6/7/93 Eliminated tclTest program, added new "tclsh" program
-that is more like wish (allows script files to be invoked automatically
-using "#!/usr/local/bin/tclsh", makes arguments available to script,
-etc.). Added support for Tcl_AppInit plus default version; this
-allows new Tcl applications to be created without modifying the
-main program for tclsh.
-
-187. 6/7/93 Fixed bug in TclWordEnd that kept backslash-newline from
-working correctly in some cases during interactive input.
-
-188. 6/9/93 Added Tcl_LinkVar and related procedures, which automatically
-keep a Tcl variable in sync with a C variable.
-
-189. 6/16/93 Increased maximum nesting depth from 100 to 1000.
-
-190. 6/16/93 Modified "trace var" command so that error messages from
-within traces are returned properly as the result of the variable
-access, instead of the generic "access disallowed by trace command"
-message.
-
-191. 6/16/93 Added Tcl_CallWhenDeleted to provide callbacks when an
-interpreter is deleted (same functionality as Tcl_WatchInterp, which
-used to exist in versions before 6.0).
-
-193. 6/16/93 Added "-code" argument to "return" command; it's there
-primarily for completeness, so that procedures implementing control
-constructs can reflect exceptional conditions back to their callers.
-
-194. 6/16/93 Split up Tcl.n to make separate manual entries for each
-Tcl command. Tcl.n now contains a summary of the language syntax.
-
-195. 6/17/93 Added new "switch" command to replace "case": allows
-alternate forms of pattern matching (exact, glob, regexp), replaces
-pattern lists with single patterns (but you can use "-" bodies to
-share one body among several patterns), eliminates "in" noise word.
-"Case" command is now obsolete.
-
-196. 6/17/93 Changed the "exec", "glob", "regexp", and "regsub" commands
-to include a "--" switch. All initial arguments starting with "-" are now
-treated as switches unless a "--" switch is present to end the list.
+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 ***
-197. 6/17/93 Changed auto-exec so that the subprocess gets stdin, stdout,
-and stderr from the parent. This allows truly interactive sub-processes
-(e.g. vi) to be auto-exec'ed from a tcl shell command line.
+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.
-198. 6/18/93 Added patchlevel.h, for use in coordinating future patch
-releases, and also added "info patchlevel" command to make the patch
-level available to Tcl scripts.
+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.
-199. 6/19/93 Modified "glob" command so that a leading "//" in a name
-gets left as is (this is needed for systems like Apollos where "//" is
-the super-root; Tcl used to collapse the two slashes into a single
-slash).
+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.
-200. 7/7/93 Added Tcl_SetRecursionLimit procedure so that the maximum
-allowable nesting depth can be controlled for an interpreter from C.
+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.
------------------ Released version 7.0 Beta 1, 7/9/93 ------------------
+---------------------- Release 3.1, 2/5/93 -------------------------
-201. 7/12/93 Modified Tcl_GetInt and tclExpr.c so that full-precision
-unsigned integers can be specified without overflow errors.
+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.
-202. 7/12/93 Configuration changes: eliminate leading blank line in
-configure script; provide separate targets in Makefile for installing
-binary and non-binary information; check for size_t and a few other
-potentially missing typedefs; don't put tclAppInit.o into libtcl.a;
-better checks for matherr support.
+---------------------- Release 3.2, 2/11/93 -------------------------
-203. 7/14/93 Changed tclExpr.c to check the termination pointer before
-errno after strtod calls, to avoid problems with some versions of
-strtod that set errno in unexpected ways.
+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.
-204. 7/16/93 Changed "scan" command to be more ANSI-conformant:
-eliminated %F, %D, etc., added code to ignore "l", "h", and "L"
-modifiers but always convert %e, %f, and %g with implicit "l";
-also added support for %u and %i. Also changed "format" command
-to eliminate %D, %U, %O, and add %i.
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-205. 7/17/93 Changed "uplevel" and "upvar" so that they can be used
-from global level to global level: this used to generate an error.
+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.
-206. 7/19/93 Renamed "setenv", "putenv", and "unsetenv" procedures
-to avoid conflicts with system procedures with the same names. If
-you want Tcl's procedures to override the system procedures, do it
-in the Makefile (instructions are in the Makefile).
+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 ***
------------------ Released version 7.0 Beta 2, 7/21/93 ------------------
+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").
-207. 7/21/93 Fixed bug in tclVar.c where freed memory was accidentally
-used if a procedure returned an element of a local array.
+2/22/93 (bug fix) Changed "#!/usr/local/wish" in demo scripts to
+"#!/usr/local/bin/wish" to reflect new location of binary.
-208. 7/22/93 Fixed bug in "unknown" where it didn't properly handle
-errors occurring in the "auto_load" procedure, leaving its state
-inconsistent.
+2/22/93 (new feature) Added new reliefs "groove" and "ridge".
-209. 7/23/93 Changed exec's ">2" redirection operator to "2>" for
-consistency with sh. This is incompatible with earlier beta releases
-of 7.0 but not with pre-7.0 releases, which didn't support either
-operator.
+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).
-210. 7/28/93 Changed backslash-newline handling so that the resulting
-space character *is* treated as a word separator unless the backslash
-sequence is in quotes or braces. This is incompatible with 7.0b1
-and 7.0b2 but is more compatible with pre-7.0 versions that the b1
-and b2 releases were.
+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.
-211. 7/28/93 Eliminated Tcl_LinkedVarWritable, added TCL_LINK_READ_ONLY to
-Tcl_LinkVar to accomplish same purpose. This change is incompatible
-with earlier beta releases, but not with releases before Tcl 7.0.
+2/25/93 (bug fix) Fixed several bugs in library/menu.tcl that caused
+menu traversal to mis-behave when menu had no entries.
-212. 7/29/93 Renamed regexp C functions so they won't clash with POSIX
-regexp functions that use the same name.
+2/26/93 (new feature) Added "wm frame" command.
-213. 8/3/93 Added "-errorinfo" and "-errorcode" options to "return"
-command: these allow for much better handling of the errorInfo
-and errorCode variables in some cases.
+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.
-214. 8/12/93 Changed "expr" so that % always returns a remainder with
-the same sign as the divisor and absolute value smaller than the
-divisor.
+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.
-215. 8/14/93 Turned off auto-exec in "unknown" unless the command
-was typed interactively. This means you must use "exec" when
-invoking subprocesses, unless it's a command that's typed interactively.
-*** POTENTIAL INCOMPATIBILITY ***
+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
-216. 8/14/93 Added support for tcl_prompt1 and tcl_prompt2 variables
-to tclMain.c: makes prompts user-settable.
+3/22/93 (bug fix) Fixed bug in tkPack.c that was causing memory to
+get trashed with the integer value 1.
-217. 8/14/93 Added asynchronous handlers (Tcl_AsyncCreate etc.) so
-that signals can be taken cleanly by Tcl applications.
+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.
-218. 8/16/93 Moved information about open files from the interpreter
-structure to global variables so that a file can be opened in one
-interpreter and read or written in another.
+6/26/93 (bug fix) Fixed numeric problems in scales that occurred with
+very large scale values.
-219. 8/16/93 Removed ENV_FLAGS from Makefile, so that there's no
-official support for overriding setenv, unsetenv, and putenv.
+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.
-220. 8/20/93 Various configuration improvements: coerce chars
-to unsigned chars before using macros like isspace; source ~/.tclshrc
-file during initialization if it exists and program is running
-interactively; allow there to be directories in auto_path that don't
-exist or don't have tclIndex files (ignore them); added Tcl_Init
-procedure and changed Tcl_AppInit to call it.
+6/26/93 (bug fix) Changed canvases to handle large stipple patterns
+gracefully (stipples used to jump around during redisplay and lose
+coherency).
-221. 8/21/93 Fixed bug in expr where "+", "-", and " " were all
-getting treated as integers with value 0.
+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.
-222. 8/26/93 Added "tcl_interactive" variable to tclsh.
+7/1/93 Changed copyright notices. The effect is the same as with the
+old notices, but the new notices more clearly disclaim liability.
-223. 8/27/93 Added procedure Tcl_FilePermissions to return whether a
-given file can be read or written or both. Modified Tcl_EnterFile
-to take a permissions mask rather than separate read and write arguments.
+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).
-224. 8/28/93 Fixed performance bug in "glob" command (unnecessary call
-to "access" for each file caused a 5-10x slow-down for big directories).
+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.
------------------ Released version 7.0 Beta 3, 8/28/93 ------------------
+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 .".
-225. 9/9/93 Renamed regexp.h to tclRegexp.h to avoid conflicts with system
-include file by same name.
+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.
-226. 9/9/93 Added Tcl_DontCallWhenDeleted.
+-------------------- Release 3.3 Beta 1, 7/9/93 -------------------------
-227. 9/16/93 Changed not to call exit C procedure directly; instead
-always invoke "exit" Tcl command so that application can redefine the
-command to do additional cleanup.
+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.
-228. 9/17/93 Changed auto-exec to handle names that contain slashes
-(i.e. don't use PATH for them).
+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.
-229. 9/23/93 Fixed bug in "read" and "gets" commands where they didn't
-clear EOF conditions.
+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.
------------------ Released version 7.0, 9/29/93 ------------------
+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.
-230. 10/7/93 "Scan" command wasn't properly aligning things in memory,
-so segmentation faults could arise under some circumstances.
+-------------------- Release 3.3 Beta 2, 7/21/93 -------------------------
-231. 10/7/93 Fixed bug in Tcl_ConvertElement where it forgot to
-backslash leading curly brace when creating lists.
+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.
-232. 10/7/93 Eliminated dependency of tclMain.c on tclInt.h and
-tclUnix.h, so that people can copy the file out of the Tcl source
-directory to make modified private versions.
+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.
-233. 10/8/93 Fixed bug in auto-loader that reversed the priority order
-of entries in auto_path for new-style index files. Now things are
-back to the way they were before 3.0: first in auto_path is always
-highest priority.
+7/24/93 (configuration improvements) Changed configure script not to
+omplain about "fd_set" missing if it's defined in <sys/select.h>.
-234. 10/13/93 Fixed bug where Tcl_CommandComplete didn't recognize
-comments and treat them as such. Thus if you typed the line
- # {
-interactively, Tcl would think that the command wasn't complete and
-wait for more input before evaluating the script.
+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.
-235. 10/14/93 Fixed bug where "regsub" didn't set the output variable
-if the input string was empty.
+8/14/93 (new feature) Added support for tcl_prompt1 and tcl_prompt2
+to wish main program: makes prompts user-settable.
-236. 10/23/93 Fixed bug where Tcl_CreatePipeline didn't close off enough
-file descriptors in child processes, causing children not to exit
-properly in some cases.
+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.
-237. 10/28/93 Changed "list" and "concat" commands not to generate
-errors if given zero arguments, but instead to just return an empty
-string.
+8/26/93 (configuration changes) Added Tk_Init, modified Tcl_AppInit
+procedures to use it and Tcl_Init. Added support for .wishrc file.
------------------ Released version 7.1, 11/4/93 ------------------
+8/28/93 (new feature) The main window is now a legitimate toplevel
+widget.
-Note: there is no 7.2 release. It was flawed and was thus withdrawn
-shortly after it was released.
+-------------------- Release 3.3 Beta 3, 8/30/93 -------------------------
-238. 11/10/93 TclMain.c didn't compile on some systems because of
-R_OK in call to "access". Changed to eliminate call to "access".
+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.
------------------ Released version 7.3, 11/26/93 ------------------
+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.
-239. 11/6/93 Modified "lindex", "linsert", "lrange", and "lreplace"
-so that "end" can be specified as an index.
+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.
-240. 11/6/93 Modified "append" and "lappend" to allow only two
-words total (i.e., nothing to append) without generating an error.
+10/11/93 (bug fix) Fixed bug in tkTextBTree.c where some deletions would
+cause core dumps due to halfwayLinePtr not getting set correctly.
-241. 12/2/93 Changed to use EAGAIN as the errno for non-blocking
-I/O instead of EWOULDBLOCK: this should fix problem where non-blocking
-I/O didn't work correctly on System-V systems.
+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).
-242. 12/22/93 Fixed bug in expressions where cancelled evaluation
-wasn't always working correctly (e.g. "set one 1; eval {1 || 1/$one}"
-failed with a divide by zero error).
+10/22/93 (bug fix) During configuration, XINCLUDE_DIR and XLIBRARY_DIR
+weren't overriding xmkmf like they were supposed to.
-243. 1/6/94 Changed TCL_VOLATILE definition from -1 to the address of
-a dummy procedure Tcl_Volatile, since -1 causes portability problems on
-some machines (e.g., Crays).
+10/23/93 (new feature) Allow negative scale factors in canvas "scale"
+widget command.
-244. 2/4/94 Added support for unary plus.
+10/23/93 (bug fix) Grabs weren't being cleaned up right if the grab
+window was deleted, causing core-dumps in some cases.
-245. 2/17/94 Changed Tcl_RecordAndEval and "history" command to
-call Tcl_GlobalEval instead of Tcl_Eval. Otherwise, invocation of
-these facilities in nested procedures can cause unwanted results.
+10/23/93 (bug fix) tk_TextSelectTo wasn't checking to be sure that
+the "anchor" mark exists.
-246. 2/17/94 Fixed bug in tclExpr.c where an expression such as
-"expr {"12398712938788234-1298379" != ""}" triggers an integer
-overflow error for the number in quotes, even though it isn't really
-a proper integer anyway.
+10/27/93 (bug fix) Fixed core dump that could occur in a text widget if
+the scroll command modifies the text.
-247. 2/19/94 Added new procedure Tcl_DStringGetResult to move result
-from interpreter to a dynamic string.
+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.
-248. 2/19/94 Fixed bug in Tcl_DStringResult that caused it to overwrite
-the contents of a static result in some situations. This can cause
-bizarre errors such as variables suddenly having empty values.
+-------------------- Release 3.4, 11/04/93 -------------------------
-249. 2/21/94 Fixed bug in Tcl_AppendElement, Tcl_DStringAppendElement,
-and the "lappend" command that caused improper omission of a separator
-space in some cases. For example, the script
- set x "abc{"; lappend x "def"
-used to return the result "abc{def" instead of "abc{ def".
+Note: there is no 3.5 release. It was flawed and was thus withdrawn
+shortly after it was released.
-250. 3/3/94 Tcl_ConvertElement was outputting empty elements as \0 if
-TCL_DONT_USE_BRACES was set. This depends on old pre-7.0 meaning of
-\0, which is no longer in effect, so it didn't really work. Changed
-to output empty elements as {} always.
+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".
-251. 3/3/94 Renamed Tcl_DStringTrunc to Tcl_DStringSetLength and extended
-it so that it can be used to lengthen a string as well as shorten it.
-Tcl_DStringTrunc is defined as a macro for backward compatibility, but
-it is deprecated.
+-------------------- Release 3.6, 11/26/93 -------------------------
-252. 3/3/94 Added Tcl_AllowExceptions procedure.
+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.
-253. 3/13/94 Fixed bug in Tcl_FormatCmd that could cause "format"
-to mis-behave on 64-bit Big-Endian machines.
+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.
-254. 3/13/94 Changed to use vfork instead of fork on systems where
-vfork exists.
+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.
-255. 3/23/94 Fixed bug in expressions where ?: didn't associate
-right-to-left as they should.
+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.
-256. 4/3/94 Fixed "exec" to flush any files used in >@ or >&@
-redirection in exec, so that data buffered for them is written
-before any new data added by the subprocess.
+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 ***
-257. 4/3/94 Added "subst" command.
+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 ***
-258. 5/20/94 The tclsh main program is now called Tcl_Main; tclAppInit.c
-has a "main" procedure that calls Tcl_Main. This makes it easier to use
-Tcl with C++ programs, which need their own main programs, and it also
-allows an application to prefilter the argument list before calling
-Tcl_Main.
+6/1/94 (feature change) Renamed "pack newinfo" command to "pack info".
+The old "pack info" command is no longer available.
*** POTENTIAL INCOMPATIBILITY ***
-259. 6/6/94 Fixed bug in procedure returns where the errorInfo variable
-could get truncated if an unset trace was invoked as part of returning
-from the procedure.
+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 ***
-260. 6/13/94 Added "wordstart" and "wordend" options to "string" command.
+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.
-261. 6/27/94 Fixed bug in expressions where they didn't properly cancel
-the evaluation of math functions in &&, ||, and ?:.
+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 ***
-262. 7/11/94 Incorrect boolean values, like "ogle", weren't being
-handled properly.
+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 ***
-263. 7/15/94 Added Tcl_RegExpCompile, Tcl_RegExpExec, and Tcl_RegExpRange,
-which provide lower-level access to regular expression pattern matching.
+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.
-264. 7/22/94 Fixed bug in "glob" command where "glob -nocomplain ~bad_user"
-would complain about a missing user. Now it doesn't complain anymore.
+-------------------- Release 4.0b1, 12/23/94 -------------------------
-265. 8/4/94 Fixed bug with linked variables where they didn't behave
-correctly when accessed via upvars.
+12/26/94 (bug fix) Removed obsolete demos from Makefile (color, dialog,
+size), fixed "install" target.
-266. 8/17/94 Fixed bug in Tcl_EvalFile where it didn't clear interp->result.
+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.
-267. 8/31/94 Modified "open" command so that errors in exec-ing
-subprocesses are returned by the open immediately, rather than
-being delayed until the "close" is executed.
+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.
-268. 9/9/94 Modified "expr" command to generate errors for integer
-overflow (includes addition, subtraction, negation, multiplication,
-division).
+1/4/95 (bug fix) Canvases forgot to register the built-in types if
+Tk_CreateItemType was called before a canvas widget was created.
-269. 9/23/94 Modified "regsub" to return a count of the number of
-matches and replacements, rather than 0/1.
+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.
-279. 10/4/94 Added new features to "array" command:
- - added "get" and "set" commands for easy conversion between arrays
- and lists.
- - added "exists" command to see if a variable is an array, changed
- "names" and "size" commands to treat a non-existent array (or scalar
- variable) just like an empty one.
- - added pattern option to "names" command.
+1/4/95 (bug fixes) Changed Control-t for entries just as for texts (see
+above) an deleted Control-x for entries (see above).
-280. 10/6/94 Modified Tcl_SetVar2 so that read traces on variables get
-called during append operations.
+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.
-281. 10/20/94 Fixed bug in "read" command where reading from stdin
-required two control-D's to stop the reading.
+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.
-282. 11/3/94 Changed "expr" command to use longs for division just like
-all other expr operators; it previously used ints for division.
+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).
-283. 11/4/94 Fixed bugs in "unknown" procedure: it wasn't properly
-handling exception returns from commands that were executed after
-being auto-loaded.
+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.
------------------ Released version 7.4b1, 12/23/94 ------------------
+1/8/95 (bug fix) Fixed problem in canvas "xview" and "yview" commands
+where divide-by-zero errors could sometimes occur.
-284. 12/26/94 Fixed "install" target in Makefile (couldn't always
-find install program).
+1/8/95 (bug fix) New event handler didn't properly handle files for
+which both TK_READABLE and TK_WRITABLE were specified.
-285. 12/26/94 Added strcncasecmp procedure to compat directory.
+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.
-286. 1/3/95 Fixed all procedure calls to explicitly cast arguments:
-implicit conversions from prototypes (especially integer->double)
-don't work when compiling under non-ANSI compilers. Tcl is now clean
-under gcc -Wconversion.
+-------------------- Release 4.0b2, 1/12/95 -------------------------
-287. 1/4/95 Fixed problem in Tcl_ArrayCmd where same name was used for
-both a label and a variable; caused problems on several older compilers,
-making array command misbehave and causing many errors in Tcl test suite.
+1/27/95 (feature removal) Removed %D substitution from binding scripts:
+wasn't portable, shouldn't be used anyway.
+*** POTENTIAL INCOMPATIBILITY ***
------------------ Released version 7.4b2, 1/12/95 ------------------
+1/27/95 (new features) Added -displayof options to the commands
+"winfo atom", "winfo atomname", "winfo containing", "winfo interps",
+and "winfo pathname".
-288. 2/9/95 Modified Tcl_CreateCommand to return a token, and added
-Tcl_GetCommandName procedure. Together, these procedures make it possible
-to track renames of a command.
+1/27/95 (new feature) Added "idle" option to "after" command to run
+scripts as idle handlers.
-289. 2/13/95 Fixed bug in expr where "089" was interpreted as a
-floating-point number rather than a bogus octal number.
+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 ***
-290. 2/14/95 Added code to Tcl_GetInt and Tcl_GetDouble to check for
-overflows when reading in numbers.
+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.
-291. 2/18/95 Changed "array set" to stop after first error, rather than
-continuing after error.
+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".
-292. 2/20/95 Upgraded to use autoconf version 2.2.
+1/30/95 (new feature) Added -xscrollincrement and -yscrollincrement
+options to canvases.
-293. 2/20/95 Fixed core dump that could occur in "scan" command if a
-close bracket was omitted.
+1/31/95 (bug fix) Geometry management was broken if a particular geometry
+manager claimed a slave away from itself.
-294. 2/27/95 Changed Makefile to always use install-sh for installations:
-there's just too much variation among "install" system programs, which
-makes installation flakey.
+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.
------------------ Released version 7.4b3, 3/24/95 ------------------
+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/29/95 (bug fix) Fixed bug where the auto-loading mechanism wasn't
-protecting the values of the errorCode and errorInfo variables.
+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/29/95 (new feature) Added optional pattern argument to "parray" procedure.
+3/25/95 (bug fix) Fixed bug where X window for "." wasn't being
+deleted.
-3/29/95 (bug fix) Made the full functionality of
- "return -code ... -errorcode ..."
-work not just inside procedures, but also in sourced files and at
-top level.
+3/27/95 (bug fix) Fixed many bugs associated with having more than
+one application in a single process.
-4/6/95 (new feature) Added "pattern" option to "array names" command.
+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.
-4/18/95 (bug fix) Fixed bug in parser where it didn't allow backslash-newline
-immediately after an argument in braces or quotes.
+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.
-4/19/95 (new feature) Added tcl_library variable, which application can
-set to override default library directory.
+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.
-4/30/95 (bug fix) During trace callbacks for array elements, the variable
-name used in the original reference would be temporarily modified to
-separate the array name and element name; if the trace callback used
-the same name string, it would get the wrong name (the array name without
-element). Fixed to restore the variable name before making trace
-callbacks.
+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/30/95 (new feature) Added -nobackslashes, -nocommands, and -novariables
-switches to "subst" command.
+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.
-5/4/95 (new feature) Added TCL_EVAL_GLOBAL flag to Tcl_RecordAndEval.
+4/6/95 (bug fix) Canvas text items weren't allowing real numbers in
+"@x,y" notation for specifying indices.
-5/5/95 (bug fix) Format command would overrun memory when printing
-integers with very large precision, as in "format %.1000d 0".
+4/7/95 (bug fix) Menus didn't display correctly when -activeborderwidth
+was large.
-5/5/95 (portability improvement) Changed to use BSDgettimeofday on
-IRIX machines, to avoid compilation problems with the gettimeofday
-declaration.
+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/9/95 (bug fix) Modified configure script to check for Solaris bug
-that makes vfork unreliable (core dumps result if vforked child
-changes a signal handler); will use fork instead of vfork if the
-bug is present.
+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).
-6/5/95 (bug fix) Modified "lsort" command to disallow recursive calls
-to lsort from a comparison function. This is needed because qsort
-is not reentrant.
+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.
-6/5/95 (bug fix) Undid change 243 above: changed TCL_VOLATILE and
-TCL_DYNAMIC back to integer constants rather than procedure addresses.
-This was needed because procedure addresses can have multiple values
-under some dynamic loading systems (e.g. SunOS 4.1 and Windows).
+5/18/95 (bug fix) Fixed bug with -spacing* options for text widget:
+screen distances weren't allowed, only integers.
-6/8/95 (feature change) Modified interface to Tcl_Main to pass in the
-address of the application-specific initialization procedure.
-Tcl_AppInit is no longer hardwired into Tcl_Main. This is needed
-in order to make Tcl a shared library.
+5/20/95 (bug fix) Eliminated memory leaks in tkTextDisp.c and elsewhere.
-6/8/95 (feature change) Modified Makefile so that the installed versions
-of tclsh and libtcl.a have version number in them (e.g. tclsh7.4 and
-libtcl7.4.a) and the library directory name also has an embedded version
-number (e.g., /usr/local/lib/tcl7.4). This should make it easier for
-Tcl 7.4 to coexist with earlier versions.
+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.
------------------ Released version 7.4b4, 6/16/95 ------------------
+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).
-6/19/95 (bug fix) Fixed bugs in tclCkalloc.c that caused core dumps
-if TCL_MEM_DEBUG was enabled on word-addressed machines such as Crays.
+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/21/95 (feature removal) Removed overflow checks for integer arithmetic:
-they just cause too much trouble (e.g. for random number generators).
+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/28/95 (new features) Added tcl_patchLevel and tcl_version variables,
-for consistency with Tk.
+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/29/95 (bug fix) Fixed problem in Tcl_Eval where it didn't record
-the right termination character if a script ended with a comment. This
-caused erroneous output for the following command, among others:
-puts "[
-expr 1+1
-# duh!
-]"
+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/29/95 (message change) Changed the error message for ECHILD slightly
-to provide a hint about why the problem is occurring.
+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.
------------------ Released version 7.4, 7/1/95 ------------------
+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.
-7/18/95 (bug fix) Changed "lreplace" so that nothing is deleted if
-the last index is less than the first index or if the last index
-is < 0.
+6/4/95 (bug fix) The "%t" substitution wasn't being made properly in
+Enter and Leave event bindings.
-7/18/95 (bug fix) Fixed bugs with backslashes in comments:
-Tcl_CommandComplete (and "info complete") didn't properly handle
-strings ending in backslash-newline, and neither Tcl_CommandComplete
-nor the Tcl parser handled other backslash sequences right, such
-as two backslashes before a newline.
+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.
-7/19/95 (bug fix) Modified Tcl_DeleteCommand to delete the hash table
-entry for the command before invoking its callback. This is needed in
-order to deal with reentrancy.
+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.
-7/22/95 (bug fix) "exec" wasn't reaping processes correctly after
-certain errors (e.g. if the name of the executable was bogus, as
-in "exec foobar").
+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 ***
-7/27/95 (bug fix) Makefile.in wasn't using the LIBS variable provided
-by the "configure" script. This caused problems on some SCO systems.
+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.
-7/27/95 (bug fix) The version of strtod in fixstrtod.c didn't properly
-handle the case where endPtr == NULL.
+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.
------------------ Released patch 7.4p1, 7/29/95 -----------------------
+6/9/95 (new feature) Added -outline and -width options to canvas polygon
+items.
-8/4/95 (bug fix) C-level trace callbacks for variables were sometimes
-receiving the PART1_NOT_PARSED flag, which could cause errors in
-subsequent Tcl library calls using the flags. (JO)
+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 ***
-8/4/95 (bug fix) Calls to toupper and tolower weren't using the
-UCHAR macros, which caused trouble in non-U.S. locales. (JO)
+-------------------- Release 4.0b4, 6/16/95 -------------------------
-8/10/95 (new feature) Added the "load" command for dynamic loading of
-binary packages, and the Tcl_PackageInitProc prototype for package
-initialization procedures. (JO)
+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.
-8/23/95 (new features) Added "info sharedlibextension" and
-"info nameofexecutable" commands, plus Tcl_FindExtension procedure. (JO)
+6/20/95 (bug fix) "bbox" widget command for texts didn't return
+proper width for tabs.
-8/25/95 (bug fix) If the target of an "upvar" was non-existent but
-had traces set, the traces were silently lost. Change to generate
-an error instead. (JO)
+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.
-8/25/95 (bug fix) Undid change from 7/19, so that commands can stay
-around while their deletion callbacks execute. Added lots of code to
-handle all of the reentrancy problems that this opens up. (JO)
+6/20/95 (new feature) Added "delta" widget command for scrollbars
+(needed for above bug fix).
-8/25/95 (bug fix) Fixed core dump that could occur in TclDeleteVars
-if there was an upvar from one entry in the table to the next entry
-in the same table. (JO)
+6/23/95 (bug fix) Listboxes weren't properly redisplaying their
+borders when the were configured to a smaller size.
-8/28/95 (bug fix) Exec wasn't handling bad user names properly, as
-in "exec ~bogus_user/foo". (JO)
+6/23/95 (new feature) Added "winfo server" command.
-8/29/95 (bug fixes) Changed backslash-newline handling to correct two
-problems:
- - Only spaces and tabs following the backslash-newline are now
- absorbed as part of the backslash-newline. Newlinew are no
- longer absorbed (add another backslash if you want to absorb
- another newline).
- - TclWordEnd returns the character just before the backslash in
- the sequence as the end of the sequence; it used to not consider
- the backslash-newline as a word separator. (JO)
+6/23/95 (bug fix) If a menu was posted, couldn't switch to another
+menu with an Alt- key.
-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)
+6/24/95 (new feature) Added "winfo pointerxy" command.
-9/10/95 Reorganized Tcl 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. Some UNIX sources are also used on other platforms. (SS)
+6/25/95 (bug fix) Tk_ParseArgv referenced beyond the end of 0-length
+option names.
-9/10/95 (feature change) Eliminated exported global variables (they
-don't work with Windows DLLs). Replaced tcl_AsyncReady and
-tcl_FileCloseProc with procedures Tcl_AsyncReady() and
-Tcl_SetFileCloseProc(). Replaced C variable tcl_RcFileName with
-a Tcl variable tcl_rcFileName. (SS)
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-9/11/95 (new feature) Added procedure Tcl_SetPanicProc to override
-the default implementation of "panic". (SS)
-
-9/11/95 (new feature) Added "interp" command to allow creation of
-new interpreters and execution of untrusted scripts. Added many new
-procedures, such as Tcl_CreateSlave, Tcl_CreateAlias,and Tcl_MakeSafe,
-to provide C-level access to the interpreter facility. This mechanism
-now provides almost all of the generic functions of Borenstein's and
-Rose's Safe-Tcl (but not any Tk or email-related stuff). (JL)
-
-9/11/95 (feature change) Changed file management so that files are
-no longer shared between interpreters: a file cannot normally be
-referenced in one interpreter if it was opened in another. This
-feature is needed to support safe interpreters. Added Tcl_ShareHandle()
-procedure for allowing files to be shared, and added "interp" argument
-to Tcl_FilePermissions procedure. (JL)
-*** POTENTIAL INCOMPATIBILITY ***
+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.
-9/11/95 (new feature) Added "AssocData" mechanism, whereby extensions
-can associate their own data with an interpreter and get called back
-when the interpreter is deleted. This is visible at C level via the
-procedures Tcl_SetAssocData and Tcl_GetAssocData. (JL)
+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.
-9/11/95 (new feature) Added Tcl_ErrnoMsg to translate an errno value
-into a human-readable string. This is now used instead of calling
-strerror because strerror mesages vary dramatically from platform
-to platform, which messes up Tcl tests. Tcl_ErrnoMsg uses the standard
-POSIX messages for all the common signals, and calls strerror for
-signals it doesn't understand.
+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.
------------------ Released patch 7.4p2, 9/15/95 -----------------------
+6/28/95 (bug fix) Changed text widget so that you can't put the
+insertion cursor after the last newline in the text.
------------------ Released 7.5a1, 9/15/95 -----------------------
+6/28/95 (bug fix) Bitmap images didn't allow ~'s in file names.
-9/22/95 (bug fix) Changed auto_mkindex to create tclIndex files that
-handle directories whose paths might contain spaces. (RJ)
+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).
-9/27/95 (bug fix) The "format" command didn't check for huge or negative
-width specifiers, which could cause core dumps. (JO)
+6/28/95 (bug fix) Texts didn't handle indices with double negatives,
+such as ".t mark set insert {insert + -20 chars}".
-9/27/95 (bug fix) Core dumps could occur if an interactive command typed
-to tclsh returned a very long result for tclsh to print out. The bug is
-actually in printf (in Solaris 2.3 and 2.4, at least); switched to use
-puts instead. (JO)
+6/28/95 (bug fix) Fixed problem where focus didn't always revert to
+its prior window after a dialog box was dismissed.
-9/28/95 (bug fix) Changed makefile.bc to eliminate a false dependency
-for tcl1675.dll on the Borland run time library. (SS)
+6/28/95 (bug fix) Fixed problem with "search" widget command returning
+incorrect length on some backwards regexp searches.
-9/28/95 (bug fix) Fixed tcl75.dll so it looks for tcl1675.dll instead
-of tcl16.dll. (SS)
+6/28/95 (bug fix) Successive "wm iconbitmap . {}" commands could cause
+a core dump.
-9/28/95 (bug fix) Tcl was not correctly detecting the difference
-between Win32s and Windows '95. (SS)
+6/29/95 (new feature) Added -elementborderwidth option for scrollbars
+so the -borderwidth can be set to 0 without flattening the arrows and
+slider.
-9/28/95 (bug fix) "exec" was not passing environment changes to child
-processes under Windows. (SS)
+-------------------- Release 4.0, 7/1/95 -------------------------
-9/28/95 (bug fix) Changed Tcl to ensure that open files are not passed
-to child processes under Windows. (SS)
+7/18/95 (bug fix) %t in event bindings didn't work properly for some
+events (e.g. PropertyNotify).
-9/28/95 (bug fix) Fixed Windows '95 and NT versions of exec so it can
-handle both console and windows apps. (SS)
+7/18/95 (bug fix) Changed "exec wish" lines in demo scripts to
+"exec wish4.0" to avoid version conflicts.
-9/28/95 (bug fix) Fixed Windows version of exec so it no longer leaves
-temp files lying around. Also changed it so the temp files are
-created in the appropriate system dependent temp directory. (SS)
+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]".
-9/28/95 (bug fix) Eliminated source dependency on the Win32s Universal
-Thunk header file, since it is not bundled with VC++. (SS)
+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.
-9/28/95 (bug fix) Under Windows, Tcl now constructs the HOME
-environment variable from HOMEPATH and HOMEDRIVE when HOME is not
-already set. (SS)
+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.
-9/28/95 (bug fix) Added support for "info nameofexecutable" and "info
-sharedlibextension" to the Windows version. (SS)
+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).
-9/28/95 (bug fix) Changed tclsh to correctly parse command line
-arguments so that backslashes are preserved under Windows. (SS)
+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.
-9/29/95 (bug fix) Tcl 7.5a1 treated either return or newline as end
-of line in "gets", which caused lines ending in CRLF to be treated as
-two separate lines. Changed to allow only character as end-of-line:
-carriage return on Macs, newline elsewhere. (JO)
+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).
-9/29/95 (new feature) Changed to install "configInfo" file in same
-directory as library scripts. It didn't used to get installed. (JO)
+7/22/95 (bug fix) Text widgets didn't update their scrollbars when
+changes were made to information that was off-screen.
-9/29/95 (bug fix) Tcl was not converting Win32 errors into POSIX
-errors under some circumstances. (SS)
+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.
-10/2/95 (bug fix) Safe interpreters no longer get initialized with
-a call to Tcl_Init(). (JL)
+7/25/95 (bug fix) Page-up and page-down bindings for listboxes didn't
+move active element to remain on the screen.
-10/1/95 (new feature) Added "tcl_platform" global variable to provide
-environment information such as the instruction set and operating
-system. (JO)
+7/25/95 (bug fix) Patched around H-P compiler problem that results in
+core-dumps in tkImgPhoto.c during image handling.
-10/1/95 (bug fix) "exec" command wasn't always generating the
-"child process exited abnormally" message when it should have. (JO)
+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".
-10/2/95 (bug fix) Changed "mkLinks.tcl" so that the scripts it generates
-won't create links that overwrite original manual entries (there was
-a problem where pack-old.n was overwriting pack.n). (JO)
+7/26/95 (bug fix) The PPM image reader couldn't handle maximum intensity
+values other than 255.
-10/2/95 (feature change) Changed to use -ldl for dynamic loading under
-Linux if it is available, but fall back to -ldld if it isn't. (JO)
+7/26/95 (bug fix) Canvases didn't redraw their borders when the relief
+changed from raised to flat.
-10/2/95 (bug fix) File sharing was causing refcounts to reach 0
-prematurely for stdin, stdout and stderr, under some circumstances. (JL)
+7/27/95 (bug fix) Canvases didn't set the scrolling values correctly
+when no scroll region was specified.
-10/2/95 (platform support) Added support for Visual C++ compiler on
-Windows, Windows '95 and Windows NT, code donated by Gordon Chaffee. (JL)
+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.
-10/3/95 (bug fix) Tcl now frees any libraries that it loads before it
-exits. (SS)
+----------------- Released patch 4.0p1, 7/29/95 ----------------------
-10/03/95 (bug fix) Fixed bug in Macintosh ls command where the -l
-and -C options would fail in anything but the HOME directory. (RJ)
+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)
------------------ Released 7.5a2, 10/6/95 -----------------------
+8/14/95 (new feature) Added -tearoffcommand option for menus.
-10/10/95 (bug fix) "file dirnam /." was returning ":" on UNIX instead
-of "/". (JO)
+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)
-10/13/95 (bug fix) Eliminated dependency on MKS toolkit for generating
-the tcl.def file from Borland object files. (SS)
-
-10/17/95 (new features) Moved the event loop from Tcl to Tk, made major
-revisions along the way:
- - New Tcl commands: after, update, vwait (replaces "tkwait variable").
- - "tkerror" is now replaced with "bgerror".
- - The following procedures are similar to their old Tk counterparts:
- Tcl_DoOneEvent, Tcl_Sleep, Tcl_DoWhenIdle, Tcl_CancelIdleCall,
- Tcl_CreateFileHandler, Tcl_DeleteFileHandler, Tcl_CreateTimerHandler,
- Tcl_DeleteTimerHandler, Tcl_BackgroundError.
- - Revised notifier, add new concept of "event source" with the following
- procedures: Tcl_CreateEventSource, Tcl_DeleteEventSource,
- Tcl_WatchFile, Tcl_SetMaxBlockTime, Tcl_FileReady, Tcl_QueueEvent,
- Tcl_WaitForEvent. (JO)
-
-10/31/95 (new features) Implemented cross platform file name support to make
-it easier to write cross platform scripts. Tcl now understands 4 file naming
-conventions: Windows (both DOS and UNC), Mac, Unix, and Network. The network
-convention is a new naming mechanism that can be used to paths in a platform
-independent fashion. See the "file" command manual page for more details.
-The primary interfaces changes are:
- - All Tcl commands that expect a file name now accept both network and
- native form.
- - Two new "file" subcommands, "nativename" and "networkname", provide a
- way to convert between network and native form.
- - Renamed Tcl_TildeSubst to Tcl_TranslateFileName, and changed it so that
- it always returns a filename in native form. Tcl_TildeSubst is defined
- as a macro for backward compatibility, but it is deprecated. (SS)
-
-11/5/95 (new feature) Made "tkerror" and "bgerror" synonyms, so that
-either name can be used to manipulate the command (provides temporary
-backward compatibility for existing scripts that use tkerror). (JO)
-
-11/5/95 (new feature) Added exit handlers and new C procedures
-Tcl_CreateExitHandler, Tcl_DeleteExitHandler, and Tcl_Exit. (JO)
-
-11/6/95 (new feature) Added pid command for Macintosh version of
-Tcl (it didn't previously exist on the Mac). (RJ)
-
-11/7/95 (new feature) New generic IO facility and support for IO to
-files, pipes and sockets based on a common buffering scheme. Support
-for asynchronous (non-blocking) IO and for event driver IO. Support
-for automatic (background) asynchronous flushing and asynchronous
-closing of channels. (JL)
-
-11/7/95 (new feature) Added new commands "fconfigure" and "fblocked"
-to support new I/O features such as nonblocking I/O. Added "socket"
-command for creating TCP client and server sockets. (JL).
-
-11/7/95 (new feature) Complete set of C APIs to the new generic IO
-facility:
- - Opening channels: Tcl_OpenFileChannel, Tcl_OpenCommandChannel,
- Tcl_OpenTcpClient, Tcl_OpenTcpServer.
- - I/O procedures on channels, which roughly mirror the ANSI C stdio
- library: Tcl_Read, Tcl_Gets, Tcl_Write, Tcl_Flush, Tcl_Seek,
- Tcl_Tell, Tcl_Close, Tcl_Eof, Tcl_InputBlocked, Tcl_GetChannelOption,
- Tcl_SetChannelOption.
- - Extension mechanism for creating new kinds of channels:
- Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType,
- Tcl_GetChannelName, Tcl_GetChannelFile, Tcl_RegisterChannel,
- Tcl_UnregisterChannel, Tcl_GetChannel.
- - Event-driven I/O on channels: Tcl_CreateChannelHandler,
- Tcl_DeleteChannelHandler. (JL)
-
-11/7/95 (new feature) Channel driver interface specification to allow
-new types of channels to be added easily to Tcl. Currently being used
-in three drivers - for files, pipes and TCP-based sockets. (JL).
-
-11/7/95 (new feature) interp delete now takes any number of path
-names of interpreters to delete, including zero. (JL).
-
-11/8/95 (new feature) implemented 'info hostname' and Tcl_GetHostName
-command to get host name of machine on which the Tcl process is running. (JL)
-
-11/9/95 (new feature) Implemented file APIs for access to low level files
-on each system. The APIs are: Tcl_CloseFile, Tcl_OpenFile, Tcl_ReadFile,
-Tcl_WriteFile and Tcl_SeekFile. Also implemented Tcl_WaitPid which waits
-in a system dependent manner for a child process. (JL)
-
-11/9/95 (new feature) Added Tcl_UpdateLinkedVar procedure to force a
-Tcl variable to be updated after its C variable changes. (JO)
-
-11/9/95 (bug fix) The glob command has been totally reimplemented so
-that it can support different file name conventions. It now handles
-Windows file names (both UNC and drive-relative) properly. It also
-supports nested braces correctly now. (SS)
-
-11/13/95 (bug fix) Fixed Makefile.in so that configure can be run
-from a clean directory separate from the Tcl source tree, and compilations
-can be performed there. (JO)
-
-11/14/95 (bug fix) Fixed file sharing between interpreters and file
-transferring between interpreters to correctly manage the refcount so that
-files are closed when the last reference to them is discarded. (JL)
-
-11/14/95 (bug fix) Fixed gettimeofday implementation for the
-Macintosh. This fixes several timing related bugs. (RJ)
-
-11/17/95 (new feature) Added missing support for info nameofexecutable
-on the Macintosh. (RJ)
-
-11/17/95 (bug fix) The Tcl variables argc argv and argv0 now return
-something reasonable on the Mac. (RJ)
-
-11/22/95 (new feature) Implemented "auto-detect" mode for end of line
-translations. On input, standalone "\r" mean MAC mode, standalone "\n"
-mean Unix mode and "\r\n" means Windows mode. On output, the mode is
-modified to whatever the platform specific mode for that platform is. (JL)
-
-11/24/95 (feature change) Replaced "configInfo" file with tclConfig.sh,
-which is more complete and uses slightly different names. Also
-arranged for tclConfig.sh to be installed in the platform-specific
-library directory instead of Tcl's script library directory. (JO)
-*** POTENTIAL INCOMPATIBILITY with Tcl 7.5a2, but not with Tcl 7.4 ***
+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)
------------------ Released patch 7.4p3, 11/28/95 -----------------------
+8/21/95 (bug fixes) Fixed memory leaks in tkSend.c, tkSelect.c, and
+tkUnixWm.c (JO).
-12/5/95 (new feature) Added Tcl_File facility to support platform-
-independent file handles. Changed all interfaces that used Unix-
-style integer fd's to use Tcl_File's instead. (SS)
-*** POTENTIAL INCOMPATIBILITY ***
+8/21/95 (bug fix) Text widgets didn't handle commands like
+".t search -backwards foo end 1.0" properly: never found foo. (JO)
-12/5/95 (new feature) Added a new "clock" command to Tcl. The command
-allows you to get the current "clicks" or seconds & allows you to
-format or scan human readable time/date strings. (RJ)
+8/23/95 (new feature) Added Makefile and configure.in support for
+dynamic loading. (JO)
-12/18/95 (new feature) Moved Tk_Preserve, Tk_Release, and Tk_EventuallyFree
-to Tcl, renamed to Tcl_Preserve, Tcl_Release, and Tcl_EventuallyFree. (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)
-12/18/95 (new feature) Added new "package" command and associated
-procedures Tcl_PkgRequire and Tcl_PkgProvide. Also wrote
-pkg_mkIndex library procedure to create index files from binaries
-and scripts. (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)
-12/20/95 (new feature) Added Tcl_WaitForFile procedure. (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)
-12/21/95 (new features) Made package name argument to "load" optional
-(Tcl will now attempt to guess the package name if necessary). Also
-added Tcl_StaticPackage and support in "load" for statically linked
-packages. (JO)
+8/25/95 (bug fix) Scrollbar bindings didn't properly handle case where
+B2 is clicked while B1 is already down. (JO)
-12/22/95 (new feature) Upgraded the foreach command to accept multiple
-loop variables and multiple value lists. This lets you iterate over
-multiple lists in parallel, and/or assign multiple loop variables from
-one value list during each iteration. The only potential compatibility
-problem is with scripts that used loop variables with a name that could be
-construed to be a list of variable names (i.e. contained spaces). (BW)
+8/26/95 (bug fix) Menus were ignoring -activebackground if tk_strictMotif
+was set, but not -activeforeground. Changed to ignore both. (JO)
-1/5/96 (new feature) Changed tclsh so it builds as a console mode
-application under Windows. Now tclsh can be used from the command
-line with pipes or interactively. Note that this only works under
-Windows 95 or NT. (SS)
+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)
-1/17/96 (new feature) Modified Makefile and configure script to allow
-Tcl to be compiled as a shared library: use the --enable-shared option
-when configuing. (JO)
+8/28/95 (bug fix) Tcl errors were occurring for tkPriv(oldGrab) when
+clicking on a disabled option menu. (JO)
-1/17/96 (removed obsolete features) Removed the procedures Tcl_EnterFile
-and Tcl_GetOpenFile: these no longer make sense with the new I/O system. (JL)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-1/19/96 (bug fixes) Prevented formation of circular aliases, through the
-Tcl 'interp alias' command and through the 'rename' command, as well as
-through the C API Tcl_CreateAlias. (JL)
+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)
-1/19/96 (bug fixes) Fixed several bugs in direct deletion of interpreters
-with Tcl_DeleteInterp when the interpreter is a slave; fixes based on a
-patch received from Viktor Dukhovni of ESM. (JL)
+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)
-1/19/96 (new feature) Implemented on-close handlers for channels; added
-the C APIs Tcl_CreateCloseHandler and Tcl_DeleteCloseHandler. (JL)
+8/30/95 (bug fix) If there was extra space at the bottom of a menu,
+it wasn't being redisplayed properly.
-1/19/96 (new feature) Implemented portable error reporting mechanism; added
-the C APIs Tcl_SetErrno and Tcl_GetErrno. (JL)
+8/30/95 (new feature) Added -transient option to menus.
-1/24/96 (bug fix) Unknown command processing properly invokes external
-commands under Windows NT and Windows '95 now. (SS)
+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)
-1/23/96 (bug fix) Eliminated extremely long startup times under Windows '95.
-The problem was a result of the option database initialization code that
-concatenated $HOME with /.Xdefaults, resulting in a // in the middle of the
-file name. Under Windows '95, this is incorrectly interpreted as a UNC
-path. They delays came from the network timeouts needed to determine that
-the file name was invalid. Tcl_TranslateFileName now suppresses duplicate
-slashes that aren't at the beginning of the file name. (SS)
-
-1/25/96 (bug fix) Changed exec and open to create children so they are
-attached to the application's console if it exists. (SS)
+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)
-1/31/96 (bug fix) Fixed command line parsing to handle embedded
-spaces under Windows. (SS)
+8/30/95 (bug fix) Errors of the form `syntax error in expression "!"'
+could occasionally happen in tkScaleDrag. (JO)
------------------ Released 7.5b1, 2/1/96 -----------------------
+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)
-2/7/96 (bug fix) Fixed off by one error in argument parsing code under
-Windows. (SS)
+9/1/95 (new feature) Added "after info" command. Also added checks
+so that one interpreter can't cancel another's "after" events. (JO)
-2/7/96 (bug fix) Fixed bugs in VC++ makefile that improperly
-initialized the tcl75.dll. Fixed bugs in Borland makefile that caused
-build failures under Windows NT. (SS)
+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)
-2/9/96 (bug fix) Fixed deadlock problem in AUTO end of line translation
-mode which would cause a socket server with several concurrent clients
-writing in CRLF mode to hang. (JL)
+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 ***
-2/9/96 (API change) Replaced -linemode option to fconfigure with a
-new -buffering option, added "none" setting to enable immediate write. (JL)
-*** INCOMPATIBILITY with b1 ***
+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)
-2/9/96 (new feature) Added C API Tcl_InputBuffered which returns the count
-of bytes currently buffered in the input buffer of a channel, and o for
-output only channels. (JL)
+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 ***
-2/9/96 (new feature) Implemented asynchronous connect for sockets. (JL)
+9/11/95 (new feature) Added procedure Tk_PreserveColormap to increment
+the reference count on colormaps. Used in photo widgets. (SS)
-2/9/96 (new feature) Added C API Tcl_SetDefaultTranslation to set (per
-channel) the default end of line translation mode. This is the mode that
-will be installed if an output operation is done on the channel while it is
-still in AUTO mode. (JL)
+----------------- Released patch 4.0p2, 9/15/95 ----------------------
-2/9/96 (bug fix) Changed Tcl_OpenCommandChannel interface to properly
-handle all of the combinations of stdio inheritance in background
-pipelines. See the Tcl_OpenFileChannel(3) man page for more
-info. This change fixes the bug where exec of a background pipeline
-was not getting passed the stdio handles properly. (SS)
+----------------- Released 4.1a1, 9/15/95 ----------------------
-2/9/96 (bug fix) Removed the new Tcl_CreatePipeline interface, and
-restored the old version for Unix platforms only. All new code should
-use Tcl_CreateCommandChannel instead. (SS)
+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)
-2/9/96 (bug fix) Changed Makefile.in to use -L and -ltcl7.5 for Tcl
-library so that shared libraries are more likely to be found correctly
-on more platforms. (JO)
+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)
-2/13/96 (new feature) Added C API Tcl_SetNotifierData and
-Tcl_GetNotifierData to allow notifier and channel driver writers to
-associate data with a Tcl_File. The result of this change is that
-Tcl_GetFileInfo now always returns an OS file handle, and Tcl_GetFile
-can be used to construct a Tcl_File for an externally constructed OS
-handle. (SS)
+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)
-2/13/96 (bug fix) Changed Windows socket implementation so it doesn't
-set SO_REUSEADDR on server sockets. Now attempts to create a server
-socket on a port that is already in use will be properly identified
-and an error will be generated. (SS)
+9/25/95 (bug fix) Text widgets sometimes scrolled backwards on
+occasion if you dragged down past the bottom of the scrollbar. (JO)
-2/13/96 (bug fix) Fixed problems with DLL initialization under Visual
-C++ that left the C run time library uninitialized. (SS)
+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)
-2/13/96 (bug fix) Fixed Windows socket initialization so it loads
-winsock the first time it is used, rather than at the time tcl75.dll
-is loaded. This should fix the bug where the modem immediately starts
-trying to connect to a service provider when wish or tclsh are
-started. (SS)
+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)
-2/13/96 (new feature) Added C APIs Tcl_MakeFileChannel and
-Tcl_MakeTcpClientChannel to wrap up existing fds and sockets into
-channels. Provided implementations on Unix and Windows. (JL)
+9/25/95 (bug fix) Fixed core dump that could occur for radiobuttons
+and selectbuttons if -selectcolor was an empty string. (JO)
-2/13/96 (bug fix) Fixed bug with seek leaving EOF and BLOCKING set. (JL)
+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)
-2/14/96 (bug fix) Fixed reentrancy problem in fileevent handling
-and made it more robust in the face of errors. (JL)
+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)
-2/14/96 (feature change) Made generic IO level emulate blocking mode if the
-channel driver is unable to provide it, e.g. if the low level device is
-always nonblocking. Thus, now blocking behavior is an advisory setting for
-channel drivers and can be ignored safely if the channel driver is unable
-to provide it. (JL)
+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)
-2/15/96 (new feature) Added "binary" end of line translation mode, which is
-a synonym of "lf" mode. (JL)
+9/26/95 (bug fix) Wish couldn't handle script files with spaces in
+their names. (JO)
-2/15/96 (bug fix) Fixed reentrancy problem in fileevent handling vs
-deletion of channel event handlers. (JL)
+9/27/95 (cosmetic clean-up) Removed extraneous spaces to make error
+messages consistent: ": should be" is now ": should be". (JO)
-2/15/96 (bug fix) Fixed bug in event handling which would cause a
-nonblocking channel to not see further readable events after the first
-readable event that had insufficient input. (JL)
+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)
-2/17/96 (bug fix) "info complete" didn't properly handle comments
-in nested commands. (JO)
+9/28/95 (bug fix) Wish incorrectly parsed the command line under
+Windows, causing backslashes to be substituted. (SS)
-2/21/96 (bug fix) "exec" under Windows NT/95 did not properly handle
-very long command lines (>200 chars). (SS)
+9/28/95 (bug fix) Wish now sources wishrc.tcl instead of .wishrc. (SS)
-2/21/96 (bug fix) Sockets could get into an infinite loop if a read
-event arrived after all of the available data had been read. (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)
-2/22/96 (bug fix) Added cast of st_size elements to (long) before
-sprintf-ing in "file size" command. This is needed to handle systems
-like NetBSD with 64-bit file offsets. (JO)
+9/29/95 (bug fix) "winfo interps" caused a crash under Windows. (SS)
------------------ Released 7.5b2, 2/23/96 -----------------------
+10/1/95 (feature change) Eliminated Tk_NotifyIdle interface in favor of
+Tk_IdlePending. (SS)
-2/23/96 (bug fix) TCL_VARARGS macro in tcl.h wasn't defined properly
-when compiling with C++. (JO)
+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)
-2/24/96 (bug fix) Removed dependencies on Makefile in the UNIX Makefile:
-this caused problems on some platforms (like Linux?). (JO)
+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)
-2/24/96 (bug fix) Fixed configuration bug that made Tcl not compile
-correctly on Linux machines with neither -ldl or -ldld. (JO)
+10/2/95 (bug fix) Tk was improperly handling Enter/Leave events
+during a button grab. (SS)
-2/24/96 (new feature) Added a block of comments and definitions to
-Makefile.in to make it easier to have Tcl's TclSetEnv etc. replace
-the library procedures setenv etc, so that calls to setenv etc. in
-the application automatically update the Tcl "env" variable. (JO)
+10/2/95 (new feature) Added support for the Macintosh do script
+('dosc') event. Available only on the Macintosh. (RJ)
-2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL)
-to C API Tcl_Close and simplified closing of command channels. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+10/4/95 (new feature) Added support for compiling with VC++.
+Resulting binaries work under Win32s through NT.
-2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL)
-to C type definition Tcl_DriverCloseProc; modified all channel drivers to
-implement close procedures that accept the additional argument. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+----------------- Released 4.1a2, 10/6/95 ----------------------
-2/28/96 (bug fix) Fixed memory leak that could occur if an upvar
-referred to an element of an array in the same stack frame as the
-upvar. (JO)
+10/10/95 (new feature) Macintosh Tk now supports the complete set
+of X cursors that Unix Tk supports. (RJ)
-2/29/96 (feature change) Modified both Tcl_DoOneEvent and Tcl_WaitForEvent
-so that they return immediately in cases where they would otherwise
-block forever (e.g. if there are no event handlers of any sort). (JO)
+10/11/95 (bug fix) Tk now supports all of the X11 cursors under
+Windows. (SS)
-2/29/96 (new feature) Added C APIs Tcl_GetChannelBufferSize and
-Tcl_SetChannelBufferSize to set and retrieve the size, in bytes, for
-buffers allocated to store input or output in a channel. (JL)
+10/11/95 (bug fix) The "wm resizable" command was missing from the
+Windows version of Tk. (SS)
-2/29/96 (new feature) Added option -buffersize to Tcl fconfigure command
-to allow Tcl scripts to query and set the size of channel buffers. (JL)
+10/12/95 (bug fix) Macintosh Tk had problems with clipping toplevel
+windows that children of any frame other than another toplevel. (RJ)
-2/29/96 (feature removed) Removed channel driver function to specify
-the buffer size to use when allocating a buffer. Removed the C typedef
-for Tcl_DriverBufferSizeProc. Channels are now created with a default
-buffer size of 4K. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+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 ***
-2/29/96 (feature change) The channel driver function for setting blocking
-mode on the device may now be NULL. If the generic code detects that the
-function is NULL, operations that set the blocking mode on the channel
-simply succeed. (JL)
+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)
-3/2/96 (bug fix) Fixed core dump that could occur if a syntax error
-(such as missing close paren) occurred in an array reference with a
-very long array name. (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)
-3/4/96 (bug fix) Removed code in the "auto_load" procedure that deletes
-all existing auto-load information whenever the "auto_path" variable
-is changed. Instead, new information adds to what was already there.
-Otherwise, changing the "auto_path" variable causes all package-
-related information to be lost. If you really want to get rid of
-existing auto-load information, use auto_reset before setting auto_path. (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)
-3/5/96 (new feature) Added version suffix to shared library names so that
-Tcl will compile under NetBSD and FreeBSD (I hope). (JO)
+11/9/95 (bug fix) The "send" command crashed if you tried to send to
+a different display with "-displayof". (JO)
-3/6/96 (bug fix) Cleaned up error messages in new I/O system to correspond
-more closely to old I/O system. (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)
-3/6/96 (new feature) Added -myaddr and -myport options to the socket
-command, removed -tcp and -- options. This lets clients and servers
-choose a particular interface. Also changed the default server address
-from the hostname to INADDR_ANY. The server accept callback now gets
-passed the client's port as well as IP address. The C interfaces for
-Tcl_OpenTcpClient and Tcl_OpenTcpServer have changed to support the
-above changes. (BW)
-*** POTENTIAL INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+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)
-3/6/96 (changed feature) The library function auto_mkindex will now
-default to using the pattern "*.tcl" if no pattern is given. (RJ)
+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)
-3/6/96 (bug fix) The socket channel code for the Macintosh has been
-rewritten to use native MacTcp. (RJ)
+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).
-3/7/96 (new feature) Added Tcl_SetStdChannel and Tcl_GetStdChannel
-interfaces to allow applications to explicitly set and get the global
-standard channels. (SS)
+11/19/95 (bug fix) The focus wasn't being restored properly after a
+menu selection in a cascaded menu. (JO)
-3/7/96 (bug fix) Tcl did close not the file descriptors associated
-with "stdout", etc. when the corresponding channels were closed. (SS)
+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)
-3/7/96 (bug fix) Reworked shared library and dynamic loading stuff to
-try to get it working under AIX. Added new @SHLIB_LD_LIBS@ autoconf
-symbol as part of this. AIX probably doesn't work yet, but it should
-be a lot closer. (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)
-3/7/96 (feature change) Added Tcl_ChannelProc typedef and changed the
-signature of Tcl_CreateChannelHandler and Tcl_DeleteChannelHandler to take
-Tcl_ChannelProc arguments instead of Tcl_FileProc arguments. This change
-should not affect any code outside Tcl because the signatures of
-Tcl_ChannelProc and Tcl_FileProc are compatible. (JL)
+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)
-3/7/96 (API change) Modified signature of Tcl_GetChannelOption to return
-an int instead of char *, and to take a Tcl_DString * argument. Modified
-the implementation so that the option name can be NULL, to mean that the
-call should retrieve a list of alternating option names and values. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+11/22/95 (bug fix) Space and return keys didn't work for menus if
+they were posted via Alt-x keystrokes. (JO)
-3/7/96 (API change) Added Tcl_DriverSetOptionProc, Tcl_DriverGetOptionProc
-typedefs, added two slots setOptionProc and getOptionProc to the channel
-type structure. These may be NULL to indicate that the channel type does
-not support any options. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+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)
-3/7/96 (feature change) stdin, stdout and stderr can now be put into
-nonblocking mode. (JL)
+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)
-3/8/96 (feature change) Eliminated dependence on the registry for
-finding the Tcl library files. (SS)
+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 ***
------------------ Released 7.5b3, 3/8/96 -----------------------
+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)
-3/12/96 (feature improvement) Modified startup script to look in several
-different places for the Tcl library directory. This should allow Tcl
-to find the libraries under all but the weirdest conditions, even without
-the TCL_LIBRARY environment variable being set. (JO)
+12/23/95 (new features) Added support for -colormap and -visual command-
+line options for wish. (JO)
-3/13/96 (bug fix) Eliminated use of the "linger" option from the Windows
-socket implementation. (JL)
+1/4/95 (bug fix) Fixed keyboard code to properly handle alt-key
+sequences for international keyboards and menu-accelerators. (SS)
-3/13/96 (new feature) Added -peername and -sockname options for fconfigure
-for socket channels. Code contributed by John Haxby of HP. (JL)
+1/5/96 (bug fix) Scrollbar code sometimes generated errors on accesses
+to tkPriv(relief) during control-clicks. (JO)
-3/13/96 (bug fix) Fixed panic and core dump that would occur if the accept
-callback script on a server socket encountered an error. (JL)
+1/9/96 (new feature) added the "grid" command to provide a table based
+geometry manager. (SU)
-3/13/96 (feature change) Added -async option to the Tcl socket command.
-If the command is creating a client socket and the flag is present, the
-client is connected asynchronously. If the option is absent (the default),
-the client socket is connected synchronously, and the command returns only
-when the connection has been completed or failed. This change was suggested
-by Mark Diekhans. (JL)
+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)
-3/13/96 (feature change) Modified the signature of Tcl_OpenTcpClient to
-take an additional int argument, async. If nonzero, the client is connected
-to the server asynchronously. If the value is zero, the connection is made
-synchronously, and the call to Tcl_OpenTcpClient returns only when the
-connection fails or succeeds. This change was suggested by Mark Diekhans. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
+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)
-3/14/96 (bug fix) "tclsh bogus_file_name" didn't print an error message. (JO)
+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)
-3/14/96 (bug fix) Added new procedures to tclCkalloc.c so that libraries
-and applications can be compiled with TCL_MEM_DEBUG even if Tcl isn't
-(however, the converse is still not true). Patches provided by Jan
-Nijtmans. (JO)
+1/12/96 (new feature) added the text "tag prevrange" operation to search
+backwards for the current or previous range of a tag. (BW)
-3/15/96 (bug fix) Marked standard IO handles of a process as close-on-exec
-to fix bug in Ultrix where exec was not sharing standard IO handles with
-subprocesses. Fix suggested by Mark Diekhans. (JL)
+1/16/96 (new feature) Added support for relative widget placement on
+the "grid" command. (SU)
-3/15/96 (bug fix) Fixed asynchronous close mechanism so that it closes the
-channel instead of leaking system resources. The manifestation was that Tcl
-would eventually run out of file descriptors if it was handling a large
-number of nonblocking sockets or pipes with high congestion. (JL)
+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)
-3/15/96 (bug fix) Fixed tests so that they no longer leak file descriptors.
-The manifestation was that Tcl would eventually run out of file descriptors
-if the tests were rerun many times (> a hundred times on Solaris). (JL)
+----------------- Released 4.1b1, 1/26/96 -----------------------
-3/15/96 (bug fix) Fixed channel creation code so that it never creates
-unnamed channels. This would cause a panic and core dump when the channel
-was closed. (JL)
+2/2/96 (bug fix) Frames were getting a default size of 200x200, whereas
+there should be no default. (JO)
-3/16/96 (bug fixes) Made lots of changes in configuration stuff to get
-Tcl working under AIX (finally). Tcl should now support the "load"
-command under AIX and should work either with or without shared
-libraries for Tcl and Tk. (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)
-3/21/96 (configuration improvement) Changed configure script so it
-doesn't use version numbers (as in -ltcl7.5 and libtcl7.5.so) under
-SunOS 4.1, where they don't work anyway. (JO)
+2/6/96 (bug fix) Fixed off by one error in argument parsing code under
+Windows. (SS)
-3/22/96 (new feature) Added C API Tcl_InterpDeleted that allows extension
-writers to discover when an interpreter is being deleted. (JL)
-
-3/22/96 (bug fix) The standard IO channels are now added to each
-trusted interpreter as soon as the interpreter is created. This ensures
-against the bug where a child would do IO before the master had done any,
-and then the child is destroyed - the standard IO channels would be then
-closed and the master would be unable to do any IO. (JL)
-
-3/22/96 (bug fix) Made Tcl more robust against interpreter deletion, by
-using Tcl_Preserve, Tcl_Release and Tcl_EventuallyFree to split the process
-of interpreter deletion into two distinct phases. Also went through all of
-Tcl and added calls to Tcl_Preserve and Tcl_Delete where needed. (JL)
-
-3/22/96 (bug fix) Fixed several places where C code was reading and writing
-into freed memory, especially during interpreter deletion. (JL)
-
-3/22/96 (bug fix) Fixed very deep bug in Tcl_Release that caused memory to
-be freed twice if the release callback did Tcl_Preserve and Tcl_Release on
-the same memory as the chunk currently being freed. (JL)
-
-3/22/96 (bug fix) Removed several memory leaks that would cause memory
-buildup on half-K chunks in the generic IO level. (JL)
-
-3/22/96 (bug fix) Fixed several core dumps which occurred when new
-AssocData was being created during the cleanups in interpreter deletion.
-The solution implemented now is to loop repeatedly over the AssocData until
-none is left to clean up. (JL)
-
-3/22/96 (bug fix) Fixed a bug in event handling which caused an infinite
-loop if there were no files being watched and no timer. Fix suggested by
-Jan Nijtmans. (JL)
-
-3/22/96 (bug fix) Fixed Tcl_CreateCommand, Tcl_DeleteCommand to be more
-robust if the interpreter is being deleted. Also fixed several order
-dependency bugs in Tcl_DeleteCommand which kicked in when an interpreter
-was being deleted. (JL)
-
-3/26/96 (bug fix) Upon a "short read", the generic code no longer calls
-the driver for more input. Doing this caused blocking on some platforms
-even on nonblocking channels. Bug and fix courtesy Mark Roseman. (JL)
-
-3/26/96 (new feature) Added 'package Tcltest' which is present only in
-test versions of Tcl; this allows the testing commands to be loaded into
-new interpreters besides the main one. (JL)
-
-3/26/96 (restored feature) Recreated the Tcl_GetOpenFile C API. You can
-now get a FILE * from a registered channel; Unix only. (JL)
-
-3/27/96 (bug fix) The regular expression code did not support more
-than 9 subexpressions. It now supports up to 20. (SS)
-
-4/1/96 (bug fixes) The CHANNEL_BLOCKED bit was being left on on a short
-read, so that fileevents wouldn't fire correctly. Bug reported by Mark
-Roseman.(JL, RJ)
-
-4/1/96 (bug fix) Moved Tcl_Release to match Tcl_Preserve exactly, in
-tclInterp.c; previously interpreters were being freed only conditionally
-and sometimes not at all. (JL)
-
-4/1/96 (bug fix) Fixed error reporting in slave interpreters when the
-error message was being generated directly by C code. Fix suggested by
-Viktor Dukhovni of ESM. (JL)
-
-4/2/96 (bug fixes) Fixed a series of bugs in Windows sockets that caused
-events to variously get lost, to get sent multiple times, or to be ignored
-by the driver. The manifestation was blocking if the channel is blocking,
-and either getting EAGAIN or infinite loops if the channel is nonblocking.
-This series of bugs was found by Ian Wallis of Cisco. Now all tests (also
-those that were previously commented out) in socket.test pass. (JL, SS)
-
-4/2/96 (feature change/bug fix) Eliminated network name support in
-favor of better native name support. Added "file split", "file join",
-and "file pathtype" commands. See the "file" man page for more
-details. (SS)
-*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
-
-4/2/96 (bug fix) Changed implementation of auto_mkindex so tclIndex
-files will properly handle path names in a cross platform context. (SS)
-
-4/5/96 (bug fix) Fixed Tcl_ReadCmd to use the channel buffer size as the
-chunk size it reads, instead of a fixed 4K size. Thus, on large reads, the
-user can set the channel buffer size to a large size and the read will
-occur orders of magnitude faster. For example, on a 2MB file, reading in 4K
-chunks took 34 seconds, while reading in 1MB chunks took 1.5 seconds (on a
-SS-20). Problem identified and fix suggested by John Haxby of HP. (JL)
-
-4/5/96 (bug fix) Fixed socket creation code to invoke gethostbyname only if
-inet_addr failed (very unlikely). Before this change the order was reversed
-and this made things much slower than they needed to be (gethostbyname
-generally requires an RPC, which is slow). Problem identified and fix
-suggested by John Loverso of OSF. (JL)
-
-4/9/96 (feature change) Modified "auto" translation mode so that it
-recognizes any of "\n", "\r" and "\r\n" in input as end of line, so
-that a file can have mixed end-of-line sequences. It now outputs
-the platform specific end of line sequence on each platform for files and
-pipes, and for sockets it produces crlf in output on all platforms. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
-
-4/11/96 (new feature) Added -eofchar option to Tcl_SetChannelOption to allow
-setting of an end of file character for input and output. If an input eof
-char is set, it is recognized as EOF and further input from the channel is
-not presented to the caller. If an output eof char is set, on output, that
-byte is appended to the channel when it is closed. On Unix and Macintosh,
-all channels start with no eof char set for input or output. On Windows,
-files and pipes start with input and output eof chars set to Crlt-Z (ascii
-26), and sockets start with no input or output eof char. (JL)
-*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
-
-4/17/96 (bug fix) Fixed series of bugs with handling of crlf sequence split
-across buffer boundaries in input, in AUTO mode. (JL, BW)
-
-4/17/96 (test suite improvement) Fixed test suite so that tests that
-depend on the availability of Unix commands such as echo, cat and others
-are not run if these commands are not present. (JL)
-
-4/17/96 (test suite improvement) The socket test now automatically starts,
-on platformst that support exec, a separate process for remote testsing. (JL)
-
------------------ Released 7.5, 4/21/96 -----------------------
-
-5/1/96 (bug fix) "file tail ~" did not correctly return the tail
-portion of the user's home directory. (SS)
-
-5/1/96 (bug fix) Fixed bug in TclGetEnv where it didn't lookup environment
-variables correctly: could confuse "H" and "HOME", for example. (JO)
-
-5/1/96 (bug fix) Changed to install tclConfig.sh under "make install-binaries",
-not "make install-libraries". (JO)
-
-5/2/96 (bug fix) Changed pkg_mkIndex not to attempt to "load" a file unless
-it has the standard shared library extension. On SunOS, attempts to load
-Tcl scripts cause the whole application to be aborted (there's no way to
-get the error back into Tcl). (JO)
-
-5/7/96 (bug fix) Moved initScript in tclUnixInit.c to writable memory to
-avoid potential core dumps. (JO)
+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)
-5/7/96 (bug fix) Auto_reset procedure was removing procedure from init.tcl,
-such as pkg_mkIndex. (JO)
-
-5/7/96 (bug fix) Fixed cast on socket address resolution code that
-would cause a failure to connect on Dec Alphas. (JL)
-
-5/7/96 (bug fix) Added "time", "subst" and "fileevent" commands to set of
-commands available in a safe interpreter. (JL)
-
-5/13/96 (bug fix) Preventing OS level handles for stdin, stdout and stderr
-from being implicitly closed when the last reference to the standard
-channel containing that handle is discarded when an interpreter is deleted.
-Explicitly closing standard channels by using "close" still works. (JL)
-
-5/21/96 (bug fix) Do not create channels for stdin, stdout and stderr on
-Unix if the devices are closed. This prevents a duplicate channel name
-panic later on when the fd is used to open a channel and the channel is
-registered in an interpreter. (JL)
-
-5/23/96 (bug fix) Fixed bug that prevented the use of standard channels in
-interpreters created after the last interpreter was destroyed. In the sequence
-
- interp = Tcl_CreateInterp();
- Tcl_DeleteInterp(interp);
- interp = Tcl_CreateInterp();
-
-channels for stdio would not be available in the second interpreter. (JL)
-
-5/23/96 (bug fix) Fixed bug that allowed Tcl_MakeFileChannel to create new
-channels with Tcl_Files in them that are already used by another channel.
-This would cause core dumps when the Tcl_Files were being freed twice. (JL)
-
-5/23/96 (bug fix) Fixed a logical timing bug that caused a standard channel
-to be removed from the standard channel table too early when the channel
-was being closed. If the channel was being flushed asynchronously, it could
-get recreated before being actually destroyed, and the recreated channel
-would contain the same Tcl_File as the one being closed, leading to
-dangling pointers and core dumps. (JL)
-
-5/27/96 (bug fix) Fixed a bug in Tcl_GetChannelOption which caused it to
-always return a list of one element, a list of the settings, for
--translation and -eofchar options. Now correctly returns the value
-described by the documentation (Mark Diekhans found this, thanks!). (JL)
-
-5/30/96 (bug fix) Fixed a couple of syntax errors in io.test. (JL)
-
-5/30/96 (bug fix) If a fileevent scripts gets an error, delete it before
-causing a background error. This is to allow the error handler to reinstall
-the fileevent and to prevent infinite loops if the event loop is reentered
-in the error handler. (JL)
-
-5/31/96 (bug fix) Channels now will get properly flushed on exit. (JL)
-
-6/5/96 (bug fix) Changed Tcl_Ckalloc, Tcl_Ckfree, and Tcl_Ckrealloc to
-Tcl_Alloc, Tcl_Free, and Tcl_Realloc. Added documentation for these
-routines now that they are officially supported. Extension writers
-should use these routines instead of free() and malloc(). (SS)
-
-6/10/96 (bug fix) Changes the Tcl close command so that it no longer
-waits on nonblocking pipes for the piped processes to exit; instead it
-reaps them in the background. (JL)
-
-6/11/96 (bug fix) Increased the length of the listen queue for server
-sockets on Unix from 5 to 100. Some OSes will disregard this and reset it
-to 5, but we should try to get as long a queue as we can, for performance
-reasons. (JL)
-
-6/11/96 (bug fix) Fixed windows sockets bug that caused a cascade of events
-if the fileevent script read less than was available. Now reading less than
-is available does not cause a flood of Tcl events. (JL, SS)
-
-6/11/96 (bug fix) Fixed bug in background flushing on closed channels that
-would prevent the last buffer from getting flushed. (JL)
-
-6/13/96 (bug fix) Fixed bug in Windows sockets that caused a core dump if
-a DLL linked with tcl.dll and referred to e.g. ntohs() without opening a
-Tcl socket. The problem was that the indirection table was not being
-initialized. (JL)
-
-6/13/96 (bug fix) Fixed OS level resource leak that would occur when a
-Tcl channel was still registered in some interpreter when the process
-exits. Previously the channel was not being closed and the OS level handles
-were not being released; the output was being flushed but the device was
-not being closed. Now the device is properly closed. This was only a
-problem on Win3.1 and MacOS. (JL, SS)
-
-6/28/96 (bug fix) Fixed bug where transient errors were leaving an error
-code around, so that it would erroneously get reported later. This bug was
-exercised intermittently by closing a channel to a file on a very loaded
-NFS server, or to a socket whose other end blocked. (JL, BW)
-
-7/3/96 (bug fix) Fileevents declared in an interpreter are now deleted
-when the channel is closed in that interpreter. Before this fix, the
-fileevent would hang around until the channel is completely closed, and
-would cause errors if events happened before the channel was closed. This
-could happen in two cases: first if the channel is shared between several
-interpreters, and second if an async flush is in progress that prevents the
-channel from being closed until the flush finishes. (JL)
-
-7/10/96 (bug fix) Fixed bugs in both "lrange" and "lreplace" commands
-where too much white space was being removed. For example, the command
- lreplace {\}\ hello} end end
-was returning "\}\", losing the significant space in the first list
-element and corrupting the list. (JO)
-
-7/20/96 (bug fix) The procedure pkg_mkIndex didn't work properly for
-extensions that depend on Tk, because it didn't load Tk into the child
-interpreter before loading the extension. Now it loads Tk if Tk is
-present in the parent. (JO)
-
-7/23/96 (bug fix) Added compat version of strftime to fix crashes
-resulting from bad implementations under Windows. (SS)
-
-7/23/96 (bug fix) Standard implementations of gmtime() and localtime()
-under Windows did not handle dates before 1970, so they were replaced
-with a revised implementation. (SS)
-
-7/23/96 (bug fix) Tcl would crash on exit under Borland 5.0 because
-the global environ pointer was left pointing to freed memory. (SS)
-
-7/29/96 (bug fix) Fixed memory leak in Tcl_LoadCmd that could occur if
-a package's AppInit procedure called Tcl_StaticPackage to register
-static packages. (JO)
-
-8/1/96 (bug fix) Fixed a series of bugs in Windows sockets so that async
-writebehind in the presence of read event handlers now works, and so that
-async writebehind also works on sockets for which a read event handler was
-declared and whose channels were then closed before the async write
-finished. The bug was reported by John Loverso and Steven Wahl,
-independently, test case supplied by John Loverso. (JL)
-
------------------ Released patch 7.5p1, 8/2/96 -----------------------
-
-5/8/96 (new feature) Added Tcl_GetChannelMode C API for retrieving whether
-a channel is open for reading and writing. (JL)
-
-5/8/96 (API changes) Revised C APIs for channel drivers:
- - Removed all Tcl_Files from channel driver interface; you can now have
- channels that are not based on Tcl_Files.
- - Added channelReadyProc and watchChannelProc procedures to interface;
- these are used to implement event notification for channels.
- - Added getFileProc to channel driver, to allow the generic IO code
- to retrieve a Tcl_File from a channel (presumably if the channel
- uses Tcl_Files they will be stored inside its instanceData). (JL)
-*** INCOMPATIBILITY with Tcl 7.5 ***
-
-5/8/96 (API change) The Tcl_CreateChannel C API was modified to not take
-Tcl_File arguments, and instead to take a mask specifying whether the
-channel is readable and/or writable. (JL)
-*** INCOMPATIBILITY with Tcl 7.5 ***
-
-6/3/96 (bug fix) Made Tcl_SetVar2 robust against the case where the value
-of the variable is a NULL pointer instead of "". (JL)
-
-6/17/96 (bug fix) Fixed "reading uninitialized memory" error reported by
-Purify, in Tcl_Preserve/Tcl_Release. (JL)
-
-8/9/96 (bug fix) Fixed bug in init.tcl that caused incorrect error message
-if the act of autoloading a procedure caused the procedure to be invoked
-again. (JO)
-
-8/9/96 (bug fix) Configure script produced bad library names and extensions
-under SunOS and a few other platforms if the --disable-load switch was used.
-(JO)
+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)
-8/9/96 (bug fix) Tcl_UpdateLinkedVar generated an error if the variable
-being updated was read-only. (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 ***
-8/14/96 (bug fix) The macintosh now supports synchronous socket
-connections. Other minor bugs were also fixed. (RJ)
+2/14/96 (bug fix) "winfo pointerxy" when applied to a non-toplevel window
+crashed wish. (SS)
-8/15/96 (configuration improvement) Changed the file patchlevel.h
-to be tclPatch.h. This avoids conflict with the Tk file and is now
-in 8.3 format on the Windows platform. (RJ)
+2/14/96 (bug fix) "tkwait visibility" would hang under Windows. (SS)
-8/20/96 (bug fix) Fixed core dump in interp alias command for interpreters
-created with Tcl_CreateInterp (as opposed to with Tcl_CreateSlave). (JL)
-
-8/20/96 (bug fix) No longer masking ECONNRESET on Windows sockets so
-that the higher level of the IO mechanism sees the error instead of
-entering an infinite loop. (JL)
-
-8/20/96 (bug fix) Destroying the last interpreter no longer closes the
-standard channels. (JL)
-
-8/20/96 (bug fix) Closing one of the stdin, stdout or stderr channels and
-then opening a new channel now correctly assigns the new channel as the
-standard channel that was closed. (JL)
-
-8/20/96 (bug fix) Added code to unix/tclUnixChan.c for using ioctl with
-FIONBIO instead of fcntl with O_NONBLOCK, for those versions of Unix where
-either O_NONBLOCK is not supported or implemented incorrectly. (JL)
-
-8/21/96 (bug fix) Fixed "file extension" so it correctly returns the
-extension on files like "foo..c" as "..c" instead of ".c". (SS)
-
-8/22/96 (bug fix) If environ[] contains static strings, Tcl would core
-dump in TclSetupEnv because it was trying to write NULLs into the actual
-data in environ[]. Now we instead copy as appropriate. (JL)
-
-8/22/96 (added impl) Added missing implementation of Tcl_MakeTcpClientChannel
-for Windows platform. Code contributed by Mark Diekhans. (JL)
-
-8/22/96 (new feature) Added a new memory allocator for the Macintosh
-version of Tcl. It's quite a bit faster than MetroWerk's version. (RJ)
-
-8/26/96 (documentation update) Removed old change bars (for all changes
-in Tcl 7.5 and earlier releases) from manual entries. (JO)
-
-8/27/96 (enhancement) The exec and open commands behave better and work in
-more situations under Windows NT and Windows 95. Documentation describes
-what is still lacking. (CS)
-
-8/27/96 (enhancement) The Windows makefiles will now compile even if the
-compiler is not in the path and/or the compiler's environment variables
-have not been set up. (CS)
-
-8/27/96 (configuration improvement) The Windows resource files are
-automatically updated when the version/patch level changes. The header file
-now has a comment that reminds the user which other files must be manually
-updated when the version/patch level changes. (CS)
-
-8/28/96 (new feature) Added file manipulation features (copy, rename, delete,
-mkdir) that are supported on all platforms. They are implemented as
-subcommands to the "file" command. See the documentation for the "file"
-command for more information. (JH)
-
------------------ Released 7.6b1, 8/30/96 -----------------------
-
-9/3/96 (bug fix) Simplified code so that standard channels are created
-lazily, they are added to an interpreter lazily, and they are never added
-to a safe interpreter. (JL)
-
-9/3/96 (bug fix) Closing a channel after closing a standard channel, e.g.
-stdout, would cause the implicit recreation of that standard channel. (JL)
-
-9/3/96 (new feature) Now calling Tcl_RegisterChannel with a NULL
-interpreter increments the refcount so that code outside any interpreter
-can use channels that are also registered in interpreters, without worrying
-that the channel may turn into a dangling pointer at any time. Calling
-Tcl_UnregisterChannel with a NULL interpreter only decrements the recount
-so that code outside any interpreter can safely declare it is no longer
-interested in a channel. (JL)
-
-9/4/96 (new features) Two changes to dynamic loading:
- - If the file name is empty in the "load" command and there is no
- statically loaded version of the package, a dynamically loaded
- version will be used if there is one.
- - Tcl_StaticPackage ignores redundant calls for the same package. (JO)
-
-9/6/96 (bug fix) Platform specific procedures for manipulating files are
-no longer macros and have been prefixed with "Tclp", such as TclpRenameFile.
-Unix file code now handles symbolic links and other special files correctly.
-The semantics of file copy and file rename has been changed so that if
-a target directory exists, the source files will NOT be merged with the
-existing files. (JH)
-
-9/6/96 (bug fix) If standard channel is NULL, because Tcl cannot connect
-to the standard channel, do not increment the refcount. The channel can
-be NULL if there is for example no standard input. (JL)
-
-9/6/96 (portability improvement) Changed parsing of backslash sequences
-like \n to translate directly to absolute values like 0xa instead of
-letting the compiler do the translation. This guarantees that the
-translation is done the same everywhere. (JO)
-
-9/9/96 (bug fix) If channel is opened and not associated with any
-interpreter, but Tcl decides to use it as one of the standard channels, it
-became impossible to close the channel with Tcl_Close -- instead you had
-to call Tcl_UnregisterChannel. Fixed now so that it's safe to call
-Tcl_Close even when Tcl is using the channel as one of the standard ones. (JL)
-
-9/11/96 (feature change) The Tcl library is now placed in the Tcl
-shared libraries resource. You no longer need to place the Tcl files
-in your applications explicitly. (RJ)
-
-9/11/96 (feature change) Extensions no longer automatically have the
-resource fork of the extension opened for it. Instead you need to
-use the tclMacLibrary.c file in your extension. (RJ)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-9/12/96 (bug fix) The extension loading mechanism on the Macintosh now
-looks at the 'cfrg' resource to determine where to load the code
-fragment from. This means FAT fragments should now work. (RJ)
-
-9/18/96 (enhancement) The exec and open commands behave better and work in
-more situations under Windows 3.X. Documentation describes what is still
-lacking. (CS)
-
-9/19/96 (bug fix) Fixed a panic which would occur if you delete a
-non-existent alias before any aliases are created. Now instead correctly
-returns an error that the alias is not found. (JL)
-
-9/19/96 (bug fix) Slave interpreters could rename aliases and they would
-not get deleted when the alias was being redefined. This led to dangling
-pointers etc. (JL)
-
-9/19/96 (bug fix) Fixed a panic where a hash table entry was being deleted
-twice during alias management operations. (JL)
-
-9/19/96 (bug fix) Fixed bug in event loop that could cause the input focus
-in Tk to get confused during menu traversal, among other problems. The
-problem was related to handling of the "marker" when its event was
-deleted. (JO)
-
-9/26/96 (bug fix) Windows was losing EOF on a socket if the FD_CLOSE event
-happened to precede any left over FD_READ events. Now correctly remembers
-seeing FD_CLOSE, so that trailing FD_READ events are not discarded if they
-do not contain any data. This allows Tcl to correctly get a zero read and
-notice EOF. (JL)
-
-9/26/96 (bug fix) Was not resetting READABLE state properly on sockets
-under Windows if the driver discarded an FD_READ event because no data was
-present. Now correctly resets the state. (JL)
-
-9/30/96 (bug fix) Made EOF sticky on Windows sockets, so that fileevent
-readable will fire repeatedly until the socket is closed. Previously the
-fileevent fired only once. This could lead to never-closed connections if
-the Tcl script in the fileevent wasn't closing the socket immediately. (JL)
-
-10/2/96 (new feature) Improved the package loader:
- - Added new variable tcl_pkgPath, which holds the default
- directories under which packages are normally installed (each
- package goes in a separate subdirectory of a directory in
- $tcl_pkgPath). These directories are included in auto_path by
- default.
- - Changed the package auto-loader to look for pkgIndex.tcl files
- not only in the auto_path directories but also in their immediate
- children. This should make it easier to install and uninstall
- packages (don't have to change auto_path or merge pkgIndex.tcl
- files). (JO)
-
-10/3/96 (bug fix) Changed tclsh to look for tclshrc.tcl instead of
-tclsh.rc on startup under Windows. This is more consistent with wish and
-uses the right extension. (SS)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-10/8/96 (bug fix) Convertclock does not parse 24-hour times of the
-form "hhmm" correctly when hour = 00. In the parse code, hour must be
->= 100 for minutes to be non-zero. Thanks to Lint LaCour for this
-bug fix. (RJ)
+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)
-10/11/96 (bug fix) Under Windows, the pid command returned the process
-handle instead of the process id. (SS)
+2/20/96 (feature change) Changed the -minsize option of grid to take
+screen units instead of pixels. (SU)
------------------ Released 7.6, 10/16/96 -----------------------
+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)
-10/29/96 (bug fix) Under Windows, sockets would consume 100% CPU time after
-the first accept(), due to a typo. (JL)
+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)
-10/29/96 (bug fix) Incorrect refcount management caused standard channels
-not to get deleted at process exit or DLL unload time, causing a memory
-leak of upwards of 20K each time. (JL)
+----------------- Released 4.1b2, 2/23/96 -----------------------
-11/7/96 (bug fix) Auto-exec didn't work on file names that contained
-spaces. (JO)
+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)
-11/8/96 (bug fix) Fixed core dump that would occur if more than one call
-to Tcl_DeleteChannelHandler was made to delete a given channel handler. (JL)
+2/23/96 (bug fix) Canvases weren't always updating their scrollbars
+when they should. (JO)
-11/8/96 (bug fix) Fixed test for return value in Tcl_Seek and Tcl_SeekCmd
-to only treat -1 as error, instead of all negative numbers. (JL)
+2/23/96 (bug fix) Fixed core dump that could occur if a WM_DELETE_PROTOCOL
+handler generated an error. (JO)
-11/12/96 (bug fix) Do not blocking waiting for processes at the end of a
-pipe during exit cleanup. (JL)
+2/24/96 (bug fix) Removed dependencies on Makefile in the UNIX Makefile:
+this caused problems on some platforms (like Linux?). (JO)
-11/12/96 (bug fix) If we are in exit cleanup, do not close the system level
-file descriptors 0, 1 and 2. Previously they were being closed which is
-incorrect, in the embedded case. This led to weird behavior for programs
-that want to interpose on I/O through the standard file descriptors (e.g.
-Netscape Navigator). (JL)
+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)
-11/15/96 (bug fix) Fixed core dump on Windows sockets due to dependency on
-deletion order at exit. Now all socket functions check to see if sockets
-are (still) initialized, before calling through function pointers. Before,
-they would call and might end up calling unloaded object code. (JL)
+2/24/96 (bug fix) Tk tended to crash with an X error when unsetting
+an icon window (e.g. "wm iconwindow . {}"). (JO)
-11/15/96 (bug fix) Fixed core dump in Windows socket initialization routine
-if sockets were not installed on the system. Before, it was not properly
-checking the result of attempting to load the socket DLL, so it would call
-through uninitialized function pointers. (JL)
+2/25/96 (bug fix) Wasn't removing windows from the WM_COLORMAP_WINDOWS
+property when they were deleted. (JO)
-11/15/96 (bug fix) Fixed memory leak in Windows sockets which left socket
-DLL handle open and could hold the socket DLL in memory uneccessarily,
-until a reboot. (JL)
+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)
-12/4/96 (bug fix) Fixed bug in Macintosh socket code that could result
-in lost data if a client was closed too soon after sending data. (RJ)
+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)
-12/17/96 (bug fix) Fixed deadlock bug in Windows sockets due to losing an
-event. This was happening because of an interaction between buffering and
-nonblocking mode on sockets. Now switched to sockets being blocking by
-default, so we are also no longer emulating blocking through a private
-event loop. (JL)
+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)
-1/21/97 (performance bug fix) Client TCP connections were slow to create
-because getservbyname was always called on the port. Now this is only
-done if Tcl_GetInt fails. (BW)
+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)
-1/21/97 (configuration fix) Made it possible to override TCL_PACKAGE_PATH
-during make. Previously it was only set during autoconf process.
+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)
-1/29/97 (bug fix) Fixed some problems with the clock command that
-impacted how dates were scaned after the year 2000. (RJ)
+3/2/96 (bug fix) Fixed yet another bug that caused long delays when
+raising toplevel windows. (JO)
------------------ Released 7.6p2, 1/31/97 -----------------------
+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)
-2/5/97 (bug fix) Fixed a bug where in CR-LF translation mode, \r bytes
-in the input stream were not being handled correctly. (JL)
+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)
-2/24/97 (bug fix) Fix bug with exec under Win32s not being able to create
-stderr file which caused all execs to fail. Fixed temp file leak under
-Win32s. Fixed optional parameter bug with SearchPath that only happened
-under Win32s 1.25. (CCS)
+3/5/96 (new feature) Added version suffix to shared library names so that
+Tk will compile under NetBSD and FreeBSD (I hope). (JO)
-----------------------------------------------------------
-Changes for Tcl 7.6 go above this line.
-Changes for Tcl 7.7 go below this line.
-----------------------------------------------------------
+3/6/96 (bug fix) Changed the way certain configure & motion events are
+reported. This fixes several bugs in menus & "winfo rootx". (RJ)
-5/8/96 (new feature) Added Tcl_Ungets C API for putting a sequence of bytes
-into a channel's input buffer. This can be used for "push" model channels
-where the input is obtained via callbacks instead of by request of the
-generic IO code. No Tcl procedure yet. (JL)
-
-11/15/96 (new feature) Implemented hidden commands. New C APIs:
- Tcl_HideCommand -- hides an existing exposed command.
- Tcl_ExposeCommand -- exposes an existing hidden command.
-New tcl APIs:
- interp invokehidden -- invokes a hidden command in a slave.
- interp hide -- hides an existing exposed command.
- interp expose -- exposes an existing hidden command.
- interp hidden -- returns a list of hidden commands.
-The implementation of Safe Tcl now uses the new hidden commands facility
-to implement the safe base, instead of deleting the commands from a safe
-interpreter. (JL)
+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)
-11/15/96 (new feature) Implemented the safe base, a mechanism for
-installing and requesting security policies, purely in Tcl code. Overloads
-the package command to also allow an interpreter to "require" a policy. The
-following new library commands are provided:
- tcl_safeCreateInterp -- creates a slave an initializes the
- policy mechanism.
- tcl_safeInitInterp -- initializes an existing slave with the
- policy mechanism.
- tcl_safeDeleteInterp -- deletes a slave and deinitializes the
- policy mechanism.
-Added a new file to the library, safeinit.tcl, to hold implementation. (JL)
-On 7/9/97, removed the policy loading mechanism from the Safe Base. Left
-only the Safe Base aliases dealing with auto-loading and source. (JL)
-
-12/6/96 (new feature) Implemented Tcl_Finalize, an API that should be
-called by a process when it is done using Tcl. This API runs all the exit
-handlers to allow them to clean up resources etc. (JL)
-
-12/17/96 (new feature) Add an http Tcl script package to the Tcl library.
-This package implements the client side of HTTP/1.0; the GET, HEAD,
-and POST requests. (BW)
-
-1/21/97 (new feature) Added a "marktrusted" subcommand to the "interp" and
-to the interpreter object command. It removes the "safe" mark on an
-interpreter and disables hard-wired checks for safety in the C sources. (JL)
-
-1/21/97 (removed feature) Removed "vwait" from set of commands available in
-a safe interpreter. (JL)
-
-2/11/97 (new feature, bug fix) http package. Added -accept to http_config
-so you can set the Accept header. Added -handler option to http_get so
-you can supply your own data handler. Also fixed POST operation to
-set the correct MIME type on the request. (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)
-----------------------------------------------------------
-Changes for Tcl 7.7 go above this line.
-Changes for Tcl 8.0 go below this line.
-----------------------------------------------------------
+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)
-9/17/96 (bug fix) Using "upvar" it was possible to turn an array element
-into an array itself. Changed to disallow this; it was quirky and didn't
-really work correctly anyway. (JO)
-
-10/21/96 (new feature) The core of the Tcl interpreter has been replaced
-with an on-the-fly compiler that translates Tcl scripts to bytecoded
-instructions; a new interpreter then executes the bytecodes. The compiler
-introduces only a few minor changes at the level of Tcl scripts. The biggest
-changes are to expressions and lists.
- - A second level of substitutions is no longer done for expressions.
- This substantially improves their execution time. This means that
- the expression "$x*4" produces a different result than in the past
- if x is "$y+2". Fortunately, not much code depends on the old
- two-level semantics. Some expressions that do, such as
- "expr [join $list +]" can be recoded to work in Tcl8.0 by adding
- an eval: e.g., "eval expr [join $list +]".
- - Lists are now completely parsed on the first list operation to
- create a faster internal representation. In the past, if you had a
- misformed list but the erroneous part was after the point you
- inserted or extracted an element, then you never saw an error.
- In Tcl8.0 an error will be reported. This should only effect
- incorrect programs that took advantage of behavior of the old
- implementation that was not documented in the man pages.
-Other changes to Tcl scripts are discussed in the web page at
-http://www.scriptics.com/doc/compiler.html. (BL)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-10/21/96 (new feature) In earlier versions of Tcl, strings were used as a
-universal representation; in Tcl 8.0 strings are replaced with Tcl_Obj
-structures ("objects") that can hold both a string value and an internal
-form such as a binary integer or compiled bytecodes. The new objects make it
-possible to store information in efficient internal forms and avoid the
-constant translations to and from strings that occurred with the old
-interpreter. There are new many new C APIs for managing objects. Some of the
-new library procedures for objects (such as Tcl_EvalObj) resemble existing
-string-based procedures (such as Tcl_Eval) but take advantage of the
-internal form stored in Tcl objects for greater speed. Other new procedures
-manage objects and allow extension writers to define new kinds of objects.
-See the manual entries doc/*Obj*.3 (BL)
-
-10/24/96 (bug fix) Fixed memory leak on exit caused by some IO related
-data structures not being deallocated on exit because their refcount was
-artificially boosted. (JL)
-
-10/24/96 (bug fix) Fixed core dump in Tcl_Close if called with NULL
-Tcl_Channel. (JL)
-
-11/19/96 (new feature) Added library procedures for finding word
-breaks in strings in a platform specific manner. See the library.n
-manual entry for more information. (SS)
-
-11/22/96 (feature improvements) Added support for different levels of
-tracing during bytecode compilation and execution. This should help in
-tracking down suspected problems with the compiler or with converting
-existing code to use Tcl8.0. Two global Tcl variables, traceCompile
-and traceExec, can be set to generate tracing information in stdout:
- - traceCompile: 0 no tracing (default)
- 1 trace compilations of top level commands and procs
- 2 trace and display instructions for all compilations
- - traceExec: 0 no tracing
- 1 trace only calls to Tcl procs
- 2 trace invocations of all commands including procs
- 3 detailed trace showing the result of each instruction
-traceExec >= 2 provides a one line summary of each called command and
-its arguments. Commands that have been "compiled away" such as set are
-not shown. (BL)
-
-11/30/96 (bug fix) The command "info nameofexecutable" could sometimes
-return the name of a directory. (JO)
-
-11/30/96 (feature improvements) Changed the code in library/init.tcl
-that reads in pkgIndex.tcl so that (a) it reads the files from child
-directories before those in the parent, so that the parent gets
-precedence, and (b) it doesn't quit if there is an error in a
-pkgIndex.tcl file; instead, it prints an error message on standard
-error and continues. (JO)
-
-10/5/96 (feature improvements) Partial implementation of binary string
-support: the ability for Tcl string values to contain embedded null bytes.
-Changed the Tcl object-based APIs to take a byte pointer and length pair
-instead of a null-terminated C string. Modified several object type managers
-to support binary strings but not, for example, the list type manager.
-Existing string-based C APIs are unchanged and will truncate binary
-strings. Compiled scripts containing nulls are also truncated. (BL)
-
-12/12/96 (feature change) Removed the commands "cp", "mkdir", "mv",
-"rm", and "rmdir" from the Macintosh version of Tcl. They were never
-officially supported and their functionality is now available via
-the file command. (RJ)
-
------------------ Released 8.0a1, 12/20/96 -----------------------
-
-1/7/97 (bug fix) Under Windows, "file stat c:" was returning error instead
-of stat for current dir on c: drive.
-
-1/10/97 (new feature) Added Tcl_GetIndexFromObj procedure for quick
-lookups of keyword arguments. (JO)
-
-1/12/97 (new feature) Serial IO channel drivers for Windows and Unix,
-available by using Tcl open command to open pseudo-files like "com1:" or
-"/dev/ttya". New option to Tcl fconfigure command for serial files:
-"-mode baud,parity,data,stop" to specify baud rate, parity, data bits, and
-stop bits. Serial IO is not yet available on Mac.
-
-1/16/97 (feature change) Restored the Tcl7.x "two level substitution
-semantics" for expressions. Expressions not enclosed in braces are
-implemented, in general, by calling the expr command procedure
-(Tcl_ExprObjCmd) at runtime after the Tcl interpreter has already done a
-first round of substitutions. This is slow (about Tcl7.x speed) because new
-code for the expression is generally compiled each time. However, if the
-expression has only variable substitutions (and not command substitutions),
-"optimistic" fast code is generated inline. This inline code will fail if a
-second round of substitutions is needed (i.e., if the value of a substituted
-variable itself requires more substitutions). The optimistic code will
-catch the error and back off to call the slower but guaranteed correct
-expr command procedure. (BL)
-
-1/16/97 (feature improvements) Added Tcl_ExprLongObj and Tcl_ExprDoubleObj
-to round out expression-related procedures. (BL)
-
-1/16/97 (feature change) Under Windows, at startup the environment variables
-"path", "comspec", and "windir" in any capitalization are converted
-automatically to upper case. The PATH variable could be spelled as path,
-Path, PaTh, etc. and it makes programming rather annoying. All other
-environment variables are left alone. (CS)
-
-1/20/97 (new features) Rewrote the "lsort" command:
- - The new version is based on reentrant merge sort code provided
- by Richard Hipp, so it eliminates the reentrancy and stability
- problems with the old qsort-based implementation.
- - The new version supports a -dictionary option for sorting, and
- it also supports a -index option for sorting lists using one
- element for comparison.
- - The new version is an object command, so it works well with the
- Tcl compiler, especially in conjunction with the new -index
- option. When the -index option is used, this version of lsort
- is more than 100 times faster than the Tcl 7.6 lsort, which had
- to use the -command option to get the same effect. (JO)
-
-1/20/97 (feature improvements) Added the improved debugging support for Tcl
-objects prototyped by Karl Lehenbauer <karl@hammer1.ops.NeoSoft.com>.
-If TCL_MEM_DEBUG is defined, the object creation calls use Tcl_DbCkalloc
-directly in order to record the caller's source file name and line
-number. (BL)
-
-1/21/97 (removed feature) Desupported the tcl_precision variable: if
-set, it is ignored. Tcl now uses the full 17 digits of precision when
-converting real numbers to strings (with the new object system real
-numbers are rarely converted to strings so there is no efficiency
-disadvantage to printing all 17 digits; the new scheme improves
-accuracy and simplifies several APIs). (JO)
-*** POTENTIAL INCOMPATIBILITY ***
+----------------- Released 4.1b3, 3/8/96 -----------------------
-1/21/97 (feature change) Removed the "interp" argument for the
-procedures Tcl_GetStringFromObj, Tcl_StringObjAppend, and
-Tcl_StringObjAppendObj. Also removed the "interp" argument for
-the updateStringProc procedure in Tcl_ObjType structures. With
-the tcl_precision changes above, these are no longer needed. (JO)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a1, but not with Tcl 7.6 ***
+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)
-1/22/97 (bug fix) Fixed http.tcl so that http_reset does not result in
-an extra call to the command callback. In addition, if the transaction
-gets a premature eof, the state(status) is "eof", not "ok". (BW)
+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)
------------------ Released 8.0a2, 1/24/97 -----------------------
+3/14/96 (bug fix) "wish bogus_file_name" didn't print an error message. (JO)
-1/29/97 (feature change) Changed how two digit years are parsed in the
-clock command. The old interface just added 1900 which will seem
-broken by the year 2000. The new scheme follows the POSIX standard
-and treats dates 70-99 as 1970-1999 and dates 00-38 as 2000-2038. All
-other two digit dates are undefined. (RJ)
-*** POTENTIAL INCOMPATIBILITY ***
+3/14/96 (bug fix) Button-2 wasn't claiming the focus during paste
+operations. (JO)
-2/4/97 (bug fix) Fixed bug in clock code that dealt with relative
-dates. Using the relative month code you could get an invalid date
-because it jumped into a non-existant day. (For example, Jan 31
-to Feb 31.) The code now will return the last valid day of the
-month in these situations. Thanks to Hume Smith for sending in
-this bug fix. (RJ)
-
-2/10/97 (feature change) Eliminated Tcl_StringObjAppend and
-Tcl_StringObjAppendObj procedures, replaced them with Tcl_AppendToObj
-and Tcl_AppendStringsToObj procedures. Added new procedure
-Tcl_SetObjLength. (JO)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2, but not with Tcl 7.6 ***
-
-2/10/97 (new feature) Added Tcl_WrongNumArgs procedure for generating
-error messages about incorrect number of arguments. (JO)
-
-2/11/97 (new feature, bug fix) http package. Added -accept to http_config
-so you can set the Accept header. Added -handler option to http_get so
-you can supply your own data handler. Also fixed POST operation to
-set the correct MIME type on the request. (BW)
-
-2/22/97 (bug fix) Fixed bug that caused $tcl_platform(osVersion) to be
-computed incorrectly under AIX. (JO)
-
-2/25/97 (new feature, feature change) Added support for both int and long
-integer objects. Added Tcl_NewLongObj/Tcl_GetLongFromObj/Tcl_SetLongFromObj
-procedures and renamed the Tcl_Obj internalRep intValue member to
-longValue. Tcl_GetIntFromObj now checks for integer values too large to
-represent as non-long integers. Changed Tcl_GetAllObjTypes to
-Tcl_AppendAllObjTypes. (BL)
-
-3/5/97 (new feature) Added new Tcl_SetListObj procedure to round out
-collection of procedures that set the type and value of existing Tcl
-objects. (BL)
-
-3/6/97 (new feature) Added -global flag for interp invokehidden. (JL)
-
-3/6/97 (new feature, feature change) Added isNativeObjectProc field to the
-Tcl_CmdInfo structure to indicate (when 1) if the command has an
-object-based command procedure. Removed the nameLength arg from
-Tcl_CreateObjCommand since command names can't contain null characters. (BL)
-
-3/6/97 (bug fix) Fixed bug in "unknown" procedure that caused auto-
-loading to fail on commands whose names begin with digits. (JO)
-
-3/7/97 (bug fix) Auto-loading now works in Safe Base. Safe interpreters
-only accept the Version 2 and onwards tclIndex files. (JL)
-
-3/13/97 (bug fix) Fixed core dump due to interaction between aliases and
-hidden commands. Bug found by Lindsay Marshall. (JL)
-
-3/14/97 (bug fix) Fixed mac bugs relating to time. The -gmt option
-now adjusts the time in the correct direction. (Thanks to Ed Hume for
-reporting a fix to this problem.) Also fixed file "mtime" etc. to
-return times from GMT rather than local time zone. (RJ)
-
-3/18/97 (feature change) Declaration of objv in Tcl_ObjCmdProc function
-changed from "Tcl_Obj *objv[]" to "Tcl_Obj *CONST objv[]". All Tcl object
-commands changed to use new declaration of objv. Naive translation of
-string-based command procs to object-based command procs could very easily
-have yielded code where the contents of the objv array were changed. This
-is not a problem with string-based command procs, but doing something as
-simple as objv[2] = objv[3] would corrupt the runtime stack and cause Tcl to
-crash. Introduced CONST in declaration of objv so that attempted assignment
-of new pointer values to elements of the objv array will be caught by the
-compiler. (CCS)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 ***
-
-3/19/97 (bug fix) Fixed panic due to object sharing. The root cause was
-that old code was using Tcl_ResetResult instead of Tcl_ResetObjResult. (JL)
-
-3/20/97 (new feature) Added a new subcommand for the file
-command. file attributes filename can give a list of platform-specific
-options (such as file/creator type on the Mac, permissions on Unix) or
-set the values of them. Added a new subcommand for the file
-command. file nativename name gives back the platform-specific form
-for the file. This is useful when the filename is needed to pass to
-the OS, such as exec under Windows 95 or AppleScript on the Mac. For
-more info, see file.n. (SRP)
-
-3/24/97 (removed feature) Removed the tcl_safePolicyPath procedure. Now
-the policy path is computed from the auto_path by appending the directory
-'policies' to each element. Also fixed several bugs in automatic tracking
-of auto_path by computed policy path. (JL)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 ***
-
-4/8/97 (new feature) If the variable whose name is passed to lappend doesn't
-already exist, and there are no value arguments, lappend now creates the
-variable with an empty value instead of returning an error. Change suggested
-by Tom Tromey. (BL)
-
-4/9/97 (feature change) Changed the name of the TCL_PART1_NOT_PARSED flag to
-TCL_PARSE_PART1. (BL)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 ***
-
-4/10/97 (bug fixes) Fixed various compilation-related bugs:
- - "UpdateStringOfCmdName should never be invoked" panic.
- - Bad code generated for expressions not in {}'s inside catch commands.
- - Segmentation fault in some command procedures when two argument
- object pointers refer to the same object.
- - Second level of substitutions were never done for expressions not
- in {}'s that consist of a single variable reference: e.g.,
- "set x 27; set bool {$x}; if $bool {puts foo}" would fail with error.
- - Bad code generated when code storage was grown while compiling some
- expressions: ones with compilation errors or consisting of only a
- variable reference.
- - Bugs involving multiple interpreters: wasn't checking that a
- procedure's code was compiled for the same interpreter as the one
- executing it, and didn't invalidate code on hidden-exposed command
- transitions.
- - "Bad stack top" panic when executing scripts that require a huge
- amount of stack space.
- - Incorrect sharing of code for procedure bodies, and procedure code
- deallocated before last execution of the procedure finished.
- - Fixed compilation of expression words in quotes. For example,
- if "0 < 3" {puts foo}.
- - Fixed performance bug in array set command with large assignments.
- - Tcl_SetObjLength segmentation fault setting length of empty object.
- - If Tcl_SetObjectResult was passed the same object as the interpreter's
- result object, it freed the object instead of doing nothing. Bug fix
- by Michael J. McLennan.
- - Tcl_ListObjAppendList inserted elements from the wrong list. Bug fix
- by Michael J. McLennan.
- - Segmentation fault if empty variable list was specified in a foreach
- command. Bug fix by Jan Nijtmans.
- - NULL command name was always passed to Tcl_CreateTrace callback
- procedure.
- - Wrong string representation generated for the value LONG_MIN.
- For example, expr 1<<31 printed incorrectly on a 32 bit machine.
- - "set {a($x)} 1" stored value in wrong variable.
- - Tcl_GetBooleanFromObj was not checking for garbage after a numeric
- value.
- - Garbled "bad operand type" error message when evaluating expressions
- not surrounded by {}'s. (BL)
-
-4/16/97 (new feature) The expr command now has the "rand()" and
-"srand()" functions for getting random numbers in expr. (RJ)
-
-4/23/97 (bug fix) Fixed core dump in bgerror when the error handler command
-deletes the current interpreter. Found by Juergen Schoenwald. (JL)
-
-4/23/97 (feature change) The notifier interfaces have been redesigned
-to make embedding in applications with external event loops possible.
-A number of interfaces in the notifier and the channel drivers have
-changed. Refer to the Notifier.3 and CrtChannel.3 manual entries for
-more details. (SS)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-4/23/97 (removed feature) The Tcl_File interfaces have been removed.
-The Tcl_CreateFileHandler/Tcl_DeleteFileHandler interfaces now take
-Unix fd's and are only supported on the Unix platform.
-Tcl_GetChannelFile has been replaced with Tcl_GetChannelHandle.
-Tcl_MakeFileChannel now takes a platform specific file handle. (SS)
-*** POTENTIAL INCOMPATIBILITY ***
+3/16/96 (bug fix) Changed configuration stuff to get dynamic loading and
+shared libraries working under AIX. (JO)
-4/23/97 (removed feature) The modal timeout interface has been
-removed (Tcl_CreateModalTimeout/Tcl_DeleteModalTimeout) (SS)
-*** POTENTIAL INCOMPATIBILITY ***
+3/16/96 (bug fix) Fixed core dumps that could occur when a slave interpreter
+was deleted in the middle of executin bindings. (JO)
-4/23/97 (feature change) Channel drivers are now required to correctly
-implement blocking behavior when they are in blocking mode. (SS)
-*** POTENTIAL INCOMPATIBILITY ***
+3/18/96 (new feature) Added support for Activate/Deactivate events.
+Currently, these new X events will generated only on the Macintosh. (RJ/CS)
-4/23/97 (new feature) Added the "binary" command for manipulating
-binary strings. Also, changed the "puts", "gets", and "read" commands
-to preserve embedded nulls. (SS)
-
-4/23/97 (new feature) Added tcl_platform(byteOrder) element to the
-tcl_platform array to identify the native byte order for the current
-host. (SS)
-
-4/23/97 (bug fix) Fixed bug in date parsing around year boundaries. (SS)
-
-4/24/97 (bug fix) In the process of copying a file owned by another user,
-Tcl was changing the owner of the copy back to the owner of the original
-file, therefore causing further file operations to fail because the current
-user didn't own the copy anymore. The owner of the copy is now left as the
-current user. (CCS)
-
-4/24/97 (feature change) Under Windows, don't automatically uppercase the
-environment variable "windir" -- it's supposed to be lower case. (CCS)
-
-4/29/97 (new feature) Added namespace support based on a namespace
-implementation by Michael J. McLennan of Lucent Technologies. A namespace
-encapsulates a collection of commands and variables to ensure that they
-won't interfere the commands and variables of other namespaces. The global
-namespace holds all global variables and commands. Additional namespaces are
-created with the new namespace command. The new variable command lets you
-create Tcl variables inside a namespace. The names of Tcl variables and
-commands may now be qualified by the name of the namespace containing them.
-The key namespace-related commands are summarized below:
- - namespace ?eval? name arg ?arg...?
- Used to define the commands and variables in a namespace.
- Optionally creates the namespace.
- - namespace export ?-clear? ?pattern pattern...?
- Specifies which commands are exported from a namespace. These
- are the ones that can be imported into another namespace.
- - namespace import ?-force? ?pattern pattern...?
- Makes the specified commands accessible in the current namespace.
- - namespace current
- Returns the name of the current namespace.
- - variable name ?value? ?name ?value?...?
- Creates one or more namespace variables. (BTL)
-
-5/1/97 (bug fix) Under Windows, file times were reported in GMT. Should be
-reported in local time. (CCS)
-
-5/2/97 (feature change) Changed the name of the two Tcl variables used for
-tracing bytecode compilation and execution to tcl_traceCompile and
-tcl_traceExec respectively. These variables are now documented in the
-tclvars man page. (BL)
-
-5/5/97 (new feature) Support "end" as the index for "lsort -index". (BW)
-
-5/5/97 (bug fixes) Cleaned up the way the http package resets connections (BW)
-
-5/8/97 (feature change) Newly created Tcl objects now have a reference count
-of zero instead of one. This simplifies C code that stores newly created
-objects in Tcl variables or in data structures such as list objects. That C
-code must increment the new object's reference count since the variable or
-data structure will contain a long-term reference to the object. Formerly,
-when new objects started out with reference count one, it was necessary to
-decrement the new object's reference count after the store to make sure it
-was left with the correct value; this is no longer necessary. (BL)
-
-5/9/97 (new feature) Added the Tcl_GetsObj interface that takes an
-object reference instead of a dynamic string (as in Tcl_Gets). (SS)
-
-5/12/97 (new feature) Added Tcl_CreateAliasObj and Tcl_GetAliasObj C APIs
-to allow an alias command to be created with a vector of Tcl_Obj structures
-and to get the vector back later. (JL)
-
-5/12/97 (feature change) Changed Tcl_ExposeCommand and Tcl_HideCommand to
-leave an object result instead of a string result. (JL)
-
-5/14/97 (feature change) Improved the handling of the interpreter result.
-This is still either an object or a string, but the two values are now kept
-consistent unless some C code reads or writes interp->result directly. See
-the SetResult man page for details. Removed the Tcl_ResetObjResult
-procedure. (BL)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 ***
-
-5/16/97 (new feature) Added "fcopy" command to move data between
-channels. Refer to the manual page for more information. Removed the
-"unsupported0" command since it is obsolete now. (SS)
-
-5/16/97 (new feature) Added Tcl_GetStringResult procedure to allow programs
-to get an interpreter's result as a string. If the result was previously set
-to an object, this procedure will convert the object to a string. Use of
-Tcl_GetStringResult is intended to replace direct access to interp->result,
-which is not safe. (BL)
-
-5/20/97 (new features) Fixed "fcopy" to return the number of bytes
-transferred in the blocking case. Updated the http package to use
-fcopy instead of unsupported0. Added -timeout and -handler options to
-http_get. http_get is now blocking by default. It is only non-blocking
-if you supply a -command argument. (BW)
-
-5/22/97 (bug fix) Fixed several bugs in the "lsort" command having to do
-with the -dictionary option and the presence of numbers embedded in the
-strings. (JO)
+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)
------------------ Released 8.0b1, 5/27/97 -----------------------
+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)
-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)
+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)
-6/2/97 (bug fix) Fixed bug in Unix notifier where the select mask was
-not being cleared under some circumstances. (SS)
-
-6/4/97 (bug fix) Fixed bug that prevented creation of Tk widgets in
-namespaces. Tcl_CreateObjCommand and Tcl_CreateCommand now always create
-commands in the global namespace unless the command names are qualified. Tcl
-procedures continue to be created in the current namespace by default. (BL)
-
-6/6/97 (new features) Added new namespace API procedures
-Tcl_AppendExportList and Tcl_Export to allow C code to get and set a
-namespace's export list. (BL)
-
-6/11/97 (new feature) Added Tcl_ConcatObj. This object-based routine
-parallels the string-based routine Tcl_Concat. (SRP)
-
-6/11/97 (new feature) Added Tcl_SetObjErrorCode. This object-based
-routines parallels the string-based routine Tcl_SetErrorCode. (SRP)
-
-6/12/97 (bug fix) Fix the "unknown" procedure so that wish under Windows
-will exec an external program, instead of always complaining "console1 not
-opened for writing". (CCS)
-
-6/12/97 (bug fix) Fixed core dump experienced by the following simple
-script:
- interp create x
- x alias exec exec
- interp delete x
-This panic was caused by not installing the new CmdDeleteProc when exec
-got redefined by the alias creation step. Reported by Lindsay Marshal (JL)
-
-6/13/97 (new features) Tcl objects newly created by Tcl_NewObj now have a
-string representation that points to a shared heap string of length 1. (They
-used to have NULL bytes and typePtr fields. This was treated as a special
-case to indicate an empty string, but made type manager implementations
-complex and error prone.) The new procedure Tcl_InvalidateStringRep is used
-to mark an object's string representation invalid and to free any storage
-associated with the old string representation. (BL)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 ***
-
-6/16/97 (bug fix) Tcl_ScanCountedElement could leave braces unmatched
-if the string ended with a backslash. (JO)
-
-6/17/97 (bug fix) Fixed channel event bug where readable events would be
-lost during recursive events loops if the input buffers contained
-data. (SS)
-
-6/17/97 (bug fix) Fixed bug in Windows socket code that didn't
-reenable read events in the case where an external entity is also
-reading from the socket. (SS)
-
-6/18/97 (bug fix) Changed initial setting of the notifier service mode
-to TCL_SERVICE_NONE to avoid unexpected event handling during
-initialization. (SS)
-
-6/19/97 (bug fix/feature change) The command callback to fcopy is now
-called in case of errors during the background copy. This adds a second,
-optional argument to the callback that is the error string. The callback
-in case of errors is required for proper cleanup by the user of fcopy. (BW)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 ***
-
-6/19/97 (bug fix) Fixed a panic due to the following four line script:
- interp create x
- x alias foo bar
- x eval rename foo blotz
- x alias foo {}
-The problem was that the interp code was not using the actual current name
-of the command to be deleted as a result of un-aliasing foo. (JL)
-
-6/19/97 (feature change) Pass interp down to the ChannelOption and
-driver specific calls so system errors can be differentiated from syntax
-ones. Changed Tcl_DriverGetOptionProc type. Affects Tcl_GetChannelOption,
-TcpGetOptionProc, TtyGetOptionProc, etc. (DL)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-6/19/97 (new feature) Added Tcl_BadChannelOption for use by by driver
-specific option procedures (Set and Get) to return a complete and
-meaningful error message. (DL)
-
-6/19/97 (bug fixes) If a system call error occurs while doing an
-fconfigure on tcp or tty/com channel: return the appropriate error
-message (instead of the syntax error one or none). (Fixed for Unix and
-most of the Win and Mac drivers). (DL)
-
-6/20/97 (feature change) Eval is no longer assumed as the subcommand name
-in namespace commands: you must now write "namespace eval nsName {...}".
-Abbreviations of namespace subcommand names are now allowed. (BL)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 ***
-
-6/20/97 (feature change) Changed the errorInfo traceback message for
-compilation errors from "invoked from within" to "while compiling". (BL)
-
-6/20/97 (bug fixes) Fixed various compilation-related bugs:
- - "UpdateStringOfCmdName should never be called" and
- "UpdateStringOfByteCode should never be called" panics.
- - Segfault in TclObjInterpProc getting procedure name after evaluation
- stack is reallocated (grown).
- - Could not use ":" at end of variable and command names.
- - Bad code generated for while and for commands with test expressions
- enclosed in quotes: e.g., "set i 0; while "$i > 5" {}".
- - Command trace procedures would crash if they did a Tcl_EvalObj that
- reallocated the evaluation stack.
- - Break and continue commands did not reset the interpreter result.
- - The Tcl_ExprXXX routines, both string- or object-based, always
- modified the interpreter result even if there was no error.
- - The argument parsing procedure used by several compile procedures
- always treated "]" as end of a command: e.g., "set a ]" would fail.
- - Changed errorInfo traceback message for compilation errors from
- "invoked from within" to "while compiling".
- - Problem initializing Tcl object managers during interpreter creation.
- - Added check and error message if formal parameter to a procedure is
- an array element. (BL)
-
-6/23/97 (new feature) Added "registry" package to allow manipulation
-of the Windows system registry. See manual entry for details. (SS)
-
-6/24/97 (feature change) Converted http to a package and added the
-http1.0 subdirectory of the Tcl script library. This means you have
-to do a "package require http" to use this, as advertised in the man page. (BW)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 ***
-
-6/24/97 (bug fix) Ensure that Tcl_Set/GetVar C APIs, when called without
-TCL_LEAVE_ERR_MSG, don't touch the interp result. (DL)
-
-6/26/97 (feature change) Changed name of Tcl_ExprStringObj to
-Tcl_ExprObj. (BL)
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 ***
+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)
------------------ Released 8.0b2, 6/30/97 -----------------------
+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)
-7/1/97 (new feature) TCL_BUILD_SHARED flag set in tclConfig.sh
-when Tcl has been built with --enable-shared. A new tclLibObjs
-make target, echoing the list of the .o's needed to build a tcl
-library, is now provided. (DL)
-
-7/1/97 (feature change) compat/getcwd.c removed and changed the
-only place where getcwd is used so a new USEGETWD flag selects
-the use of the replacement "getwd". Adding this flag is recommended
-for SunOS 4 (because getcwd on SunOS 4 uses a pipe to pwd(1)!). (DL)
-
-7/7/97 (feature change) The split command now supports binary data (i.e.,
-null characters in strings). (BL)
-
-7/7/97 (bug fix) string first returned the wrong result if the first
-argument string was empty. (BL)
-
-7/8/97 (bug fix) Fixed core dump in fcopy that could occur when a command
-callback was supplied and an error or eof condition caused no background
-activity. A refcount bug triggered a panic in Tcl_ListObjAppendElement. (BW)
-
-7/8/97 (bug fix) Relaxed the pattern matching on http_get so you do not
-need a trailing path component. You can now get away with just
-http_get www.scriptics.com (BW)
-
-7/9/97 (bug fix) Creating anonymous interpreters no longer smashes existing
-commands with names similar to the generated name. Previously creating an
-anonymous interpreter could smash an existing command, now it skips until
-it finds a command name that isn't being used. (JL)
-
-7/9/97 (feature change) Removed the policy management mechanism from the
-Safe Base; left the aliases to source and load modules, and to do a limited
-form of the "file" command. See entry of 11/15/96. (JL)
-
-7/9/97 (bug fixes) Fixed various compilation-related bugs:
- - Line numbers in errorInfo now are the same as those in Tcl7.6 unless
-there are compilation errors. Compilation error messages now include the
-entire command in error.
- - Trailing ::s after namespace names weren't being ignored.
- - Could not refer to an namespace variable with an empty name using a
-name of the form "n::". (BL)
-
-7/9/97 (bug fix) Fixed bug in Tcl_Export that prevented you from exporting
-from other than the current namespace. (BL)
-
-7/9/97 (bug fix) env.test was removing env var needed for proper finding
-of libraries in child process. (DL)
-
-7/10/97 (bug fixes/new feature) Cleanup in Tcl_MakeSafe. Less information
-is leaked to safe interps. Error message fixes for interp sub commands.
-Likewise changes in safealias.tcl; tcl_safeCreateInterp can now be called
-without argument to generate the slave name (like in interp create). (DL)
-
-7/10/97 (bug fixes) Bytecode compiler now generates more detailed
-command location information: subcommands as well as commands now have
-location information. This means command trace procedures now get the
-correct source string for each command in their command parameter. (BL)
-
-7/22/97 (bug fixes) Performance improvement in Safe interpreters
-handling. Added new mask value to (tclInt.h) Interp.flags record. (DL)
-
-7/22/97 (bug fix) Fixed panic in 'interp target {} foo'. This bug
-was present since Tcl 7.6. (JL)
-
-7/22/97 (bug fix) Fixed bug in compilation of procedures in namespaces: the
-procedure's namespace must be used to look up compile procedures, not the
-current namespace. (BL)
-
-7/22/97 (bug fix) Use of the -channel option of http_get was not setting
-the end of line translations mode on the channel, so copying binary data
-with the -channel option was corrupting the result on non-unix platforms. (BW)
-
-7/22/97 (bug fixes) file commands and ~user (seg fault and other
-improper returns). (DL)
-
-7/23/97 (feature change) Reenabled "vwait" in Safe Base. (JL)
-
-7/23/97 (bug fixes) Fixed two bugs involving read traces on array variables
-in procedures: trace procedures were sometimes not called, and reading
-nonexistant array elements didn't create undefined element variables that
-could later be defined by trace procedures. (BL)
-
-7/24/97 (bug fix) Windows memory allocation performance was
-superlinear in some cases. Made the Mac allocator generic and changed
-both the Mac and Windows platforms to use the new allocator instead of
-malloc and free. (SS)
-
-7/24/97 - 8/12/97 (bug fixes/change of features) Completely revamped safe
-sourcing/loading (see safe.n) to hide pathnames, use virtual
-paths tokens instead, improved security in several respects and made it
-more tunable. Multi level interp loading can work too now. Package auto
-loading now works in safe interps as long as the package directory is in
-the auto_path (no deep crawling allowed in safe interps). (DL)
-*** POTENTIAL INCOMPATIBILITY with previous alpha and beta releases ***
-
-7/24/97 (bug fixes) Made Tcl_SetVar* and Tcl_NewString* treat a NULL value
-as an empty string. (This fixes hairy crash case where you would crash
-because load command for other interps assumed presence of
-errorInfo...). (DL)
-
-7/28/97 (bug fix) Fixed pkg_mkIndex to understand namespaces. It will
-use the export list of a namespace and create auto_index entries for
-all export commands. Those names are in their fully qualified form in the
-auto_index. Therefore, I tweaked unknown to try both $cmd and ::$cmd.
-Also fixed pkg_mkIndex so you can have "package require" commands inside
-your packages. These commands are ignored, which is mostly ok except
-when you must load another package before loading yours because of
-linking dependencies. (BW)
-
-7/28/97 (bug fix) A variable created by the variable command now persists
-until the namespace is destroyed or the variable is unset. This is true even
-if the variable has not been initialized; these variables used to be
-destroyed if an error occurred when accessing them. In addition, the "info
-vars" command lists uninitialized namespace variables, while the "info
-exists" command returns 0 for them. (BL)
-
-7/29/97 (feature change) Changed the http package to use the ::http
-namespace. http_get renamed to http::geturl, http_config renamed to
-http::config, http_formatQuery renamed to http::formatQuery.
-It now provides the 2.0 version of the package.
-The 1.0 version is still available with the old names.
-*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b2 but not with Tcl 7.6 ***
-
-7/29/97 (bug fix, new feature) Tcl_Main now uses Tcl objects internally to
-preserve NULLs in commands and command output. Added new API procedure
-Tcl_RecordAndEvalObj that resembles Tcl_RecordAndEval but takes an object
-containing a command. (BL)
-
-7/30/97 (bug fix) Tcl freed strings in the environ array even if it
-did not allocate them. (SS)
-
-7/30/97 (bug fix) If a procedure is renamed into a different namespace, it
-now executes in the context of that namespace. (BL)
-
-7/30/97 (bug fix) Prevent renaming of commands into and from namespaces as
-part of hiding them. (JL)
-
-7/31/97 (feature change) Moved the history command from C to tcl.
-This uses the ::history namespace. The "words" and "substitute" options
-are no longer supported. In addition, the "keep" option without a value
-returns the current keep limit. There is a new "clear" option.
-The unknown command now supports !! again. (BW)
-*** POTENTIAL INCOMPATIBILTY ***
-
-7/30/97 (bug fix) Made sure that a slave can not fool the master into
-hiding the wrong command. Made sure we don't crash in hiding + namespaces
-issues. (DL)
-
-8/4/97 (bug fix) Concat, eval, uplevel, and similar commands were
-incorrectly trimming trailing space characters from their arguments
-even when the space characters were preceded by a backslash. (JO)
-
-8/4/97 (bug fix) Removed the hard link between bgerror and tkerror.
-Only bgerror is supported in tcl core. Tk will still look for a
-tkerror but using regular tcl code for that feature. (DL)
-*** POTENTIAL INCOMPATIBILTY with code relying on the hard link ***
-
-8/6/97 (bug fix) Reduced size required for compiled bytecodes by using a
-more compact encoding for the command pc-to-source map. (BL)
-
-8/6/97 (new feature) Added support for additional compilation and execution
-statistics when Tcl is compiled with the TCL_COMPILE_STATS flag. (BL)
-
-8/7/97 (bug fix) Expressions not in {}s that have a comparison operator as
-the topmost operator must be compiled out-of-line (call the expr cmd at
-runtime) to properly support expr's two-level substitution semantics. An
-example is "set a 2; set b {$a}; puts [expr $b == 2]". (BL)
-
-8/11/97 (bug fix) The catch command would sometimes crash if a variable name
-was given and the bytecode evaluation stack was grown when executing the
-argument script. (BL)
-
-8/12/97 (feature change) Reinstated the variable tcl_precision to control
-the number of digits used when floating-point values are converted to
-strings, with default of 12 digits. However, had to make tcl_precision
-shared among all interpreters (except that safe interpreters can't
-modify it). This makes the Tcl 8.0 behavior almost identical to 7.6
-except that the default precision is 12 instead of 6. (JO)
-*** POTENTIAL INCOMPATIBILITY ***
+4/5/96 (bug fix) Tk would occasionally crash when destroying toplevels
+under Windows. (SS)
------------------ Released 8.0, 8/18/97 -----------------------
+4/5/96 (bug fix) Fonts were not being properly deallocated, causing
+GDI resources to be consumed and never released under Windows. (SS)
-8/19/97 (bug fix) Minimal fix for glob -nocomplain bugs:
-"glob -nocomplain unreadableDir/*" was generating an anonymous
-error. More in depth fixes will come with 8.1. (DL).
-
-8/20/97 (bug fix) Removed check for FLT_MIN in binary command so
-underflow conditions are handled by the compiler automatic
-conversions. (SS)
-
-8/20/97 (bug fixes) Fixed several compilation-related bugs:
- - Array cmd wasn't detecting arrays that, while compiled, do not yet
- exist (e.g., are marked undefined since they haven't been assigned
- to yet).
- - The GetToken procedure in tclCompExpr.c wasn't recognizing properly
- whether an integer token was invalid. For example, "0x$" is not
- a valid integer.
- - Performance bug in TclExecuteByteCode: the size of its stack frame
- was reduced by over 20% by moving errorInfo code elsewhere.
- - Uninitialized memory read error in tclCompile.c. (BL)
-
-8/21/97 (bug fix) safe::interpConfigure now behave like Tk widget's
-configure : it changes only the options you provide and you can get
-the current value of any single option. New ?-nested boolean? and
-?-statics boolean? for all safe::interp* commands but we still
-accept (upward compatibility) the previously defined non valued
-flags ?-noStatics? and ?-nestedLoadOk?. Improved the documentation. (DL).
+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)
-8/22/97 (bug fix) Updated PrintDbl.3 to reflect the fact that the
-tcl_precision variable is still used and that it is now shared by all
-interpreters. (BL)
+4/11/96 (bug fix) "wm minsize" did not properly report the minimum
+size imposed by the Windows window manager. (SS)
-8/25/97 (bug fix) Fixed array access bug in IllegalExprOperandType
-procedure in tclExecute.c: it was not properly supporting the || and &&
-operators. (BL)
+4/13/96 (bug fix) Text widgets could dump core in some cases where
+text was inserted on the top visible line. (JO)
-8/27/97 (bug fix) In cases where a channel handler was created with an
-empty event mask while data was still buffered in the channel, the
-channel code would get stuck spinning on a timer that would starve
-idle handlers. This mostly happened in Tk when reading from stdin. (SS)
-
-9/4/97 (bug fix) Slave interps now inherit the maximum recursion limit
-of their parent instead of starting back at the default. {nb: this still
-does not prevent stack overflow by multi-interps recursion or aliasing} (DL)
-
-9/11/97 (bug fix) An uninitialized variable in Tcl_WaitPid caused
-pipes to fail to report eof properly under Windows. (SS)
-
-9/12/97 (bug fix) "exec" was misidentifying some DOS executables as not
-executable. (CCS)
-
-9/14/97 (bug fix) Was using the wrong structure in sizeof operation in
-tclUnixChan.c. (JL)
-
-9/15/97 (bug fix) Fixed notifier to break out of do-one-event loop if
-Tcl_WaitForEvent returns 1, so that callers of Tcl_DoOneEvent will get
-a chance to check whether the event just handled is significant. This
-affected mainly recursive calls to Tcl_VWaitCmd; these did not get a
-chance to notice that the variable they were waiting for has been set
-and thus they didn't terminate the vwait. (JL, DL, SS)
-
-9/15/97 (bug fix) Alignment problems in "binary format" would cause a
-crash on some platforms when formatting floating point numbers. (SS)
-
-9/15/97 (bug fix) Fixed bug in Macintosh socket code. Now passes all
-tests in socket.test that are not platform specific. (Thanks to Mark
-Roseman for the pointer on the fix.) (RJ)
-
-9/18/97 (bug fix) Fixed bug -dictionary option of lsort that could
-cause the compare function to run off the end of an array if the
-number only contained 0's. (Thanks to Greg Couch for the report.) (RJ)
-
-9/18/97 (bug fix) TclFinalizeEnvironment was not cleaning up
-properly. (DL, JI)
-
-9/18/97 (bug fix) Fixed long-standing bug where an "array get" command
-did not trigger traces on the array or its elements. (BL)
-
-9/18/97 (bug fixes) Fixed compilation-related bugs:
- - Fixed errorInfo traceback information for toplevel coomands that
- contain nested commands.
- - In the expr command, && and || now accept boolean operands as well
- as numeric ones. (BL)
-
-9/22/97 (bug fix) Fixed bug that prevented translation modes from being
-set independently for input and output on sockets if input was "auto". (JL)
-
-9/24/97 (bug fix) Tcl_EvalFile(3) and thus source(n) now works fine on
-files containing NUL chars. (DL)
-
-9/26/97 (bug fix) Fixed use of uninitialized memory in the environ array
-that later could cause random core dumps. Applies to all platforms. (JL)
-
-9/26/97 (bug fix) Fixed use of uninitialized memory in socket address data
-structure under some circumstances. This could cause random core dumps.
-This applies only to Unix. (JL)
-
-9/26/97 (bug fix) Opening files on PC-NFS volumes would cause a hang
-until the system timed after the file was closed. (SS)
-
-10/6/97 (bug fix) The join(n) command, though objectified, was loosing
-NULs in the joinString and in list elements after the 2nd one.
-Now you can "join $list \0" for instance. (DL)
-
-10/9/97 (bug fix) Under windows, if env(TMP) or env(TEMP) referred to a
-non-existent directory, exec would fail when trying to create its temporary
-files. (CCS)
-
-10/9/97 (bug fix) Under mac and windows, "info hostname" would crash if
-sockets were installed but the hostname could not be determined anyhow.
-Tcl_GetHostName() was returning NULL when it should have been returning
-an empty string. (CCS)
-
-10/10/97 (bug fix) "file attribute /" returned error on windows. (CCS)
-
-10/10/97 (bug fix) Fixed the auto_load procedure to handle procedures
-defined in namespaces better. Also fixed pgk_mkIndex so it sees procedures
-defined in nested namespaces. Index entries are still only made for
-exported procedures. (BW)
-
-10/13/97 (bug fix) On unix, for files with unknown group or owner
-attributes, querying the "file attributes" would return an error rather than
-returning the group's or owner's id number, although tha command accepts
-numbers when setting the file's group or owner. (CCS)
-
-10/22/97 (bug fix) "fcopy" did not eval the callback script at the
-global scope. (SS)
-
-10/22/97 (bug fix) Fixed the signature of the CopyDone callback used in
-the http package(s) so they can handle error cases properly. (BW)
-
-10/28/97 (bug fixes) Fixed a problem where lappend would free the Tcl object
-in a variable if a Tcl_ObjSetVar2 failed because of an error calling a trace
-on the variable. (BL)
-
-10/28/97 (bug fix) Changed binary scan to properly handle sign
-extension of integers on 64-bit or larger machines. (SS)
-
-11/3/97 (bug fixes) Fixed several bugs:
- - expressions such as "expr ($x)" must be compiled out-of-line
- (call the expr command procedure at runtime) to ensure the correct
- behavior when "$x" is an expression such as "5+10".
- - "array set a {}" now creates a new array var with an empty array
- value if the var didn't already exist.
- - "lreplace $foo end end" no longer returns an error (just an empty
- list) if foo is empty.
- - upvar will no longer create a variable in a namespace that refers
- to a variable in a procedure.
- - deleting a command trace within a command trace callback would
- make the code that calls traces to reference freed memory.
- - significantly sped up "string first" and "string last" (fix from
- darrel@gemstone.com).
- - seg fault in Tcl_NewStringObj() when a NULL is passed as the byte
- pointer argument and Tcl is compiled with -DTCL_MEM_DEBUG.
- - documentation and error msg fixes. (BL)
-
-11/3/97 (bug fix) Fixed a number of I/O bugs related to word sizes on
-64-bit machines. (SS)
-
-11/6/97 (bug fix) The exit code of the first process created by Tcl
-on Windows was not properly reported due to an initialization
-problem. (SS)
+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 8.0p1, 11/7/97 -----------------------
+----------------- Released 4.1, 4/21/96 -----------------------
-11/19/97 (bug fix) Fixed bug in linsert where it sometimes accidently
-cleared out a shared argument list object. (BL).
+5/1/96 (bug fix) "option readfile" did not handle files with CRLF
+line termination. (SS)
-11/19/97 (bug fix) Autoloading in namespaces was not working properly.
-auto_mkindex is still not really namespace aware but most common
-cases should now be handled properly (see init.test). (BW, DL)
+5/1/96 (bug fix) Changed to install tkConfig.sh under "make install-binaries",
+not "make install-libraries". (JO)
-11/20/97 (enhancement) Made the changes required by the new Apple
-Universal Headers V.3.0, so that Tcl will compile with CW Pro 2.
+5/7/96 (bug fix) Moved initScript in tkUnixInit.c to writable memory to
+avoid potential core dumps. (JO)
-11/24/97 (bug fix) Fixed tests in clock test suite that needed the
--gmt flag set. Thanks to Jan Nijtmans for reporting the problem. (RJ)
+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)
------------------ Released 8.0p2, 11/25/97 -----------------------
+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)
-12/3/97 (bug fix/optimization) Removed uneeded 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)
+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)
----- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ----
+5/16/96 (new feature) Implemented application embedding on Windows
+platforms (only Tk inside another application, not the other way yet). (JL)
-12/8/97 (bug fix) Need to protect the newly accepted channel in an
-accept callback on a socket, otherwise the callback may close it and
-cause an error, which would cause the C code to attempt to close the
-now deleted channel. Bumping the refcount assures that the channel sticks
-around to be really closed in this case. (JL)
-
-12/8/97 (bug fix) Need to protect the channel in a fileevent so that it
-is not deleted before the fileevent handler returns. (CS, JL)
-
-12/18/97 (bug fix) In the opt argument parsing package: if the description
-had only flags, the "too many arguments" case was not detected. The default
-value was not used for the special "args" ending argument. (DL)
-
-1/15/98 (improvement) Moved common part of initScript in common file.
-Moved windows specific initialization to init.tcl so you can initialize
-Tcl in windows without having to call Tcl_Init which is now only
-searching for init.tcl {back ported from 8.1}. (DL)
-
----- Shipped as part of the plugin as 8.0p2Plugin2, Jan 15th 98 ----
-
-5/27/98 (bug fix) Windows socket driver did not notice new data arriving
-on nonblocking sockets until the event loop was entered. (SS)
-
-5/27/98 (bug fix) Windows socket driver used FIONREAD, which is not
-supported correctly by WinSock. (SS)
-
-6/9/98 (bug fix) Generic channel code failed to report readable file
-events on buffered data that was left behind by a gets or read that
-did not consume all available data. (SS)
-
-6/18/98 (bug fix) Compilation of loop expressions was too aggressive
-and incorrectly inlined non-literal expressions. (SS)
-
-6/18/98 (bug fix) "info var" and "info locals" incorrectly reported
-the existence of compiler temporary variables. (SS)
-
-6/18/98 (bug fix) Dictionary sorting used signed character
-comparisons. (SS)
-
-6/18/98 (bug fix) Compile procs corrupted the exception stack in some
-cases. (SS)
-
-6/18/98 (bug fix) Array set had erratic behavior when initializing a
-variable from an empty value list. (SS)
-
-6/18/98 (bug fix) The Windows registry package had a bad bounds check
-that could lead to a crash. (SS)
-
-6/18/98 (bug fix) The foreach compile proc did not correctly handle
-non-local variable references. (SS)
-
-6/25/98 (new features) Added name resolution hooks to support [incr Tcl].
-There are new internal Tcl_*Resolver* APIs to add, query and remove the hooks.
-With this changes it should be possible to dynamically load [incr Tcl]
-as an extension. (MM)
-
-7/1/97 (bug fix) The commands "info args, body, default, procs" did
-not correctly handle imported procedures. (RJ)
-
-7/6/98 (improvement) pkg_mkIndex now implements the "package require"
-command. This makes it possible to create index files for packages
-that require another package and then execute code from that package in
-their file. Previously, this would throw an error because the required
-package had not been loaded. The -nopkgrequied flag is provided to
-revert back to the old functionality. (EMS)
-
-7/6/98 (improvement) back-ported the -direct flag from 8.1 into
-pkg_mkIndex. This results in pkgIndex.tcl files that contain direct
-source or load commands instead of tclPkgSetup commands. (EMS)
-
-7/6/98 (improvement) made changes to the AuxData items structures to support
-storage of compiled scripts on disk. Also some related minor changes in
-the compilation and execution engine. (EMS)
-
-6/4/98 (enhancement) Added new internal routines to support inserting
-and deleting from the stat, access, and open-file-channel mechanisms.
-TclAccessInsertProc, TclStatInsertProc, & TclOpenFileChannelInsertProc
-insert pointers to such routines; TclAccessDeleteProc, TclStatDeleteProc,
-& TclOpenFileChannelDeleteProc delete pointers to such routines. See
-the file generic/tclIOUtils.c for more details. (SKS)
-
-7/1/98 (enhancement) Added a new internal C variable
-tclPreInitScript. This is a pointer to a string that may hold an
-initialization script; If this pointer is non-NULL it is evaluated in
-Tcl_Init() prior to the built-in initialization script defined in the
-file generic/tclInitScript.h. (SKS)
-
-7/6/98 (bug fix) Removed dead code in PlatformInitExitHandler so that
-the TCL_LIBRARY value can be safely patched in binaries. (BW)
-
-7/24/98 (enhancement) Incorporated a new version of auto_mkindex that
-can support the [incr Tcl] class structures. This version will index
-all procedures in a source file, not just those where "proc" starts
-at the beginning of the line. If you want the old behavior, use the
-auto_mkindex_old procedure. (MM)
-
-7/24/98 (feature change) Changed the Windows registry key to be
-HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, and to store the path
-in the default value instead of "Root". Also, this key can be
-specified at compile time in case Tcl is being used in a different
-context where it needs an alternate library path from the standard Tcl
-installation. (SS)
-
-7/24/98 (feature change) Changed the search order for init.tcl. The
-tcl_library variable can now be set before calling Tcl_Init to avoid
-doing any searches. If it isn't set, then Tcl checks
-env(TCL_LIBRARY), the static value set at compile time, an install
-directory relative to the executable, a source directory relative to
-the executable, and a tcl directory relative to the source heirarchy
-containing the executable. See the comment at the top of
-generic/tclInitScript.h for more details. (SS)
-
-7/27/98 (config change) Changed the use of the DBGX flag in configure.in
-and the makefile to be TCL_DBGX. Users of tclConfig.sh may need to pass
-this through their configure files with AC_SUBST. (BW)
-
-729/98 (bug fix) Changed [info body] to return a copy of the body of a
-compiled procedure instead of the body itself, to avoid invalidation
-of the internal rep and loss of the byte-codes. (EMS)
-
-8/5/98 (bug fix) The platform init code could walk off the end of a
-buffer when reading the PkgPath registry value on Windows. (SS)
-
-8/5/98 (Windows makefile change) Introduced a set of macros to deal with
-exporting symbols when compiling DLLS on Windows. See win/README for
-details. (EMS)
-
-8/5/98 (addendum) Added a second Windows registry key under
-HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, named "pkgPath".
-This is a multi-string value used to initialize the tcl_pkgPath
-variable. This is required if extension DLLs are in architecture specific
-subdirectories. (SS)
-
-8/6/98 (new feature) Added tcl_findLibrary to init.tcl for use by
-extensions, including Tk. This searches in a canonical way for
-an extensions library directory and initialization file. (BW)
-
-8/10/98 (bug fix) Imported commands used to get lost if the target
-of the import was redefined. Tcl_CreateCommand and Tcl_CreateObjCommand
-were updated to restore import links. (Note that if you rename a command,
-the import links move to the new name, and if you delete a command then
-the import links get lost. These semantics have not changed.) (MC)
-
--------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/10/98 ------
-
-9/3/98 (bug fix) Tcl_Realloc was failing under Windows because the
-GlobalReAlloc API was not correctly re-allocating blocks that were
-32k+. The fix was to use newer Win32 APIs (HeapAlloc, HeapFree, and
-HeapReAlloc.) (BS)
-
-10/5/98 (bug fix) Fixed bug in pkg_mkIndex that caused some files that do
-a "package require" of packages in the Tcl libraries to give a warning like
- warning: "xx.tcl" provides more than one package ({xx 2.0} {yy 0.3})
-and generate a broken pkgIndex.tcl file. (EMS)
-
-10/5/98 (bug fix) Pkg_mkIndex was not doing a case-insensitive comparison
-of extensions to determine whether to load or source a file. Thus, under
-Windows, MYDLLNAME.DLL was sourced, and mydllname.dll loaded. (EMS)
-
-10/5/98 (new feature) Created a new Tcl_Obj type, "procbody". This object's
-internal representation holds a pointer to a Proc structure. Extended
-TclCreateProc to take both strings and "procbody". (EMS)
-
-10/13/98 (bug fix) The "info complete" command can now handle strings
-with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au
-for providing this fix. (RJ)
-
-10/13/98 (bug fix) The "lsort -dictionary" command did not properly
-handle some numbers starting with 0. Thanks to Richard Hipp
-<drh@acm.org> for submitting the fix to Scriptics. (RJ)
-
-10/13/98 (bug fix) The function Tcl_SetListObj was creating an invalid
-Tcl_Obj if the list had zero elements (despite what the comments said
-it would do). Thanks to Sebastian Wangnick for reporting the
-problem. (RJ)
-
-10/20/98 (new feature) Added tcl_platform(debug) element to the
-tcl_platform array on Windows platform. The existence of the debug
-element of the tcl_platform array indicates that the particular Tcl
-shell has been compiled with debug information. Using
-"info exists tcl_platform(debug)" a Tcl script can direct the
-interpreter to load debug versions of DLLs with the load
-command. (SKS)
+5/16/96 (new feature) Added C API Tk_SafeInit that adds Tk to a safe
+interpreter. (JL)
-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 ***
+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)
-10/23/98 (bug fix) tcl_findLibrary had a stray ] in one of the
-pathnames it searched for the initialization script. tclInitScript.h
-was incorrectly adding the parent of tcl_library to tcl_pkgPath. This
-logic was moved into init.tcl, and the initialization of auto_path was
-documented. Thanks to Donald Porter and Tom Silva for related
-patches. (BW)
+5/16/96 (new feature) Implemented application embedding on Windows
+platforms (only Tk inside another application, not the other way yet). (JL)
-10/29/98 (bug fix) Fixed Tcl_NotifyChannel to use Tcl_Preserve instead
-of Tcl_RegisterChannel so that 1) unregistered channels do not get
-closed after their first fileevent, and 2) errors that occur during
-close in a fileevent script are actually reflected by the close
-command. (BW)
+5/16/96 (new feature) Added C API Tk_SafeInit that adds Tk to a safe
+interpreter. (JL)
-10/30/98 (bug fix) Overhaul of pkg_mkIndex to deal with transitive
-package requires and packages split among scripts and binary files.
-Also fixed ommision of global for errorInfo in tcl_findLibrary. (BW)
+5/22/96 (bug fix) Listboxes weren't properly ignoring double clicks on
+button 1. (JO)
-11/08/98 (bug fix) Fixed the resource command to always detect
-the case where a file is opened a second time with the same
-permissions. IM claims that this will always cause the same
-FileRef to be returned, but in MacOS 8.1+, this is no longer the case,
-so we have to test for this explicitly. (JI)
+6/12/96 (bug fix) Focus was automatically placed on new toplevels.
+This caused the titlebar to flash during menubar traversal. (SS)
-11/10/98 (feature change) When compiling with Metrowerk's MSL, use the
-exit function from MSL rather than ExitToShell. This allows MSL to
-clean up its temporary files. Thanks to Vince Darley for this
-improvement. (JI)
+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)
------------------ Released 8.0.4, 11/19/98 -------------------------
+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)
-11/20/98 (bug fix) Handle possible NULL return in TclGetStdFiles. (RJ)
+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)
-11/20/98 (bug fix) The dltests would not build on SGI. They reported
-that you could not mix n32 with 032 binaries. The configure script
-has been modified to get the EXTRA_CFLAGS from the tcl configure
-script. [Bug id: 840] (RJ)
+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)
-12/3/98 (bug fix) Windows NT creates sockets so they are inheritable
-by default. Fixed socket code so it turns off this bit right after
-creation so sockets aren't kept open by exec'ed processes. [Bug: 892]
-Thanks to Kevin Kenny for this fix. (SS)
+7/19/96 (bug fix) Fixed bug in tkImgGIF.c that cause core dumps if a
+GIF file contained multiple images. (JO)
-1/11/98 (bug fix) On HP, "info sharedlibextension" was returning
-empty string on static apps. It now always returns ".sl". (RJ)
+7/20/96 (bug fix) Deadlock could occur if a recursive series of send
+operations involved multiple displays. (JO)
-1/28/99 (configure change) Now support -pipe option on gcc. (RJ)
+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)
-2/2/99 (bug fix) Fixed initialization problem on Windows where no
-searching for init.tcl would be performed if the registry keys were
-missing. (stanton)
+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)
-2/2/99 (bug fix) Added support for HKEY_PERFORMANCE_DATA and
-HKEY_DYN_DATA keys in the "registry" command. (stanton)
+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)
-2/2/99 (bug fix) ENOTSUP and EOPNOTSUPP clashed on some Linux
-variants. (stanton)
+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)
-2/2/99 (enhancement) The "open" command has been changed to use the
-object interfaces. (stanton)
+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)
-2/2/99 (bug fix) In some cases Tcl would crash due to an overflow of
-the exception stack resulting from a missing byte code in some
-expressions. (stanton)
+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)
-2/2/99 (bug fix) Changed configure so Linux and IRIX shared libraries
-are linked with the system libraries. (stanton)
+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)
-2/2/99 (bug fix) Added support for BSDI 4.x (BSD/OS-4*) to the
-configure script. (stanton)
+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)
-2/2/99 (bug fix) Fixed bug where upvar could resurrect a namespace
-variable after the namespace had been deleted. (stanton)
+8/22/96 (feature change) The order in which the grid geometry manager
+reports slaves is now last-managed first. (SU)
-2/2/99 (bug fix) In some cases when creating variables, the
-interpreter result was being modified even if the TCL_LEAVE_ERR_MSG
-flag was set. (stanton)
+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)
-2/2/99 (bug fix & new feature) Changed the socket drivers to properly
-handle failures during an async socket connection. Added a new
-fconfigure option "-error" to retrieve the failure message. See the
-socket.n manual entry for details. (stanton)
+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)
-2/2/99 (bug fix) Deleting a renamed interp alias could result in a
-panic. (stanton)
+8/22/96 (new demos) Added "fsbox", "msgbox" and "clrpick" demos. (IL)
-2/2/99 (feature change/bug fix) Changed the behavior of "file
-extension" so that it splits at the last period. Now the extension of
-a file like "foo..o" is ".o" instead of "..o" as in previous versions.
+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 ***
------------------ Released 8.0.5, 3/9/99 -------------------------
-
-======== Changes for 8.0 go above this line ========
-======== Changes for 8.1 go below this line ========
-
-6/18/97 (new feature) Tcl now supports international character sets:
- - All C APIs now accept UTF-8 strings instead of iso8859-1 strings,
- wherever you see "char *", unless explicitly noted otherwise.
- - All Tcl strings represented in UTF-8, which is a convenient
- multi-byte encoding of Unicode. Variable names, procedure names,
- and all other values in Tcl may include arbitrary Unicode characters.
- For example, the Tcl command "string length" returns how many
- Unicode characters are in the argument string.
- - For Java compatibility, embedded null bytes in C strings are
- represented as \xC080 in UTF-8 strings, but the null byte at the end
- of a UTF-8 string remains \0. Thus Tcl strings once again do not
- contain null bytes, except for termination bytes.
- - For Java compatibility, "\uXXXX" is used in Tcl to enter a Unicode
- character. "\u0000" through "\uffff" are acceptable Unicode
- characters.
- - "\xXX" is used to enter a small Unicode character (between 0 and 255)
- in Tcl.
- - Tcl automatically translates between UTF-8 and the normal encoding for
- the platform during interactions with the system.
- - The fconfigure command now supports a -encoding option for specifying
- the encoding of an open file or socket. Tcl will automatically
- translate between the specified encoding and UTF-8 during I/O.
- See the directory library/encoding to find out what encodings are
- supported (eventually there will be an "encoding" command that
- makes this information more accessible).
- - There are several new C APIs that support UTF-8 and various encodings.
- See Utf.3 for procedures that translate between Unicode and UTF-8
- and manipulate UTF-8 strings. See Encoding.3 for procedures that
- create new encodings and translate between encodings. See
- ToUpper.3 for procedures that perform case conversions on UTF-8
- strings.
-
-9/18/97 (enhancement) Literal objects are now shared by the ByteCode
-structures created when compiled different scripts. This saves up to 45%
-of the total memory needed for all literals. (BL)
-
-9/24/97 (bug fixes) Fixed Tcl_ParseCommand parsing of backslash-newline
-sequences at start of command words. Suppressed Tcl_EvalDirect error logging
-if non-TCL_OK result wasn't an error. (BL)
-
-10/17/97 (feature enhancement) "~username" now refers to the users' home
-directory on Windows (previously always returned failure). (CCS)
-
-10/20/97 (implementation change) The Tcl parser has been completely rewritten
-to make it more modular. It can now be used to parse a script without actually
-executing it. The APIs for the new parser are not correctly exported, but
-they will eventually be exported and augmented with Tcl commands so that
-Tcl scripts can parse other Tcl scripts. (JO)
-
-10/21/97 (API change) Added "flags" argument to Tcl_EvalObj, removed
-Tcl_GlobalEvalObj procedure. Added new procedures Tcl_Eval2 and
-Tcl_EvalObjv. (JO)
+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/22/97 (API change) Renamed Tcl_ObjSetVar2 and Tcl_ObjGetVar2 to
-Tcl_SetObjVar2 and Tcl_GetObjVar2 (for consistency with other C APIs)
-and changed the name arguments to be strings instead of objects. (JO)
+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/27/97 (enhancement) Bytecode compiler rewritten to use the new Tcl
-parser. (BL)
+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)
-11/3/97 (New routines) Added Tcl_AppendObjToObj, which appends the
-string rep of one Tcl_Obj to another. Added Tcl_GetIndexFromObjStruct,
-which is similar to Tcl_GetIndexFromObj, except that you can give an
-offset between strings. This allows Tcl_GetIndexFromObjStruct to be
-called with a table of records which have strings in them. (SRP)
+10/1/96 (bug fix) "The way grid handles '^' short-cuts was re-written
+to eliminate core dumps. (SAU)
-12/4/97 (enhancement) New Tcl expression parser added. Added new procedure
-Tcl_ParseExpr and new token types TCL_TOKEN_SUB_EXPR and
-TCL_TOKEN_OPERATOR. Expression compiler is reimplemented to use this
-parser. (BL)
+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).
-12/9/97 (bug fix) Tcl_EvalObj() increments/decrements the refcount of the
-script object to prevent the object from deleting itself while in the
-middle of being evaluated. (CCS)
+10/3/96 (bug fix) Under Windows text placed on the clipboard did not
+undergo CRLF translation when delivered to other applications. (SS)
-12/9/97 (bug fix) Memory leak in Tcl_GetsObjCmd(). (CCS)
+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)
-12/11/97 (bug fix) Environment array leaked memory when compiled with
-Visual C++. (SS)
+10/3/96 (bug fix) Under Windows, the image blank subcommand did not
+work. (SS)
-12/11/97 (bug fix) File events and non-blocking I/O did not work on
-pipes under Windows. Changed to use threads to achieve non-blocking
-behavior. (SS)
+10/10/96 (bug fix) Under Windows & Macintosh, XSetFont and XChangeGC
+were not implemented, and XSetLineAttributes did not correctly update
+the GC. (SS)
-12/18/97 (bug fixes) Fixed segfault in "namespace import"; importing a
-procedure that causes a cycle now returns an error. Modified "info procs",
-"info args", "info body", and "info default" to return information about
-imported procedures as well as procedures defined in a namespace. (BL)
+10/10/96 (bug fix) Under Windows, 8-bit non-palette displays were not
+handled properly. (SS)
-12/19/97 (enhancement) Added new Tcl_GetString() procedure that can be used
-in place of Tcl_GetStringFromObj() if the string representation's length
-isn't needed. (BL)
+10/10/96 (bug fix) Under Windows, images of depth other than 8 or 24
+bits were not being rendered properly. (SS)
-12/18/97 (bug fix) In the opt argument parsing package: if the description
-had only flags, the "too many arguments" case was not detected. The default
-value was not used for the special "args" ending argument. (DL)
+10/10/96 (bug fix) Under Windows, bitmap subimages were not correctly
+displayed. (SS)
-1/7/98 (clean up) Moved everything not absolutly necessary out of init.tcl
-procs now in auto.tcl and package.tcl can be autoloaded if needed. (DL)
+10/14/96 (bug fix) Under Window, wm resizable would constrain both
+programatic resizes as well as user resizes. (SS)
-1/7/98 (enhancement) tcltest made at install time will search for it's
-init.tcl where it is, even when using virtual path compilation. (DL)
+----------------- Released 4.2, 10/16/96 -----------------------
-1/8/98 (os bug workaround) when needed, using a replacement for memcmp so
-string compare "char with high bit set" "char w/o high bit set" returns
-the expected value on all platforms. (DL)
+10/17/96 (bug fix) XCopyPlane was broken under Windows and would cause
+a crash when used with a clipping bitmap. (SS)
-1/8/98 (unix portability/configure) building from .../unix/targetName/
-subdirectories and simply using "../configure" should now work fine. (DL)
+10/21/96 (bug fix) Added missing resources needed by tk_getOpenDialog
+on the Macintosh to the shared library for Tk. (RJ)
-1/14/98 (enhancement) Added new regular expression package that
-supports AREs, EREs, and BREs. The new package includes new escape
-characters, meta-syntax, and character classes inside brackets.
-Regexps involving backslashes may behave differently. (MH)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-1/16/98 (os workaround) Under windows, "file volume" was causing chatter
-and/or several seconds of hanging when querying empty floppy drives.
-Changed implementation to call an empirically-derived function that doesn't
-cause this. (CCS)
+10/23/96 (bug fix) Errors in files sourced by the Macintosh
+"Source..." menu are now correctly reported via the background
+error mechanism. (RJ)
-1/16/98 (enhancement) Converted regular expressions to a Tcl_Obj type so
-their compiled form gets cached automatically. Reduced NSUBEXP from 100
-to 20. (BW)
+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)
-1/16/98 (documentation) Change unclear documentation and comments for
-functions like Tcl_TranslateFileName() and Tcl_ExternalToUtfDString(). Now
-it explicitly says they take an uninitialized or free DString. A DString
-that is "empty" or "not holding anything" could have been interpreted as one
-currently with a zero length, but with a large dynamically allocated buffer.
-(CCS)
+10/24/96 (bug fix) Provided workaround for Apple bug that doesn't
+handle zooming correctly for floating windows. (RJ)
------------------ Released 8.1a1, 1/22/98 -----------------------
+10/24/96 (bug fix) Macintosh tearoff menus are now correctly
+displayed as Mac floating windows. (RJ)
-1/28/98 (new feature) Added a "-direct" optional flag to pkg_mkIndex
-to generate direct loading package indexes (such those you need
-if you use namespaces and plan on using namespace import just after
-package require). pkg_mkIndex still has limitations regarding
-package dependencies but errors are now ignored and with -direct, correct
-package indexes can be generated even if there are dependencies as long
-as the "package provide" are done early enough in the files. (DL)
-
-1/28/98 (enhancement) Performance tuning of regexp and regsub. (CCS)
-
-1/28/98 (bug fix) regexp and regsub with "-indices" returned the byte-offsets
-of the characters in the UTF-8 representation, not the character offsets
-themselves. (CCS)
-
-1/28/98 (bug fix) "clock format 0 -format %Z -gmt 1" would return the local
-timezone string instead of "GMT" on Solaris and Windows.
-
-1/28/98 (bug fix) Restore tty settings when closing serial device on Unix.
-This is good behavior when closing real serial devices, essential when
-closing the pseudo-device /dev/tty because the user's terminal settings
-would be left useless, in raw mode, when tcl quit. (CCS)
-
-1/28/98 (bug fix) Tcl_OpenCommandChannel() was modifying the contents of the
-argv array passed to it, causing problems for any caller that wanted to
-continue to use the argv array after calling Tcl_OpenCommandChannel(). (CCS)
-
-2/1/98 (bug fix) More bugs with %Z in format string argument to strftime():
-1. Borland always returned empty string.
-2. MSVC always returned the timezone string for the current time, not the
- timezone string for the specified time.
-3. With MSVC, "clock format 0 -format %Z -gmt 1" would return "GMT" the first
- time it was called, but would return the current timezone string on all
- subsequent calls. (CCS)
-
-2/1/98 (bug fix) "file stat" was broken on Windows.
-1. "file stat" of a root directory (local or network) or a relative path that
- resolved to a root directory (c:. when in pwd was c:/) was returning error.
-2. "file stat" on a regular file (S_IFREG), the st_mode was sign extended to
- a negative int if the platform-dependant type "mode_t" was declared as a
- short instead of an unsigned short.
-3. "file stat" of a network directory, the st_dev was incorrectly reported
- as the id of the last accessed local drive rather than the id of the
- network drive. (CCS)
-
-2/1/98 (bug fix) "file attributes" of a relative path that resolved to a
-root directory was returning error. (CCS)
-
-2/1/98 (bug fix) Change error message when "file attribute" could not
-determine the attributes for a file. Previously it would return different
-error messages on Unix vs. Windows vs. Mac. (CCS)
-
-2/4/98 (bug fixes) Fixed several instances of bugs where the parser/compiler
-would reach outside the range of allocated memory. Improved the array
-lookup algorithm in set compilation. (DL)
-
-2/5/98 (change) The TCL_PARSE_PART1 flag for Set/Get(Obj)Var2 C APIs is now
-deprecated and ignored. The part1 is always parsed when the part2 argument
-is NULL. This is to avoid a pattern of errors for extension writers converting
-from string based Tcl_SetVar() to new Tcl_SetObjVar2() and who could easily
-forget to provide the flag and thus get code working for normal variables
-but not for array elements. The performance hit is minimal. A side effect
-of that change is that is is no longer possible to create scalar variables
-that can't be accessed by tcl scripts because of their invalid name
-(ending with parenthesis). Likewise it is also parsed and checked to
-ensure that you don't create array elements of array whose name is a valid
-array element because they would not be accessible from scripts anyway.
-Note: There is still duplicate array elements parsing code. (DL)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-2/11/98 (bug fix) Sharing objects between interps, such as by "interp
-eval" or "send" could cause a crash later when dereferencing an interp
-that had been deleted, given code such as:
- set a {set x y}
- interp create foo
- interp eval foo $a
- interp delete foo
- unset a
-Interp "foo" was gone, but "a" had a internal rep consisting of bytecodes
-containing a dangling pointer to "foo". Unsetting "a" would attempt to
-return resources back to "foo", causing a crash as random memory was
-accessed. The lesson is that that if an object's internal rep depends on
-an interp (or any other data structure) it must preserve that data in
-some fashion. (CCS)
-
-2/11/98 (enhancement) The "interp" command was returning inconsistent error
-messages when the specified slave interp could not be found. (CCS)
-
-2/11/98 (bug fix) Result codes like TCL_BREAK and TCL_CONTINUE were not
-propagating through the master/slave interp boundaries, such as "interp
-eval" and "interp alias". TCL_OK, TCL_ERROR, and non-standard codes like
-teh integer 57 work. There is still a question as to whether TCL_RETURN
-can/should propagate. (CCS)
-
-2/11/98 (bug fix) TclCompileScript() was derefering memory 1 byte before
-start of the string to compile, looking for ']'. (CCS,DL)
-
-2/11/98 (bug fix) Tcl_Eval2() was derefering memory 1 byte before start
-of the string to eval, looking for ']'. (CCS,DL)
-
-2/11/98 (bug fix) Compiling "set a(b" was running off end of string. (CCS,DL)
-
-2/11/98 (bug fix) Windows initialization code was dereferencing
-uninitialized memory if TCL_LIBRARY environment didn't exist. (CCS)
-
-2/11/98 (bug fix) Windows "registry" command was dereferencing
-uninitialized memory when constructing the $errorCode for a failed
-registry call. (CCS)
-
-2/11/98 (enhancement) Eliminate the TCL_USE_TIMEZONE_VAR definition from
-configure.in, because it was the same information as the already existing
-HAVE_TM_ZONE definition. The lack of HAVE_TM_ZONE is used to work around a
-Solaris and Windows bug where "clock format [clock sec] -format %Z -gmt 1"
-produces the local timezone string instead of "GMT". (CCS)
-
-2/11/98 (bug fix) Memleaks and dereferencing of uninitialized memory in
-regexp if an error occurred while compiling a regular expression. (CCS).
-
-2/18/98 (new feature) Added mutexes and thread local storage in order
-to make Tcl thread safe. For testing purposes, there is a testthread
-command that creates a new thread and an interpreter inside it. See
-thread.test for examples, but this script-level interface is not fixed.
-Each thread has its own notifier instance to manage its own events,
-and threads can post messages to each other's message queue.
-This uses pthreads on UNIX, and native thread support on other platforms.
-You enable this by configuring with --enable-threads. Note that at
-this time *Tk* is still not thread safe. Special thanks to
-Richard Hipp: his earlier implementation inspired this work. (BW, SS, JI)
-
-2/18/98 (hidden feature change) The way the env() array is shared among
-interpreters changed. Updates to env used to trigger write traces in
-other interpreters. This undocumented feature is no longer implemented.
-Instead, variable tracing is used to keep the C-level environ array in sync
-with the Tcl-level env array. This required adding TCL_TRACE_ARRAY support
-to Tcl_TraceVar2 so that array names works properly. (BW)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-2/18/98 (enhancement) Conditional compilation for unix systems (e.g.,
-IRIX, SCO) that use f_bsize instead of st_blksize to determine disk block
-size. (CCS)
+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)
-2/23/98 (bug fix) Fixed the emulation of polling selects in the threaded
-version of the Unix notifier. The bug was showing up on a multiprocessor
-as starvation of the notifier thread. (BW)
+12/5/96 (bug fix) Fixed the Macintosh implementation of pointer x/y
+which was returning garbage. (RJ)
------------------ Released 8.1a2, Feb 23 1998 -----------------------
+12/6/96 (bug fix) Fixed grid bug where the positioning of slaves was
+incorrect for non-zero values of ipadx and ipady (SU)
-9/22/98 (bug fix) Changed the value of TCL_TRACE_ARRAY so it no longer
-conflicts with the deprecated TCL_PARSE_PART1 flag. This should
-improve portability of C code. (stanton)
+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)
-10/6/98 (bug fix) The compile procedure for "if" incorrectly attempted
-to match against the literal string "if", resulting in a stack
-overflow when "::if" was compiled. It also would incorrectly accept
-"if" instead of "elsif" in later clauses. (stanton)
+----------------- Released 4.2p1, 12/8/96 (Mac only) --------------
-10/15/98 (new feature) Added a "totitle" subcommand to the "string"
-command to convert strings to capitalize the first character of a string
-and lowercase all of the other characters. (stanton)
+1/17/97 (bug fix) Fixed bug where the Tk clipboard was not in sync
+with the Macintosh clipboard on start-up. (RJ)
-10/15/98 (bug fix) Changed regexp and string commands to properly
-handle case folding according to the Unicode character
-tables. (stanton)
+----------------- Released 4.2p2, 1/31/97 --------------
-10/21/98 (new feature) Added an "encoding" command to facilitate
-translations of strings between different character encodings. See
-the encoding.n manual entry for more details. (stanton)
+----------------------------------------------------------
+Changes for Tk 4.2 go above this line.
+Changes for Tk 4.3 go below this line.
+----------------------------------------------------------
-11/3/98 (bug fix) The regular expression character classification
-syntax now includes Unicode characters in the supported
-classes. (stanton)
+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)
-11/6/98 (bug fix) Variable traces were causing crashes when upvar
-variables went out of scope. [Bug: 796] (stanton)
+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)
-11/9/98 (bug fix) "format" now correctly handles multibyte characters
-in %s format strings. (stanton)
+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)
-11/10/98 (new feature) "regexp" now accepts three new switches
-("-line", "-lineanchor", and "-linestop") that control how regular
-expressions treat line breaks. See the regexp manual entry for more
-details. (stanton)
+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)
-11/17/98 (bug fix) "scan" now correctly handles Unicode
-characters. (stanton)
+12/02/96 (new feature) A safe Tk interpreter can no longer generate
+postscript output from a canvas. (JL)
-11/17/98 (new feature) "scan" now supports XPG3 position specifiers
-and the "%n" conversion character. See the "scan" manual entry for
-more details. (stanton)
-
-11/17/98 (bug fix) The Tcl memory allocator now returns 8-byte aligned
-chunks of memory which improves performance on Windows and avoids
-crashes on other platforms. [Bug: 834] (stanton)
-
-11/23/98 (bug fix) Applied various regular expression performance bug
-fixes supplied by Henry Spencer. (stanton)
-
-11/30/98 (bug fix) Fixed various thread related race conditions. [Bug:
-880 & 607] (stanton)
-
-11/30/98 (bug fix) Fixed a number of memory overflow and leak
-bugs. [Bug: 584] (stanton)
-
-12/1/98 (new feaure) Added support for Korean encodings. (stanton)
-
-12/1/98 (feature change) Changed the Tcl_EvalObjv interface to remove
-the string and length arguments.
-*** POTENTIAL INCOMPATIBILITY with previous alpha releases ***
-
-12/2/98 (bug fix) Fixed various bugs related to line feed
-translation. [Bug: 887] (stanton)
-
-12/4/98 (new feature) Added a message catalog facility to help with
-localizing Tcl scripts. Thanks to Mark Harrison for contributing the
-initial implementation of the "msgcat" package. (stanton)
-
-12/7/98 (bug fix) The memory allocator was failing to update the
-block list for large memory blocks that were reallocated into a
-different address. [Bug: 933] (stanton)
-
------------------ Released 8.1b1, Dec 10 1998 -----------------------
-
-12/22/98 (performance improvement) Improved the -command option of the
-lsort command to better use the object system for improved
-performance (about 5x speed up). Thanks to Syd Polk for suppling the
-patch. [RFE: 726] (rjohnson)
-
-2/10/99 (bug fix) Restored the Tcl_ObjSetVar2/Tcl_ObjGetVar2
-interfaces from 8.0 and renamed the Tcl_GetObjVar2/Tcl_SetObjVar2
-interfaces to Tcl_GetVar2Ex and Tcl_SetVar2Ex. This should provide
-better compatibility with 8.0. (stanton)
-*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases ***
-
-2/10/99 (bug fix) Made the eval interfaces compatible with 8.0 by
-renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to
-Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces
-so they match Tcl 8.0. (stanton)
-*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases ***
-
-2/25/99 (bug fix/new feature) On Windows, the channel drivers for
-consoles and serial ports now completely support file events. (redman)
-
-3/5/99 (bug fix) Integrated patches to fix various configure problems
-that affected HP-UX-11, 64-bit IRIX, Linux, and Solaris. (stanton)
-
-3/9/99 (bug fix) Integrated various AIX related patches to improve
-support for shared libraries. (stanton)
-
-3/9/99 (new feature) Added tcl_platform(user) to provide a portable
-way to get the name of the current user. (welch)
-
-3/9/99 (new feature) Integrated the stub library mechanism contributed
-by Jan Nijtmans, Paul Duffin, and Jean-Claude Wippler. This feature
-should make it possible to write extensions that support multiple
-versions of Tcl simultaneously. It also makes it possible to
-dynamically load extensions into statically linked interpreters. This
-patch includes the following changes:
- - Added a Tcl_InitStubs() interface
- - Added Tcl_PkgProvideEx, Tcl_PkgRequireEx, Tcl_PkgPresentEx,
- and Tcl_PkgPresent.
- - Added va_list versions of all VARARGS functions so they can be
- invoked from wrapper functions.
-See the manual for more information. (stanton)
-
-
-3/10/99 (feature change) Replaced Tcl_AlertNotifier with
-Tcl_ThreadAlert since the Tcl_AlertNotifier function relied on passing
-internal data structures. (stanton)
-*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases ***
-
-3/10/99 (new feature) Added a Tcl_GetVersion API to make it easier to
-check the Tcl version and patch level from C. (redman)
-
-3/14/99 (feature change) Tried to unify the TclpInitLibrary path
-routines to look in similar places from Windows to UNIX. The new
-library search path is: TCL_LIBRARY, TCL_LIBRARY/../tcl8.1, relative
-to DLL (Windows Only) relative to installed executable, relative to
-develop executable, and relative to compiled-in in location (UNIX
-Only.) This fix included:
- - Defining a TclpFindExecutable
- - Moving Tcl_FindExecutable to a common area in tclEncoding.c
- - Modifying the TclpInitLibraryPath routines.
-(surles)
-
-3/14/99 (feature change) Added hooks for TclPro Wrapper to initialize
-the location of the encoding files and libraries. This fix included:
- - Adding the TclSetPerInitScript routine.
- - Modifying the Tcl_Init routines to evaluate the non-NULL
- pre-init script.
- - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir
- routines.
- - Modifying the TclpInitLibrary routines to append the default
- encoding dir.
-(surles)
+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)
-3/14/99 (feature change) Test suite now uses "test" namespace to
-define the test procedure and other auxiliary procedures as well as
-global variables.
- - Global array testConfige is now called ::test::testConfig.
- - Global variable VERBOSE is now called ::test::verbose, and
- ::test::verbose no longer works with numerical values. We've
- switched to a bitwise character string. You can set
- ::test::verbose by using the -verbose option on the Tcl command
- line.
- - Global variable TESTS is now called ::test::matchingTests, and
- can be set on the Tcl command line via the -match option.
- - There is now a ::test::skipTests variable (works similarly to
- ::test::matchTests) that can be set on the Tcl command line via
- the -match option.
- - The test suite can now be run in any working directory. When
- you run "make test", the working directory is nolonger switched
- to ../tests.
-(hirschl)
+----------------------------------------------------------
+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 ***
---------------- Released 8.1b2, March 16, 1999 ----------------------
+11/19/96 (bug fix) Under Windows, images were incorrectly drawn on
+16-bit displays. (SS)
-3/18/99 (bug fix) Fixed missing/incorrect characters in shift-jis table
-(stanton)
+11/19/96 (bug fix) Under Windows, the class name for the main window
+(.) was not properly generated from argv0. (SS)
-3/18/99 (feature change) The glob command ignores the
-FS_CASE_IS_PRESERVED bit on file systesm and always returns
-exactly what it gets from the system. (stanton)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-3/19/99 (new feature) Added support for --enable-64bit. For now,
-this is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun
-compiler. (redman)
+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)
-3/23/99 (bug fix) Fixed fileevents and gets on Windows consoles and
-serial devices so that non-blocking channels do not block on partial
-input lines. (redman)
+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)
-3/23/99 (bug fix) Added a new Tcl_ServiceModeHook interface.
-This is used on Windows to avoid the various problems that people
-have been seeing where the system hangs when tclsh is running
-outside of the event loop. As part of this, renamed
-TclpAlertNotifier back to Tcl_AlertNotifier since it is public.
-(stanton)
+11/26/96 (new feature) Added support for images as primitive types in
+text widgets. (SU)
-3/23/99 (feature change) Test suite now uses "tcltest" namespace to
-define the test procedure and other auxiliary procedures as well as
-global variables. The previously chosen "test" namespace was thought
-to be too generic and likely to create conflits.
-(hirschl)
-*** POTENTIAL INCOMPATIBILITY ***
+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)
-3/24/99 (bug fix) Make sockets thread safe on Windows.
-(redman)
+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)
-3/24/99 (bug fix) Fix cases where expr would incorrect return
-a floating point value instead of an integer. (stanton)
+12/4/96 (bug fix) The "update" command was only syncing the display
+for its main window. Changed to sync all displays. (JO)
-3/25/99 (bug fix) Added ASCII to big5 and gb2312 encodings.
-(stanton)
+12/5/96 (bug fix) Color deallocation would occasionally cause a panic
+under Windows. (SS)
-3/25/99 (feature change) Changed so aliases are invoked at current
-scope in the target interpreter instead of at the global scope. This
-was an incompatibility introduced in 8.1 that is being removed.
-(stanton)
-*** POTENTIAL INCOMPATIBILITY with previous beta releases ***
+12/5/96 (bug fix) Errors during startup were silently discarded under
+Windows. (SS)
-3/26/99 (feature change) --enable-shared is now the default and build
-Tcl as a shared library; specify --disable-shared to build a static Tcl
-library and shell.
-*** POTENTIAL INCOMPATIBILITY ***
+12/5/96 (bug fix) Errors during startup were silently discarded under
+Windows. (SS)
-3/29/99 (bug fix) Removed the stub functions and changed the stub
-macros to just use the name without params. Pass &tclStubs into the
-interp (don't use tclStubsPtr because of collisions with the stubs on
-Solaris). (redman)
+12/11/96 (bug fix) Text widgets weren't considering the -spacing1
+and -spacing2 options when computing their desired geometry. (JO)
-3/30/99 (bug fix) Loadable modules are now unloaded at the last
-possible moment during Tcl_Finalize to fix various exit-time crashes.
-(welch)
+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)
-3/30/99 (bug fix) Tcl no longer calls setlocale(). It looks at
-env(LANG) and env(LC_TYPE) instead. (stanton)
+12/12/96 (feature change) The destroy command no longer returns an
+error when a window does not exist. (SRP)
-4/1/99 (bug fix) Fixed the Ultrix multiple symbol definition problem.
-Now, even Tcl includes a copy of the Tcl stub library. (redman)
+12/13/96 (new feature) grid row/column-configure accepts a list of
+indices in addition to a single index. (SU)
-4/1/99 (bug fix) Internationalized the registry package.
+12/17/96 (bug fix) Under Windows, command line was not being parsed
+correctly if it contained the literal characters \" (CS)
-4/1/99 (bug fix) Changed the implemenation of Tcl_ConditionWait and
-Tcl_ConditionNotify on Windows. The new algorithm eliminates a race
-condition and was suggested by Jim Davidson. (welch)
+12/17/96 (feature change) Native Windows labels do not get a focus-ring
+border. (CS)
-4/2/99 (new apis) Made various Unicode utility functions public.
-Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString, Tcl_UniCharLen,
-Tcl_UniCharNcmp, Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha,
-Tcl_UniCharIsDigit, Tcl_UniCharIsLower, Tcl_UniCharIsSpace,
-Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar, Tcl_WinUtfToTChar,
-Tcl_WinTCharToUtf (stanton)
+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)
-4/2/99 (feature change) Add new DDE package and removed the Tk
-send command from the Windows version. Changed DDE-based send
-code into "dde eval" command. The DDE package can be loaded
-into tclsh, not just wish. Windows only. (redman)
+----------------- Released 8.0a1, 12/17/96 -----------------------
-4/5/99 (bug fix) Changed safe-tcl so that the encoding command
-is an alias that masks out the "encoding system" subcommand.
-(redman)
+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)
-4/5/99 (bug fix) Configure patches to improve support for
-OS/390 and BSD/OS 4.*. (stanton)
+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)
-4/5/99 (bug fix) Fixed crash in the clock command that occurred
-with negative time values in timezones east of GMT. (stanton)
+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)
-4/6/99 (bug fix) Moved the "array set" C level code into a common
-routine (TclArraySet). The TclSetupEnv routine now uses this API to
-create an env array w/ no elements. This fixes the bug caused when
-every environ varaible is removed, and the Tcl env variable is
-synched. If no environ vars existed, the Tcl env var would never be
-created. (surles)
+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)
-4/6/99 (bug fix) Made the Env module I18N compliant. (surles)
+1/8/97 (bug fix) Under Windows, the windows were not being unmapped
+properly, which led to strange packer behavior. (SS)
-4/6/99 (bug fix) Changed the FindVariable routine to TclpFindVariable,
-that now does a case insensitive string comparison on Windows, and not
-on UNIX. (surles)
+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)
---------------- Released 8.1b3, April 6, 1999 ----------------------
+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)
-4/9/99 (bug fix) Fixed notifier deadlock situation when the pipe used
-to talk back notifier thread is filled with data. Found as a result of the
-focus.test for Tk hanging. (redman)
+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)
-4/13/99 (bug fix) Fixed bug where socket -async combined with
-fileevent for writing did not work under Windows NT. (redman)
+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)
-4/13/99 (encoding fix) Restored the double byte definition of GB2312
-and added the EUC-CN encoding. EUC-CN is a variant of GB2312 that
-shifts the characters into bytes with the high bit set and includes
-ASCII as a subset. (stanton)
+1/21/97 (bug fix) Grid no longer reports rows or columns "out of range"
+when requesting their constraints. (SAU)
-4/27/99 (bug fix) Added 'extern "C" {}' block around the stub table
-pointer declaration so the stub library can be used from C++. (stanton)
+1/21/97 (bug fix) Fixed some window manager related bugs on the
+Macintosh. Now better support global grabs. (RJ)
---------------- Released 8.1 final, April 29, 1999 ----------------------
+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)
-4/22/99 (bug fix) Changed Windows NT socket implementation to avoid
-creating a communication window. This avoids the problem where the
-system hangs waiting for tclsh to respond to a system-wide synchronous
-broadcast (e.g. if you change system colors). (redman)
+1/21/97 (bug fix) Small interlaced GIF images were not properly
+decoded. (SS)
-4/22/99 (bug fix) Added call to TclWinInit from TclpInitPlatform when
-building a static library since DllMain will not be invoked. This
-could break old code that explicitly called TclWinInit, but should be
-simpler in the long run. (stanton)
+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 ***
-4/23/99 (bug fix) Added support for the koi8-r Cyrillic
-encoding. [Bug: 1771] (stanton)
+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 ***
-4/28/99 (bug fix) Changed internal Tcl_Obj usage to avoid freeing the
-internal representation after the string representation has been
-freed. This makes it easier to debug extensions. (stanton)
+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 ***
-4/30/99 (bug fix) Fixed a memory leak in CommandComplete. (stanton)
+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 ***
-5/3/99 (bug fix) Fixed a bug where the Tcl_ObjType was not being set
-in a duplicated Tcl_Obj. [Bug: 1975, 2047] (stanton)
+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 ***
-5/3/99 (bug fix) Changed Tcl_ParseCommand to avoid modifying eval'ed
-strings that are already null terminated. [Bug: 1793] (stanton)
+----------------- Released 8.0b1, 5/27/97 -----------------------
-5/3/99 (new feature) Applied Jeff Hobbs's string patch which includes
-the following changes:
- - added new subcommands: equal, repeat, map, is, replace
- - added -length option to "string compare|equal"
- - added -nocase option to "string compare|equal|match"
- - string and list indices can be an integer or end?-integer?.
- - added optional first and last index args to string toupper, et al.
-See the string.n manual entry for more details about the new string
-features. [Bug: 1845] (stanton)
+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)
-5/6/99 (new feature) Added Tcl_UtfNcmp and Tcl_UtfNcasecmp to make Utf
-string comparision easier. (stanton)
+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)
-5/7/99 (bug fix) Improved OS/390 support. [Bug: 1976, 1997] (stanton)
+6/2/97 (bug fix) Virtual events associated with <Enter>/<Leave> in text
+widget tag caused panic. (CCS)
-5/12/99 (bug fix) Changed Windows initialization code to avoid using
-GetUserName system call in favor of the env(USERNAME) variable. This
-provides a significant startup speed improvement. (stanton)
+6/6/97 (bug fix) On some systems, struct timeval.tv_sec is unsigned. (SS)
-5/12/99 (bug fix) Replaced the per-interpreter regexp cache with a
-per-thread cache. Changed the Regexp object to take advantage of this
-extra cache. Added a reference count to the TclRegexp type so regexps
-can be shared by multiple objects. Removed the per-interp regexp cache
-from the interpreter. Now regexps can be used with no need for an
-interpreter. This set of changes should provide significant speed
-improvements for many Tcl scripts. [Bug: 1063] (stanton)
+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 ***
-5/14/99 (bug fix) Durining initialization on Unix, Tcl now extracts the
-encoding subfield from the LANG/LC_ALL environment variables in cases
-where the locale is not found in the built-in locale table. It also
-attempts to initialize the locale subsystem so X11 is happy. [Bug: 1989]
-(stanton)
+6/9/97 (bug fix) Canvas postscript printing now works for bitmaps
+under Windows. (SS)
-5/14/99 (bug fix) Applied the patch to fix 100-year and 400-year
-boundaries in leap year code, from Isaac Hollander. [Bug: 2066] (redman)
+6/10/97 (bug fix) Fixed bug in bindings for listboxes where state wasn't
+being properly initialized on Shift-1 button presses. (JO)
-5/14/99 (bug fix) Fixed a crash caused by a failure to reset the result
-before evaluating the test expression in an uncompiled for
-statement. (stanton)
+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)
-5/18/99 (bug fix) Modified initialization code on Windows to avoid
-inherenting closed or invalid channels. If the standard input is
-anything other than a console, file, serial port, or pipe, then we fall
-back to the standard Tk window console. (stanton)
+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)
-5/19/99 (bug fix) Added an extern "C" block around the entire tcl.h
-header file to avoid C++ linkage issues. (redman)
+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)
-5/19/99 (new feature) Applied Jeff Hobb's patch to add
-Tcl_StringCaseMatch to support case insensitive glob style matching and
-Tcl_UniCharIs* character classification functions. (stanton)
+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)
-5/20/99 (bug fix) Added the directory containing the executuble and the
-../lib directory relative to that to the auto_path variable. (redman)
+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)
---------------- Released 8.1.1, May 25, 1999 ----------------------
+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)
-5/21/99 (bug fix) Fixed launching command.com on Win95/98, no longer
-hangs. [Bug: 2105] (redman)
+6/17/97 (bug fix) Tk buttons on the Macintosh will now correctly
+draw under MacOS 8.0. (RJ)
-5/28/99 (bug fix) Fixed bug where dde calls were being passed an
-invalid dde handle. [Bug: 2124] (stanton)
+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/1/99 (bug fix) Small configure.in patches. [Bug: 2121] (stanton)
+6/18/97 (bug fix) Tk was using the wrong system colors to draw various
+widgets under Windows. (SS)
-6/1/99 (bug fix) Applied latest regular expression patches to fix an
-infinite loop bug and add support for testing whether a string could
-match with additional input. [Bug: 2117] (stanton)
+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/2/99 (bug fix) Fixed incorrect computation of relative ordering in
-Utf case-insensitive comparison. [Bug: 2135] (stanton)
+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/3/99 (bug fix) Fxied bug where string equal/compare -nocase
-reported wrong result on null strings. [Bug: 2138] (stanton)
+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/4/99 (new feature) Windows build now uses Cygwin tools plus GNU
-make and autoconf to build static/dynamic and debug/nodebug. (stanton)
+6/25/97 (bug fix) Error message was not properly reported when using
+button 'toggle'. (DL)
-6/7/99 (new feature) Optimized string index, length, range, and
-append commands. Added a new Unicode object type. (hershey)
+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)
-6/8/99 (bug fix) Rolled back Windows socket driver to 8.1.0
-version. (stanton)
+----------------- Released 8.0b2, 6/30/97 -----------------------
-6/9/99 (new feature) Added Tcl_RegExpMatchObj and Tcl_RegExpGetInfo
-to public Tcl API, these functions are needed by Expect. Changed
-tools/genStubs.tcl to always write output in LF mode. (stanton)
+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 ***
-6/14/99 (new feature) Merged string and Unicode object types. Added
-new public Tcl API functions: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj,
-Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange,
-Tcl_AppendUnicodeToObj. (hershey)
+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)
-6/16/99 (new feature) Changed to conform to TEA specification, added
-tcl.m4 and aclocal.m4 macro libraries for configure. (wart)
+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)
-6/17/99 (new feature) Added new regexp interfaces: -expanded, -line,
--linestop, and -lineanchor switches. Renamed Tcl_RegExpMatchObj to
-Tcl_RegExpExecObj and added new Tcl_RegExpMatchObj that is equivalent
-to Tcl_RegExpMatch. Added public macros for regexp flags. Added
-REG_BOSONLY flag to allow Expect to iterate through a string and only
-find matches that start at the current position within the
-string. (stanton)
+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)
-6/21/99 (bug fix) Fixed memory leak in TclpThreadCreate where thread
-attributes were not being released. [Bug: 2254] (stanton)
+----------------- Released 8.0, 8/18/97 -----------------------
-6/23/99 (new feature) Updated Unicode character tables to reflect
-Unicode 2.1 data. (stanton)
+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)
-6/25/99 (new feature) Fixed bugs in non-greedy quantifiers for regular
-expression code. (stanton)
+8/27/97 (new feature) Added support for new X11R6 colors under Windows
+and Mac platforms. (SS)
-6/25/99 (new feature) Added initial implementation of new Tcl test
-harness package. Modified test files to use new tcltest package.
-(jenn)
+8/29/97 (bug fix) Wish crashed if stdin was closed. (SS)
-6/26/99 (new feature) Applied patch from Peter Hardie to add poke
-command to dde and changed the dde package version number to
-1.1. (redman)
+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)
-6/28/99 (bug fix) Applied patch from Peter Hardie to fix problem in
-Tcl_GetIndexFromObj() when the key being passed is the empty string.
-[Bug: 1738] (redman)
+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)
-6/29/99 (new feature) Added options to tcltest package: -preservecore,
--limitconstraints, -help, -file, -notfile, and flags. (jenn)
+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)
-7/3/99 (new feature) Changed parsing of variable names to allow empty
-array names. Now "$(foo)" is a variable reference. Previously you
-had to use something line $::(foo), which is slower. This change was
-requested by Jean-Luc Fontaine for his STOOOP package. (welch)
+9/18/97 (bug fix) Revamped Macintosh focus code. Cut, Copy & Paste
+virtual events now go to the correct (focus) window. (RJ)
-7/3/99 (new feature) Added Tcl_SetNotifier (public API) and
-associated hook points in the notifiers to be able to replace the
-notifier calls at runtime. The Xt notifier and test program use this
-hook. (welch)
+9/19/97 (bug fix) Made Macintosh tearoff menus non-resizable. (RJ)
-7/3/99 (new feature) Added a new variant of the "Trf core patch" from
-Andreas Kupries that adds new C APIs Tcl_StackChannel,
-Tcl_UnstackChannel, and Tcl_GetStackedChannel. This allows the Trf
-extension to work without applying patches to the Tcl core. (welch)
+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)
-7/6/99 (new feature) Added -timeout option to http.tcl to handle
-timeouts that occur during connection attempts to hosts that are
-down. (welch)
+10/9/97 (bug fix) Image code could cause crashes during "exit" under
+some conditions (such as an image named "place"). (JO)
-7/6/99 (bug fix) Applied new implementation of the Windows serial
-port driver from Rolf Schroedter that fixes reading only one byte from
-the port at a time. Uses polling every 10ms to implement
-fileevents. [Bug: 1980 2217] (redman)
+10/9/97 (bug fix) Fixed bug that sometimes prevented listboxes from
+scrolling far enough horizontally to see the rightmost character. (JO)
-7/8/99 (bug fix) Applied fix for bug in DFA state caching under
-lookahead conditions (regular expressions). [Bug: 2318] (stanton)
+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)
-7/8/99 (bug fix) Fixed bug in string range bounds checking
-code. (stanton)
+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)
---------------- Released 8.2b1, July 14, 1999 ----------------------
+10/13/97 (bug fix) Selection could not be restored to a text widget
+after "selection clear" on Windows. (SS)
-7/16/99 (bug fix) Added Tcl_SetNotifier to stub table. [Bug: 2364]
-Added check for Alpha/Linux to correct the IEEE floating point flag,
-patch from Don Porter. (redman)
+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)
-7/20/99 (bug fix) Merged 8.0.5 code to handle tcl_library properly,
-also fixed a bug that caused TCL_LIBRARY to be ignored. (hershey)
+10/20/97 (bug fix) Omitting the arguments to the text widget "mark
+gravity" option caused a crash. (SS)
-7/21/99 (bug fix) Implemented modified socket driver for Windows that
-uses a thread to manage the socket event window. Code works the same
-on all supported versions of Windows and was based on original 8.1.0
-code. [Bug: 2178 2256 2259 2329 2323 2355] (redman)
+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)
-7/21/99 (new feature) Applied patch from Rolf Schroedter to add
--pollinterval option to fconfigure for Windows serial ports. Allows
-the maxblocktime to be modified to control how often serial ports are
-checked for fileevents. Also added documentation for \\.\comX
-notation for opening serial ports on Windows. (redman)
+10/23/97 (bug fix) Memory leak in unix's TkpGetFontFamilies. Thanks
+to James Bonfield for the fix. (DL)
-7/21/99 (bug fix) Changed APIs in stub tables to use "unsigned long"
-instead of the platform-specific "size_t", primarily after SunOS 4
-users could no longer compile. (redman)
+10/27/97 (bug fix) Fixed event reporting for the Mac during a grab
+when the pointer was out of the toplevel window. (RJ)
-7/22/99 (bug fix) Fixed crashing during "array set a(b) {}".
-[Bug: 2427] (redman)
+10/28/97 (bug fix) Under Unix, override-redirect was getting set
+incorrectly for menus, so that "wm overrideredirect" returned 0. (JO)
-7/22/99 (bug fix) The install-sh script must be given execute
-permissions prior to running. [Bug: 2413] (redman)
+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)
-7/22/99 (bug fix) Applied patch from Ulrich Ring to remove ANSI-style
-prototypes in the code. [Bug: 2391] (redman)
+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)
-7/22/99 (bug fix) Added #if blocks around #includes of sys/*.h header
-files, to allow an extension author on Windows to use the MetroWerks
-compiler. [Bug: 2385] (redman)
+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)
-7/22/99 (bug fix) Fixed running the safe.test test suite, one change
-to the Windows Makefile.in to fix paths and another in safe.test to
-check for the tcl_platform(threaded) variable properly. (redman)
+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)
-7/22/99 (bug fix) Fixed hanging in new Win32 socket driver with
-threads enabled. (redman)
+10/28/97 (bug fix) Under Windows, button grabs did not report motion
+events that occurred outside of Tk windows. (SS)
-7/26/99 (bug fix) Fixed terminating of helper threads by holding any
-mutexes from the primary thread while waiting for the helper thread to
-terminate. Fixes dual-CPU WinNT hangs, only one rare sporadic hang
-that still exists with dual-CPU WinNT. Also fixed test cases so that
-they would not depend as much on timing for dual-CPU WinNT. (redman)
+10/28/97 (bug fix) Fixed incorrect display of transparent images on
+the Macintosh. (JI)
-7/27/99 (bug fix) Some test suite cleanup. (jenn)
+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)
-7/29/99 (bug fix) Applied patch to fix typo in .SH NAME line in
-doc/Encoding.n [Bug: 2451]. Applied patch to avoid linking pack.n to
-pack-old.n [Bug: 2469]. Patches from Don Porter. (redman)
+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)
-7/29/99 (bug fix) Allow tcl to open CON and NUL, even for redirection
-of std channels. [Bug: 2393 2392 2209 2458] (redman)
+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)
-7/30/99 (bug fix) Applied fixed Trf patch from Andreas Kupries.
-[Bug: 2386] (hobbs)
+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)
-7/30/99 (bug fix) Fixed bug in info complete. [Bug: 2383 2466] (hobbs)
+10/28/97 (bug fix) Safe Tk interps on unix were leaking env(DISPLAY). (DL)
-7/30/99 (bug fix) Applied patch to fix threading on Irix 6.5, patch
-provided by James Dennett. [Bug: 2450] (redman)
+10/31/97 (bug fix) Fixed problems related to the input focus when one
+application had windows open simultaneously on several displays. (JO)
-7/30/99 (bug fix) Fixed launching of 16bit applications on Win9x from
-wish. The command line was being primed with tclpip82.dll, but it was
-ignored later.
+10/31/97 (bug fix) Fixed several problems with traversal of menus via
+the keyboard under Unix. (SRP)
-7/30/99 (bug fix) Added functions to stub table, patch provided by Jan
-Nijtmans. [Bug: 2445] (hobbs)
+11/4/97 (bug fix) Fixed various word-size related problems for 64-bit
+architectures. (SS)
-8/1/99 (bug fix) Changed Windows socket driver to terminate threads
-by sending a message to the window rather than calling
-TerminateThread(), which seems to leak about 4k from the helper
-thread's stack space. (redman)
+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.2b2, August 5, 1999 ----------------------
+----------------- Released 8.0p1, 11/7/97 -----------------------
-8/4/99 (bug fix) Applied patches supplied by Henry Spencer to greatly
-enhance performance of certain classes of regular expressions.
-[Bug: 2440 2447] (stanton)
+11/20/97 (bug fix) Fixed bug on the Mac where the "package require"
+command caused menus to stop working. (JI)
-8/5/99 (doc change) Made it clear that tcl_pkgPath was not set for
-Windows. [Bug: 2455] (hobbs)
+11/20/97 (bug fix) Fixed bug in rendering transparent gifs on Text
+widgets. (JI)
-8/5/99 (bug fix) Fixed reference to bytes that might not be null
-terminated in tclLiteral.c. [Bug: 2496] (hobbs)
+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)
-8/5/99 (bug fix) Fixed typo in http.tcl. [Bug: 2502] (hobbs)
+----------------- Released 8.0p2, 11/25/97 -----------------------
-8/9/99 (bug fix) Fixed test suite to handle larger integers
-(64bit). Patch from Don Porter. (hobbs)
+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)
-8/9/99 (documentation fix) Clarified Tcl_DecrRefCount docs
-[Bug: 1952]. Clarified array pattern docs [Bug: 1330]. Fixed clock docs
-[Bug: 693]. Fixed formatting errors [Bug: 2188 2189]. Fixed doc error
-in tclvars.n [Bug: 2042]. (hobbs)
+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)
-8/9/99 (bug fix) Fixed path handling in auto_execok [Bug: 1276] (hobbs)
+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)
-8/9/99 (internal api change) Removed the TclpMutexLock and TclpMutexUnlock
-APIs and added a new exported api, Tcl_GetAllocMutex. These APIs are all for
-the mutex used in the simple memory allocators. By making this change
-we are able to substitute different implementations of the thread-related
-APIs without having to recompile the Tcl core. (welch)
+12/8/97 (bug fix) on Windows, using "winfo pathname" before "." was mapped
+was crashing. (DL)
-8/9/99 (new C API) Tcl_GetChannelNames returns a list of open channel
-names in the interpreter result. Still no Tcl-level version of this,
-but server-like applications can use this to clean up files without
-deleting interpreters. (welch)
+---- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ----
-8/9/99 (bug fix) Traces were not firing on "info exists", which used to
-happen in Tcl 7.6 and earlier. An "info exists" now fires a read trace,
-if defined. This makes it possible to fully implement variables that
-are defined via traces. (welch)
+12/97 (bug fix) more Macintosh embeding fixes needed for the plugin. (JI)
-8/10/99 (bug fix) Fixed Brent's changes so that they work on
-Windows. (redman)
+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)
---------------- Released 8.2b3, August 11, 1999 ----------------------
+---- Shipped as part of the plugin2.0 as 8.0p2Plugin2, Jan 15th 98 ----
-8/12/99 (Mac) Rearrange projects in tclMacProjects.sea.hqx so that the
-build directory is separate from the sources. (Jim Ingham)
+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)
-8/12/99 (bug fix) Fixed bug in Tcl_EvalEx where the termOffset was not
-being updated in cases where the evaluation returned a non TCL_OK
-error code. [Bug: 2535] (stanton)
+6/12/98 (feature change) Focus -force now sets the foreground window
+on Windows platforms in addition to moving the focus. (SS)
---------------- Released 8.2.0, August 17, 1999 ----------------------
+6/12/98 (bug fix) Fixed bug in Windows font measurement that did not
+take kerning into account. (BS)
-9/21/99 (config fixes) fixed several AIX configuration issues. gcc and
-threading may still cause problems on AIX. (hobbs)
+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)
-9/21/99 (bug fix) fixed expr double-eval problem. [Bug: 732] (hobbs)
+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)
-9/21/99 (bug fix) fixed static buffer overflow problem. [Bug: 2483] (hobbs)
+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.
-9/21/99 (bug fix) fixed end-int linsert interpretation. [Bug: 2693] (hobbs)
+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)
-9/21/99 (bug fix) fixed bug when setting array in non-existent
-namespace. [Bug: 2613] (hobbs)
+7/6/98 (new feature) Added support for the Macintosh Appearance Manager. (JI)
---- Released 8.2.1, October 04, 1999 --- See ChangeLog for details ---
+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)
-10/30/99 (feature enhancement) new regexp engine from Henry Spencer
-was patched in - should greatly reduce stack space usage. (spencer)
+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)
-10/30/99 (bug fix) fixed Purify reported memory leaks in findexecutable
-test command, TclpCreateProcess on Unix, in handling of C environ array,
-and in testthread code. No more known (reported) mem leaks for Tcl
-built using gcc on Solaris 2.5.1. Also none reported for Tcl on NT
-(using Purify 6.0). (hobbs)
+8/4/98 (bug fix) Fixed memory leak in Windows menu code. (SS)
-10/30/99 (bug fix) fixed improper bytecode handling of
-'eval {set array($unknownvar) 5}' (also for incr) (hobbs)
+8/4/98 (bug fix) Fixed bug where bgerror's were not being generated
+from menu callbacks on Windows. (SS)
-10/30/99 (bug fix) fixed event/io threading problems by making
-triggerPipe non-blocking (nick kisserbeth)
+8/4/98 (bug fix) Alt-key bindings were not being handled properly
+under Windows, resulting in annoying beeps. (SS)
-10/30/99 (bug fix) fixed Tcl_AppendStringsToObjVA and Tcl_AppendResultVA
-to only iterates once over the va_list (avoiding non-portable memcpy).
-(joe english, hobbs)
+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)
-10/30/99 (bug fix) removed savedChar trick in tclCompile.c that appeared
-to be causing a segv when the literal table was released.
-[Bug: 2459, 2515] (David Whitehouse)
+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)
-10/30/99 (bug fix) fixed [string index] to return ByteArrayObj
-when indexing into one (test case string-5.16) [Bug: 2871] (hobbs)
+8/5/98 (bug fix) <Insert> binding in entries was masking the virtual
+event <<Paste>> binding to Shift-Insert on Windows. (SS)
-10/30/99 (bug fix) fixes for mac UTF filename handling (ingham)
+8/5/98 (bug fix) wm frame would crash if the window had not been
+mapped yet on Windows. (SS)
---- Released 8.2.2, November 04, 1999 --- See ChangeLog for details ---
+8/5/98 (bug fix) Local grabs did not exclude menus or the caption bar
+under Windows. (SS)
-11/19/99 (feature enhancement) bug fixes for http package as well as
-patch required by TLS (SSL) extension that adds http::(un)register
-and -type to http::geturl. Up'd http pkg version to 2.2.
+8/5/98 (bug fix) Reduced message traffic by setting
+WS_EX_NOPARENTNOTIFY on TkChild windows. (SS)
-11/19/99 (bug fix) removed extra decr of numLevels in Tcl_EvalObjEx
-that could cause seg fault (mjansen@wendt.de)
+8/6/98 (feature change) Changed tkInitScript.h to use the new
+tcl_findLibrary procedure to locate its script library. (BW)
-11/19/99 (bug fixes) numerous minor big fixes, including correcting the
-installation of the koi8-r encoding and tcltest1.0 on Windows.
+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)
-11/30/99 (bug fix) fixes scan where %[..] didn't match anything
+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)
-11/30/99 (bug fix) fixed setting of isNonBlocking flag in PipeBlockModeProc
-so you can now close a non-blocking channel without waiting.
+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)
-11/30/99 (bug work-around) prevented the unloading of DLLs for Unix in
-TclFinalizeLoad. This stops the seg fault on exit that some users would
-see (ie with oratcl) when using DLLs that do nasty things like register
-atexit handlers.
+-------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/13/98 ------
-12/07/99 (bug fix) fixes for 'expr + {[incr]}' and 'expr + {[error]}'
-cases (different causes).
+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)
---- Released 8.2.3, December 16, 1999 --- See ChangeLog for details ---
+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)
-1999-09-14 (feature enhancement) added -start switch to regexp and regsub.
+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)
-1999-09-15 (feature enhancement) add 'array unset' command.
+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 ***
-1999-09-15 (feature enhancement) rewrote runtime libraries to use new
-string functions
+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)
-1999-08-18 (feature enhancement) added 'file channels' command, along with
-Tcl_GetChannelNames(Ex) public C APIs.
+----------------- Released 8.0.4, 11/20/98 -----------------------
-1999-10-19 (feature enhancement) enhanced tcltest package
+11/24/98 (bug fix) On some X servers, XQueryLoadFont will always
+return a font, even if the name is meaningless. This prevents Tk from
+parsing the font name, so now we perform a quick sanity check on the
+name before letting X have it. (stanton)
-1999-09-16 (feature enhancement) added -milliseconds switch to 'clock clicks'
+12/30/98 (bug fix) Fixed bug in "grid forget" that failed to cancel
+pending idle handlers, resulting in a crash in a few odd cases. (stanton)
-1999-10-28 (feature enhancement) added support for inline 'scan'
+1/28/99 (configure change) Now support -pipe option on gcc. (RJ)
-1999-10-28 (feature enhancement) added support for touch functionality by
-extendeding 'file atime' and 'file mtime' to take an optional time argument
+2/4/99 (bug fix) Changed so color tables in photo images are freed
+immediately instead of being delayed. This ensures that color tables
+are properly disposed at process exit. (stanton)
-1999-11-24 (feature enhancement) added 'fconfigure $sock -lasterror'
-command to Windows to query the last error received on a serial socket.
+2/4/99 (bug fix) Changed postscript template to include a European
+character with an umlaut when determining font height. (stanton)
-1999-11-30 (bug fix) fixed handling of %Z on NT for timezones that don't
-have DST
+2/4/99 (bug fix) If an image bitmap mask changed but ended up with the
+same XID, the GC failed to be updated and so the new mask was
+not used. (stanton)
-1999-12-03 (feature enhancement) improved error message in bad octal cases
-and improper use of comments. (hobbs)
+2/4/99 (bug fix) Changed so focus window is always set if -force is
+specified. This fixes the problem on Windows where Tk does not
+activate the window if it already has focus. (stanton)
-1999-12-07 (bug fix) fixed Tcl_ScanCountedElement to not step
-beyond the end of the counted string
+2/4/99 (bug fix) Fixed so errors in console eval are reported
+properly. Eliminated duplicate result messages. (stanton)
-1999-12-09 (feature enhancement) removed all references to 16 bit
-compatibility code for Windows (hobbs)
+2/4/99 (bug fix) Under Windows, changed so toplevels that aren't
+resizable don't have resize handles and the zoom box is disabled. (stanton)
-1999-12-10 (bug fix) removed check for vfork - Tcl now uses only fork in
-exec. (hobbs)
+2/4/99 (bug fix) Changed to cancel the mouse timer when a user
+initiated move/resize loop begins on Windows. (stanton)
-1999-12-10 (optimization) changed Tcl_ConcatObj to return a list
-object when it receives all pure list objects as input (used by 'concat'),
-added optimizations in Tcl_EvalObjEx for pure list case, and optimized
-INST_TRY_CVT_TO_NUMERIC in TclExecuteByteCode for boolean objects.
-(oakley, hobbs)
+2/4/99 (configure change) TK_LD_SEARCH_FLAGS was set incorrectly if
+SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through the C
+compiler. Systems affected are Linux, MP-RAS and NEXTSTEP, but also
+with gcc on many more systems.
-1999-12-12 (feature enhancement) enhanced glob command with -type, -path,
--directory and -join switches. (darley, hobbs)
+2/4/99 (bug fix) Changed some EXTERN declarations to extern since they
+are not defining exported interfaces. This avoids generating useless
+declspec() attributes and makes the Windows makefile simpler. (stanton)
-1999-12-21 (bug fix) changed CreateThread to _beginthreadex and
-ExitThread to _endthreadex to prevent 4K mem leak (gravereaux)
+2/4/99 (bug fix) Changed so keyboard shortcuts will only be found in
+the current toplevel. Previously, they might be found in menus
+attached to other toplevels that might not even be mapped. (stanton)
+*** POTENTIAL INCOMPATIBILITY ***
-1999-12-21 (bug fix) fixed applescript for I18N
+2/4/99 (bug fix) Changed to treat zero width lines in the canvas like
+they have width 1 for purposes of selection. (stanton)
-1999-12-21 (feature enhancement) added -unique option to lsort (hobbs)
+2/4/99 (bug fix) Added a workaround for a bug in GetTextExtentExPoint
+on Win NT 4.0/Japanese that cause a crash in some cases. (stanton)
-1999-12-21 (bug fix) changed thread ids to longs (for 64bit systems)
+2/4/99 (bug fix) Fixed uninitialized memory access bug in Unix send
+code. (stanton)
---- Released 8.3b1, December 22, 1999 --- See ChangeLog for details ---
+----------------------------------------------------------
+Changes for Tk 8.0 go above this line.
+Changes for Tk 8.1 go below this line.
+----------------------------------------------------------
-2000-01-10 (feature enhancement) clock scan now supports the common
-ISO 8601 date/time formats. See docs for details. (melski)
+1/16/98 (new feature) Tk now supports international characters sets:
+ - Font display mechanism overhauled to display Unicode strings
+ containing full set of international characters. You do not need
+ Unicode fonts on your system in order to use tk or see international
+ characters. For those familiar with the Japanese or Chinese patches,
+ there is no "-kanjifont" option. Characters from any available fonts
+ will automatically be used if the widget's originally selected font is
+ not capable of displaying a given character.
+ - Textual widgets are international aware. For instance, cursor
+ positioning commands would now move the cursor forwards/back by 1
+ international character, not by 1 byte.
+ - Input Method Editors (IMEs) work on Mac and Windows. Unix is still in
+ progress.
+
+7/7/97 (new feature) The send command now works for Microsoft
+Windows. It is implemented using Dynamic Data Exchange, and a new
+command, dde, allows Tk to send more generic DDE commands to other
+applications. (SRP)
+
+11/3/97 (new feature) Major overhaul of code that manages configuration
+options to use Tcl_Obj structures instead of strings:
+ - There is a new set of procedures including Tk_CreateOptionTable,
+ Tk_InitOptions, and Tk_SetOptions, which replace Tk_ConfigureWidget
+ and related procedures. The old procedures are still available.
+ The new procedures use a new format for configuration tables.
+ See SetOptions.3 for more information.
+ - There are new procedures Tk_AllocColorFromObj, Tk_GetColorFromObj,
+ and Tk_FreeColorFromObj to manage colors using objects to hold the
+ name of the color and cache the corresponding XColor pointer.
+ There are similar procedures Tk_Alloc3DBorderFromObj,
+ Tk_AllocBitmapFromObj, Tk_AllocCursorFromObj, Tk_AllocFontFromObj,
+ and so on to manage borders, bitmaps, cursors, and fonts.
+ - The old-style procedures such as Tk_GetColor and Tk_GetBitmap no
+ longer take Tk_Uids for arguments; they just take strings.
+ - Menus, labels, buttons, checkbuttons, and radiobuttons have been
+ converted to use the new object-based configuration library.
+ (SRP & JO)
+
+11/7/97 (improvement) Changed code referring to "interp->result" to call
+accessor functions like Tcl_SetResult().
+
+12/23/97 (fix) Fixed transparency and web optimized the palette of
+the images/ Tcl powered logos. (DL)
+
+12/16/97 (bug fix) Canvas and text "bind" subcommands generated an
+error with no message if called to fetch a binding that didn't exist.
+They now silently return without an error like the "bind" command. (SS)
+
+1/13/98 (bug fix) Keysyms for international characters were not being
+reported properly under Windows. (SS)
-2000-01-10 (bug fix) prevented \ooo substitution from accepting
-non-octal digits [Bug: 3975] (hobbs)
+----------------- Released 8.1a1, 1/22/98 -----------------------
-2000-01-11 (bug fix) fixed improper handling of DST by clock when
-using relative times (like "1 month" or "tomorrow"). (melski)
+2/4/98 (bug fix) Calling XFreeFontNames() twice if couldn't allocate
+font. (CCS)
-2000-01-12 (bug fix) improved build support for Tru64 v5, NetBSD
-and Reliant Unix (hobbs)
+2/10/98 (bug fix) Inlined prolog.ps in tkCanvPs.c to make it accessible
+from safe interpreters: canvas postscript now works in safe interps
+(like in tk8.0plugin). (DL)
-2000-01-12 (bug fix) made imported commands also import their
-compile procedure (duffin)
+2/11/98 (bug fix) Windows "send" to a remote interp wasn't propagating
+$errorInfo correctly from the remote interp to the local invoking interp.
+(CCS)
-2000-01-12 (bug fix) fixed 'info procs ::namesp::*' behavior to return
-procs in a namespace (dejong)
+2/11/98 (bug fix) Windows "send" should have accepted "--" to mean "no more
+arguments". (CCS)
-2000-01-12 (feature enhancement) added support for setting permissions
-symbolicly (like chmod) in [file attributes $file -permissions ...] (schoebel)
+2/11/98 (bug fix) Windows "send" was concatenating its arguments
+incorrectly (not consistent with "eval", "uplevel", or Unix "send"). (CCS)
-2000-01-13 (bug fix) fixed lsort -dictionary problem when sorting
-characters between 'Z' and 'a' (flawed upper/lower comparison logic) (melski)
+2/18/98 (bug fix) Macintosh radiobuttons and checkbuttons now color
+their backgrounds correctly under Appearance. The controls gadgets themselves
+however, remain the Theme colors. (JI)
---- Released 8.3b2, January 13, 2000 --- See ChangeLog for details ---
+2/18/98 (improvement) The corner pixels that peek through around the
+rounded corners of the Mac button widget are now controlled by the
+-highlightbackground, rather than the -background option. (JI)
-2000-01-14 (feature enhancement) clock format %Q added, clock scan updated
+2/18/98 (improvement) Implemented the intra-application Send on the
+Mac (RJ)
-2000-01-20 (bug fix) corrected complex array elem compiling (Spjuth)
+2/18/98 (bug fix) Under X, a problem mapping from a fontStructPtr to an
+XLFD (no XA_FONT attribute) would lead to dereferencing NULL. (CCS)
-2000-01-20 (bug fix) made [info body] always return a string type arg,
-to prevent possible misuse of bytecodes in the wrong context (hobbs)
+----------------- Released 8.1a2, Feb 20 1998 -----------------------
-2000-01-20 (bug fixes) several fixes to variable handling to prevent
-possible crashes, and further definition of correct behavior (melski)
+10/21/98 (bug fix) Tk_UnderlineChars did not handle UTF strings properly
+so underline indices were in bytes instead of characters. (stanton)
-2000-01-25 (bug fixes) improved QNX, Ultrix and OSF1 (Tru64) config and
-compatibility (edge, furukawa)
+11/19/98 (bug fix) Fixed menus and titles so they properly display
+Unicode characters under Windows. [Bug: 819] (stanton)
-2000-01-25 (bug fix) fixed mem leak when calling lsort with a bad -command
-argument (hobbs)
+11/24/98 (bug fix) Fixed a bunch of memory leaks in the Windows menu
+code. [Bug: 620] (stanton)
-2000-01-27 (feature enhancement) package mechanism overhaul: changed
-behavior of pkg_mkIndex to do -direct by default, added -lazy option.
-Fixed pkg_mkIndex to handle odd proc names and auto_mkIndex to use platform
-independent file paths. Other fixes for odd package quirks. Added
-::pkg namespace and ::pkg::create helper function. (melski)
+11/25/98 (bug fix) Various small bug fixes: (stanton)
+ - hidemargin option was not honored properly in menus [Bug: 859]
+ - disabled menu entries were getting reenabled whenever the
+ mouse passed over the entry [Bug: 860]
+ - fixed deletion order bug where a crash would result if a
+ binding deleted "."
-2000-02-01 (bug fix) fixed problem where http POST would send one extra
-newline (vasiljevic)
+11/30/98 (bug fix) The error result was getting lost when restoring
+configuration options in buttons. [Bug: 619] (stanton)
-2000-02-02 (feature enhancement) added docs for new regexp -inline and
--all switches. (hobbs)
+12/8/98 (bug fix) The Windows clipboard was not correctly traslating
+multibyte characters. [Bug: 935] (stanton)
-2000-02-08 (bug fix) corrected handling of "next monthname" in clock scan
-(melski)
+----------------- Released 8.1b1, Dec 11 1998 -----------------------
-2000-02-09 (bug fix) restored Mac source to build readiness and prevented
-mac panic from an error when closing an async socket (steffen, ingham)
+1/29/99 (bug fix) Fixed bug in "grid forget" that failed to cancel
+pending idle handlers, resulting in a crash in a few odd
+cases. (stanton)
-2000-02-10 (feature enhancement) improved error reporting for failed
-loads on Windows (dejong, hobbs)
+2/4/99 (bug fix): Fixed uninitialized memory access in
+Tk_SetAppName. [Bug: 919] (stanton)
---- Released 8.3.0, February 10, 2000 --- See ChangeLog for details ---
+2/4/99 (bug fix): Added a workaround for a bug in GetTextExtentExPoint
+on Win NT 4.0/Japanese. [Bug: 1006] (stanton)
-2000-03 (bug fixes, feature enhancement) overhaul of http package for
-proper handling of async callbacks (new options), version is now at 2.3
-(tamhankar, welch)
+2/4/99 (bug fix): Changed so keyboard shortcuts for menus will only be
+found in the current toplevel. Previously, they might be found in
+menus attached to other toplevels that might not even be mapped.
+[Bug: 924] (stanton)
-2000-03 (performance enhancement) speedup in Windows filename handling (newman)
-and ==/!= empty string in exprs. (hobbs)
+2/4/99 (bug fix): Changed to treat zero width lines in the canvas like
+they have width 1 for purposes of selection. [Bug: 925] (stanton)
-2000-03-27 (bug fix) added uniq'ing test to namespace export list to
-prevent unnecessary mem growth (hobbs)
+2/4/99 (bug fix): TK_LD_SEARCH_FLAGS was set incorrectly if
+SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through the C
+compiler. Systems affected are Linux, MP-RAS and NEXTSTEP, but also
+with gcc on many more systems. [Bug: 908] (stanton)
-2000-03-29 (bug fix) fixed mem leak when repeatedly sourcing the same
-bytecompiled (tbc) code repeatedly across different interpreters (hobbs)
+2/4/99 (feature enhancement): Changed so windows that aren't resizable
+don't have resize handles and the zoom box is disabled on
+Windows. (stanton)
-2000-03-29 (config enhancement) improved build support for gcc/mingw on
-Windows (nijtmans, hobbs) and added RPM target (melski)
+2/4/99 (bug fix): Fixed so errors in console eval are reported
+properly. Eliminated duplicate result messages. [Bug: 973] (stanton)
-2000-03-31 (bug fix) corrected data encoding problem when using
-"exec << $data" construct (melski)
+2/4/99 (bug fix): Changed so focus window is always set if -force is
+specified. This fixes the problem on Windows where Tk does not
+activate the window if it already has focus. (stanton)
-2000-04 (feature enhancement) overhaul of threading mechanism to better
-support tcl level thread command (new APIs Tcl_ConditionFinalize,
-Tcl_MutexFinalize, Tcl_CreateThread, etc, all docs in Thread.3).
-(kupries, graveraux)
-This enables the tcl level thread extension. (welch)
+2/4/99 (bug fix): If an image mask changed but ended up with the same
+XID, the GC failed to be updated and so the new mask was not
+used. [Bug: 970] (stanton)
-2000-04-10 (bug fix) fixed infinite loop case in regexp -all (melski)
+2/12/99 (new feature): Tk is now thread safe. You enable this by
+configuring with --enable-threads. Tcl must also be compiled with
+--enable-threads. See Tcl for more information about the threading
+interfaces. (lfb)
-2000-04-13 (config enhancement) added support for --enable-64bit-vis
-Sparc target. (hobbs)
+2/25/99 (bug fix) Under Windows, wish can now inherit pipe handles on
+stdio so it is possible to use the wish executable in a command
+pipeline to capture the output of puts or read from the pipe with
+gets. (redman)
-2000-04-18 (bug fix) moved tclLibraryPath to thread-local storage to fix
-possible race condition on MP machines (hobbs)
+3/1/99 (bug fix) Under Windows, Tk was not properly handling focus and
+activation changes in some cases. (redman)
-2000-04-18 (config enhancement) added MacOS X build target and
-tclLoadDyld.c dl type. (sanchez)
+3/10/99 (new feature) Tk now uses the new stub library feature in Tcl.
+The Tk library now contains no direct references to any symbols in
+Tcl. In addition, there is a new Tk_MainEx() function that takes an
+interpreter as an argument. See the Tcl documentation for more
+information about the stubs mechanism. (redman)
-2000-04-23 (bug fix) several Mac socket fixes (ingham)
+3/14/99 (feature change) Test suite now uses "test" namespace to
+define the test procedure and other auxiliary procedures as well as
+global variables.
+ - Global array testConfige is now called ::test::testConfig.
+ - Global variable VERBOSE is now called ::test::verbose, and
+ ::test::verbose no longer works with numerical values. We've
+ switched to a bitwise character string. You can set
+ ::test::verbose by using the -verbose option on the Tk command
+ line.
+ - Global variable TESTS is now called ::test::matchingTests, and
+ can be set on the Tk command line via the -match option.
+ - There is now a ::test::skipTests variable (works similarly to
+ ::test::matchTests) that can be set on the Tk command line via
+ the -match option.
+ - The test suite can now be run in any working directory. When
+ you run "make test", the working directory is nolonger switched
+ to ../tests.
+(hirschl)
+*** POTENTIAL INCOMPATIBILITY ***
-2000-04-24 (bug fix) fixed hang in threaded Unix case when backgrounded
-exec process was running (dejong)
+----------------- Released 8.1b2, March 16, 1999 ---------------------
---- Released 8.3.1, April 26, 2000 --- See ChangeLog for details ---
+3/23/99 (feature change) Test suite now uses "tcltest" namespace to
+define the test procedure and other auxiliary procedures as well as
+global variables. The previously chosen "test" namespace was thought
+to be too generic and likely to create conflits.
+(hirschl)
+*** POTENTIAL INCOMPATIBILITY ***
-2000-04-26 (doc fix) updated/added documentation for many API's and
-commands (melski)
+3/26/99 [bug fix] Fixed bug reported by Bryan Oakley in the
+menubutton bindings. There was a false assumption that there was
+always a menu attached to the button. [Bug 1116] (surles)
-2000-05-02 (feature enhancement) added support for joinable threads;
-extended API's for channels to allow channels to move between threads
-(kupries)
+3/26/99 (feature change) Removed --enable-tcl-stub from the configure
+script. Linking Tk to Tcl stubs is causing too many problems when
+linking executables like wish. Until the Tk is a fully loadable
+extension, linking against the Tcl stubs is not supported in Tk.
+(redman)
-2000-05-02 (feature enhancement) changed error return for procedures
-with incorrect args to be like the Tcl_WrongNumArgs API, with a "wrong
-# args: ..." message printed, with an args list (hobbs)
+3/26/99 (feature change) --nameble-shared is now the default and builds
+Tk as a shared library; specify --disable-shared to build a static Tk
+library and shell.
+*** POTENTIAL INCOMPATIBILITY ***
-2000-05-08 (feature enhancement) added [array statistics] command
+3/29/99 (api change) Standardized text layout and font interfaces
+so they are consistent with respect to byte versus character
+oriented indices. The layout functions all manipulate character
+oriented values while the lower level measurement functions all
+operate on byte oriented values. (stanton)
-2000-05-08 (performance enhancement) rewrote Tcl_StringCaseMatch
-algorithm for better performance; this affects the [string match]
-command; added "eq" and "ne" operands to expr, for testing
-string equality and inequality (hobbs)
+4/1/99 (bug fix) Image handlers are finalized before the font subsystem
+to fix crashes during finalization of complex widgets. (stanton)
-2000-05-09 (feature enhancement) extended [lsearch] to support sorted
-list searches and typed list searches (melski)
+4/1/99 (feature change) Removed the send command on Windows. Moved
+the DDE basis of that command out to its own extension. The send
+implementation on top of DDE was causing Tk to lock up in some cases.
+(redman)
-2000-05-10 (feature enhancement) added [namespace exists] command
-(darley)
+4/5/99 (bug fix) Fixed handling of Unicode in text searches. The
+-count option was returning byte counts instead of character counts.
-2000-05-18 (build enhancement) added support for mingw compile env and
-cross-compiling (dejong)
+4/5/99 (feature change) Cut and paste to an entry widget returns the
+selection instead of the widget contents, which can be different if the
+-show option is used to hide the display. (stanton)
-2000-05-18 (bug fix) corrected clock grammar to properly handle the
-"ago" keyword when it follows multiple relative unit specifiers
-(melski)
+--------------- Released 8.1b3, April 6, 1999 ----------------------
-2000-05-22 (compile fix) type cast cleanups (dejong)
+4/20/99 (compiler fix) changed definition of Status type to use a
+typedef instead of a #define to avoid conflicting with the cygwin win32
+headers. (redman)
-2000-05-23 (performance enhancement) added byte-compiled
-implementation of [return] command and [string] command (melski)
+4/22/99 (bug fix) Set the -translation and -encoding options to binary
+for image files. (redman)
-2000-05-26 (performance enhancement) extended byte-compiled [string]
-command with support for [string compare/index/match] (hobbs)
+4/27/99 (bug fix) Changed to avoid the need for forward declarations in
+stub initializers. Added extern "C" blocks around stub table pointer
+declarations so the stubs can be used from C++ code. (stanton)
-2000-05-27 (feature enhancement) added ability to set [info script]
-return value ([info script ?newFileName?]) (welch)
+--------------- Released 8.1 final, April 29, 1999 ----------------------
-2000-05-31 (feature enhancement) added support for regexp and exact
-pattern matching for [array names] (gazetta)
+5/7/99 (bug fix) Fixed bug wheretk_popup fails when called too
+quickly. [Bug: 2009] (stanton)
-2000-05-31 (feature enhancement) added -nocomplain and -- flags to
-[unset] to allow for silent unset operation (hobbs)
+5/18/99 (bug fix) Fixed clipboard code so it handles Unicode data
+properly on Windows NT and 95. [Bug: 1791] (stanton)
---- Released 8.4a1, June 6, 2000 --- See ChangeLog for details ---
+5/19/99 (bug fix) Add extern "C" block around entire header file for
+C++ compilers to fix linkage issues. Submitted by Don Porter and Paul
+Duffin. (redman)
-2000-05-29 (bug fix) corrected resource cleanup in http error cases.
-Improved handling of error cases in http. (tamhankar)
+--------------- Released 8.1.1, May 25, 1999 ----------------------
-2000-07 (feature rewrite) complete rewrite of the Tcl IO channel subsystem
-to correct problems (hangs, core dumps) with the initial stacked channel
-implementation. The new system has many more tests for robustness and
-scalability. There are new C APIs (see Tcl_CreateChannel), but only
-stacked channel drivers are affected (ie: TLS, Trf, iogt). The iogt
-extension has been added to the core test code to test the system.
-(hobbs, kupries)
- **** POTENTIAL INCOMPATABILITY ****
+5/21/99 (bug fix) Fixed clipboard code to handle lack of CF_LOCALE
+information (from command.com). (stanton)
-2000-07 (build improvements) cleanup of the makefiles and configure scripts
-to correct support for building under gcc for Windows. (dejong)
+6/1/99 (bug fix) Improved I18N selection support. COMPOUND_TEXT
+is converted to/from iso2022, and STRING is converted to/from
+iso8859-1. More work is needed. (stanton)
-2000-08-07 (bug fix) corrected sizeof error in Tcl_GetIndexFromObjStruct.
-(perkins)
+6/3/99 (bug fix) Fixed selection code to handle Unicode data in
+COMPOUND_TEXT and STRING selections. [Bug: 1791] (stanton)
-2000-08-07 (bug fix) correct off-by-one error in HistIndex, which was
-causing [history redo] to start its search at the wrong event index. (melski)
+6/16/99 (new feature) Changes to makefiles and configure scripts to
+support TEA specification. (wart)
-2000-08-07 (bug fix) corrected setlocale calls for XIM support and locale
-issues in startup. (takahashi)
+6/30/99 (bug fix) Removed deprecated functions, patch from Jan
+Nijtmans. [Bug 2080] (redman)
-2000-08-07 (bug fix) correct code to handle locale specific return values
-from strftime, if any. (wagner)
+6/30/99 (bug fix) Applied patch to allow Img extension to work with
+8.2, patch from Jan Nijtmans. [Bug 2068] (redman)
-2000-08-07 (bug fix) tweaked grammar to properly handle the "ago" keyword
-when it follows multiple relative unit specifiers, as in
-"2 days 2 hours ago". (melski)
+6/30/99 (bug fix) Applied patch from Don Porter to prevent the Windows
+shutdown code from calling Tcl functions when the stub table has not
+been initialized in TkWinWmCleanup. [Bug: 2269] (redman)
-2000-08-07 (doc fixes) numerous doc fixes to correct SEE ALSO and NAME
-sections. (english)
+7/8/99 (bug fix) Changed TkWinChildProc to pass WM_WINDOWSPOSCHANGED
+through to DefWindowProc to make OpenGL sub-windows happpy. This
+allows Windows to generate the WM_SIZE and WM_MOVE messages. (stanton)
-2000-08-07 (bug fix) new man pages memory.n, TCL_MEM_DEBUG.3, Init.3 and
-DumpActiveMemory.3. (melski)
+--------------- Released 8.2b1, July 14, 1999 ----------------------
---- Released 8.3.2, August 9, 2000 --- See ChangeLog for details ---
+7/16/99 (bug fix) Copy prolog.ps from the generic directory for
+install-libraries make target. (redman)
-2000-06 thru 2000-11 (build improvements) Added support for mingw (gcc on
-Windows), AIX-5 and Win64 builds (dejong, hobbs)
+7/22/99 (bug fix) Applied patch from Jeff Hobbs to fix
+library/menu.tcl. [Bug: 2425] (redman)
-2000-06-23 (feature enhancement) ability to use Tcl_Obj *s as hash keys (duffin)
+7/22/99 (bug fix) Make install-sh have executable permissions before
+calling from the Makefile. [Bug: 2413] (redman)
-2000-06-29 (new features) added [mcmax] and [mcmset] and extended [unknown] in
-msgcat package (duperval, krone, nelson)
-=> msgcat 1.1
+7/22/99 (bug fix) Block out sys/stat.h include with #if to allow
+extension writers to use the MetroWerks compiler on Windows.
+[Bug: 2385] (redman)
-2000-08 thru 2000-09 added tclPlatDecls.h to default install (melski, hobbs)
+7/29/99 (bug fix) Allow tcl to opn CON and NUL on Windows, moved check
+to Tk Console code instead. [Bug: 2393 2392 2209 2458] (redman)
-2000-08-24 (new feature) Enhanced trace syntax to add:
- trace {add|remove|list} {variable|command} name ops command
-(darley, melski)
+7/30/99 (bug fix) corrected the Windows build of threaded Tk from both
+sets of makefiles (nmake and gmake). (redman)
-2000-09-06 (cross-platform feature) Set ^Z (\32) as default EOF char. (hobbs)
+7/30/99 (bug fix) Added XFillRectangle to stub table, patch from Jan
+Njitmans. [Bug: 2446] (hobbs)
-2000-09-07 partial fix for bug 2460 to prevent exec mem leak on Windows for the
-common case (gravereaux)
+8/1/99 (bug fix) Wrapped #define of panic() inside #ifndef blocks to
+avoid compiler errors on Macintosh. Patch from Vince Darley.
+[Bug: 2389] (hobbs)
-2000-09-14 Improved string allocation growth for large strings (hintermayer,
-melski)
+--------------- Released 8.2b2, August 5, 1999 ----------------------
-2000-09-14 New non-panic'ing mem allocation functions Tcl_AttemptAlloc,
-Tcl_AttemptRealloc, Tcl_AttemptSetObjLength (melski)
+8/13/99 (Mac) Rearranged the projects in the tkMacProjects.sea.hqx so
+that the build directory is separate from the sources. Fixed bug in
+Tk_DrawChars(). (Jim Ingham)
-2000-09-20 (new features) completely new, enhanced syntax in tcltest package.
-Backwards compatable with tcltest v1. (hom)
-=> tcltest 2.0
+--------------- Released 8.2.0, August 17, 1999 ----------------------
-2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that
-didn't set nonBlocking correctly when resetting the flags for the write
-side (mem leak) Correct mem leak in channels when statePtr was released
-(hobbs)
+9/21/99 (bug fix) fixed 'wm deiconify' quirks on Windows. (hobbs)
-2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason)
+9/21/99 (bug fix) fix fg<>bg GC swap bug for canvas. [Bug: 2676] (hobbs)
-2000-10-06 (bug fix) corrected [file channels] to only return channels in
-the current interpreter (hobbs)
+9/21/99 (config fix) fixed AIX config issues for Tk. (hobbs)
-2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to
-speed up command significantly in base cases (hobbs)
+9/24/99 (feature change) tk_dialog now uses {Times 12} by default. (hobbs)
-2000-10-27 Fixed mem leak in Tcl_CreateChannel. Re-purified core via test
-suites. (hobbs)
+--- Released 8.2.1, October 04, 1999 --- See ChangeLog for details ---
-2000-10-30 (new feature) add "ja_JP.eucJP" map to "euc-jp" encoding (takahashi)
+10/30/99 (bug fix) fixed XKeysymToKeycode to handle mapping of symbolic
+keysyms (Left, Home, ...) with event generate (hobbs)
-2000-11-01 (mem leak) Corrected excessive mem use of info exists on a
-non-existent array element (hobbs)
+10/30/99 (bug fix) change tkEntrySeeInsert to avoid the use of a while loop
+that could eat CPU tremendously. Behavior of moving the cursor at the
+right edge changes slightly. [Bug: 3195] (hobbs)
-2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded
-environment (gravereaux)
+10/30/99 (bug fix) changed tkScrollButtonUp to check for existence of
+tkPriv(relief) in order to avoid spurious release events (hobbs)
-2000-11-03 (new feature) Tcl_SetMainLoop enables defining an event loop for
-tclsh. This enables Tk as a truly loadable package. (hobbs)
+--- Released 8.2.2, November 04, 1999 --- See ChangeLog for details ---
---- Released 8.4a2, November 3, 2000 --- See ChangeLog for details ---
+11/19/99 (bug fix) fixed expression error that could cause
+'malformed bucket chain' error in tkEntry.c. (hobbs)
-2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that
-didn't set nonBlocking correctly when resetting the flags for the write
-side (mem leak) Correct mem leak in channels when statePtr was released
-(hobbs)
+11/19/99 (bug fix) fixed Tk_NameOfColor (hobbs)
-2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason)
+--- Released 8.2.3, December 16, 1999 --- See ChangeLog for details ---
-2000-10-06 (bug fix) corrected [file channels] to only return channels in
-the current interpreter (hobbs)
+1999-09-01 (feature enhancement) rewrote runtime libraries to use new
+Tcl functions where appropriate
-2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to
-speed up command significantly in base cases (hobbs)
+1999-10-28 (feature enhancement) added Img patch from Jan Nijtmans that
+makes the image command Tcl_Obj-based, adds support for binary -data args,
+adds alpha channel to images, adds GIF write capability (RLE). Binary
+compatability is maintained, and source level compatibility is retained
+with -DUSE_OLD_IMAGE. (nijtmans)
-2000-11-01 (mem leak) Corrected excessive mem use of info exists on a
-non-existent array element (hobbs)
+1999-11-16 (feature enhancement) made listbox Tcl_Obj based, added
+-listvariable option and itemconfigure command to allow coloring
+individual items. (melski)
-2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded
-environment (gravereaux)
+1999-11-23 (feature enhancement) added TK_OPTION_DONT_SET_DEFAULT as an
+equivalent to TK_CONFIG_DONT_SET_DEFAULT (hobbs)
-2000-11-23 (mem leak) fixed potential memory leak in error case of lsort
-(fellows)
+1999-11-24 (feature enhancement) updated dialogs to use color icons on
+Unix, center properly over -parent. (hipp, hobbs)
-2000-12-09 (feature enhancement) changed %o and %x to use strtoul instead
-of strtol to correctly preserve scan<>format conversion of large integers
-(hobbs)
-Fixed handling of {!<boolean>} in expressions (hobbs, fellows)
+1999-12-01 (feature enhancement) added hooks into main() code to support
+"big" shells more easily. (redman)
-2000-12-14 (feature enhancement) improved (s)rand for 64-bit platforms
-(porter)
+1999-12-02 (feature enhancement) converted Tk_DestroyCmd, Tk_LowerCmd and
+Tk_RaiseCmd to their ObjCmd equivalent.
-2001-01-04 (bug fix) corrected parsing of $tcl_libPath at startup on
-Windows (porter)
+1999-12-12 (bug fix) fixed bug in TextSearchCmd for multibyte chars
-2001-01-30 (bug fix) Fixed possible hangs in fcopy. (porter)
+1999-12-13 (feature enhancement) added support for pointer warping via the
+event -warp option, added some items from Dash patch: canvas widget now
+Tcl_Obj-based, added Tk_CreateSmoothMethod, added support for <Quadruple>
+clicks, entry widget validation routines, new -state hidden in text
+widgets, new -state -active* -disabled* -offset options to canvas items
+(see man page for full docs). New features include dashed line support on
+the canvas, -elide support for TkMan, postscript printing of images and
+windows from the canvas. Binary compatibility is maintained with 8.2, and
+source level compatibility is kept by using -DUSE_OLD_CANVAS.
+(hobbs, nijtmans, et al)
-2001-02-15 (performance enhancement) improved efficiency of [string split]
-(fellows)
+1999-12-16 (feature enhancement) added "bitstream cyberbit" to list of
+font fallbacks. (hobbs)
-2001-03-13 (bug fix) Correctly possible memory corruption in string map {}
-$str (fellows)
+1999-12-16 (feature enhancement) added new 'tk useinputmethods ...' command
+to provide support for disabling/enabling the use of XIM on X. This was
+previously all done at compile time, and always on. Now it is turned off
+by default, even when available, and the user must turn it on to use XIM
+(per display).
+ *** POTENTIAL INCOMPATIBILITY ***
+user must add 'tk useinputmethods 1' to retain old style. (hobbs)
-2001-03-29 (bug fix) prevent potential race condition and security leak in
-tmp filename creation on Unix. (max)
-Fixed handling of timeout for threads (corrects excessive CPU usage issue
-for Tk on Unix in threaded Tcl environment). (ruppert)
+1999-12-16 (feature enhancement) added proper support for -initialfile
+to tk_get*File, and made Unix version better match Windows file box
+that it was emulating. (hobbs)
-2001-03-30 (bug fix) corrected Windows memory error on exit (wu)
-Fixed race condition in readability of socket on Windows.
+1999-12-16 (bug fix) removed necessity of 'update idle' before 'wm
+deiconify' on Windows. (mao)
-2001-04-03 (doc fixes) numerous doc corrections and clarifications.
-Update of READMEs.
+1999-12-16 (feature enhancement) added support for Windows system cursors
+to TkGetCursorByName (use -cursor @filename)
-2001-04-04 (build improvements) redid Mac build structure (steffen)
-Corrected IRIX-5* configure (english). Added support for AIX-5 (hobbs).
-Added support for Win64 (hobbs).
+1999-12-21 (bug fix) fixed lack of refresh for thin frames (darley)
---- Released 8.3.3, April 6, 2001 --- See ChangeLog for details ---
+1999-12-21 (bug fix) fixed panic in Tk_CoordsToWindow to print error
+to stderr instead (for Tix) (hobbs)
-2000-11-23 (new feature)[TIP 7] higher resolution timer on Windows (kenny)
+1999-12-21 (bug fix) fixed segv with scale widget when using -cursor (hobbs)
-2001-01-18 (new feature) Tcl_InitHashTableEx renamed to Tcl_InitCustomHashTable
-(kupries)
+--- Released 8.3b1, December 22, 1999 --- See ChangeLog for details ---
-2001-03-30 (new feature)[TIP 10] support for thread-aware/hot channels (kupries)
+2000-01-05 (bug fix) Applied fixes for unprotected arg passing through eval
+and after in Tk runtime code [Bug: 3943] (hobbs)
-2001-04-06 (new feature)[219280] auto-loading hidden in ::errorInfo (porter)
+2000-01-05 (bug fix) Applied fix for i18n problems with Mac clipboard
+[Bug: 3544] (hobbs)
-2001-04-07 (bug fix)[406709] corrected panic when extra items left on the
-byte compiler execution stack (sofer)
+2000-01-05 (feature change) removed the 8.3b1 introduced -state option
+for text tags, and documented -elide (-state hidden == -elide true) (hobbs)
-2001-04-09 (bug fix)[219136,232558] improved use of thread-safe functions in
-unix time commands (kenny)
+2000-01-12 (bug fix) fix Windows 'wm deiconify' to zoomed state [Bug: 2077]
+and fixed possible flashing of unmapped toplevel in deiconify [Bug: 3338]
+and fixed unwanted mapping of transient window [Bug: 572] (hobbs)
-2001-04-24 (new feature)[TIP 27] started CONST-ification of the Tcl APIs (kenny)
+2000-01-12 (feature enhancement) extended 'wm state' to accept a state
+to set for the toplevel, and added support for zoomed (maximized) state
+on Windows (hobbs)
-2001-05-03 (new feature) [auto_import] now matches patterns like
-[namespace import], not like [string match] (porter)
- **** POTENTIAL INCOMPATABILITY ****
+2000-01-12 (bug fix) Applied fix for cursor to not blink when entry or
+text widget was disabled [Bug: 1807] (hobbs)
-2001-05-07 (new feature)[416643] distinct srand() seed per interp (sofer)
+--- Released 8.3b2, January 13, 2000 --- See ChangeLog for details ---
-2001-05-15 (new feature) new Tcl_GetUnicodeFromObj API (hobbs)
+2000-01-20 (bug fix) fixed interpretation of consecutive ^ characters in
+grid command (melski)
-2001-05-16 (performance enhancement) byte-compiled versions of [lappend],
-[append] simple cases (hobbs)
+2000-01-20 (bug fix) fixed -select(bg|fg) class names in listbox (hobbs)
-2001-05-23 (new feature) added ISO-8859-15 and koi8-u encodings, updated other
-encoding tables based on http://www.unicode.org/Public/MAPPINGS/ (kuhn)
+2000-01-20 (bug fix) fixed handling of too few coords for line item type in
+canvas (hobbs)
-2001-05-27 (new feature) updated to Unicode 3.1.0 data set (still using 16
-bits for Tcl_UniChar though) (hobbs)
+2000-01-20 (bug fix) fixed dialog's association with parent (melski)
-2001-05-30 (new feature)[TIP 15] Tcl_GetMathFuncInfo, Tcl_ListMathFuncs,
-Tcl_InfoObjCmd, InfoFunctionsCmd APIs (fellows)
+2000-01-26 (bug fix) fixed handling of binary data for -data option to
+image create (melski)
-2001-06-08 (bug fix,feature enhancement)[219170,414936] all Tcl_Panic
-definitions brought into agreement (porter)
+2000-01-26 (feature enhancement) improved GIF decoding speed by ~60%
+(melski)
-2001-06-12 (bug fix)[219232] regexp returned non-matching sub-pairs to have
-index pair {-1 -1} (fellows)
+2000-01-26 (feature enhancement) added tk_chooseDirectory implementation
+for Unix and Mac (nelson, melski)
-2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII
-characters. (hobbs, riefenstahl)
+2000-02-01 (bug fix) fixed resolution rounding problem in scale (porter)
+and fixed potential Unix seg fault due to use of ckfree instead of
+Tcl_EventuallyFree (hobbs)
-2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer)
+2000-02-01 (bug fix) fixed handling of negative dash values for canvas
+items (nijtmans)
-2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings
-(hobbs, barras)
+2000-02-01 (bug fix) fixed dialog lockup on Windows where once the native
+dialog disappeared, the parent window could end up locked up (hobbs)
-2001-07-12 (new feature)[TIP 36] Tcl_SubstObj API (fellows)
+2000-02-03 (bug fix) fixed text dump to use char indices instead of byte
+indices (melski)
-2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows
-(hobbs, jsmith)
+2000-02-07 (bug fix) fixed handling of default extension in unix file
+dialogs (dejong)
-2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size
-of a channel is changed after channel use has already begun (kupries, porter)
+2000-02-08 (bug fix) corrected windows symbol font use to restrict itself
+to 8-bit chars (kenny)
-2001-07-31 (new feature)[TIP 17] TclFS* APIs provide new virtual file
-system. This includes the addition of 'file normalize', 'file system',
-'file separator' and 'glob -tails' (darley)
+2000-02-08 (feature enhancement) improved support for moving from the old
+style image C API to the new obj'ified one with new Tk_InitImageArgs
+command and stub'ing of image code. See docs for how to make the
+transition. (nijtmans)
-2001-08-06 (bug fix) removed use of tmpnam in TclpCreateTempFile on Unix (lim)
+2000-02-08 (bug fix) fixed incorrect handling of CapsLock on Win9* and the
+use of dead keys on international keyboards (spjuth)
- * improved build support for IRIX, GNU HURD, Mac OS 9 and OS X
+2000-02-10 (bug fix) brought Mac back to building state, added support
+for Appearance Manager (ingham)
- * configure scripts revamped for better support of cygwin and gcc on
- Windows (mdejong)
+2000-02-10 (feature enhancement) added support for buttons 4 && 5 as
+mousewheel style scrolling in listbox and text widget for Unix.
- * corrected several minor errors noted by Purify (hobbs)
+--- Released 8.3.0, February 10, 2000 --- See ChangeLog for details ---
---- Released 8.4a3, August 6, 2001 --- See ChangeLog for details ---
+2000-03-02 (bug fix) fixed crash in listbox when cursor was configure and
+then widget was destroyed (hobbs)
-2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII
-characters. (hobbs, riefenstahl)
+2000-03-02 (feature enhancement) added %V substitution to entry widget
+validation to clarify type of validation occuring (hobbs)
-2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer)
+2000-03-07 (feature enhancement) added -disabledforeground/-state to labels
+(melski)
-2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings
-(hobbs, barras)
+2000-03-29 (config enhancement) improved build support for gcc/mingw on
+Windows (nijtmans, hobbs) and added RPM target (melski)
-2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows
-(hobbs, jsmith)
+2000-03-24 (bug fixes) numerous corrections for more correct Unix dialog
+behaviors (melski)
-2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size
-of a channel is changed after channel use has already begun (kupries, porter)
+2000-03-27 (bug fix) fixed mem leak in wm commands (hu)
-2001-08-06 (bug fix)[442665] corrected object reference counting in [gets]
-(jikamens)
+2000-03-31 (bug fix) correct initialization of Windows static builds and
+added Unicode aware open/save file dialogs on Windows (hobbs)
-2001-08-06 (new feature) added GNU (HURD) configuration target. (brinkmann)
+2000-03 (bug fix) canvas: corrected support for transparency in dashed
+lines on Windows (nijtmans); added support for postscript generation of
+images on Windows, also fixing transparency printing (biancardi); corrected
+handling of configure options in non-empty canvas (melski)
-2001-08-07 (bug fix)[406709] corrected panic when extra items left on the
-byte compiler execution stack (see test foreach-5.5) (sofer, tallneil, jstrot)
+2000-04-07 (bug fix) correct font name length restriction that prevented
+the use of long named (>16 char) fonts on NT/2000 (hobbs)
-2001-08-08 (new features) updated packages msgcat 1.1.1, opt 0.4.3,
-tcltest 1.0.1, dependencies checked (porter)
+2000-04-07 (bug fix) fixed safe Tk to work in base cases (hobbs)
-2001-08-20 (new feature)[452217] http 2.3.2: include port number in Host: header
-to comply with HTTP/1.1 spec (RFC 2068) (hobbs, tils)
+2000-04-10 (bug fix) corrected Alt-Key event generation and handling of
+Alt-sequence Windows special char generation and (Control|Shift|Alt)_L/_R
+determination (melski)
-2001-08-23 (new feature) added QNX-6 build support (loverso)
+2000-04-10 (bug fix) correctly check state of parent when popping up
+bgerror dialog. (melski)
-2001-08-23 (bug fix) corrected handling of spaces in path name passed to
-[exec] on Windows (kenpoole)
+2000-04-11 (feature enhancement) msgcat now searches up the namespace chain
+for a match instead of just in the local namespace (hershey)
-2001-08-24 (bug fix) corrected [package forget] stopping on non-existent
-package (porter)
+2000-04-12 (bug fix) corrected handling of Windows clipboard to allow for
+use of user-defined types within the Tk app (hobbs)
-2001-08-24 (bug fix) corrected construction of script library search path
-relative to executable (porter)
+2000-04-13 (feature enhancement) improved handling of shadow determination
+for 3D borders in very light/dark cases (hipp, melski)
-2001-08-24 (bug fix) [auto_import] now matches patterns like
-[namespace import], not like [string match] (porter)
- **** POTENTIAL INCOMPATABILITY ****
+2000-04-13 (bug fix) correctly color separator bg in menus on Windows
+(melski)
-2001-08-27 (new feature) added Tcl_SetMainLoop() to enable loading Tk as a
-true package (hobbs)
+2000-04-14 (bug fix) improved handling of scale widget, reduced number of
+redraws (hobbs)
-2001-08-30 (bug fix) build support for Crays (andreasen)
+2000-04-17 (feature enhancement) made shift-selection more Windows-like
+(intuitive) in text widget (melski)
-2001-09-01 (bug fix) rewrite of Tcl_Async* APIs to better manage thread
-cleanup (gravereaux)
+2000-04-22 (bug fix) mac bug fixes, nav services handling (ingham)
-2001-09-06 (new feature) http 2.4: honor the Content-encoding and charset
-parameters; add -binary switch for forcing the issue (hobbs, saoukhi, orwell)
-=> http 2.4
+2000-04 more docs for public APIs (melski)
-2001-09-06 (performance enhancement) rewrite of file I/O flush management on
-Windows. Approximately 100x speedup for some operations. (kupries, traum)
+--- Released 8.3.1, April 26, 2000 --- See ChangeLog for details ---
+2000-04 (doc updates) extended, updated docs (melski)
-2001-09-10 (bug fix) corrected finalization error in TclInExit (darley)
+2000-05-09 (feature change) removed WS_EX_TOOLWINDOW style bit for
+transient windows on Windows platforms, so that transients have
+full-size titlebars (melski)
-2001-09-10 (bug fix) protect against alias loops (hobbs)
+2000-05-09 (bug fix) fixed calling of takeFocus proc (nemethi)
-2001-09-12 (bug fix) added missing #include in tclLoadShl.c (techentin)
+2000-05-11 (bug fix) corrected handling of 3DBorder, Cursor and Color
+objects on multiple screens (hobbs)
-2001-09-12 (bug fix) script library path construction on Windows no longer
-uses registry, nor adds the current working directory to the path (porter)
+2000-05-12 (feature enhancement) improved support for chars in 0-255
+range for bitmap ANSI fonts (spjuth, hobbs)
-2001-09-12 (bug fix) correct bugs in compatibility strtod() (porter)
+2000-05-12 (widget enhancement) added support for -repeatdelay,
+-repeatinterval for command buttons; and -compound (image and text
+simultaneously) for labels, check-, radio-, and command buttons (melski)
-2001-09-13 (bug fix) Tcl_UtfPrev now returns the proper location when the
-middle of a UTF-8 byte is passed in (hobbs)
+2000-05-14 (widget change) added "readonly" state for entries and
+changed behavior of "disabled" entries; added -readonlybackground
+option for entries (melski)
+*** THIS IS A BACKWARDS INCOMPATIBLE BEHAVIOR CHANGE ***
-2001-09-19 (bug fix) [format] and [scan] corrected for 64-bit machines (rmax)
+2000-05-15 (feature enhancement) added [image inuse] command (melski)
-2001-09-19 (new feature) --enable-64-bit support for HP-11. (hobbs)
+2000-05-15 (feature enhancement) added -nice option to [bell] command (duncan)
-2001-09-19 (new feature) native memory allocator now default on Windows
-(hobbs)
+2000-05-17 (widget enhancement) added -overrelief option for
+check/radio/buttons (melski)
-2001-09-20 (new feature) WIN64 support and extra processor definitions
-(hobbs, mstacy)
+2000-05-26 (feature change) added support for new syntax in
+Tk_OptionSpec tables; if the database name for an option contains an
+embedded "." it indicates that the name contains an overriding window
+class specifier in addition to the database name, which allows widgets
+to perform queries for certain options as if they were options for a
+different widget class (melski)
-2001-09-26 (bug fix) corrected potential deadlock in channels that do not
-provide a BlockModeProc (kupries, kogorman)
+2000-05-28 (new widget) added spinbox widget (hobbs)
-2001-10-03 (new feature) WIN64 build support (hobbs)
+2000-05-31 (feature change) replaced bgerror dialog with a new and
+improved one (fellows, melski)
-2001-10-03 (bug fix) correction in thread finalization (rbrunner)
+--- Released 8.4a1, June 6, 2000 --- See ChangeLog for details ---
-2001-10-04 (new feature) updated encodings with latest mappings from
-www.unicode.org (hobbs)
+2000-05-15 (bug fix) changed wm deiconify from using idle callback to
+calling restack and focus code immediately. (hobbs)
-2001-10-11 (bug fix) corrected cleanup of self-referential bytecodes at
-interpreter deletion (sofer, rbrunner)
+2000-07 (build cleanup) cleanup of defines in tkConfig.sh, and cleanup
+in make and configure files to better handle .rc files across
+builds. (welch)
-2001-10-16 (new feature) config support for MacOSX / Darwin (steffen)
+2000-07 (build improvements) cleanup of the makefiles and configure scripts
+to correct support for building under gcc for Windows. (dejong)
-2001-10-16 (new feature, Mac) change in binary extension format from MachO
-bundles to standard .dylib dynamic libraries like on other unices.
- *** POTENTIAL INCOMPATIBILITY ***
+2000-08 (feature enhancements) for Windows, corrected drawing of separator
+menu entries, disable menu entries and the height for separator
+bars. (melski)
-2001-10-18 (bug fix) corrected off-by-one-day error in clock scan with
-relative months and years during swing hours. (lavana)
+2000-08 (bug fix) fixed calling of takeFocus proc with arg bearing
+functions. (nemethi)
---- Released 8.3.4, October 19, 2001 --- See ChangeLog for details ---
+2000-08 (bug fix) For text widgets, added a test for a NULL segment pointer
+when doing backwards searches for "", correct searching over elided chars,
+and corrected search combining -regexp and -nocase. (melski)
-2001-08-21 (bug fix)[219184] overagressive compilation of [catch] (sofer)
+2000-08 (bug fix) Corrected code for using 'place', cursors, colors and 3D
+borders on multiple screens simultaneously. (hobbs, hipp)
-2001-08-22 (new feature)[227482] [dde request -binary] (hobbs)
-=> dde 1.2
+--- Released 8.3.2, August 9, 2000 --- See ChangeLog for details ---
-2001-08-30 (performance enhancement)[456668] fully qualified command names use
-cached Command for all namespaces, avoiding repeated lookups (sofer)
+2000-06-15 (new feature) [tk_getOpenFile ... -multiple] (melski)
-2001-08-31 (performance enhancement) bytecompiled [list] (hobbs)
+2000-06-29 (new feature) localization support in Tk dialogs (duperval,
+melski, et al)
-2001-09-02 (bug fix)[403553] Add -Zl to VC++ compile line for tclStubLib to
-avoid any specific C-runtime library dependence. (gravereaux)
+200-07-28 (new feature) -state option for listbox, better native color
+defaults (melski)
-2001-09-05 (new feature) restored support for Borland compiler (gravereaux)
+2000-08 (feature rewrites) Tcl_Obj'ified clipboard, message, tkwait,
+bindtags, grab. place, selection commands (melski)
-2001-09-05 (new feature)[TIP 49] Tcl_OutputBuffered API (schroedter, fellows)
+2000-08-24 (new feature) More correct GNU configure support (no more
+--enable-gcc) (dejong)
+ *** POTENTIAL INCOMPATIBILITY ***
-2001-09-07 (new feature) restored VC++ 5.0 compatibility (gravereaux)
+2000-08-29 (bug fix) Corrected Windows menu indicator drawing (oberhumer)
-2001-09-10 (performance enhancement)[TIP 53,451441] [proc foo args {}] now
-compiles to 0 bytecodes (sofer)
+2000-09-01 (bug fix) Added tkPlatDecls.h to default install (melski)
-2001-09-13 (new feature)[TIP 56] Tcl_EvalTokensStandard API (sofer)
+2000-09-17 (new feature) Added TK_OPTION_CUSTOM type, similar to
+TK_CONFIG_CUSTOM (melski)
-2001-09-13 (new feature) Old ChangeLog entries => ChangeLog.1999 (hobbs)
+2000-09-29 (bug fix) Several fixes for multi-display uses of Tk (hipp, hobbs)
-2001-09-17 (new feature) compiling with TCL_COMPILE_DEBUG now required to
-enable all compile and execution tracing (sofer)
- *** POTENTIAL INCOMPATIBILITY ***
+2000-10-05 (new feature) Tk_CreateAnonymousWindow API to create anonymous
+Tk windows controllable from C (melski)
-2001-09-19 (bug fix)[411825] made TclNeedSpace UTF-8 aware (fellows)
+2000-10-27 (new default behavior) [tk useinputmethods 1] is the default
+in tk.tcl, for users of XIM and "dead" keys (hobbs)
-2001-09-19 (bug fix)[219166] overagressive compilation of "quoted" bodies of
-[for], [foreach], [if], and [while] (sofer)
+2000-10-30 Improved support for static builds on Windows (gravereaux)
-2001-09-19 (performance enhancement) bytecompiled [string match] (hobbs)
+ * Added support for mingw (gcc on Windows), AIX-5 and Win64 builds
+ (dejong, hobbs)
-2001-10-15 (new feature)[TIP 35] serial channel configuration: Win (schroedter)
+ * Improved error checking in Windows native dialogs (melski, hobbs)
-2001-11-06 (bug fix)[478856] loss of fileevents due to short reads (kupries)
+--- Released 8.4a2, November 3, 2000 --- See ChangeLog for details ---
-2001-11-06 (new feature) revitalized makefile.vc (gravereaux)
+2001-04-04 (build improvements) redid Mac build structure (steffen)
+Corrected IRIX-5* configure (english). Added support for AIX-5 (hobbs).
+Added support for Win64 (hobbs).
-2001-11-07 (new feature) Cygwin gcc support dropped. Use mingw (dejong)
- *** POTENTIAL INCOMPATIBILITY ***
+2001-04-04 (doc fixes) numerous doc corrections and clarifications.
+Update of READMEs.
-2001-11-07 (new feature) Support --include-dir= and --libdir= options to
-configure. Store in tclConfig.sh as TCL_INCLUDE_SPEC and TCL_LIB_SPEC.
-(dejong)
- *** POTENTIAL INCOMPATIBILITY ***
+2001-04-04 (bug fix) corrected reseting of service mode to only occur when
+it was set (hedin, hobbs)
-2001-11-08 (new feature) Enable --enable-threads on FreeBSD (dejong)
+2001-04-02 (bug fix) Improved tests on Windows for correctness.
+Checked for menu deletion before calling associated menu entry command.
+Fixed listbox, canvas and entry destruction to be more aware of current
+widget activity. (hobbs)
-2001-11-08 (new feature) New make target 'make gdb' (dejong)
+2001-03-30 (feature enhancement) added support for changing IME on the fly
+in Windows (2000) (lam)
+(bug fix) handled the error case where a valid-looking but invalid
+identifier could be passed in certain event generate options causing a
+crash (hobbs)
-2001-11-09 (bug fix)[480176] [global] mishandled varnames matching :* (porter)
+2001-03-29 (bug fix) corrected handling of drag-selection (dejong)
-2001-11-12 (new feature)[TIP 22,33,45] new command [lset],
-[lindex] extended to accept multiple indices. (kenny, hobbs)
+2001-01-02 (feature enhancement) added Windows icon support in wm
+iconbitmap (darley)
-2001-11-16 (new feature) new configure option --enable-langinfo=no.
-By default, nl_langinfo() is used on Unix to determine system encoding.
-Tcl's built-in system is used only if that fails, or configured with
---enable-langinfo=no. (hobbs, wagner)
+2000-10-27 (feature enhancement) made [tk useinputmethods 1] the default
+for Tk (hobbs)
-2001-11-19 (new feature)[TIP 62] A Tcl_VarTraceProc can now return Tcl_Obj *
-or a dynamic string as well as a static string to indicate an error (fellows)
+2000-10-18 (bug fix) Corrected rendering of 1-pixel wide stippled lines on
+Windows. Correct use of active- and disabledwidth values for displaying
+lines. Enhanced error handling in Windows native dialogs (melski)
-2001-11-19 (new feature)[TIP 73] Tcl_GetTime API (kenny)
+2000-09-29 (bug fix) corrected BadMatch errors when using Tk on multiple
+screens (hipp)
-2001-11-19 (bug fix)[478847] overflows in [time] of >2**31 microseconds (kenny)
+2000-08-18 (feature enhancement) Removed redundant call to DitherInstance
+(melski)
-2001-11-29 (performance enhancement) caching scheme added to [binary scan]
-(fellows)
+--- Released 8.3.3, April 6, 2001 --- See ChangeLog for details ---
-2001-12-05 (new feature) new algorithm for [array get] adds safety when read
-traces modify the array. (sofer)
- *** POTENTIAL INCOMPATIBILITY ***
+2000-11-21 (new feature)[TIP 5] Tk_ClassProcs, Tk_SetClassProcs API (melski)
-2001-12-10 (bug fix)[490514] doc fixes (porter,english)
+2000-12-13 (performance enhancement)[403327] Tcl_Objs of type "double"
+are recognized in SetMMFromAny to speed up canvas coord calculations (hobbs)
-2001-12-18 (new feature) removed unix/dltest/configure; unix/configure does
-all (dejong)
+2001-01-02 (new feature)[TIP 8] [wn iconbitmap -default] on Windows (darley)
-2001-12-19 (new feature) New make target 'make shell' (dejong)
+2001-02-12 (new feature)[TIP #21] asymmetric padding in the pack and grid
+geometry managers (hipp)
-2001-12-21 (new feature) MaxOSX / Darwin support (steffen)
+2001-05-21 (new feature)[TIP #11], -compound for [menubutton] widget (helfter)
-2001-12-28 (new feature) new command [memory onexit] replaces [checkmem] when
-compiled with TCL_MEM_DEBUG. Added documentation. (porter)
- *** POTENTIAL INCOMPATIBILITY ***
+2001-06-03 (bug fix) corrected support for is10646 fonts on Unix, added a
+ucs-2be encoding (welch)
-2001-12-28 (bug fix) proper case in [auto_execok] use of $env(COMPSPEC) (hobbs)
+2001-07-02 (bug fix) allowed tkwin to be Tcl_EventuallyFree'd in
+Tk_DestroyWindow so other widgets could register their use of it. Updated
+entry and listbox widgets to use this, correcting potential crashes. (hobbs)
-2002-01-05 (feature rewrite) Tcl_Main() rewritten and documentation improved.
-Interactive operation and event loop operation (via Tcl_SetMainLoop) now
-interleave cleanly. Also more robust against strange happenings. (porter)
+2001-08-01 (interface rewrite)[TIP 44] moved all private tk[A-Z]* commands and
+variables into the ::tk:: namespace (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
-2002-01-17 (bug fix)[504642] Tcl_Obj refCounts in [gets] (griffen,kupries)
+ * overhaul of configure scripts for cleaner standard support and support
+ of mingw gcc on Windows. (mdejong)
-2002-01-21 (bug fix)[506297] infinite loop writing in iso2022-jap encoding
-(forssen,kupries)
+ * improved tests to better handle results on variant systems (hobbs)
-2002-01-24 (HTTP server bug workaround)[504508] leave the default port out
-of the Host: header value
-=> http 2.4.1 (hobbs)
+ * correct several minor Purify complaints (hobbs)
-2002-01-25 (new feature)[496733] socket options -eofchar and -translation
-return read-only values (dejong)
+--- Released 8.4a3, August 6, 2000 --- See ChangeLog for details ---
-2002-01-28 (new feature) Old ChangeLog entries => ChangeLog.20900 (hobbs)
+2001-08-06 (new feature) added GNU (HURD) build support. (brinkman)
-2002-01-28 (performance enhancement) bytecompiled [regexp] for trivial cases
-that amount to string matching. Also -nocase and --. (hobbs)
+2001-08-23 (new feature) added QNX-6 build support. (loverso)
-2002-02-05 (bug fix) [http::error] called when [::error] intended
-=> http 2.4.2 (porter)
+2001-08-24 (bug fix) correct several possible free memory reads and array
+bounds read errors reported by purify. (hobbs)
-2002-02-05 (bug fix)[465765] avoid zero-byte writes to STREAMs
-(talcott,kupries)
+2001-08-27 (new feature) added call to Tcl_SetMainLoop which enables Tk to
+be loaded interactively into tclsh and have the event loop kick in
+correctly. (hobbs)
-2002-02-06 (performance enhancement) [regsub] special cases that map to
-[string map] detected. (hobbs)
+2001-08-28 (bug fix) fixed tk_chooseDirectory crash on Win95. (baker)
-2002-02-06 (bug fix)[495213] [scan] accept 0x as prefix of base 16 value
-(hobbs)
+2001-08-28 (bug fix) removed 2 second 'raise' delay seen by some Unix
+window managers. (hobbs, baker)
-2002-02-10 (new feature)[TIP 32,79] Tcl_CreateObjTrace API (kenny)
+2001-09-14 (bug fix) fixed memory leaks that occured if errors were
+thrown while initializing the channel for an image. (darley)
-2002-02-12 (new feature) partial support for DJGPP Tcl on DOS (gravereaux)
+2001-09-20 (new feature) --enable-64bit support was added for HP 11 when
+using the native compiler.
-2002-02-14 (mem leak) Fixed leaking an empty Tcl_Obj when [gets $chan]
-errored out. (kupries, sofer)
+2001-10-03 (new feature) finalized Win64 support with latest RC1 release
+and SDK. (hobbs, stacy)
-2002-02-15 (new feature)[TIP 72] support for 64-bit integer values on
-32-bit platforms and ability to work with >2GiB files. Extends many
-commands. See ChangeLog and TIP for details.
- *** POTENTIAL INCOMPATIBILITY ***
+2001-10-04 (new feature) added enhanced bgerror dialog from Hipp. (hobbs)
-2002-02-22 (bug fix)[476537] Fix panic when loading shared library without
-proper use of stubs on platform without backlinking (porter)
+2001-10-09 (new feature) added brace/quote matching and file/path/var
+expansion to the Win/Mac console. (hobbs)
-2002-02-22 (new feature) 64-bit support for xlc compiler on AIX-4 (hobbs)
+2001-10-17 (bug fix) fixed file filtering in the motif file dialog (nelson)
-2002-02-22 (new feature)[521560] Removed limits on filename length and
-format [source]able through the Safe Base (hobbs)
+2001-10-17 (bug fix) updated Mac build support. (steffen)
-2002-02-22 (performance enhancement) optimized bytecodes for [if], [for],
-[while] and constant conditions (sofer)
+--- Released 8.3.4, October 19, 2001 --- See ChangeLog for details ---
-2002-02-22 (new feature)[TIP 76] [regsub] can now return result (fellows)
+2001-08-14 (bug fix)[450545] Tk's Tcl_ObjTypes now registered (fellows)
-2002-02-25 (bug fix)[495207] buffer overrun when closing ] left out of
-argument to [subst] (sofer, english)
+2001-08-20 (performance enhancement) internal use of a "window" Tcl_ObjType
+(fellows)
-2002-02-25 (bug fix)[514392] [load] updated for Mac OS X 10.1 (steffen)
+2001-08-20 (performance enhancement) Obj-ified [grid] and [pack] (spjuth)
-2002-02-26 (bug fix) [info hostname] choked on names >31 characters (hobbs)
+2001-09-26 (new feature)[TIP 18] add labels to frames, update geometry
+managers (spjuth)
-2002-02-26 (new feature)[TIP 35] serial channel configuration: Unix
-(schroedter, hobbs)
+2001-09-30 (new feature)[TIP 37] [grid {row|column}configure -uniform] (spjuth)
-2002-02-25 (bug fix)[483575] [fconfigure ... -error] now no-op on Mac (kupries)
+2001-10-12 (new feature)[TIP 63] [$menu add ... -compound] (helfter)
-2002-02-28 (performance enhancement)[458872] fully qualified command names use
-cached Command for all namespaces, avoiding repeated lookups (sofer)
+2001-10-18 (build improvement) no more warnings about building with
+thread-enabled Tcl (hobbs)
- * (new feature)[TIP 27] completed CONST-ification of TCL APIs.
-Added compiler macro USE_NON_CONST to keep using those old API prototypes
-that present irreconcilable source incompatibilities with header files
-of prior Tcl releases. Others will need to be reconciled.
- *** POTENTIAL INCOMPATIBILITY ***
+2001-11-10 (build improvement) new make target 'make gdb' (dejong)
-2002-03-04 (bug fix)[474358, 218099, 219314, 524674] fixed several problems
-related to the handling of iso2022 text and finalization of escape-based
-encodings. (taguchi, takahashi, hobbs)
+2001-11-12 (new feature)[TIP 26] simple undo/redo in text widget (callewaert)
---- Released 8.4a4, March 5, 2002 --- See ChangeLog for details ---
+2001-11-12 (build improvement) revitalized makefile.vc (gravereaux)
-2002-03-06 (new feature)[TIP 80] expanded [lsearch] options (wilkason, fellows)
+2001-11-17 (visual change) default button size on Windows changed to
+conform to Windows style (hobbs)
+ **** POTENTIAL VISUAL INCOMPATABILITY ****
-2002-03-07 (new feature)[TIP 87] [interp recursionlimit] (trier)
+2001-12-03 (new feature)[TIP 74] [wm stackorder] (dejong, steffen)
-2002-03-08 (platform feature) mingw 1.1 build favored (dejong)
+2001-12 (new feature) more use of Unicode in native widgets on Windows (hobbs)
-2002-03-20 (new feature)[TIP 27] CONST-ified variable access functions (porter)
+2001-12-18 (bug fix)[413735] event-click-drag-1.2 test failure (porter)
-2002-03-24 (bug fix)[511666,511658,523217,530960] expanded
-Tcl_FSMatchInDirectory to handle assorted [glob] bugs in VFS. (darley)
- *** POTENTIAL INCOMPATIBILITY with prior 8.4a releases ***
+2001-12-28 (new feature) On Windows, buttons accept negative widths, meaning
+minimum size, enabling native L&F (hobbs)
-2002-03-25 (bug fix)[495726] stopped tcltest disabling of auto-loading (porter)
+2002-01 (bug fix) updates for CONST-ification in Tcl API, notably
+Tcl_ParseArgv. Use -DUSE_NON_CONST to suppress source incompatibility
+ **** POTENTIAL INCOMPATABILITY ****
-2002-03-25 (bug fix)[495977] allow \n in test constraints (porter)
+2002-01-31 (bug fix)[508988] logic error in menu cloning (helfter)
-2002-03-27 (platform support)[527941,533862] VC/winhelp/W9X (spjuth,
-gravereaux)
+2002-02-01 (new feature)[TIP 14] [$photo transparency] (fellows)
-2002-03-28 (bug fix)[219181] exception at level 0 issues (sofer)
+2002-02-01 (bug fix)[511956] C99 spec: avoid 'bool' as a variable name (hobbs)
-2002-03-28 (bug fix)[219362] command termination; Tcl_CreateTrace (knoll,sofer)
+2002-02-19 (bug fix) updates to image code calls of Tcl_Seek/Tcl_Tell to
+address TIP 72 changes (64-bit) in Tcl (fellows)
-2002-04-05 (bug fix)[536879] exceptions during variable subst (porter)
+2002-02-21 (new widget)[TIP 41] added [panedwindow] (hobbs)
-2002-04-15 (bug fix)[497446,513983] tcltest syntax errors now raised (porter)
- ***POTENTIAL INCOMPATIBILITY with prior tcltest 2.0.* (8.4aX)***
+2002-02-22 (new feature) 64-bit support for xlc compiler on AIX-4 (hobbs)
-2002-04-17 (bug fix)[495660] [(save|restore)state] deprecated (porter)
+2002-02-25 (bug fix)[503772] blinking cursor fix in [text] (hobbs)
-2002-04-17 (bug fix)[526524] escape-based encodings corrected (yamamoto, hobbs)
+2002-02-25 (bug fix)[503613] [listbox] handling of invalid listvar (hobbs)
-2002-04-18 (bug fix)[542588] [expr] error msgs improved (ehrens, sofer)
+2002-02-25 (feature change)[493145] mirror B2 bindings to B3 on Windows (hobbs)
-2002-04-18 (bug fix)[545325] [info level $level] now returns [namespace eval]
-as documented (suchenwirth,sofer)
+ * (updated demos) many updates to show new features (fellows)
-2002-04-19 (bug fix)[544727] export [mcload]; ns context of [mcmax] (porter)
-=> msgcat 1.2.3
+--- Released 8.4a4, March 5, 2002 --- See ChangeLog for details ---
-2002-04-22 (performance enhancement) threaded memory allocator (AOL, hobbs)
+2002-03-20 (feature change)[TIP 27][532644] Constness changes (porter)
-2002-04-24 (new feature) TCLTK_NO_LIBRARY_TEXT_RESOURCES #define disables
-inclusion of tcl library code in resource fork on Mac. (steffen)
+2002-03-21 (bug fix)[528441] Change in optimization flags for windows
+(gravereaux)
-2002-05-21 (platform support) static libs on OSF (dejong)
+2002-04-08 (bug fix) MSL stdin/out fixes prevent crash on exit (steffen)
-2002-05-24 (bug fix)[557878] set encoding on listening socket (staplin,
-kupries)
+2002-04-12 (bug fix) Centralized closing of display, mem-leak fixes (hobbs)
-2002-05-24 (new feature)[TIP 91] Tcl_Seek compatibility (fellows)
+2002-04-22 (bug fix)[223739] More robust FP comparisons for odd
+architectures (fellows)
-2002-05-28 (bug fix)[545579] VFS [load] left temp file (darley)
+2002-04-22 (bug fix)[541999] Fixed posible overun of 16-bit size limit
+of X windows in drawchars (hobbs,bonfield)
-2002-05-28 (bug fix)[559376] plug timezone env leak on Windows (hobbs)
+2002-04-22 (bug fix)[541849] ButtonLeave implementation corrected (hobbs)
-2002-05-29 (performance enhancement) [string compare] optimized (hobbs,fellows)
+2002-04-24 (new feature) TCLTK_NO_LIBRARY_TEXT_RESOURCES check added,
+allowing disable of inclusion of tk lib into resources (steffen)
-2002-05-31 (bug fix)[550534] plug interp leak in [pkg_mkIndex] (helmut)
+2002-05-07 (bug fix)[553208] Makefile/Win fix (TCLDIR, INSTALLDIR
+forward slash trouble resolved) (gravereaux)
-2002-05-31 (dead code)[474335,555635] removed all use of matherr() (english)
- *** POTENTIAL INCOMPATIBILITY ***
+2002-05-20 (bug fix) msgcat added to resources, fixed setup of bindings
+on startup (steffen, porter)
-2002-06-04 (new feature)[TIP 85,521362] custom result match in tcltest
-(markus, porter)
-=> tcltest 2.1
+2002-05-21 (bug fix) Build system fix, SC_ENABLE_SHARED before
+SC_CONFIG_CFLAGS for usage for SHARED_BUILD (dejong)
-2002-06-06 (bug fix)[524352] encoding, threading, and environment issues on
-MacOSX (steffen)
+2002-05-26 (bug fix)[548765] Fixed -value "" redraw error for variable
+created by radiobutton (spjuth)
-2002-06-06 (bug fix)[512214,558742,512214,461000] lazy initialization of
-tcltest constraints (porter)
+2002-05-27 (feature change) [wm transient .t .t] now raises an error (dejong)
+ *** POTENTIAL INCOMPATIBILITY ***
-2002-06-07 (bug fix)[563122,564595] EOVERFLOW definitions (fellows)
+2002-06-10 (new feature)[566605] Utilities for -underline, ampersand magic
+(kovalenko)
-2002-06-11 (bug fix)[567386] [info locals] corrections (sofer)
+2002-06-12 (feature change) A transient toplevel now mirrors state changes
+in the master. (dejong)
+ *** POTENTIAL INCOMPATIBILITY ***
-2002-06-14 (new feature)[TIP 102] [trace list] renamed [trace info] (fellows)
+2002-06-13 (bug fix) Fixed handling of cursor specs across platforms to
+be consistent. (fellows)
-2002-06-17 (new feature)[525522,525525] msgcat support for XPG4 locales;
-examination of LC_ALL, LC_MESSAGES environment variables (haible, porter)
-=> msgcat 1.3
+2002-06-14 (new feature) [TIP 98] Enhanced photo compositing (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
-2002-06-17 (new feature)[565088] header files assume modern C compiler by
-default; older compilers may need configuration (english)
- *** POTENTIAL INCOMPATIBILITY ***
+2002-06-14 (bug fix) Removed references to matherr (kupries)
-2002-06-17 (bug fix)[554068] [exec] argument quoting on Windows (darley)
+2002-06-14 (new feature) [TIP 47] Reorganized Tk to allow usage in writing
+an X wm (english)
-2002-06-17 (new feature)[TIP 62,462580] command execution traces (lavana)
+2002-06-14 (new feature) [TIP 84] Full motion events upon request (hobbs)
-2002-06-19 (bug fix)[558324] regexp sets a linked variable (watson)
+2002-06-17 (new feature) [TIP 82] -offrelief option for check/radiobutton
+(hipp)
- * (performance enhancment) optimizations of bytecode execution (sofer)
+2002-06-17 (enhancement) Added msg catalog for UK English. (porter)
-2002-06-21 (new feature)[TIP 99,562970] new [file link] command (darley)
+2002-06-17 (new feature) [TIP 96] Added caret handling (hobbs)
-2002-06-24 (new feature)[TIP 101] new [tcltest::configure] command (porter)
-=> tcltest 2.2
+2002-06-19 (new feature) [TIP 48] Added style engine (bonnet)
-2002-06-25 (new feature) --enable-man-symlinks and --enable-man-compression
-options to configure (max)
+2002-06-19 (bug fix)[570902] Reorganized Tk shutdown to work around bugs in
+X (dejong)
-2002-06-26 (bug fix)[565880] [clock format] now respects locale (max)
- *** POTENTIAL INCOMPATIBILITY ***
+2002-06-20 (new feature) [TIP 94] Added -activestyle for [listbox] (hobbs)
-2002-07-03 (bug fix)[577015] [catch] catches even compile errors (sofer)
+2002-06-21 (new feature) [TIP 104] generalized text undo/redo (callewart,
+hobbs)
---- Released 8.4b1, July 5, 2002 --- See ChangeLog for details ---
+2002-06-22 (new feature) [TIP 95] Added [wm attributes] command (hobbs)
+
+2002-06-22 (new feature) [TIP 93] enhanced get/delete to accept accept
+multiple range pairs (hobbs)
-2002-07-08 (bug fix) restored compatibility of [viewFile] in tcltest (porter)
+--- Released 8.4b1, July 5, 2002 --- See ChangeLog for details ---
-2002-07-11 (bug fix) [file normalize] returns long form on Win 95/98/ME (darley)
+2002-07-11 (bug fix) some memory allocation failures now result in
+ error messages rather than panic (fellows)
-2002-07-15 (performance enhancment) variable operations rewritten to store
- and use cached Var pointers (sofer)
+2002-07-15 (platform support) Borland makefile on Windows (gravereaux,giese)
-2002-07-22 (bug fix)[218000] Inf and Nan are floating-point values (fellows)
+2002-07-16 (bug fix)[220800,581627] icon reading (darley)
-2002-07-23 (platform support)[219220] 64-bit compile on IRIX (dejong)
+2002-07-19 (bug fix) Postscript generation on Win2K (hipp)
-2002-07-25 (bug fix)[219218] return codes in background errors (english)
+2002-07-22 (bug fix)[570764,568278] transient windows (dejong)
-2002-07-28 (bug fix)[582522] alias fires exec traces (sofer)
+2002-07-24 (bug fix)[581560] canvas memory management (hobbs)
-2002-07-29 (bug fix)[578363] regexp (fellows,pvgoran)
+2002-07-24 (bug fix)[584691] focus ring on compound button (hobbs)
-2002-07-30 (bug fix)[584603] WriteChars infinite loop non-UTF-8 string (kupries)
+2002-07-25 (feature enhancement)[564521] Obj-ified [wm] (spjuth)
-2002-08-04 (new feature)[584051,580433,585105,582429][TIP 27] Tcl interfaces
- are now fully CONST-ified. Use the symbols USE_NON_CONST or
- USE_COMPAT_CONST to select interfaces with fewer changes.
+2002-08-04 (new feature)[589853][TIP 27] Tk interfaces are now fully
+ CONST-ified. Use the symbols USE_NON_CONST or USE_COMPAT_CONST
+ to select interfaces with fewer changes.
*** POTENTIAL INCOMPATIBILITY ***
-2002-08-05 (bug fix)[589859] tcltest setup and cleanup scripts skipped when
- test body is skipped (porter)
- => tcltest 2.2
+2002-08-07 (bug fix)[578654] bezier curves on canvas (hobbs)
-2002-08-07 (bug fix)[587488] mem leak with USE_THREAD_ALLOC (sofer,sass)
-
-2002-08-07 (feature enhancement)[584794,584650,472576] boolean values
- are no longer always re-parsed from string. (sofer)
+2002-08-07 (platform support)[468139] native directory browser on Win (hobbs)
-Many internal bugs fixed.
-Considerable cleanup of the test suite.
+2002-08-07 (bug fix)[467524] fixed -from handling for gifs (obermeier)
+
+2002-08-08 (bug fix)[592201] wm transient panic (english,dejong)
+
+Rewrote Tk test suite to use tcltest package.
--- Released 8.4b2, August 9, 2002 --- See ChangeLog for details ---
-2002-08-20 (new feature) --enable-memdebug configure option (kupries)
+2002-08-20 (bug fix) tk.h checks for matching tcl.h version (porter)
+
+2002-08-27 (bug fix)[582457] toolbar button bindings (hipp)
-2002-08-23 (bug fix)[597936] mem leak with USE_THREAD_ALLOC (sofer,zoran)
+2002-08-31 (platform support)[602770] Mac OS X / Aqua port (steffen)
-2002-08-26 (bug fix)[599788] segfault in compiler (sofer,wilkason)
+2002-09-02 (bug fix)[565485] button height on windows (hobbs)
-2002-08-28 (bug fix)[414910] avoid mem leaks accessing environment variables
- on Windows (welton,gravereaux)
+2002-09-02 (new feature)[TIP 108] new comand [tk windowingsystem] (steffen)
-2002-08-31 (platform support)[TIP 108] Mac OS X port (steffen,ingham)
+2002-09-02 (new feature)[TIP 107][601518] [raise] is non-blocking (english)
2002-09-02 (platfrom support) 64-bit compile on HP-11 (martin)
diff --git a/tcl/compat/license.terms b/tcl/compat/license.terms
index f1dcaa5245c..03ca6fcb319 100644
--- a/tcl/compat/license.terms
+++ b/tcl/compat/license.terms
@@ -1,8 +1,7 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
+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
@@ -37,4 +36,4 @@ 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.
+terms specified in this license.
diff --git a/tcl/doc/3DBorder.3 b/tcl/doc/3DBorder.3
new file mode 100644
index 00000000000..e57dfef0cff
--- /dev/null
+++ b/tcl/doc/3DBorder.3
@@ -0,0 +1,305 @@
+'\"
+'\" Copyright (c) 1990-1993 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_Alloc3DBorderFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_Alloc3DBorderFromObj, Tk_Get3DBorder, Tk_Get3DBorderFromObj, Tk_Draw3DRectangle, Tk_Fill3DRectangle, Tk_Draw3DPolygon, Tk_Fill3DPolygon, Tk_3DVerticalBevel, Tk_3DHorizontalBevel, Tk_SetBackgroundFromBorder, Tk_NameOf3DBorder, Tk_3DBorderColor, Tk_3DBorderGC, Tk_Free3DBorderFromObj, Tk_Free3DBorder \- draw borders with three-dimensional appearance
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+Tk_3DBorder
+\fBTk_Alloc3DBorderFromObj(\fIinterp, tkwin, objPtr\fB)\fR
+.sp
+Tk_3DBorder
+\fBTk_Get3DBorder(\fIinterp, tkwin, colorName\fB)\fR
+.sp
+Tk_3DBorder
+\fBTk_Get3DBorderFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+void
+\fBTk_Draw3DRectangle(\fItkwin, drawable, border, x, y, width, height, borderWidth, relief\fB)\fR
+.sp
+void
+\fBTk_Fill3DRectangle(\fItkwin, drawable, border, x, y, width, height, borderWidth, relief\fB)\fR
+.sp
+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
+CONST char *
+\fBTk_NameOf3DBorder(\fIborder\fB)\fR
+.sp
+XColor *
+\fBTk_3DBorderColor(\fIborder\fB)\fR
+.sp
+GC *
+\fBTk_3DBorderGC(\fItkwin, border, which\fB)\fR
+.sp
+.VS 8.1
+\fBTk_Free3DBorderFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+\fBTk_Free3DBorder(\fIborder\fB)\fR
+.SH ARGUMENTS
+.AS "Tk_3DBorder" borderWidth
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tk_Window tkwin in
+Token for window (for all procedures except \fBTk_Get3DBorder\fR,
+must be the window for which the border was allocated).
+.AP Tcl_Obj *objPtr in
+.VS 8.1
+Pointer to object whose value describes color corresponding to
+background (flat areas). Illuminated edges will be brighter than
+this and shadowed edges will be darker than this.
+.AP char *colorName in
+Same as \fIobjPtr\fR except value is supplied as a string rather
+than an object.
+.VE
+.AP Drawable drawable in
+X token for window or pixmap; indicates where graphics are to be drawn.
+Must either be the X window for \fItkwin\fR or a pixmap with the
+same screen and depth as \fItkwin\fR.
+.AP Tk_3DBorder border in
+Token for border previously allocated in call to \fBTk_Get3DBorder\fR.
+.AP int x in
+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.
+.VS 8.1
+\fBTk_Alloc3DBorderFromObj\fR
+allocates colors and Pixmaps needed to draw a border in the window
+given by the \fItkwin\fR argument. The value of \fIobjPtr\fR
+is a standard Tk color name that determines the border colors.
+The color indicated by \fIobjPtr\fR will not actually be used in
+the border; it indicates the background color for the window
+(i.e. a color for flat surfaces).
+The illuminated portions of the border will appear brighter than indicated
+by \fIobjPtr\fR, and the shadowed portions of the border will appear
+darker than \fIobjPtr\fR.
+.PP
+\fBTk_Alloc3DBorderFromObj\fR returns a token that may be used in later calls
+to \fBTk_Draw3DRectangle\fR. If an error occurs in allocating information
+for the border (e.g. a bogus color name was given)
+then NULL is returned and an error message is left in \fIinterp->result\fR.
+If it returns successfully, \fBTk_Alloc3DBorderFromObj\fR caches
+information about the return value in \fIobjPtr\fR, which speeds up
+future calls to \fBTk_Alloc3DBorderFromObj\fR with the same \fIobjPtr\fR
+and \fItkwin\fR.
+.PP
+\fBTk_Get3DBorder\fR is identical to \fBTk_Alloc3DBorderFromObj\fR except
+that the color is specified with a string instead of an object. This
+prevents \fBTk_Get3DBorder\fR from caching the return value, so
+\fBTk_Get3DBorder\fR is less efficient than \fBTk_Alloc3DBorderFromObj\fR.
+.PP
+\fBTk_Get3DBorderFromObj\fR returns the token for an existing border, given
+the window and color name used to create the border.
+\fBTk_Get3DBorderFromObj\fR doesn't actually create the border; it must
+already have been created with a previous call to
+\fBTk_Alloc3DBorderFromObj\fR or \fBTk_Get3DBorder\fR. The return
+value is cached in \fIobjPtr\fR, which speeds up
+future calls to \fBTk_Get3DBorderFromObj\fR with the same \fIobjPtr\fR
+and \fItkwin\fR.
+.VE
+.PP
+Once a border structure has been created, \fBTk_Draw3DRectangle\fR may be
+invoked to draw the border.
+The \fItkwin\fR argument specifies the
+window for which the border was allocated, and \fIdrawable\fR
+specifies a window or pixmap in which the border is to be drawn.
+\fIDrawable\fR need not refer to the same window as \fItkwin\fR, but it
+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 color used to create \fIborder\fR). Then it calls
+\fBTk_Draw3DRectangle\fR to draw a border just inside the outer edge of
+the rectangular area. The argument \fIrelief\fR indicates the desired
+effect (TK_RELIEF_FLAT means no border should be drawn; all that
+happens is to fill the rectangle with the background color).
+.PP
+The procedure \fBTk_Draw3DPolygon\fR may be used to draw more complex
+shapes with a three-dimensional appearance. The \fIpointPtr\fR and
+\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 specified when \fIborder\fR was created; for monochrome
+displays, the resulting background
+will be a light stipple pattern, in order to distinguish the background from
+the illuminated portion of the border.
+.PP
+Given a token for a border, the procedure \fBTk_NameOf3DBorder\fR
+will return the color name that was used to create the border.
+.PP
+The procedure \fBTk_3DBorderColor\fR returns the XColor structure
+that will be used for flat surfaces drawn for its \fIborder\fR
+argument by procedures like \fBTk_Fill3DRectangle\fR.
+The return value corresponds to the color name that was used to
+create the border.
+The XColor, and its associated pixel value, will remain allocated
+as long as \fIborder\fR exists.
+.PP
+The procedure \fBTk_3DBorderGC\fR returns one of the X graphics contexts
+that are used to draw the border.
+The argument \fIwhich\fR selects which one of the three possible GC's:
+TK_3D_FLAT_GC returns the context used for flat surfaces,
+TK_3D_LIGHT_GC returns the context for light shadows,
+and TK_3D_DARK_GC returns the context for dark shadows.
+.PP
+.VS 8.1
+When a border is no longer needed, \fBTk_Free3DBorderFromObj\fR
+or \fBTk_Free3DBorder\fR should
+be called to release the resources associated with it.
+For \fBTk_Free3DBorderFromObj\fR the border to release is specified
+with the window and color name used to create the
+border; for \fBTk_Free3DBorder\fR the border to release is specified
+with the Tk_3DBorder token for the border.
+There should be exactly one call to \fBTk_Free3DBorderFromObj\fR or
+\fBTk_Free3DBorder\fR for each call to \fBTk_Alloc3DBorderFromObj\fR
+or \fBTk_Get3DBorder\fR.
+.VE
+
+.SH KEYWORDS
+3D, background, border, color, depressed, illumination, object, polygon, raised, shadow, three-dimensional effect
diff --git a/tcl/doc/AddOption.3 b/tcl/doc/AddOption.3
new file mode 100644
index 00000000000..93a482e4380
--- /dev/null
+++ b/tcl/doc/AddOption.3
@@ -0,0 +1,60 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\"
+.so man.macros
+.TH Tk_AddOption 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_AddOption \- Add an option to the option database
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+void
+\fBTk_AddOption\fR(\fItkwin, name, value, priority\fR)
+.SH ARGUMENTS
+.AP Tk_Window tkwin in
+Token for window.
+.AP "CONST char" *name in
+Multi-element name of option.
+.AP "CONST char" *value in
+Value of option.
+.AP int priority in
+Overall priority level to use for option.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is invoked to add an option to the database
+associated with \fItkwin\fR's main window. \fIName\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 the text string to associate with \fIname\fR;
+this value will be returned in calls to \fBTk_GetOption\fR.
+\fIPriority\fR specifies the priority of the value; when options are
+queried using \fBTk_GetOption\fR, the value with the highest priority
+is returned. \fIPriority\fR must be between 0 and TK_MAX_PRIO. Some
+common priority values are:
+.TP
+20
+Used for default values hard-coded into widgets.
+.TP
+40
+Used for options specified in application-specific startup files.
+.TP
+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
+80
+Used for options specified interactively after the application starts
+running.
+.PP
+
+.SH KEYWORDS
+class, name, option, add
diff --git a/tcl/doc/BindTable.3 b/tcl/doc/BindTable.3
new file mode 100644
index 00000000000..b5e78748e62
--- /dev/null
+++ b/tcl/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
+CONST 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 "CONST 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/tcl/doc/CanvPsY.3 b/tcl/doc/CanvPsY.3
new file mode 100644
index 00000000000..fda70a767e8
--- /dev/null
+++ b/tcl/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_CanvasPs 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, tkFont\fR)
+.sp
+\fBTk_CanvasPsPath\fR(\fIinterp, canvas, coordPtr, numPoints\fR)
+.sp
+int
+\fBTk_CanvasPsStipple\fR(\fIinterp, canvas, bitmap\fR)
+.SH ARGUMENTS
+.AS "unsigned int" "numPoints"
+.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 Tk_Font tkFont 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_CanvasPsY\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 \fItkFont\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/tcl/doc/CanvTkwin.3 b/tcl/doc/CanvTkwin.3
new file mode 100644
index 00000000000..7a214228330
--- /dev/null
+++ b/tcl/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 "CONST 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/tcl/doc/CanvTxtInfo.3 b/tcl/doc/CanvTxtInfo.3
new file mode 100644
index 00000000000..81d069a52dc
--- /dev/null
+++ b/tcl/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/tcl/doc/Clipboard.3 b/tcl/doc/Clipboard.3
new file mode 100644
index 00000000000..612c17ae0dc
--- /dev/null
+++ b/tcl/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/tcl/doc/ClrSelect.3 b/tcl/doc/ClrSelect.3
new file mode 100644
index 00000000000..1de0c1887b0
--- /dev/null
+++ b/tcl/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/tcl/doc/ConfigWidg.3 b/tcl/doc/ConfigWidg.3
new file mode 100644
index 00000000000..dd4be4e1f21
--- /dev/null
+++ b/tcl/doc/ConfigWidg.3
@@ -0,0 +1,628 @@
+'\"
+'\" 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
+\fBTk_ConfigureValue(\fIinterp, tkwin, specs, widgRec, argvName, flags\fB)\fR
+.sp
+\fBTk_FreeOptions(\fIspecs, widgRec, display, flags\fB)\fR
+.SH ARGUMENTS
+.AS Tk_ConfigSpec *widgRec in/out
+.AP Tcl_Interp *interp in
+Interpreter to use for returning error messages.
+.AP Tk_Window tkwin in
+Window used to represent widget (needed to set up X resources).
+.AP Tk_ConfigSpec *specs in
+Pointer to table specifying legal configuration options for this
+widget.
+.AP int argc in
+Number of arguments in \fIargv\fR.
+.AP "CONST 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 "CONST 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
+.VS 8.1
+.PP
+Note: \fBTk_ConfigureWidget\fP should be replaced with the new
+\fBTcl_Obj\fP based API \fBTk_SetOptions\fP. The old interface is
+retained for backward compatibility.
+.VE
+.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_GetFont\fR. The value is converted
+to a \fBTk_Font\fR by calling \fBTk_GetFont\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_FreeFont\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 "SEE ALSO"
+Tk_SetOptions(3)
+
+.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/tcl/doc/ConfigWind.3 b/tcl/doc/ConfigWind.3
new file mode 100644
index 00000000000..fd1c2c6919e
--- /dev/null
+++ b/tcl/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/tcl/doc/CoordToWin.3 b/tcl/doc/CoordToWin.3
new file mode 100644
index 00000000000..9cfd2ee5dc9
--- /dev/null
+++ b/tcl/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/tcl/doc/CrtCmHdlr.3 b/tcl/doc/CrtCmHdlr.3
new file mode 100644
index 00000000000..10cae345e5b
--- /dev/null
+++ b/tcl/doc/CrtCmHdlr.3
@@ -0,0 +1,69 @@
+'\"
+'\" Copyright (c) 2000 Ajuba Solutions.
+'\"
+'\" 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_CreateClientMessageHandler 3 "8.4" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_CreateClientMessageHandler, Tk_DeleteClientMessageHandler \- associate procedure callback with ClientMessage type X events
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_CreateClientMessageHandler\fR(\fIproc\fR)
+.sp
+\fBTk_DeleteClientMessageHandler\fR(\fIproc\fR)
+.SH ARGUMENTS
+.AP Tk_ClientMessageProc *proc in
+Procedure to invoke whenever a ClientMessage X event occurs on any display.
+.BE
+
+.SH DESCRIPTION
+.PP
+
+\fBTk_CreateClientMessageHandler\fR arranges for \fIproc\fR to be invoked
+in the future whenever a ClientMessage X event occurs that isn't handled by
+\fBWM_PROTOCOL\fR. \fBTk_CreateClientMessageHandler\fR is intended for use
+by applications which need to watch X ClientMessage events, such as drag and
+drop applications.
+.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_ClientMessageProc\fR:
+.CS
+typedef int Tk_ClientMessageProc(
+ Tk_Window \fItkwin\fR,
+ XEvent *\fIeventPtr\fR);
+.CE
+The \fItkwin\fR parameter to \fIproc\fR is the Tk window which is
+associated with this event. \fIEventPtr\fR is a pointer to the X event.
+.PP
+Whenever an X ClientMessage event is processed by \fBTk_HandleEvent\fR,
+the \fIproc\fR is called if it wasn't handled as a \fBWM_PROTOCOL\fR.
+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 ClientMessage event handlers, each one is called
+for each event, in the order in which they were established.
+.PP
+\fBTk_DeleteClientMessageHandler\fR may be called to delete a
+previously-created ClientMessage event handler: it deletes each handler it
+finds that matches the \fIproc\fR argument. If no such handler exists,
+then \fBTk_DeleteClientMessageHandler\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 argument.
+
+.SH KEYWORDS
+bind, callback, event, handler
diff --git a/tcl/doc/CrtErrHdlr.3 b/tcl/doc/CrtErrHdlr.3
new file mode 100644
index 00000000000..77495830332
--- /dev/null
+++ b/tcl/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/tcl/doc/CrtGenHdlr.3 b/tcl/doc/CrtGenHdlr.3
new file mode 100644
index 00000000000..c4d6609bfae
--- /dev/null
+++ b/tcl/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/tcl/doc/CrtImgType.3 b/tcl/doc/CrtImgType.3
new file mode 100644
index 00000000000..e0f4d72da29
--- /dev/null
+++ b/tcl/doc/CrtImgType.3
@@ -0,0 +1,283 @@
+'\"
+'\" 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.3 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_CreateImageType, Tk_GetImageMasterData, Tk_InitImageArgs \- 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)
+.sp
+\fBTk_InitImageArgs\fR(\fIinterp, argc, argvPtr\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 "CONST 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.
+.AP int argc in
+Number of arguments
+.AP char ***argvPtr in/out
+Pointer to argument list
+.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 PORTABILITY
+.PP
+In Tk 8.2 and earlier, the createProc below had a different
+signature. If you want to compile an image type using the
+old interface which should still run on all Tcl/Tk versions,
+compile it with the flag -DUSE_OLD_IMAGE. Further on, if
+you are using Stubs, you need to call the function
+Tk_InitImageArgs(interp, argc, &argv) first in your
+createProc. See below for a description of this function.
+
+.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 \fIobjc\fR,
+ Tcl_Obj *CONST \fIobjv\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 \fIobjc\fR and \fIobjv\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 \fIobjc\fR and \fIobjv\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 TK_INITIMAGEARGS
+.VS
+.PP
+The function \fBTk_InitImageArgs\fR converts the arguments of the
+\fBcreateProc\fR from objects to strings when necessary. When
+not using stubs, not using the old interface, or running
+under an older (pre-8.3) Tk version, this function has no
+effect. This function makes porting older image handlers to
+the new interface a lot easier: After running this function,
+the arguments are guaranteed to be in string format, no
+matter how Tk deliverd them.
+
+.SH "SEE ALSO"
+Tk_ImageChanged, Tk_GetImage, Tk_FreeImage, Tk_RedrawImage, Tk_SizeOfImage
+
+.SH KEYWORDS
+image manager, image type, instance, master
diff --git a/tcl/doc/CrtItemType.3 b/tcl/doc/CrtItemType.3
new file mode 100644
index 00000000000..d389c7bc8d0
--- /dev/null
+++ b/tcl/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 \fIobjc\fR,
+ Tcl_Obj* CONST \fIobjv\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 \fIobjc\fR and \fIobjv\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
+\fIobjc\fR will be \fB6\fR and \fIobjv\fR[0] will contain the
+integer object \fB10\fR.
+.PP
+\fIcreateProc\fR should use \fIobjc\fR and \fIobjv\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 \fIobjc\fR,
+ Tcl_Obj* CONST \fIobjv\fR,
+ int \fIflags\fR);
+.CE
+The \fIinterp\fR objument 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.
+\fIobjc\fR and \fIobjv\fR contain the configuration options. For
+example, if the following command is invoked:
+.CS
+\fB\&.c itemconfigure 2 \-fill red \-outline black\fR
+.CE
+\fIobjc\fR is \fB4\fR and \fIobjv\fR contains the string objects \fB\-fill\fR
+through \fBblack\fR.
+\fIobjc\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 \fIobjc\fR,
+ Tcl_Obj* CONST \fIobjv\fR);
+.CE
+The arguments \fIinterp\fR, \fIcanvas\fR, and \fIitemPtr\fR
+all have the standard meanings, and \fIobjc\fR and \fIobjv\fR
+describe the coordinate arguments.
+For example, if the following widget command is invoked:
+.CS
+\fB\&.c coords 2 30 90\fR
+.CE
+\fIobjc\fR will be \fB2\fR and \fBobjv\fR will contain the integer objects
+\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_CanvasPsFont\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_ItemCursorProc(
+ 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/tcl/doc/CrtPhImgFmt.3 b/tcl/doc/CrtPhImgFmt.3
new file mode 100644
index 00000000000..7ad3c87a070
--- /dev/null
+++ b/tcl/doc/CrtPhImgFmt.3
@@ -0,0 +1,245 @@
+'\"
+'\" 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 8.3 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_CreatePhotoImageFormat \- define new file format for photo images
+.SH SYNOPSIS
+.nf
+\fB#include <tk.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 PORTABILITY
+.PP
+In Tk 8.2 and earlier, a different interface was used. Tk 8.3 will
+still support the old format handlers if the format name is in upper
+case. If you still want to compile old format handlers with Tk8.3,
+use the flag -DUSE_OLD_IMAGE. This will restore all function prototypes
+to match the pre-8.3 situation.
+
+.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. For new format handlers, the name should
+be in lower case. Pre-8.3 format handlers are assumed to be in
+upper case.
+
+.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,
+ CONST char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\fR,
+ int *\fIwidthPtr\fR,
+ int *\fIheightPtr\fR,
+ Tcl_Interp *\fIinterp\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
+\fIformat\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(
+ Tcl_Obj *\fIdata\fR,
+ Tcl_Obj *\fIformat\fR,
+ int *\fIwidthPtr\fR,
+ int *\fIheightPtr\fR,
+ Tcl_Interp *\fIinterp\fR);
+.CE
+The \fIdata\fR argument points to the object containing the image
+data. The \fIformat\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,
+ CONST char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\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 \fIformat\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,
+ Tcl_Obj *\fIdata\fR,
+ Tcl_Obj *\fIformat\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 \fIdata\fR argument points to the image data in object form.
+The \fIformat\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,
+ CONST char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\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 \fIformat\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_Obj *\fIformat\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 put in the interpreter \fIinterp\fR result.
+The \fIformat\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/tcl/doc/CrtSelHdlr.3 b/tcl/doc/CrtSelHdlr.3
new file mode 100644
index 00000000000..91d4dfbfe89
--- /dev/null
+++ b/tcl/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/tcl/doc/CrtWindow.3 b/tcl/doc/CrtWindow.3
new file mode 100644
index 00000000000..2e7ff4d72b7
--- /dev/null
+++ b/tcl/doc/CrtWindow.3
@@ -0,0 +1,151 @@
+'\"
+'\" 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_CreateAnonymousWindow\fR(\fIinterp, parent, 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 "CONST char" *name in
+Name to use for this window. Must be unique among all children of
+the same \fIparent\fR.
+.AP "CONST 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 "CONST 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
+\fBTk_CreateAnonymousWindow\fR, 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_CreateAnonymousWindow\fR differs from \fBTk_CreateWindow\fR in
+that it creates an unnamed window. This window will be manipulable
+only using C interfaces, and will not be visible to Tcl scripts. Both
+interior windows and top-level windows may be created with
+\fBTk_CreateAnonymousWindow\fR.
+.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 is an internal window, 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/tcl/doc/DeleteImg.3 b/tcl/doc/DeleteImg.3
new file mode 100644
index 00000000000..6cdbffd6aa6
--- /dev/null
+++ b/tcl/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 "CONST 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/tcl/doc/DrawFocHlt.3 b/tcl/doc/DrawFocHlt.3
new file mode 100644
index 00000000000..d659933b08c
--- /dev/null
+++ b/tcl/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_DrawFocusHighlight(\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/tcl/doc/EventHndlr.3 b/tcl/doc/EventHndlr.3
new file mode 100644
index 00000000000..234daea0f03
--- /dev/null
+++ b/tcl/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_HandleEvent\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/tcl/doc/FindPhoto.3 b/tcl/doc/FindPhoto.3
new file mode 100644
index 00000000000..60a0fdb9705
--- /dev/null
+++ b/tcl/doc/FindPhoto.3
@@ -0,0 +1,234 @@
+'\"
+'\" 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, compRule\fR)
+.sp
+void
+\fBTk_PhotoPutZoomedBlock\fR(\fIhandle, blockPtr, x, y, width, height,\
+zoomX, zoomY, subsampleX, subsampleY, compRule\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 "CONST 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).
+.VS 8.4
+.AP int compRule in
+Specifies the compositing rule used when combining transparent pixels
+in a block of data with a photo image. Must be one of
+TK_PHOTO_COMPOSITE_OVERLAY (which puts the block of data over the top
+of the existing photo image, with the previous contents showing
+through in the transparent bits) or TK_PHOTO_COMPOSITE_SET (which
+discards the existing photo image contents in the rectangle covered by
+the data block.)
+.VE 8.4
+.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[4]\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, blue and alpha
+(transparency) components. These are normally 0, 1, 2 and 3, but can
+have other values, e.g., for images that are stored as separate red,
+green and blue planes.
+.PP
+.VS 8.4
+The \fIcompRule\fR parameter to \fBTk_PhotoPutBlock\fR specifies a
+compositing rule that says what to do with transparent pixels. The
+value TK_PHOTO_COMPOSITE_OVERLAY says that the previous contents of
+the photo image should show through, and the value
+TK_PHOTO_COMPOSITE_SET says that the previous contents of the photo
+image should be completely ignored, and the values from the block be
+copied directly across. The behavior in Tk8.3 and earlier was
+equivalent to having TK_PHOTO_COMPOSITE_OVERLAY as a compositing rule.
+.VE 8.4
+.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 PORTABILITY
+.VS 8.4
+.PP
+In Tk 8.3 and earlier, \fBTk_PhotoPutBlock\fR and
+\fBTk_PhotoPutZoomedBlock\fR had different signatures. If you want to
+compile code that uses the old interface against 8.4 without updating
+your code, compile it with the flag
+-DUSE_COMPOSITELESS_PHOTO_PUT_BLOCK. Code linked using Stubs against
+older versions of Tk will continue to work.
+.VE 8.4
+
+.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/tcl/doc/FontId.3 b/tcl/doc/FontId.3
new file mode 100644
index 00000000000..2c55153e4f0
--- /dev/null
+++ b/tcl/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_GetFontMetrics, 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/tcl/doc/FreeXId.3 b/tcl/doc/FreeXId.3
new file mode 100644
index 00000000000..3f8419c737b
--- /dev/null
+++ b/tcl/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_GetFont\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/tcl/doc/GeomReq.3 b/tcl/doc/GeomReq.3
new file mode 100644
index 00000000000..71278f3ae81
--- /dev/null
+++ b/tcl/doc/GeomReq.3
@@ -0,0 +1,97 @@
+'\"
+'\" 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 "8.4" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GeometryRequest, Tk_SetMinimumRequestSize, Tk_SetInternalBorder, Tk_SetInternalBorderEx \- 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_SetMinimumRequestSize\fR(\fItkwin, minWidth, minHeight\fR)
+.sp
+\fBTk_SetInternalBorder\fR(\fItkwin, width\fR)
+.sp
+\fBTk_SetInternalBorderEx\fR(\fItkwin, left, right, top, bottom\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 minWidth in
+Desired minimum requested width for \fItkwin\fR, in pixel units.
+.AP int minHeight in
+Desired minimum requested height for \fItkwin\fR, in pixel units.
+.AP int width in
+Space to leave for internal border for \fItkwin\fR, in pixel units.
+.AP int left in
+Space to leave for left side of internal border for \fItkwin\fR, in pixel units.
+.AP int right in
+Space to leave for right side of internal border for \fItkwin\fR, in pixel units.
+.AP int top in
+Space to leave for top side of internal border for \fItkwin\fR, in pixel units.
+.AP int bottom in
+Space to leave for bottom side of 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
+\fBTk_SetInternalBorderEx\fR works like \fBTk_SetInternalBorder\fR
+but lets you specify different widths for different sides of the window.
+.PP
+\fBTk_SetMinimumRequestSize\fR is called by widget code to indicate
+that a geometry manager should request at least this size for the
+widget. This allows a widget to have some control over its size when
+a propagating geometry manager is used inside it.
+.PP
+The information specified in calls to \fBTk_GeometryRequest\fR,
+\fBTk_SetMinimumRequestSize\fR, \fBTk_SetInternalBorder\fR and
+\fBTk_SetInternalBorderEx\fR can be retrieved using the macros
+\fBTk_ReqWidth\fR, \fBTk_ReqHeight\fR, \fBTk_MinReqWidth\fR,
+\fBTk_MinReqHeight\fR, \fBTk_MinReqWidth\fR, \fBTk_InternalBorderLeft\fR,
+\fBTk_InternalBorderRight\fR, \fBTk_InternalBorderTop\fR and
+\fBTk_InternalBorderBottom\fR.
+See the \fBTk_WindowId\fR manual entry for details.
+
+.SH KEYWORDS
+geometry, request
diff --git a/tcl/doc/GetAnchor.3 b/tcl/doc/GetAnchor.3
new file mode 100644
index 00000000000..a245349ba70
--- /dev/null
+++ b/tcl/doc/GetAnchor.3
@@ -0,0 +1,86 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_GetAnchorFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetAnchorFromObj, Tk_GetAnchor, Tk_NameOfAnchor \- translate between strings and anchor positions
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+int
+\fBTk_GetAnchorFromObj(\fIinterp, objPtr, anchorPtr\fB)\fR
+.VE
+.sp
+int
+\fBTk_GetAnchor(\fIinterp, string, anchorPtr\fB)\fR
+.sp
+CONST char *
+\fBTk_NameOfAnchor(\fIanchor\fB)\fR
+.SH ARGUMENTS
+.AS "Tk_Anchor" *anchorPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting, or NULL.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value contains name of anchor point: \fBn\fR, \fBne\fR,
+\fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR;
+internal rep will be modified to cache corresponding Tk_Anchor.
+.AP "CONST char" *string in
+Same as \fIobjPtr\fR except description of anchor point is passed as
+a string.
+.VE
+.AP int *anchorPtr out
+Pointer to location in which to store anchor position corresponding to
+\fIobjPtr\fR or \fIstring\fR.
+.AP Tk_Anchor anchor in
+Anchor position, e.g. \fBTCL_ANCHOR_CENTER\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+.VS 8.1
+\fBTk_GetAnchorFromObj\fR places in \fI*anchorPtr\fR an anchor position
+(enumerated type \fBTk_Anchor\fR)
+corresponding to \fIobjPtr\fR's value. The result will be one of
+\fBTK_ANCHOR_N\fR, \fBTK_ANCHOR_NE\fR, \fBTK_ANCHOR_E\fR, \fBTK_ANCHOR_SE\fR,
+\fBTK_ANCHOR_S\fR, \fBTK_ANCHOR_SW\fR, \fBTK_ANCHOR_W\fR, \fBTK_ANCHOR_NW\fR,
+or \fBTK_ANCHOR_CENTER\fR.
+Anchor positions are typically used for indicating a point on an object
+that will be used to position the object, e.g. \fBTK_ANCHOR_N\fR means
+position the top center point of the object at a particular place.
+.PP
+Under normal circumstances the return value is \fBTCL_OK\fR and
+\fIinterp\fR is unused.
+If \fIstring\fR doesn't contain a valid anchor position
+or an abbreviation of one of these names, \fBTCL_ERROR\fR is returned,
+\fI*anchorPtr\fR is unmodified, and an error message is
+stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
+\fBTk_GetAnchorFromObj\fR caches information about the return
+value in \fIobjPtr\fR, which speeds up future calls to
+\fBTk_GetAnchorFromObj\fR with the same \fIobjPtr\fR.
+.PP
+\fBTk_GetAnchor\fR is identical to \fBTk_GetAnchorFromObj\fR except
+that the description of the anchor is specified with a string instead
+of an object. This prevents \fBTk_GetAnchor\fR from caching the
+return value, so \fBTk_GetAnchor\fR is less efficient than
+\fBTk_GetAnchorFromObj\fR.
+.VE
+.PP
+\fBTk_NameOfAnchor\fR is the logical inverse of \fBTk_GetAnchor\fR.
+Given an anchor position such as \fBTK_ANCHOR_N\fR it returns a
+statically-allocated string corresponding to \fIanchor\fR.
+If \fIanchor\fR isn't a legal anchor value, then
+``unknown anchor position'' is returned.
+
+.SH KEYWORDS
+anchor position
diff --git a/tcl/doc/GetBitmap.3 b/tcl/doc/GetBitmap.3
new file mode 100644
index 00000000000..b0da2f26382
--- /dev/null
+++ b/tcl/doc/GetBitmap.3
@@ -0,0 +1,318 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_AllocBitmapFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_AllocBitmapFromObj, Tk_GetBitmap, Tk_GetBitmapFromObj, Tk_DefineBitmap, Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeBitmapFromObj, Tk_FreeBitmap \- maintain database of single-plane pixmaps
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+Pixmap
+\fBTk_GetBitmapFromObj(\fIinterp, tkwin, objPtr\fB)\fR
+.sp
+Pixmap
+\fBTk_GetBitmap(\fIinterp, tkwin, info\fB)\fR
+.sp
+Pixmap
+\fBTk_GetBitmapFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+int
+\fBTk_DefineBitmap(\fIinterp, name, source, width, height\fB)\fR
+.sp
+CONST char *
+\fBTk_NameOfBitmap(\fIdisplay, bitmap\fB)\fR
+.sp
+\fBTk_SizeOfBitmap(\fIdisplay, bitmap, widthPtr, heightPtr\fB)\fR
+.sp
+.VS 8.1
+\fBTk_FreeBitmapFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+\fBTk_FreeBitmap(\fIdisplay, bitmap\fB)\fR
+.SH ARGUMENTS
+.AS "unsigned long" *pixelPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting; if NULL then no error message
+is left after errors.
+.AP Tk_Window tkwin in
+Token for window in which the bitmap will be used.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value describes desired bitmap; internal rep will be
+modified to cache pointer to corresponding Pixmap.
+.AP "CONST char" *info in
+Same as \fIobjPtr\fR except description of bitmap is passed as a string and
+resulting Pixmap isn't cached.
+.VE
+.AP "CONST char" *name in
+Name for new bitmap to be defined.
+.AP "CONST char" *source in
+Data for bitmap, in standard bitmap format.
+Must be stored in static memory whose value will never change.
+.AP "int" width in
+Width of bitmap.
+.AP "int" height in
+Height of bitmap.
+.AP "int" *widthPtr out
+Pointer to word to fill in with \fIbitmap\fR's width.
+.AP "int" *heightPtr out
+Pointer to word to fill in with \fIbitmap\fR's height.
+.AP Display *display in
+Display for which \fIbitmap\fR was allocated.
+.AP Pixmap bitmap in
+Identifier for a bitmap allocated by \fBTk_AllocBitmapFromObj\fR or
+\fBTk_GetBitmap\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures manage a collection of bitmaps (one-plane pixmaps)
+being used by an application. The procedures allow bitmaps to be
+re-used efficiently, thereby avoiding server overhead, and also
+allow bitmaps to be named with character strings.
+.PP
+.VS 8.1
+\fBTk_AllocBitmapFromObj\fR returns a Pixmap identifier for a bitmap
+that matches the description in \fIobjPtr\fR and is suitable for use
+in \fItkwin\fR. It re-uses an existing bitmap, if possible, and
+creates a new one otherwise. \fIObjPtr\fR's value must have one
+of the following forms:
+.VE
+.TP 20
+\fB@\fIfileName\fR
+\fIFileName\fR must be the name of a file containing a bitmap
+description in the standard X11 or X10 format.
+.TP 20
+\fIname\fR
+\fIName\fR must be the name of a bitmap defined previously with
+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
+.VS 8.1
+Under normal conditions, \fBTk_AllocBitmapFromObj\fR
+returns an identifier for the requested bitmap. If an error
+occurs in creating the bitmap, such as when \fIobjPtr\fR refers
+to a non-existent file, then \fBNone\fR is returned and an error
+message is left in \fIinterp\fR's result if \fIinterp\fR isn't
+NULL. \fBTk_AllocBitmapFromObj\fR caches information about the return
+value in \fIobjPtr\fR, which speeds up future calls to procedures
+such as \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmapFromObj\fR.
+.PP
+\fBTk_GetBitmap\fR is identical to \fBTk_AllocBitmapFromObj\fR except
+that the description of the bitmap is specified with a string instead
+of an object. This prevents \fBTk_GetBitmap\fR from caching the
+return value, so \fBTk_GetBitmap\fR is less efficient than
+\fBTk_AllocBitmapFromObj\fR.
+.PP
+\fBTk_GetBitmapFromObj\fR returns the token for an existing bitmap, given
+the window and description used to create the bitmap.
+\fBTk_GetBitmapFromObj\fR doesn't actually create the bitmap; the bitmap
+must already have been created with a previous call to
+\fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR. The return
+value is cached in \fIobjPtr\fR, which speeds up
+future calls to \fBTk_GetBitmapFromObj\fR with the same \fIobjPtr\fR
+and \fItkwin\fR.
+.VE
+.PP
+\fBTk_DefineBitmap\fR associates a name with
+in-memory bitmap data so that the name can be used in later
+calls to \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR. The \fInameId\fR
+argument gives a name for the bitmap; it must not previously
+have been used in a call to \fBTk_DefineBitmap\fR.
+The arguments \fIsource\fR, \fIwidth\fR, and \fIheight\fR
+describe the bitmap.
+\fBTk_DefineBitmap\fR normally returns TCL_OK; if an error occurs
+(e.g. a bitmap named \fInameId\fR has already been defined) then
+TCL_ERROR is returned and an error message is left in
+\fIinterp->result\fR.
+Note: \fBTk_DefineBitmap\fR expects the memory pointed to by
+\fIsource\fR to be static: \fBTk_DefineBitmap\fR doesn't make
+a private copy of this memory, but uses the bytes pointed to
+by \fIsource\fR later in calls to \fBTk_AllocBitmapFromObj\fR or
+\fBTk_GetBitmap\fR.
+.PP
+Typically \fBTk_DefineBitmap\fR is used by \fB#include\fR-ing a
+bitmap file directly into a C program and then referencing
+the variables defined by the file.
+For example, suppose there exists a file \fBstip.bitmap\fR,
+which was created by the \fBbitmap\fR program and contains
+a stipple pattern.
+The following code uses \fBTk_DefineBitmap\fR to define a
+new bitmap named \fBfoo\fR:
+.VS
+.CS
+Pixmap bitmap;
+#include "stip.bitmap"
+Tk_DefineBitmap(interp, "foo", stip_bits,
+ stip_width, stip_height);
+\&...
+bitmap = Tk_GetBitmap(interp, tkwin, "foo");
+.CE
+.VE
+This code causes the bitmap file to be read
+at compile-time and incorporates the bitmap information into
+the program's executable image. The same bitmap file could be
+read at run-time using \fBTk_GetBitmap\fR:
+.VS
+.CS
+Pixmap bitmap;
+bitmap = Tk_GetBitmap(interp, tkwin, "@stip.bitmap");
+.CE
+.VE
+The second form is a bit more flexible (the file could be modified
+after the program has been compiled, or a different string could be
+provided to read a different file), but it is a little slower and
+requires the bitmap file to exist separately from the program.
+.PP
+Tk maintains a database of all the bitmaps that are currently in use.
+Whenever possible, it will return an existing bitmap rather
+than creating a new one.
+When a bitmap is no longer used, Tk will release it automatically.
+This approach can substantially reduce server overhead, so
+\fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR should generally
+be used in preference to Xlib procedures like \fBXReadBitmapFile\fR.
+.PP
+The bitmaps returned by \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR
+are shared, so callers should never modify them.
+If a bitmap must be modified dynamically, then it should be
+created by calling Xlib procedures such as \fBXReadBitmapFile\fR
+or \fBXCreatePixmap\fR directly.
+.PP
+The procedure \fBTk_NameOfBitmap\fR is roughly the inverse of
+\fBTk_GetBitmap\fR.
+Given an X Pixmap argument, it returns the textual description that was
+passed to \fBTk_GetBitmap\fR when the bitmap was created.
+\fIBitmap\fR must have been the return value from a previous
+call to \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR.
+.PP
+\fBTk_SizeOfBitmap\fR returns the dimensions of its \fIbitmap\fR
+argument in the words pointed to by the \fIwidthPtr\fR and
+\fIheightPtr\fR arguments. As with \fBTk_NameOfBitmap\fR,
+\fIbitmap\fR must have been created by \fBTk_AllocBitmapFromObj\fR or
+\fBTk_GetBitmap\fR.
+.PP
+.VS 8.1
+When a bitmap is no longer needed, \fBTk_FreeBitmapFromObj\fR or
+\fBTk_FreeBitmap\fR should be called to release it.
+For \fBTk_FreeBitmapFromObj\fR the bitmap to release is specified
+with the same information used to create it; for
+\fBTk_FreeBitmap\fR the bitmap to release is specified
+with its Pixmap token.
+There should be exactly one call to \fBTk_FreeBitmapFromObj\fR
+or \fBTk_FreeBitmap\fR for each call to \fBTk_AllocBitmapFromObj\fR or
+\fBTk_GetBitmap\fR.
+.VE
+
+.SH BUGS
+In determining whether an existing bitmap can be used to satisfy
+a new request, \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR
+consider only the immediate value of the string description. For
+example, when a file name is passed to \fBTk_GetBitmap\fR,
+\fBTk_GetBitmap\fR will assume it is safe to re-use an existing
+bitmap created from the same file name: it will not check to
+see whether the file itself has changed, or whether the current
+directory has changed, thereby causing the name to refer to
+a different file.
+
+.SH KEYWORDS
+bitmap, pixmap
diff --git a/tcl/doc/GetCapStyl.3 b/tcl/doc/GetCapStyl.3
new file mode 100644
index 00000000000..5a88045a824
--- /dev/null
+++ b/tcl/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
+CONST char *
+\fBTk_NameOfCapStyle(\fIcap\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *capPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP "CONST 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/tcl/doc/GetClrmap.3 b/tcl/doc/GetClrmap.3
new file mode 100644
index 00000000000..490ef780108
--- /dev/null
+++ b/tcl/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 "CONST 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/tcl/doc/GetColor.3 b/tcl/doc/GetColor.3
new file mode 100644
index 00000000000..cd67e41ec00
--- /dev/null
+++ b/tcl/doc/GetColor.3
@@ -0,0 +1,190 @@
+'\"
+'\" Copyright (c) 1990-1991 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_AllocColorFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_AllocColorFromObj, Tk_GetColor, Tk_GetColorFromObj, Tk_GetColorByValue, Tk_NameOfColor, Tk_FreeColorFromObj, Tk_FreeColor \- maintain database of colors
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.VS 8.1
+.sp
+XColor *
+\fBTk_AllocColorFromObj(\fIinterp, tkwin, objPtr\fB)\fR
+.sp
+XColor *
+\fBTk_GetColor(\fIinterp, tkwin, name\fB)\fR
+.sp
+XColor *
+\fBTk_GetColorFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+XColor *
+\fBTk_GetColorByValue(\fItkwin, prefPtr\fB)\fR
+.sp
+CONST char *
+\fBTk_NameOfColor(\fIcolorPtr\fB)\fR
+.sp
+GC
+\fBTk_GCForColor(\fIcolorPtr, drawable\fB)\fR
+.sp
+.VS 8.1
+\fBTk_FreeColorFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+\fBTk_FreeColor(\fIcolorPtr\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *colorPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tk_Window tkwin in
+Token for window in which color will be used.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value describes desired color; internal rep will be
+modified to cache pointer to corresponding (XColor *).
+.AP char *name in
+Same as \fIobjPtr\fR except description of color is passed as a string and
+resulting (XColor *) isn't cached.
+.VE
+.AP XColor *prefPtr in
+Indicates red, green, and blue intensities of desired
+color.
+.AP XColor *colorPtr in
+Pointer to X color information. Must have been allocated by previous
+call to \fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR or
+\fBTk_GetColorByValue\fR, except when passed to \fBTk_NameOfColor\fR.
+.AP Drawable drawable in
+Drawable in which the result graphics context will be used. Must have
+same screen and depth as the window for which the color was allocated.
+.BE
+
+.SH DESCRIPTION
+.VS 8.1
+.PP
+These procedures manage the colors being used by a Tk application.
+They allow colors to be shared whenever possible, so that colormap
+space is preserved, and they pick closest available colors when
+colormap space is exhausted.
+.PP
+Given a textual description of a color, \fBTk_AllocColorFromObj\fR
+locates a pixel value that may be used to render the color
+in a particular window. The desired color is specified with an
+object whose string value must have one of the following forms:
+.VE
+.TP 20
+\fIcolorname\fR
+Any of the valid textual names for a color defined in the
+server's color database file, such as \fBred\fR or \fBPeachPuff\fR.
+.TP 20
+\fB#\fIRGB\fR
+.TP 20
+\fB#\fIRRGGBB\fR
+.TP 20
+\fB#\fIRRRGGGBBB\fR
+.TP 20
+\fB#\fIRRRRGGGGBBBB\fR
+A numeric specification of the red, green, and blue intensities
+to use to display the color. Each \fIR\fR, \fIG\fR, or \fIB\fR
+represents a single hexadecimal digit. The four forms permit
+colors to be specified with 4-bit, 8-bit, 12-bit or 16-bit values.
+When fewer than 16 bits are provided for each color, they represent
+the most significant bits of the color. For example, #3a7 is the
+same as #3000a0007000.
+.PP
+.VS 8.1
+\fBTk_AllocColorFromObj\fR returns a pointer to
+an XColor structure; the structure indicates the exact intensities of
+the allocated color (which may differ slightly from those requested,
+depending on the limitations of the screen) and a pixel value
+that may be used to draw with the color in \fItkwin\fR.
+If an error occurs in \fBTk_AllocColorFromObj\fR (such as an unknown
+color name) then NULL is returned and an error message is stored in
+\fIinterp\fR's result if \fIinterp\fR isn't NULL.
+If the colormap for \fItkwin\fR is full, \fBTk_AllocColorFromObj\fR
+will use the closest existing color in the colormap.
+\fBTk_AllocColorFromObj\fR caches information about
+the return value in \fIobjPtr\fR, which speeds up future calls to procedures
+such as \fBTk_AllocColorFromObj\fR and \fBTk_GetColorFromObj\fR.
+.PP
+\fBTk_GetColor\fR is identical to \fBTk_AllocColorFromObj\fR except
+that the description of the color is specified with a string instead
+of an object. This prevents \fBTk_GetColor\fR from caching the
+return value, so \fBTk_GetColor\fR is less efficient than
+\fBTk_AllocColorFromObj\fR.
+.PP
+\fBTk_GetColorFromObj\fR returns the token for an existing color, given
+the window and description used to create the color.
+\fBTk_GetColorFromObj\fR doesn't actually create the color; the color
+must already have been created with a previous call to
+\fBTk_AllocColorFromObj\fR or \fBTk_GetColor\fR. The return
+value is cached in \fIobjPtr\fR, which speeds up
+future calls to \fBTk_GetColorFromObj\fR with the same \fIobjPtr\fR
+and \fItkwin\fR.
+.VE
+.PP
+\fBTk_GetColorByValue\fR is similar to \fBTk_GetColor\fR except that
+the desired color is indicated with the \fIred\fR, \fIgreen\fR, and
+\fIblue\fR fields of the structure pointed to by \fIcolorPtr\fR.
+.PP
+This package maintains a database
+of all the colors currently in use.
+If the same color is requested multiple times from
+\fBTk_GetColor\fR or \fBTk_AllocColorFromObj\fR (e.g. by different
+windows), or if the
+same intensities are requested multiple times from
+\fBTk_GetColorByValue\fR, then existing pixel values will
+be re-used. Re-using an existing pixel avoids any interaction
+with the window server, which makes the allocation much more
+efficient. These procedures also provide a portable interface that
+works across all platforms. For this reason, you should generally use
+\fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR, or \fBTk_GetColorByValue\fR
+instead of lower level procedures like \fBXAllocColor\fR.
+.PP
+Since different calls to this package
+may return the same shared
+pixel value, callers should never change the color of a pixel
+returned by the procedures.
+If you need to change a color value dynamically, you should use
+\fBXAllocColorCells\fR to allocate the pixel value for the color.
+.PP
+The procedure \fBTk_NameOfColor\fR is roughly the inverse of
+\fBTk_GetColor\fR. If its \fIcolorPtr\fR argument was created
+by \fBTk_AllocColorFromObj\fR or \fBTk_GetColor\fR then the return value
+is the string that was used to create the
+color. If \fIcolorPtr\fR was created by a call to \fBTk_GetColorByValue\fR,
+or by any other mechanism, then the return value is a string
+that could be passed to \fBTk_GetColor\fR to return the same
+color. Note: the string returned by \fBTk_NameOfColor\fR is
+only guaranteed to persist until the next call to
+\fBTk_NameOfColor\fR.
+.PP
+\fBTk_GCForColor\fR returns a graphics context whose \fBforeground\fR
+field is the pixel allocated for \fIcolorPtr\fR and whose other fields
+all have default values.
+This provides an easy way to do basic drawing with a color.
+The graphics context is cached with the color and will exist only as
+long as \fIcolorPtr\fR exists; it is freed when the last reference
+to \fIcolorPtr\fR is freed by calling \fBTk_FreeColor\fR.
+.PP
+.VS 8.1
+When a color is no longer needed \fBTk_FreeColorFromObj\fR or
+\fBTk_FreeColor\fR should be called to release it.
+For \fBTk_FreeColorFromObj\fR the color to release is specified
+with the same information used to create it; for
+\fBTk_FreeColor\fR the color to release is specified
+with a pointer to its XColor structure.
+There should be exactly one call to \fBTk_FreeColorFromObj\fR
+or \fBTk_FreeColor\fR for each call to \fBTk_AllocColorFromObj\fR,
+\fBTk_GetColor\fR, or \fBTk_GetColorByValue\fR.
+.VE
+.SH KEYWORDS
+color, intensity, object, pixel value
diff --git a/tcl/doc/GetCursor.3 b/tcl/doc/GetCursor.3
new file mode 100644
index 00000000000..ab1d103fa8e
--- /dev/null
+++ b/tcl/doc/GetCursor.3
@@ -0,0 +1,246 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_AllocCursorFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_AllocCursorFromObj, Tk_GetCursor, Tk_GetCursorFromObj, Tk_GetCursorFromData, Tk_NameOfCursor, Tk_FreeCursorFromObj, Tk_FreeCursor \- maintain database of cursors
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+Tk_Cursor
+\fBTk_AllocCursorFromObj(\fIinterp, tkwin, objPtr\fB)\fR
+.sp
+Tk_Cursor
+\fBTk_GetCursor(\fIinterp, tkwin, name\fB)\fR
+.sp
+Tk_Cursor
+\fBTk_GetCursorFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+Tk_Cursor
+\fBTk_GetCursorFromData(\fIinterp, tkwin, source, mask, width, height, xHot, yHot, fg, bg\fB)\fR
+.sp
+CONST char *
+\fBTk_NameOfCursor(\fIdisplay, cursor\fB)\fR
+.sp
+.VS 8.1
+\fBTk_FreeCursorFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+\fBTk_FreeCursor(\fIdisplay, cursor\fB)\fR
+.SH ARGUMENTS
+.AS "unsigned long" *pixelPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tk_Window tkwin in
+Token for window in which the cursor will be used.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+Description of cursor; see below for possible values. Internal rep will be
+modified to cache pointer to corresponding Tk_Cursor.
+.AP char *name in
+Same as \fIobjPtr\fR except description of cursor is passed as a string and
+resulting Tk_Cursor isn't cached.
+.VE
+.AP "CONST char" *source in
+Data for cursor cursor, in standard cursor format.
+.AP "CONST char" *mask in
+Data for mask cursor, in standard cursor format.
+.AP "int" width in
+Width of \fIsource\fR and \fImask\fR.
+.AP "int" height in
+Height of \fIsource\fR and \fImask\fR.
+.AP "int" xHot in
+X-location of cursor hot-spot.
+.AP "int" yHot in
+Y-location of cursor hot-spot.
+.AP Tk_Uid fg in
+Textual description of foreground color for cursor.
+.AP Tk_Uid bg in
+Textual description of background color for cursor.
+.AP Display *display in
+Display for which \fIcursor\fR was allocated.
+.AP Tk_Cursor cursor in
+Opaque Tk identifier for cursor. If passed to \fBTk_FreeCursor\fR, must
+have been returned by some previous call to \fBTk_GetCursor\fR or
+\fBTk_GetCursorFromData\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures manage a collection of cursors
+being used by an application. The procedures allow cursors to be
+re-used efficiently, thereby avoiding server overhead, and also
+allow cursors to be named with character strings.
+.PP
+.VS 8.1
+\fBTk_AllocCursorFromObj\fR takes as argument an object describing a
+cursor, and returns an opaque Tk identifier for a cursor corresponding
+to the description. It re-uses an existing cursor if possible and
+creates a new one otherwise. \fBTk_AllocCursorFromObj\fR caches
+information about the return value in \fIobjPtr\fR, which speeds up
+future calls to procedures such as \fBTk_AllocCursorFromObj\fR and
+\fBTk_GetCursorFromObj\fR. If an error occurs in creating the cursor,
+such as when \fIobjPtr\fR refers to a non-existent file, then \fBNone\fR
+is returned and an error message will be stored in \fIinterp\fR's result
+if \fIinterp\fR isn't NULL. \fIObjPtr\fR must contain a standard Tcl
+list with one of the following forms:
+.VE
+.TP
+\fIname\fR\0[\fIfgColor\fR\0[\fIbgColor\fR]]
+\fIName\fR is the name of a cursor in the standard X cursor cursor,
+i.e., any of the names defined in \fBcursorcursor.h\fR, without
+the \fBXC_\fR. Some example values are \fBX_cursor\fR, \fBhand2\fR,
+or \fBleft_ptr\fR. Appendix B of ``The X Window System''
+by Scheifler & Gettys has illustrations showing what each of these
+cursors looks like. If \fIfgColor\fR and \fIbgColor\fR are both
+specified, they give the foreground and background colors to use
+for the cursor (any of the forms acceptable to \fBTk_GetColor\fR
+may be used). If only \fIfgColor\fR is specified, then there
+will be no background color: the background will be transparent.
+If no colors are specified, then the cursor
+will use black for its foreground color and white for its background
+color.
+.RS
+.PP
+The Macintosh version of Tk supports all of the X cursors and
+will also accept any of the standard Mac cursors
+including \fBibeam\fR, \fBcrosshair\fR, \fBwatch\fR, \fBplus\fR, and
+\fBarrow\fR. In addition, Tk will load Macintosh cursor resources of
+the types \fBcrsr\fR (color) and \fBCURS\fR (black and white) by the
+name of the of the resource. The application and all its open
+dynamic library's resource files will be searched for the named
+cursor. If there are conflicts color cursors will always be loaded
+in preference to black and white cursors.
+.RE
+.TP
+\fB@\fIsourceName\0maskName\0fgColor\0bgColor\fR
+In this form, \fIsourceName\fR and \fImaskName\fR are the names of
+files describing cursors for the cursor's source bits and mask.
+Each file must be in standard X11 or X10 cursor format.
+\fIFgColor\fR and \fIbgColor\fR
+indicate the colors to use for the
+cursor, in any of the forms acceptable to \fBTk_GetColor\fR. This
+form of the command will not work on Macintosh or Windows computers.
+.TP
+\fB@\fIsourceName\0fgColor\fR
+This form is similar to the one above, except that the source is
+used as mask also. This means that the cursor's background is
+transparent. This form of the command will not work on Macintosh
+or Windows computers.
+.TP
+\fB@\fIsourceName\fR
+This form only works on Windows, and will load a Windows system
+cursor (\fB.ani\fR or \fB.cur\fR) from the file specified in
+\fIsourceName\fR.
+.PP
+.VS 8.1
+\fBTk_GetCursor\fR is identical to \fBTk_AllocCursorFromObj\fR except
+that the description of the cursor is specified with a string instead
+of an object. This prevents \fBTk_GetCursor\fR from caching the
+return value, so \fBTk_GetCursor\fR is less efficient than
+\fBTk_AllocCursorFromObj\fR.
+.PP
+\fBTk_GetCursorFromObj\fR returns the token for an existing cursor, given
+the window and description used to create the cursor.
+\fBTk_GetCursorFromObj\fR doesn't actually create the cursor; the cursor
+must already have been created with a previous call to
+\fBTk_AllocCursorFromObj\fR or \fBTk_GetCursor\fR. The return
+value is cached in \fIobjPtr\fR, which speeds up
+future calls to \fBTk_GetCursorFromObj\fR with the same \fIobjPtr\fR
+and \fItkwin\fR.
+.VE
+.PP
+\fBTk_GetCursorFromData\fR allows cursors to be created from
+in-memory descriptions of their source and mask cursors. \fISource\fR
+points to standard cursor data for the cursor's source bits, and
+\fImask\fR points to standard cursor data describing
+which pixels of \fIsource\fR are to be drawn and which are to be
+considered transparent. \fIWidth\fR and \fIheight\fR give the
+dimensions of the cursor, \fIxHot\fR and \fIyHot\fR indicate the
+location of the cursor's hot-spot (the point that is reported when
+an event occurs), and \fIfg\fR and \fIbg\fR describe the cursor's
+foreground and background colors textually (any of the forms
+suitable for \fBTk_GetColor\fR may be used). Typically, the
+arguments to \fBTk_GetCursorFromData\fR are created by including
+a cursor file directly into the source code for a program, as in
+the following example:
+.CS
+Tk_Cursor cursor;
+#include "source.cursor"
+#include "mask.cursor"
+cursor = Tk_GetCursorFromData(interp, tkwin, source_bits,
+ mask_bits, source_width, source_height, source_x_hot,
+ source_y_hot, Tk_GetUid("red"), Tk_GetUid("blue"));
+.CE
+.PP
+Under normal conditions \fBTk_GetCursorFromData\fR
+will return an identifier for the requested cursor. If an error
+occurs in creating the cursor then \fBNone\fR is returned and an error
+message will be stored in \fIinterp\fR's result.
+.PP
+\fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, and
+\fBTk_GetCursorFromData\fR maintain a
+database of all the cursors they have created. Whenever possible,
+a call to \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, or
+\fBTk_GetCursorFromData\fR will
+return an existing cursor rather than creating a new one. This
+approach can substantially reduce server overhead, so the Tk
+procedures should generally be used in preference to Xlib procedures
+like \fBXCreateFontCursor\fR or \fBXCreatePixmapCursor\fR, which
+create a new cursor on each call. The Tk procedures are also more
+portable than the lower-level X procedures.
+.PP
+The procedure \fBTk_NameOfCursor\fR is roughly the inverse of
+\fBTk_GetCursor\fR. If its \fIcursor\fR argument was created
+by \fBTk_GetCursor\fR, then the return value is the \fIname\fR
+argument that was passed to \fBTk_GetCursor\fR to create the
+cursor. If \fIcursor\fR was created by a call to \fBTk_GetCursorFromData\fR,
+or by any other mechanism, then the return value is a hexadecimal string
+giving the X identifier for the cursor.
+Note: the string returned by \fBTk_NameOfCursor\fR is
+only guaranteed to persist until the next call to
+\fBTk_NameOfCursor\fR. Also, this call is not portable except for
+cursors returned by \fBTk_GetCursor\fR.
+.PP
+.VS 8.1
+When a cursor returned by \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR,
+or \fBTk_GetCursorFromData\fR
+is no longer needed, \fBTk_FreeCursorFromObj\fR or
+\fBTk_FreeCursor\fR should be called to release it.
+For \fBTk_FreeCursorFromObj\fR the cursor to release is specified
+with the same information used to create it; for
+\fBTk_FreeCursor\fR the cursor to release is specified
+with its Tk_Cursor token.
+There should be exactly one call to \fBTk_FreeCursor\fR for
+each call to \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR,
+or \fBTk_GetCursorFromData\fR.
+.VE
+
+.SH BUGS
+In determining whether an existing cursor can be used to satisfy
+a new request, \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR,
+and \fBTk_GetCursorFromData\fR
+consider only the immediate values of their arguments. For
+example, when a file name is passed to \fBTk_GetCursor\fR,
+\fBTk_GetCursor\fR will assume it is safe to re-use an existing
+cursor created from the same file name: it will not check to
+see whether the file itself has changed, or whether the current
+directory has changed, thereby causing the name to refer to
+a different file. Similarly, \fBTk_GetCursorFromData\fR assumes
+that if the same \fIsource\fR pointer is used in two different calls,
+then the pointers refer to the same data; it does not check to
+see if the actual data values have changed.
+
+.SH KEYWORDS
+cursor
diff --git a/tcl/doc/GetDash.3 b/tcl/doc/GetDash.3
new file mode 100644
index 00000000000..c9cc357f19f
--- /dev/null
+++ b/tcl/doc/GetDash.3
@@ -0,0 +1,70 @@
+'\"
+'\" Copyright (c) 1989-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_GetDash 3 8.3 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetDash \- convert from string to valid dash structure.
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_GetDash\fR(\fIinterp, string, dashPtr\fR)
+.SH ARGUMENTS
+.AS Tk_Dash *dashPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP "CONST char *" string in
+Textual value to be converted.
+.AP Tk_Dash *dashPtr out
+Points to place to store the dash pattern
+value converted from \fIstring\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedure parses the string and fills in the result in the
+Tk_Dash structure. The string can be a list of integers or a
+character string containing only \fB[.,-_]\fR or spaces. If all
+goes well, TCL_OK is returned. If \fIstring\fR doesn't have the
+proper syntax then TCL_ERROR is returned, an error message is left
+in the interpreter's result, and nothing is stored at *\fIdashPtr\fR.
+.PP
+The first possible syntax is a list of integers. Each element
+represents the number of pixels of a line segment. Only the odd
+segments are drawn using the "outline" color. The other segments
+are drawn transparent.
+.PP
+The second possible syntax is a character list containing only
+5 possible characters \fB[.,-_ ]\fR. The space can be used
+to enlarge the space between other line elements, and can not
+occur as the first posibion in the string. Some examples:
+ -dash . = -dash {2 4}
+ -dash - = -dash {6 4}
+ -dash -. = -dash {6 4 2 4}
+ -dash -.. = -dash {6 4 2 4 2 4}
+ -dash {. } = -dash {2 8}
+ -dash , = -dash {4 4}
+.PP
+The main difference of this syntax with the previous is that it
+it shape-conserving. This means that all values in the dash
+list will be multiplied by the line width before display. This
+assures that "." will always be displayed as a dot and "-"
+always as a dash regardless of the line width.
+.PP
+On systems where only a limited set of dash patterns, the dash
+pattern will be displayed as the most close dash pattern that
+is available. For example, on Windows only the first 4 of the
+above examples are available. The last 2 examples will be
+displayed identically as the first one.
+
+.SH KEYWORDS
+dash, conversion
diff --git a/tcl/doc/GetFont.3 b/tcl/doc/GetFont.3
new file mode 100644
index 00000000000..259b8fa1f88
--- /dev/null
+++ b/tcl/doc/GetFont.3
@@ -0,0 +1,125 @@
+'\"
+'\" Copyright (c) 1990-1992 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_AllocFontFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_AllocFontFromObj, Tk_GetFont, Tk_GetFontFromObj, Tk_NameOfFont, Tk_FreeFontFromObj, Tk_FreeFont \- maintain database of fonts
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+Tk_Font
+\fBTk_AllocFontFromObj(\fIinterp, tkwin, objPtr\fB)\fR
+.sp
+Tk_Font
+\fBTk_GetFont(\fIinterp, tkwin, string\fB)\fR
+.sp
+Tk_Font
+\fBTk_GetFontFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+CONST char *
+\fBTk_NameOfFont(\fItkfont\fB)\fR
+.sp
+.VS 8.1
+Tk_Font
+\fBTk_FreeFontFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+void
+\fBTk_FreeFont(\fItkfont\fB)\fR
+
+.SH ARGUMENTS
+.AS "const char" *tkfont
+.AP "Tcl_Interp" *interp in
+Interpreter to use for error reporting. If NULL, then no error
+messages are left after errors.
+.AP Tk_Window tkwin in
+Token for window in which font will be used.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+Gives name or description of font. See documentation
+for the \fBfont\fR command for details on acceptable formats.
+Internal rep will be modified to cache corresponding Tk_Font.
+.AP "const char" *string in
+Same as \fIobjPtr\fR except description of font is passed as a string and
+resulting Tk_Font isn't cached.
+.VE
+.AP Tk_Font tkfont in
+Opaque font token.
+.BE
+.SH DESCRIPTION
+.PP
+.VS 8.1
+\fBTk_AllocFontFromObj\fR finds the font indicated by \fIobjPtr\fR and
+returns a token that represents the font. The return value can be used
+in subsequent calls to procedures such as \fBTk_GetFontMetrics\fR,
+\fBTk_MeasureChars\fR, and \fBTk_FreeFont\fR. The Tk_Font token
+will remain valid until
+\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR is called to release it.
+\fIObjPtr\fR can contain either a symbolic name or a font description; see
+the documentation for the \fBfont\fR command for a description of the
+valid formats. If \fBTk_AllocFontFromObj\fR is unsuccessful (because,
+for example, \fIobjPtr\fR did not contain a valid font specification) then it
+returns \fBNULL\fR and leaves an error message in \fIinterp\fR's result
+if \fIinterp\fR isn't NULL. \fBTk_AllocFontFromObj\fR caches
+information about the return
+value in \fIobjPtr\fR, which speeds up future calls to procedures
+such as \fBTk_AllocFontFromObj\fR and \fBTk_GetFontFromObj\fR.
+.PP
+\fBTk_GetFont\fR is identical to \fBTk_AllocFontFromObj\fR except
+that the description of the font is specified with a string instead
+of an object. This prevents \fBTk_GetFont\fR from caching the
+matching Tk_Font, so \fBTk_GetFont\fR is less efficient than
+\fBTk_AllocFontFromObj\fR.
+.PP
+\fBTk_GetFontFromObj\fR returns the token for an existing font, given
+the window and description used to create the font.
+\fBTk_GetFontFromObj\fR doesn't actually create the font; the font
+must already have been created with a previous call to
+\fBTk_AllocFontFromObj\fR or \fBTk_GetFont\fR. The return
+value is cached in \fIobjPtr\fR, which speeds up
+future calls to \fBTk_GetFontFromObj\fR with the same \fIobjPtr\fR
+and \fItkwin\fR.
+.VE
+.PP
+\fBTk_AllocFontFromObj\fR and \fBTk_GetFont\fR maintain
+a database of all fonts they have allocated. If
+the same font is requested multiple times (e.g. by different
+windows or for different purposes), then a single Tk_Font will be
+shared for all uses. The underlying resources will be freed automatically
+when no-one is using the font anymore.
+.PP
+The procedure \fBTk_NameOfFont\fR is roughly the inverse of
+\fBTk_GetFont\fR. Given a \fItkfont\fR that was created by
+\fBTk_GetFont\fR (or \fBTk_AllocFontFromObj\fR), the return value is
+the \fIstring\fR argument that was
+passed to \fBTk_GetFont\fR to create the font. The string returned by
+\fBTk_NameOfFont\fR is only guaranteed to persist until the \fItkfont\fR
+is deleted. The caller must not modify this string.
+.PP
+.VS 8.1
+When a font is no longer needed,
+\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR should be called to
+release it. For \fBTk_FreeFontFromObj\fR the font to release is specified
+with the same information used to create it; for
+\fBTk_FreeFont\fR the font to release is specified
+with its Tk_Font token. There should be
+exactly one call to \fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR
+for each call to \fBTk_AllocFontFromObj\fR or \fBTk_GetFont\fR.
+.VE
+
+.SH "SEE ALSO"
+Tk_FontId(3)
+
+.SH KEYWORDS
+font
diff --git a/tcl/doc/GetGC.3 b/tcl/doc/GetGC.3
new file mode 100644
index 00000000000..53e120663c7
--- /dev/null
+++ b/tcl/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/tcl/doc/GetHINSTANCE.3 b/tcl/doc/GetHINSTANCE.3
new file mode 100644
index 00000000000..587ce151c0a
--- /dev/null
+++ b/tcl/doc/GetHINSTANCE.3
@@ -0,0 +1,25 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_GetHISTANCE 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetHINSTANCE \- retrieve the global application instance handle
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+HINSTANCE
+\fBTk_GetHINSTANCE\fR()
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetHINSTANCE\fR returns the Windows application instance handle
+for the Tk application. This function is only available on Windows platforms.
+
+.SH KEYWORDS
+identifier, instance
diff --git a/tcl/doc/GetHWND.3 b/tcl/doc/GetHWND.3
new file mode 100644
index 00000000000..5ed1b22ca4a
--- /dev/null
+++ b/tcl/doc/GetHWND.3
@@ -0,0 +1,29 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\"
+.so man.macros
+.TH Tk_GetHWND 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetHWND \- retrieve the Windows handle for an X window
+.SH SYNOPSIS
+.nf
+\fB#include <tkPlatDecls.h>\fR
+.sp
+HWND
+\fBTk_GetHWND\fR(\fIwindow\fR)
+.SH ARGUMENTS
+.AP Window window in
+X token for window.
+.BE
+.SH DESCRIPTION
+.PP
+\fBTk_GetHWND\fR returns the Windows HWND identifier for X Windows
+window given by \fIwindow\fR.
+
+.SH KEYWORDS
+identifier, window
diff --git a/tcl/doc/GetImage.3 b/tcl/doc/GetImage.3
new file mode 100644
index 00000000000..da3f751d2fc
--- /dev/null
+++ b/tcl/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 "CONST 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_RedrawImage\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/tcl/doc/GetJoinStl.3 b/tcl/doc/GetJoinStl.3
new file mode 100644
index 00000000000..44f6777cd5c
--- /dev/null
+++ b/tcl/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
+CONST char *
+\fBTk_NameOfJoinStyle(\fIjoin\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *joinPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP "CONST 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/tcl/doc/GetJustify.3 b/tcl/doc/GetJustify.3
new file mode 100644
index 00000000000..3604c3e028a
--- /dev/null
+++ b/tcl/doc/GetJustify.3
@@ -0,0 +1,93 @@
+'\"
+'\" Copyright (c) 1990-1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_GetJustifyFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetJustifyFromObj, Tk_GetJustify, Tk_NameOfJustify \- translate between strings and justification styles
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+int
+\fBTk_GetJustifyFromObj(\fIinterp, objPtr, justifyPtr\fB)\fR
+.sp
+int
+\fBTk_GetJustify(\fIinterp, string, justifyPtr\fB)\fR
+.sp
+CONST char *
+\fBTk_NameOfJustify(\fIjustify\fB)\fR
+.SH ARGUMENTS
+.AS "Tk_Justify" *justifyPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting, or NULL.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value contains name of justification style (\fBleft\fR, \fBright\fR, or
+\fBcenter\fR). The
+internal rep will be modified to cache corresponding justify value.
+.AP "CONST char" *string in
+Same as \fIobjPtr\fR except description of justification style is passed as
+a string.
+.VE
+.AP int *justifyPtr out
+Pointer to location in which to store justify value corresponding to
+\fIobjPtr\fR or \fIstring\fR.
+.AP Tk_Justify justify in
+Justification style (one of the values listed below).
+.BE
+
+.SH DESCRIPTION
+.PP
+.VS 8.1
+\fBTk_GetJustifyFromObj\fR places in \fI*justifyPtr\fR the justify value
+corresponding to \fIobjPtr\fR's value.
+.VE
+This value will be one of the following:
+.TP
+\fBTK_JUSTIFY_LEFT\fR
+Means that the text on each line should start at the left edge of
+the line; as a result, the right edges of lines may be ragged.
+.TP
+\fBTK_JUSTIFY_RIGHT\fR
+Means that the text on each line should end at the right edge of
+the line; as a result, the left edges of lines may be ragged.
+.TP
+\fBTK_JUSTIFY_CENTER\fR
+Means that the text on each line should be centered; as a result,
+both the left and right edges of lines may be ragged.
+.PP
+.VS 8.1
+Under normal circumstances the return value is \fBTCL_OK\fR and
+\fIinterp\fR is unused.
+If \fIobjPtr\fR doesn't contain a valid justification style
+or an abbreviation of one of these names, \fBTCL_ERROR\fR is returned,
+\fI*justifyPtr\fR is unmodified, and an error message is
+stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
+\fBTk_GetJustifyFromObj\fR caches information about the return
+value in \fIobjPtr\fR, which speeds up future calls to
+\fBTk_GetJustifyFromObj\fR with the same \fIobjPtr\fR.
+.PP
+\fBTk_GetJustify\fR is identical to \fBTk_GetJustifyFromObj\fR except
+that the description of the justification is specified with a string instead
+of an object. This prevents \fBTk_GetJustify\fR from caching the
+return value, so \fBTk_GetJustify\fR is less efficient than
+\fBTk_GetJustifyFromObj\fR.
+.VE
+.PP
+\fBTk_NameOfJustify\fR is the logical inverse of \fBTk_GetJustify\fR.
+Given a justify value it returns a statically-allocated string
+corresponding to \fIjustify\fR.
+If \fIjustify\fR isn't a legal justify value, then
+``unknown justification style'' is returned.
+
+.SH KEYWORDS
+center, fill, justification, string
diff --git a/tcl/doc/GetOption.3 b/tcl/doc/GetOption.3
new file mode 100644
index 00000000000..775d59215c9
--- /dev/null
+++ b/tcl/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 "CONST char" *name in
+Name of desired option.
+.AP "CONST 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/tcl/doc/GetPixels.3 b/tcl/doc/GetPixels.3
new file mode 100644
index 00000000000..6ec9f57ac76
--- /dev/null
+++ b/tcl/doc/GetPixels.3
@@ -0,0 +1,111 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_GetPixelsFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetPixelsFromObj, Tk_GetPixels, Tk_GetMMFromObj, Tk_GetScreenMM \- translate between strings and screen units
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+int
+\fBTk_GetPixelsFromObj(\fIinterp, tkwin, objPtr, intPtr\fB)\fR
+.VE
+.sp
+int
+\fBTk_GetPixels(\fIinterp, tkwin, string, intPtr\fB)\fR
+.sp
+.VS 8.1
+int
+\fBTk_GetMMFromObj(\fIinterp, tkwin, objPtr, doublePtr\fB)\fR
+.VE
+.sp
+int
+\fBTk_GetScreenMM(\fIinterp, tkwin, string, doublePtr\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *joinPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tk_Window tkwin in
+Window whose screen geometry determines the conversion between absolute
+units and pixels.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value specifies a distance on the screen;
+internal rep will be modified to cache converted distance.
+.AP "CONST char" *string in
+Same as \fIobjPtr\fR except specification of distance is passed as
+a string.
+.VE
+.AP int *intPtr out
+Pointer to location in which to store converted distance in pixels.
+.AP double *doublePtr out
+Pointer to location in which to store converted distance in millimeters.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures take as argument a specification of distance on
+.VS 8.1
+the screen (\fIobjPtr\fR or \fIstring\fR) and compute the
+.VE
+corresponding distance either in integer pixels or floating-point millimeters.
+In either case,
+.VS 8.1
+\fIobjPtr\fR or \fIstring\fR
+.VE
+specifies a screen distance as a
+floating-point number followed by one of the following characters
+that indicates units:
+.TP
+<none>
+The number specifies a distance in pixels.
+.TP
+\fBc\fR
+The number specifies a distance in centimeters on the screen.
+.TP
+\fBi\fR
+The number specifies a distance in inches on the screen.
+.TP
+\fBm\fR
+The number specifies a distance in millimeters on the screen.
+.TP
+\fBp\fR
+The number specifies a distance in printer's points (1/72 inch)
+on the screen.
+.PP
+.VS 8.1
+\fBTk_GetPixelsFromObj\fR converts the value of \fIobjPtr\fR to the
+nearest even number of pixels and stores that value at \fI*intPtr\fR.
+It returns \fBTCL_OK\fR under normal circumstances.
+If an error occurs (e.g. \fIobjPtr\fR contains a number followed
+by a character that isn't one of the ones above) then
+\fBTCL_ERROR\fR is returned and an error message is left
+in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
+\fBTk_GetPixelsFromObj\fR caches information about the return
+value in \fIobjPtr\fR, which speeds up future calls to
+\fBTk_GetPixelsFromObj\fR with the same \fIobjPtr\fR.
+.PP
+\fBTk_GetPixels\fR is identical to \fBTk_GetPixelsFromObj\fR except
+that the screen distance is specified with a string instead
+of an object. This prevents \fBTk_GetPixels\fR from caching the
+return value, so \fBTk_GetAnchor\fR is less efficient than
+\fBTk_GetPixelsFromObj\fR.
+.PP
+\fBTk_GetMMFromObj\fR and \fBTk_GetScreenMM\fR are similar to
+\fBTk_GetPixelsFromObj\fR and \fBTk_GetPixels\fR (respectively) except
+that they convert the screen distance to millimeters and
+store a double-precision floating-point result at \fI*doublePtr\fR.
+.VE
+
+.SH KEYWORDS
+centimeters, convert, inches, millimeters, pixels, points, screen units
diff --git a/tcl/doc/GetPixmap.3 b/tcl/doc/GetPixmap.3
new file mode 100644
index 00000000000..777ba33e482
--- /dev/null
+++ b/tcl/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/tcl/doc/GetRelief.3 b/tcl/doc/GetRelief.3
new file mode 100644
index 00000000000..28532e6fe4c
--- /dev/null
+++ b/tcl/doc/GetRelief.3
@@ -0,0 +1,83 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_GetReliefFromObj 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetReliefFromObj, Tk_GetRelief, Tk_NameOfRelief \- translate between strings and relief values
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+.VS 8.1
+int
+\fBTk_GetReliefFromObj(\fIinterp, objPtr, reliefPtr\fB)\fR
+.VE
+.sp
+int
+\fBTk_GetRelief(\fIinterp, name, reliefPtr\fB)\fR
+.sp
+CONST char *
+\fBTk_NameOfRelief(\fIrelief\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *reliefPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value contains name of relief (one of \fBflat\fR, \fBgroove\fR,
+\fBraised\fR, \fBridge\fR, \fBsolid\fR, or \fBsunken\fR);
+internal rep will be modified to cache corresponding relief value.
+.AP char *string in
+Same as \fIobjPtr\fR except description of relief is passed as
+a string.
+.VE
+.AP int *reliefPtr out
+Pointer to location in which to store relief value corresponding to
+\fIobjPtr\fR or \fIname\fR.
+.AP "CONST char" *name
+Name of the relief.
+.AP int relief in
+Relief value (one of TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN,
+TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE).
+.BE
+
+.SH DESCRIPTION
+.PP
+.VS 8.1
+\fBTk_GetReliefFromObj\fR places in \fI*reliefPtr\fR the relief value
+corresponding to the value of \fIobjPtr\fR. This value will be one of
+TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN,
+TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE.
+Under normal circumstances the return value is TCL_OK and
+\fIinterp\fR is unused.
+If \fIobjPtr\fR doesn't contain one of the valid relief names
+or an abbreviation of one of them, then TCL_ERROR is returned,
+\fI*reliefPtr\fR is unmodified, and an error message
+is stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
+\fBTk_GetReliefFromObj\fR caches information about the return
+value in \fIobjPtr\fR, which speeds up future calls to
+\fBTk_GetReliefFromObj\fR with the same \fIobjPtr\fR.
+.PP
+\fBTk_GetRelief\fR is identical to \fBTk_GetReliefFromObj\fR except
+that the description of the relief is specified with a string instead
+of an object. This prevents \fBTk_GetRelief\fR from caching the
+return value, so \fBTk_GetRelief\fR is less efficient than
+\fBTk_GetReliefFromObj\fR.
+.VE
+.PP
+\fBTk_NameOfRelief\fR is the logical inverse of \fBTk_GetRelief\fR.
+Given a relief value it returns the corresponding string (\fBflat\fR,
+\fBraised\fR, \fBsunken\fR, \fBgroove\fR, \fBsolid\fR, or \fBridge\fR).
+If \fIrelief\fR isn't a legal relief value, then ``unknown relief''
+is returned.
+
+.SH KEYWORDS
+name, relief, string
diff --git a/tcl/doc/GetRootCrd.3 b/tcl/doc/GetRootCrd.3
new file mode 100644
index 00000000000..9726a382b54
--- /dev/null
+++ b/tcl/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/tcl/doc/GetScroll.3 b/tcl/doc/GetScroll.3
new file mode 100644
index 00000000000..985d2c1bab8
--- /dev/null
+++ b/tcl/doc/GetScroll.3
@@ -0,0 +1,78 @@
+'\"
+'\" 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 8.0 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetScrollInfo, Tk_GetScrollInfoObj \- parse arguments for scrolling commands
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_GetScrollInfo(\fIinterp, argc, argv, dblPtr, intPtr\fB)\fR
+.sp
+int
+\fBTk_GetScrollInfoObj(\fIinterp, objc, objv, 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 "CONST 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.
+.AP int objc in
+Number of Tcl_Obj's in \fIobjv\fR array.
+.AP "Tcl_Obj *CONST" objv[] in
+Argument objects. 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.
+.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.
+.PP
+\fBTk_GetScrollInfoObj\fR is identical in function to
+\fBTk_GetScrollInfo\fR. However, \fBTk_GetScrollInfoObj\fR accepts
+Tcl_Obj style arguments, making it more appropriate for use with new
+development.
+
+.SH KEYWORDS
+parse, scrollbar, scrolling command, xview, yview
diff --git a/tcl/doc/GetSelect.3 b/tcl/doc/GetSelect.3
new file mode 100644
index 00000000000..92c03eb6f19
--- /dev/null
+++ b/tcl/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/tcl/doc/GetUid.3 b/tcl/doc/GetUid.3
new file mode 100644
index 00000000000..77e896771dc
--- /dev/null
+++ b/tcl/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/tcl/doc/GetVRoot.3 b/tcl/doc/GetVRoot.3
new file mode 100644
index 00000000000..9cf7d1bd0f3
--- /dev/null
+++ b/tcl/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/tcl/doc/GetVisual.3 b/tcl/doc/GetVisual.3
new file mode 100644
index 00000000000..943dad7559c
--- /dev/null
+++ b/tcl/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 "CONST 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/tcl/doc/Grab.3 b/tcl/doc/Grab.3
new file mode 100644
index 00000000000..d9ea162be7d
--- /dev/null
+++ b/tcl/doc/Grab.3
@@ -0,0 +1,65 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_Grab 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_Grab, Tk_Ungrab \- manipulate grab state in an application
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_Grab\fR(\fIinterp, tkwin, grabGlobal\fR)
+.sp
+void
+\fBTk_Ungrab\fR(\fItkwin\fR)
+
+.SH ARGUMENTS
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting
+.AP Tk_Window tkwin in
+Window on whose behalf the pointer is to be grabbed or released
+.AP int grabGlobal in
+Boolean indicating whether the grab is global or application local
+.BE
+
+.SH DESCRIPTION
+.PP
+These functions are used to set or release a global or
+application local grab. When a grab is set on a particular window
+in a Tk application, mouse and keyboard events can only be received by
+that window and its descendants. Mouse and keyboard events for
+windows outside the tree rooted at \fItkwin\fR will be redirected to
+\fItkwin\fR. If the grab is global, then all mouse and keyboard
+events for windows outside the tree rooted at \fItkwin\fR (even those
+intended for windows in other applications) will be redirected to
+\fItkwin\fR. If the grab is application local, only mouse and
+keyboard events intended for a windows within the same application
+(but outside the tree rooted at \fItkwin\fR) will be redirected.
+
+.PP
+\fBTk_Grab\fR sets a grab on a particular window. \fITkwin\fR
+specifies the window on whose behalf the pointer is to be grabbed.
+\fIGrabGlobal\fR indicates whether the grab should be global or
+application local; if it is non-zero, it means the grab should be
+global. Normally, \fBTk_Grab\fR returns TCL_OK; if an error occurs
+and the grab cannot be set, TCL_ERROR is returned and an error message
+is left if \fIinterp\fR's result. Once this call completes
+successfully, no window outside the tree rooted at \fItkwin\fR will
+receive pointer- or keyboard-related events until the next call to
+Tk_Ungrab. If a previous grab was in effect within the application,
+then it is replaced with a new one.
+
+.PP
+\fBTcl_Ungrab\fR releases a grab on the mouse pointer and keyboard, if
+there is one set on the window given by \fItkwin\fR. Once a grab is
+released, pointer and keyboard events will start being delivered to
+other windows again.
+
+.SH KEYWORDS
+grab, window
diff --git a/tcl/doc/HWNDToWindow.3 b/tcl/doc/HWNDToWindow.3
new file mode 100644
index 00000000000..34baf022a1b
--- /dev/null
+++ b/tcl/doc/HWNDToWindow.3
@@ -0,0 +1,30 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_HWNDToWindow 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_HWNDToWindow \- Find Tk's window information for a Windows window
+.SH SYNOPSIS
+.nf
+\fB#include <tkPlatDecls.h>\fR
+.sp
+Tk_Window
+\fBTk_HWNDToWindow\fR(\fIhwnd\fR)
+.SH ARGUMENTS
+.AP HWND hwnd in
+Windows handle for the window.
+.BE
+
+.SH DESCRIPTION
+.PP
+Given a Windows HWND window identifier, this procedure returns the
+corresponding Tk_Window handle. If there is no Tk_Window corresponding
+to \fIhwnd\fR then NULL is returned.
+
+.SH KEYWORDS
+Windows window id
diff --git a/tcl/doc/HandleEvent.3 b/tcl/doc/HandleEvent.3
new file mode 100644
index 00000000000..26b75278bec
--- /dev/null
+++ b/tcl/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 \fBTcl_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 \fBTcl_QueueEvent\fR followed by
+\fBTcl_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/tcl/doc/IdToWindow.3 b/tcl/doc/IdToWindow.3
new file mode 100644
index 00000000000..0755f35bbb9
--- /dev/null
+++ b/tcl/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/tcl/doc/ImgChanged.3 b/tcl/doc/ImgChanged.3
new file mode 100644
index 00000000000..7588fb8cc4d
--- /dev/null
+++ b/tcl/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/tcl/doc/InternAtom.3 b/tcl/doc/InternAtom.3
new file mode 100644
index 00000000000..6264a265d59
--- /dev/null
+++ b/tcl/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
+CONST 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 "CONST 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/tcl/doc/MainLoop.3 b/tcl/doc/MainLoop.3
new file mode 100644
index 00000000000..2cbe3c9d06b
--- /dev/null
+++ b/tcl/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/tcl/doc/MainWin.3 b/tcl/doc/MainWin.3
new file mode 100644
index 00000000000..b409509b93f
--- /dev/null
+++ b/tcl/doc/MainWin.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_MainWindow 3 7.0 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_MainWindow, Tk_GetNumMainWindows \- functions for querying main
+window information
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Window
+\fBTk_MainWindow\fR(\fIinterp\fR)
+.sp
+int
+\fBTk_GetNumMainWindows\fR()
+
+.SH ARGUMENTS
+.AS Tcl_Interp *pathName
+.AP Tcl_Interp *interp in/out
+Interpreter associated with the application.
+.BE
+
+.SH DESCRIPTION
+.PP
+A main window is a special kind of toplevel window used as the
+outermost window in an application.
+.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.
+.PP
+\fBTk_GetNumMainWindows\fR returns a count of the number of main
+windows currently open in the process.
+
+.SH KEYWORDS
+application, main window
diff --git a/tcl/doc/MaintGeom.3 b/tcl/doc/MaintGeom.3
new file mode 100644
index 00000000000..7137973f487
--- /dev/null
+++ b/tcl/doc/MaintGeom.3
@@ -0,0 +1,103 @@
+'\"
+'\" 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, as well as handling the simpler
+case of slaves whose masters are 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/tcl/doc/ManageGeom.3 b/tcl/doc/ManageGeom.3
new file mode 100644
index 00000000000..50e0c7aa682
--- /dev/null
+++ b/tcl/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/tcl/doc/MapWindow.3 b/tcl/doc/MapWindow.3
new file mode 100644
index 00000000000..b23cee7a14f
--- /dev/null
+++ b/tcl/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_CreateWindow\fR was
+used to create a child window), 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/tcl/doc/MeasureChar.3 b/tcl/doc/MeasureChar.3
new file mode 100644
index 00000000000..38cbf754153
--- /dev/null
+++ b/tcl/doc/MeasureChar.3
@@ -0,0 +1,137 @@
+'\"
+'\" 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 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_MeasureChars, Tk_TextWidth, Tk_DrawChars, Tk_UnderlineChars \- routines to measure and display simple single-line strings.
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_MeasureChars(\fItkfont, string, numBytes, maxPixels, flags, lengthPtr\fB)\fR
+.sp
+int
+\fBTk_TextWidth(\fItkfont, string, numBytes\fB)\fR
+.sp
+void
+\fBTk_DrawChars(\fIdisplay, drawable, gc, tkfont, string, numBytes, x, y\fB)\fR
+.sp
+void
+\fBTk_UnderlineChars(\fIdisplay, drawable, gc, tkfont, string, x, y, firstByte, lastByte\fB)\fR
+.sp
+.SH ARGUMENTS
+.AS "const char" firstChar
+.AP Tk_Font tkfont in
+Token for font in which text is to be drawn or measured. Must have been
+returned by a previous call to \fBTk_GetFont\fR.
+.AP "const char" *string in
+Text to be measured or displayed. Need not be null terminated. Any
+non-printing meta-characters in the string (such as tabs, newlines, and
+other control characters) will be measured or displayed in a
+platform-dependent manner.
+.VS 8.1
+.AP int numBytes in
+The maximum number of bytes to consider when measuring or drawing
+\fIstring\fR. Must be greater than or equal to 0.
+.VE 8.1
+.AP int maxPixels in
+If \fImaxPixels\fR is >= 0, it specifies the longest permissible
+line length in pixels. Characters from \fIstring\fR are processed only
+until this many pixels have been covered. If \fImaxPixels\fR is < 0, then
+the line length is unbounded and the \fIflags\fR argument is ignored.
+.AP int flags in
+Various flag bits OR-ed together: TK_PARTIAL_OK means include a character
+as long as any part of it fits in the length given by \fImaxPixels\fR;
+otherwise, a character must fit completely to be considered.
+TK_WHOLE_WORDS means stop on a word boundary, if possible. If
+TK_AT_LEAST_ONE is set, it means return at least one character even if no
+characters could fit in the length given by \fImaxPixels\fR. If
+TK_AT_LEAST_ONE is set and TK_WHOLE_WORDS is also set, it means that if
+not even one word fits on the line, return the first few letters of the
+word that did fit; if not even one letter of the word fit, then the first
+letter will still be returned.
+.AP int *lengthPtr out
+Filled with the number of pixels occupied by the number of characters
+returned as the result of \fBTk_MeasureChars\fR.
+.AP Display *display in
+Display on which to draw.
+.AP Drawable drawable in
+Window or pixmap in which to draw.
+.AP GC gc in
+Graphics context for drawing characters. The font selected into this GC
+must be the same as the \fItkfont\fR.
+.AP int "x, y" in
+Coordinates at which to place the left edge of the baseline when displaying
+\fIstring\fR.
+.VS 8.1
+.AP int firstByte in
+The index of the first byte of the first character to underline in the
+\fIstring\fR. Underlining begins at the left edge of this character.
+.AP int lastByte in
+The index of the first byte of the last character up to which the
+underline will be drawn. The character specified by \fIlastByte\fR
+will not itself be underlined.
+.VE 8.1
+.BE
+
+.SH DESCRIPTION
+.PP
+These routines are for measuring and displaying simple single-font,
+single-line, strings. To measure and display single-font, multi-line,
+justified text, refer to the documentation for \fBTk_ComputeTextLayout\fR.
+There is no programming interface in the core of Tk that supports
+multi-font, multi-line text; support for that behavior must be built on
+top of simpler layers.
+.VS 8.1
+Note that the interfaces described here are
+byte-oriented not character-oriented, so index values coming from Tcl
+scripts need to be converted to byte offsets using the
+\fBTcl_UtfAtIndex\fR and related routines.
+.VE 8.1
+.PP
+A glyph is the displayable picture of a letter, number, or some other
+symbol. Not all character codes in a given font have a glyph.
+Characters such as tabs, newlines/returns, and control characters that
+have no glyph are measured and displayed by these procedures in a
+platform-dependent manner; under X, they are replaced with backslashed
+escape sequences, while under Windows and Macintosh hollow or solid boxes
+may be substituted. Refer to the documentation for
+\fBTk_ComputeTextLayout\fR for a programming interface that supports the
+platform-independent expansion of tab characters into columns and
+newlines/returns into multi-line text.
+.PP
+\fBTk_MeasureChars\fR is used both to compute the length of a given
+string and to compute how many characters from a string fit in a given
+amount of space. The return value is the number of bytes from
+\fIstring\fR that fit in the space specified by \fImaxPixels\fR subject to
+the conditions described by \fIflags\fR. If all characters fit, the return
+value will be \fInumBytes\fR. \fI*lengthPtr\fR is filled with the computed
+width, in pixels, of the portion of the string that was measured. For
+example, if the return value is 5, then \fI*lengthPtr\fR is filled with the
+distance between the left edge of \fIstring\fR[0] and the right edge of
+\fIstring\fR[4].
+.PP
+\fBTk_TextWidth\fR is a wrapper function that provides a simpler interface
+to the \fBTk_MeasureChars\fR function. The return value is how much
+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/tcl/doc/MoveToplev.3 b/tcl/doc/MoveToplev.3
new file mode 100644
index 00000000000..b0b076f4ada
--- /dev/null
+++ b/tcl/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/tcl/doc/Name.3 b/tcl/doc/Name.3
new file mode 100644
index 00000000000..d4a2dbed7b2
--- /dev/null
+++ b/tcl/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 "CONST 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/tcl/doc/NameOfImg.3 b/tcl/doc/NameOfImg.3
new file mode 100644
index 00000000000..fdc71f52b9c
--- /dev/null
+++ b/tcl/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
+CONST 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/tcl/doc/OwnSelect.3 b/tcl/doc/OwnSelect.3
new file mode 100644
index 00000000000..9b2e59d1e14
--- /dev/null
+++ b/tcl/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/tcl/doc/ParseArgv.3 b/tcl/doc/ParseArgv.3
new file mode 100644
index 00000000000..4fc886d2fe0
--- /dev/null
+++ b/tcl/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 "CONST 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/tcl/doc/QWinEvent.3 b/tcl/doc/QWinEvent.3
new file mode 100644
index 00000000000..7e58055d465
--- /dev/null
+++ b/tcl/doc/QWinEvent.3
@@ -0,0 +1,53 @@
+'\"
+'\" 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_CollapseMotionEvents, Tk_QueueWindowEvent \- Add a window event to the Tcl event queue
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_CollapseMotionEvents\fR(\fIdisplay, collapse\fR)
+.sp
+\fBTk_QueueWindowEvent\fR(\fIeventPtr, position\fR)
+.SH ARGUMENTS
+.AS Tcl_QueuePosition position
+.AP Display *display in
+Display for which to control motion event collapsing.
+.AP int collapse in
+Indicates whether motion events should be collapsed or not.
+.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
+\fBTk_QueueWindowEvent\fR 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
+When multiple motion events are received for the same window in rapid
+succession, they are collapsed by default. This behavior can be controlled
+with \fBTk_CollapseMotionEvents\fR. \fBTk_CollapseMotionEvents\fR always
+returns the previous value for collapse behavior on the \fIdisplay\fR.
+.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, events
diff --git a/tcl/doc/Restack.3 b/tcl/doc/Restack.3
new file mode 100644
index 00000000000..6389d09d36f
--- /dev/null
+++ b/tcl/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/tcl/doc/RestrictEv.3 b/tcl/doc/RestrictEv.3
new file mode 100644
index 00000000000..cb5653fe03a
--- /dev/null
+++ b/tcl/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/tcl/doc/SetAppName.3 b/tcl/doc/SetAppName.3
new file mode 100644
index 00000000000..293129fd153
--- /dev/null
+++ b/tcl/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
+CONST 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 "CONST 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/tcl/doc/SetCaret.3 b/tcl/doc/SetCaret.3
new file mode 100644
index 00000000000..067ee4a5d92
--- /dev/null
+++ b/tcl/doc/SetCaret.3
@@ -0,0 +1,40 @@
+'\"
+'\" Copyright (c) 2002 ActiveState 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 Tk_SetCaretPos 3 8.4 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_SetCaretPos \- set the display caret location
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_SetCaretPos\fR(\fItkwin, x, y, height\fR)
+.SH ARGUMENTS
+.AP Tk_Window tkwin in
+Token for window.
+.AP int x in
+Window-relative x coordinate.
+.AP int y in
+Window-relative y coordinate.
+.AP int h in
+Height of the caret in the window.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_SetCaretPos\fR sets the caret location for the display of the
+specified Tk_Window \fItkwin\fR. The caret is the per-display cursor
+location used for indicating global focus (e.g. to comply with Microsoft
+Accessibility guidelines), as well as for location of the over-the-spot XIM
+(X Input Methods) or Windows IME windows.
+
+.SH KEYWORDS
+caret, cursor
diff --git a/tcl/doc/SetClass.3 b/tcl/doc/SetClass.3
new file mode 100644
index 00000000000..9b2f9814724
--- /dev/null
+++ b/tcl/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/tcl/doc/SetClassProcs.3 b/tcl/doc/SetClassProcs.3
new file mode 100644
index 00000000000..5b563ee3dc8
--- /dev/null
+++ b/tcl/doc/SetClassProcs.3
@@ -0,0 +1,91 @@
+'\"
+'\" Copyright (c) 2000 Ajuba Solutions.
+'\"
+'\" 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_SetClassProcs 3 8.4 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_SetClassProcs \- register widget specific procedures
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_SetClassProcs\fR(\fItkwin, procs, instanceData\fR)
+.SH ARGUMENTS
+.AS Tk_ClassProc instanceData
+.AP Tk_Window tkwin in
+Token for window to modify.
+.AP Tk_ClassProcs *procs in
+Pointer to data structure containing widget specific procedures.
+The data structure pointed to by \fIprocs\fR must be static:
+Tk keeps a reference to it as long as the window exists.
+.AP ClientData instanceData in
+Arbitrary one-word value to pass to widget callbacks.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_SetClassProcs\fR is called to register a set of procedures that
+are used as callbacks in different places.
+.PP
+The structure pointed to by \fIprocs\fR contains the following:
+.CS
+typedef struct Tk_ClassProcs {
+ unsigned int \fIsize\fR;
+ Tk_ClassWorldChangedProc *\fIworldChangedProc\fR;
+ Tk_ClassCreateProc *\fIcreateProc\fR;
+ Tk_ClassModalProc *\fImodalProc\fR;
+} Tk_ClassProcs;
+.CE
+The \fIsize\fR field is used to simplify future expansion of the
+structure. It should always be set to (literally) \fBsizeof(Tk_ClassProcs)\fR.
+.PP
+\fIworldChangedProc\fR is invoked when the system has altered
+in some way that requires some reaction from the widget. For example,
+when a font alias (see the \fBfont\fR manual entry) is reconfigured,
+widgets configured to use that font alias must update their display
+accordingly. \fIworldChangedProc\fR should have arguments and results
+that match the type \fBTk_ClassWorldChangedProc\fR:
+.CS
+typedef void Tk_ClassWorldChangedProc(
+ ClientData \fIinstanceData\fR);
+.CE
+The \fIinstanceData\fR parameter passed to the \fIworldChangedProc\fR
+will be identical to the \fIinstanceData\fR paramter passed to
+\fBTk_SetClassProcs\fR.
+.PP
+\fIcreateProc\fR is used to create platform-dependant windows. It is
+invoked by \fBTk_MakeWindowExist\fR. \fIcreateProc\fR should have
+arguments and results that match the type \fBTk_ClassCreateProc\fR:
+.CS
+typedef Window Tk_ClassCreateProc(
+ Tk_Window \fItkwin\fR,
+ Window \fIparent\fR,
+ ClientData \fIinstanceData\fR);
+.CE
+The \fItkwin\fR and \fIinstanceData\fR parameters will be identical to
+the \fItkwin\fR and \fIinstanceData\fR parameters passed to
+\fBTk_SetClassProcs\fR. The \fIparent\fR parameter will be the parent
+of the window to be created. The \fIcreateProc\fR should return the
+created window.
+.PP
+\fImodalProc\fR is invoked after all bindings on a widget have been
+triggered in order to handle a modal loop. \fImodalProc\fR should
+have arguments and results that match the type \fBTk_ClassModalProc\fR:
+.CS
+typedef void Tk_ClassModalProc(
+ Tk_Window \fItkwin\fR,
+ XEvent *\fIeventPtr\fR);
+.CE
+The \fItkwin\fR parameter to \fImodalProc\fR will be identical to the
+\fItkwin\fR parameter passed to \fBTk_SetClassProcs\fR. The
+\fIeventPtr\fR parameter will be a pointer to an XEvent structure
+describing the event being processed.
+
+.SH KEYWORDS
+callback, class
diff --git a/tcl/doc/SetGrid.3 b/tcl/doc/SetGrid.3
new file mode 100644
index 00000000000..d867ca4c3ee
--- /dev/null
+++ b/tcl/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/tcl/doc/SetOptions.3 b/tcl/doc/SetOptions.3
new file mode 100644
index 00000000000..925a68767d5
--- /dev/null
+++ b/tcl/doc/SetOptions.3
@@ -0,0 +1,653 @@
+'\"
+'\" Copyright (c) 1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tk_SetOptions 3 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_CreateOptionTable, Tk_DeleteOptionTable, Tk_InitOptions, Tk_SetOptions, Tk_FreeSavedOptions, Tk_RestoreSavedOptions, Tk_GetOptionValue, Tk_GetOptionInfo, Tk_FreeConfigOptions, Tk_Offset \- process configuration options
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_OptionTable
+\fBTk_CreateOptionTable(\fIinterp, templatePtr\fB)\fR
+.sp
+\fBTk_DeleteOptionTable(\fIoptionTable\fB)\fR
+.sp
+int
+\fBTk_InitOptions(\fIinterp, recordPtr, optionTable, tkwin\fB)\fR
+.sp
+int
+\fBTk_SetOptions(\fIinterp, recordPtr, optionTable, objc, objv, tkwin, savePtr, maskPtr\fB)\fR
+.sp
+\fBTk_FreeSavedOptions(\fIsavedPtr\fB)\fR
+.sp
+\fBTk_RestoreSavedOptions(\fIsavedPtr\fB)\fR
+.sp
+Tcl_Obj *
+\fBTk_GetOptionValue(\fIinterp, recordPtr, optionTable, namePtr, tkwin\fB)\fR
+.sp
+Tcl_Obj *
+\fBTk_GetOptionInfo(\fIinterp, recordPtr, optionTable, namePtr, tkwin\fB)\fR
+.sp
+\fBTk_FreeConfigOptions(\fIrecordPtr, optionTable, tkwin\fB)\fR
+.sp
+int
+\fBTk_Offset(\fItype, field\fB)\fR
+.SH ARGUMENTS
+.AS Tk_SavedOptions "*CONST objv[]" in/out
+.AP Tcl_Interp *interp in
+A Tcl interpreter. Most procedures use this only for returning error
+messages; if it is NULL then no error messages are returned. For
+\fBTk_CreateOptionTable\fR the value cannot be NULL; it gives the
+interpreter in which the option table will be used.
+.AP Tk_OptionSpec *templatePtr in
+Points to an array of static information that describes the configuration
+options that are supported. Used to build a Tk_OptionTable. The information
+pointed to by this argument must exist for the lifetime of the Tk_OptionTable.
+.AP Tk_OptionTable optionTable in
+Token for an option table. Must have been returned by a previous call
+to \fBTk_CreateOptionTable\fR.
+.AP char *recordPtr in/out
+Points to structure in which values of configuration options are stored;
+fields of this record are modified by procedures such as \fBTk_SetOptions\fR
+and read by procedures such as \fBTk_GetOptionValue\fR.
+.AP Tk_Window tkwin in
+For options such as TK_OPTION_COLOR, this argument indicates
+the window in which the option will be used. If \fIoptionTable\fR uses
+no window-dependent options, then a NULL value may be supplied for
+this argument.
+.AP int objc in
+Number of values in \fIobjv\fR.
+.AP Tcl_Obj "*CONST objv[]" in
+Command-line arguments for setting configuring options.
+.AP Tk_SavedOptions *savePtr out
+If not NULL, the structure pointed to by this argument is filled
+in with the old values of any options that were modified and old
+values are restored automatically if an error occurs in \fBTk_SetOptions\fR.
+.AP int *maskPtr out
+If not NULL, the word pointed to by \fImaskPtr\fR is filled in with the
+bit-wise OR of the \fItypeMask\fR fields for the options that
+were modified.
+.AP Tk_SavedOptions *savedPtr in/out
+Points to a structure previously filled in by \fBTk_SetOptions\fR with
+old values of modified options.
+.AP Tcl_Obj *namePtr in
+The value of this object is the name of a particular option. If NULL
+is passed to \fBTk_GetOptionInfo\fR then information is returned for
+all options. Must not be NULL when \fBTk_GetOptionValue\fR is called.
+.AP "type name" type in
+The name of the type of a record.
+.AP "field name" field in
+The name of a field in records of type \fItype\fR.
+.BE
+.SH DESCRIPTION
+.PP
+These procedures handle most of the details of parsing configuration
+options such as those for Tk widgets. Given a description of what
+options are supported, these procedures handle all the details of
+parsing options and storing their values into a C structure associated
+with the widget or object. The procedures were designed primarily for
+widgets in Tk, but they can also be used for other kinds of objects that
+have configuration options. In the rest of this manual page ``widget'' will
+be used to refer to the object whose options are being managed; in
+practice the object may not actually be a widget. The term ``widget
+record'' is used to refer to the C-level structure in
+which information about a particular widget or object is stored.
+.PP
+Note: the easiest way to learn how to use these procedures is to
+look at a working example. In Tk, the simplest example is the code
+that implements the button family of widgets, which is an \fBtkButton.c\fR.
+Other examples are in \fBtkSquare.c\fR and \fBtkMenu.c\fR.
+.PP
+In order to use these procedures, the code that implements the widget
+must contain a static array of Tk_OptionSpec structures. This is a
+template that describes the various options supported by that class of
+widget; there is a separate template for each kind of widget. The
+template contains information such as the name of each option, its type,
+its default value, and where the value of the option is stored in the
+widget record. See TEMPLATES below for more detail.
+.PP
+In order to process configuration options efficiently, the static
+template must be augmented with additional information that is available
+only at runtime. The procedure \fBTk_CreateOptionTable\fR creates this
+dynamic information from the template and returns a Tk_OptionTable token
+that describes both the static and dynamic information. All of the
+other procedures, such as \fBTk_SetOptions\fR, take a Tk_OptionTable
+token as argument. Typically, \fBTk_CreateOptionTable\fR is called the
+first time that a widget of a particular class is created and the
+resulting Tk_OptionTable is used in the future for all widgets of that
+class. A Tk_OptionTable may be used only in a single interpreter, given
+by the \fIinterp\fR argument to \fBTk_CreateOptionTable\fR. When an
+option table is no longer needed \fBTk_DeleteOptionTable\fR should be
+called to free all of its resources. All of the option tables
+for a Tcl interpreter are freed automatically if the interpreter is deleted.
+.PP
+\fBTk_InitOptions\fR is invoked when a new widget is created to set
+the default values for all of the widget's configuration options.
+\fBTk_InitOptions\fR is passed a token for an option table (\fIoptionTable\fR)
+and a pointer to a widget record (\fIrecordPtr\fR), which is the C
+structure that holds information about this widget. \fBTk_InitOptions\fR
+uses the information in the option table to
+choose an appropriate default for each option, then it stores the default
+value directly into the widget record, overwriting any information that
+was already present in the widget record. \fBTk_InitOptions\fR normally
+returns TCL_OK. If an error occurred while setting the default values
+(e.g., because a default value was erroneous) then TCL_ERROR is returned
+and an error message is left in \fIinterp\fR's result if \fIinterp\fR
+isn't NULL.
+.PP
+\fBTk_SetOptions\fR is invoked to modify configuration options based
+on information specified in a Tcl command. The command might be one that
+creates a new widget, or a command that modifies options on an existing
+widget. The \fIobjc\fR and \fIobjv\fR arguments describe the
+values of the arguments from the Tcl command. \fIObjv\fR must contain
+an even number of objects: the first object of each pair gives the name of
+an option and the second object gives the new value for that option.
+\fBTk_SetOptions\fR looks up each name in \fIoptionTable\fR, checks that
+the new value of the option conforms to the type in \fIoptionTable\fR,
+and stores the value of the option into the widget record given by
+\fIrecordPtr\fR. \fBTk_SetOptions\fR normally returns TCL_OK. If
+an error occurred (such as an unknown option name or an illegal option
+value) then TCL_ERROR is returned and an error message is left in
+\fIinterp\fR's result if \fIinterp\fR isn't NULL.
+.PP
+\fBTk_SetOptions\fR has two additional features. First, if the
+\fImaskPtr\fR argument isn't NULL then it points to an integer
+value that is filled in with information about the options that were
+modified. For each option in the template passed to
+\fBTk_CreateOptionTable\fR there is a \fItypeMask\fR field. The
+bits of this field are defined by the code that implements the widget;
+for example, each bit might correspond to a particular configuration option.
+Alternatively, bits might be used functionally. For example, one bit might
+be used for redisplay: all options that affect the widget's display, such
+that changing the option requires the widget to be redisplayed, might have
+that bit set. Another bit might indicate that the geometry of the widget
+must be recomputed, and so on. \fBTk_SetOptions\fR OR's together the
+\fItypeMask\fR fields from all the options that were modified and returns
+this value at *\fImaskPtr\fR; the caller can then use this information
+to optimize itself so that, for example, it doesn't redisplay the widget
+if the modified options don't affect the widget's appearance.
+.PP
+The second additional feature of \fBTk_SetOptions\fR has to do with error
+recovery. If an error occurs while processing configuration options, this
+feature makes it possible to restore all the configuration options to their
+previous values. Errors can occur either while processing options in
+\fBTk_SetOptions\fR or later in the caller. In many cases the caller does
+additional processing after \fBTk_SetOptions\fR returns; for example, it
+might use an option value to set a trace on a variable and may detect
+an error if the variable is an array instead of a scalar. Error recovery
+is enabled by passing in a non-NULL value for the \fIsavePtr\fR argument
+to \fBTk_SetOptions\fR; this should be a pointer to an uninitialized
+Tk_SavedOptions structure on the caller's stack. \fBTk_SetOptions\fR
+overwrites the structure pointed to by \fIsavePtr\fR with information
+about the old values of any options modified by the procedure.
+If \fBTk_SetOptions\fR returns successfully, the
+caller uses the structure in one of two ways. If the caller completes
+its processing of the new options without any errors, then it must pass
+the structure to \fBTk_FreeSavedOptions\fR so that the old values can be
+freed. If the caller detects an error in its processing of the new
+options, then it should pass the structure to \fBTk_RestoreSavedOptions\fR,
+which will copy the old values back into the widget record and free
+the new values.
+If \fBTk_SetOptions\fR detects an error then it automatically restores
+any options that had already been modified and leaves *\fIsavePtr\fR in
+an empty state: the caller need not call either \fBTk_FreeSavedOptions\fR or
+\fBTk_RestoreSavedOptions\fR.
+If the \fIsavePtr\fR argument to \fBTk_SetOptions\fR is NULL then
+\fBTk_SetOptions\fR frees each old option value immediately when it sets a new
+value for the option. In this case, if an error occurs in the third
+option, the old values for the first two options cannot be restored.
+.PP
+\fBTk_GetOptionValue\fR returns the current value of a configuration option
+for a particular widget. The \fInamePtr\fR argument contains the name of
+an option; \fBTk_GetOptionValue\fR uses \fIoptionTable\fR
+to lookup the option and extract its value from the widget record
+pointed to by \fIrecordPtr\fR, then it returns an object containing
+that value. If an error occurs (e.g., because \fInamePtr\fR contains an
+unknown option name) then NULL is returned and an error message is left
+in \fIinterp\fR's result unless \fIinterp\fR is NULL.
+.PP
+\fBTk_GetOptionInfo\fR returns information about configuration options in
+a form suitable for \fBconfigure\fR widget commands. If the \fInamePtr\fR
+argument is not NULL, it points to an object that gives the name of a
+configuration option; \fBTk_GetOptionInfo\fR returns an object containing
+a list with five elements, which are the name of the option, the name and
+class used for the option in the option database, the default value for
+the option, and the current value for the option. If the \fInamePtr\fR
+argument is NULL, then \fBTk_GetOptionInfo\fR returns information about
+all options in the form of a list of lists; each sublist describes one
+option. Synonym options are handled differently depending on whether
+\fInamePtr\fR is NULL: if \fInamePtr\fR is NULL then the sublist for
+each synonym option has only two elements, which are the name of the
+option and the name of the other option that it refers to; if \fInamePtr\fR
+is non-NULL and names a synonym option then the object returned
+is the five-element list
+for the other option that the synonym refers to. If an error occurs
+(e.g., because \fInamePtr\fR contains an unknown option name) then NULL
+is returned and an error message is left in \fIinterp\fR's result unless
+\fIinterp\fR is NULL.
+.PP
+\fBTk_FreeConfigOptions\fR must be invoked when a widget is deleted.
+It frees all of the resources associated with any of the configuration
+options defined in \fIrecordPtr\fR by \fIoptionTable\fR.
+.PP
+The \fBTk_Offset\fR macro is provided as a safe way of generating the
+\fIobjOffset\fR and \fIinternalOffset\fR values for entries in
+Tk_OptionSpec structures. It takes two arguments: the name of a type
+of record, and the name of a field in that record. It returns the byte
+offset of the named field in records of the given type.
+
+.SH "TEMPLATES"
+.PP
+The array of Tk_OptionSpec structures passed to \fBTk_CreateOptionTable\fR
+via its \fItemplatePtr\fR argument describes the configuration options
+supported by a particular class of widgets. Each structure specifies
+one configuration option and has the following fields:
+.CS
+typedef struct {
+ Tk_OptionType \fItype\fR;
+ char *\fIoptionName\fR;
+ char *\fIdbName\fR;
+ char *\fIdbClass\fR;
+ char *\fIdefValue\fR;
+ int \fIobjOffset\fR;
+ int \fIinternalOffset\fR;
+ int \fIflags\fR;
+ ClientData \fIclientData\fR;
+ int \fItypeMask\fR;
+} Tk_OptionSpec;
+.CE
+The \fItype\fR field indicates what kind of configuration option this is
+(e.g. TK_OPTION_COLOR for a color value, or TK_OPTION_INT for
+an integer value). \fIType\fR determines how the
+value of the option is parsed (more on this below).
+The \fIoptionName\fR field is a string such as \fB\-font\fR or \fB\-bg\fR;
+it is the name used for the option in Tcl commands and passed to
+procedures via the \fIobjc\fR or \fInamePtr\fR arguments.
+The \fIdbName\fR and \fIdbClass\fR fields are used by \fBTk_InitOptions\fR
+to look up a default value for this option in the option database; if
+\fIdbName\fR is NULL then the option database is not used by
+\fBTk_InitOptions\fR for this option. The \fIdefValue\fR field
+specifies a default value for this configuration option if no
+value is specified in the option database. The \fIobjOffset\fR and
+\fIinternalOffset\fR fields indicate where to store the value of this
+option in widget records (more on this below); values for the \fIobjOffset\fR
+and \fIinternalOffset\fR fields should always be generated with the
+\fBTk_Offset\fR macro.
+The \fIflags\fR field contains additional information
+to control the processing of this configuration option (see below
+for details).
+\fIClientData\fR provides additional type-specific data needed
+by certain types. For instance, for TK_OPTION_COLOR types,
+\fIclientData\fR is a string giving the default value to use on
+monochrome displays. See the descriptions of the different types
+below for details.
+The last field, \fItypeMask\fR, is used by \fBTk_SetOptions\fR to
+return information about which options were modified; see the description
+of \fBTk_SetOptions\fR above for details.
+.PP
+When \fBTk_InitOptions\fR and \fBTk_SetOptions\fR store the value of an
+option into the widget record, they can do it in either of two ways.
+If the \fIobjOffset\fR field of the Tk_OptionSpec is greater than
+or equal to zero, then the value of the option is stored as a
+(Tcl_Obj *) at the location in the widget record given by \fIobjOffset\fR.
+If the \fIinternalOffset\fR field of the Tk_OptionSpec is
+greater than or equal to zero, then the value of the option is stored
+in a type-specific internal form at the location in the widget record
+given by \fIinternalOffset\fR. For example, if the option's type is
+TK_OPTION_INT then the internal form is an integer. If the
+\fIobjOffset\fR or \fIinternalOffset\fR field is negative then the
+value is not stored in that form. At least one of the offsets must be
+greater than or equal to zero.
+.PP
+The \fIflags\fR field consists of one or more bits ORed together. At
+present only a single flag is supported: TK_OPTION_NULL_OK. If
+this bit is set for an option then an empty string will be accepted as
+the value for the option and the resulting internal form will be a
+NULL pointer, a zero value, or \fBNone\fR, depending on the type of
+the option. If the flag is not set then empty strings will result
+in errors.
+TK_OPTION_NULL_OK is typically used to allow a
+feature to be turned off entirely, e.g. set a cursor value to
+\fBNone\fR so that a window simply inherits its parent's cursor.
+Not all option types support the TK_OPTION_NULL_OK
+flag; for those that do, there is an explicit indication of that fact
+in the descriptions below.
+.PP
+The \fItype\fR field of each Tk_OptionSpec structure determines
+how to parse the value of that configuration option. The
+legal value for \fItype\fR, and the corresponding actions, are
+described below. If the type requires a \fItkwin\fR value to be
+passed into procedures like \fBTk_SetOptions\fR, or if it uses
+the \fIclientData\fR field of the Tk_OptionSpec, then it is indicated
+explicitly; if not mentioned, the type requires neither \fItkwin\fR
+nor \fIclientData\fR.
+.TP
+\fBTK_OPTION_ANCHOR\fR
+The value must be a standard anchor position such as \fBne\fR or
+\fBcenter\fR. The internal form is a Tk_Anchor value like the ones
+returned by \fBTk_GetAnchorFromObj\fR.
+.TP
+\fBTK_OPTION_BITMAP\fR
+The value must be a standard Tk bitmap name. The internal form is a
+Pixmap token like the ones returned by \fBTk_AllocBitmapFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_BOOLEAN\fR
+The value must be a standard boolean value such as \fBtrue\fR or
+\fBno\fR. The internal form is an integer with value 0 or 1.
+.TP
+\fBTK_OPTION_BORDER\fR
+The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR.
+The internal form is a Tk_3DBorder token like the ones returned
+by \fBTk_Alloc3DBorderFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_COLOR\fR
+The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR.
+The internal form is an (XColor *) token like the ones returned by
+\fBTk_AllocColorFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_CURSOR\fR
+The value must be a standard cursor name such as \fBcross\fR or \fB@foo\fR.
+The internal form is a Tk_Cursor token like the ones returned by
+\fBTk_AllocCursorFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and when the option is set the cursor
+for the window is changed by calling \fBXDefineCursor\fR. This
+option type also supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_CUSTOM\fR
+This option allows applications to define new option types. The
+clientData field of the entry points to a structure defining the new
+option type. See the section CUSTOM OPTION TYPES below for details.
+.TP
+\fBTK_OPTION_DOUBLE\fR
+The string value must be a floating-point number in
+the format accepted by \fBstrtol\fR. The internal form is a C
+\fBdouble\fR value. This option type supports the TK_OPTION_NULL_OK
+flag; if a NULL value is set, the internal representation is set to zero.
+.TP
+\fBTK_OPTION_END\fR
+Marks the end of the template. There must be a Tk_OptionSpec structure
+with \fItype\fR TK_OPTION_END at the end of each template. If the
+\fIclientData\fR field of this structure isn't NULL, then it points to
+an additional array of Tk_OptionSpec's, which is itself terminated by
+another TK_OPTION_END entry. Templates may be chained arbitrarily
+deeply. This feature allows common options to be shared by several
+widget classes.
+.TP
+\fBTK_OPTION_FONT\fR
+The value must be a standard font name such as \fBTimes 16\fR.
+The internal form is a Tk_Font handle like the ones returned by
+\fBTk_AllocFontFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_INT\fR
+The string value must be an integer in the format accepted by
+\fBstrtol\fR (e.g. \fB0\fR and \fB0x\fR prefixes may be used to
+specify octal or hexadecimal numbers, respectively). The internal
+form is a C \fBint\fR value.
+.TP
+\fBTK_OPTION_JUSTIFY\fR
+The value must be a standard justification value such as \fBleft\fR.
+The internal form is a Tk_Justify like the values returned by
+\fBTk_GetJustifyFromObj\fR.
+.TP
+\fBTK_OPTION_PIXELS\fR
+The value must specify a screen distance such as \fB2i\fR or \fB6.4\fR.
+The internal form is an integer value giving a
+distance in pixels, like the values returned by
+\fBTk_GetPixelsFromObj\fR. Note: if the \fIobjOffset\fR field isn't
+used then information about the original value of this option will be lost.
+See \fBOBJOFFSET VS. INTERNALOFFSET\fR below for details. This option
+type supports the TK_OPTION_NULL_OK flag; if a NULL value is set, the
+internal representation is set to zero.
+.TP
+\fBTK_OPTION_RELIEF\fR
+The value must be standard relief such as \fBraised\fR.
+The internal form is an integer relief value such as
+TK_RELIEF_RAISED. This option type supports the TK_OPTION_NULL_OK
+flag; if the empty string is specified as the value for the option,
+the integer relief value is set to TK_RELIEF_NULL.
+.TP
+\fBTK_OPTION_STRING\fR
+The value may be any string. The internal form is a (char *) pointer
+that points to a dynamically allocated copy of the value.
+This option type supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_STRING_TABLE\fR
+For this type, \fIclientData\fR is a pointer to an array of strings
+suitable for passing to \fBTcl_GetIndexFromObj\fR. The value must
+be one of the strings in the table, or a unique abbreviation of
+one of the strings. The internal form is an integer giving the index
+into the table of the matching string, like the return value
+from \fBTcl_GetStringFromObj\fR.
+.TP
+\fBTK_OPTION_SYNONYM\fR
+This type is used to provide alternative names for an option (for
+example, \fB\-bg\fR is often used as a synonym for \fB\-background\fR).
+The \fBclientData\fR field is a (char *) pointer that gives
+the name of another option in the same table. Whenever the
+synonym option is used, the information from the other option
+will be used instead.
+.TP
+\fBTK_OPTION_WINDOW\fR
+The value must be a window path name. The internal form is a
+\fBTk_Window\fR token for the window.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR (in order to identify the application),
+and it supports the TK_OPTION_NULL_OK flag.
+
+.SH "STORAGE MANAGEMENT ISSUES"
+.PP
+If a field of a widget record has its offset stored in the \fIobjOffset\fR
+or \fIinternalOffset\fR field of a Tk_OptionSpec structure then the
+procedures described here will handle all of the storage allocation and
+resource management issues associated with the field. When the value
+of an option is changed, \fBTk_SetOptions\fR (or \fBTk_FreeSavedOptions\fR)
+will automatically free any resources associated with the old value, such as
+Tk_Fonts for TK_OPTION_FONT options or dynamically allocated memory for
+TK_OPTION_STRING options. For an option stored as an object using the
+\fIobjOffset\fR field of a Tk_OptionSpec, the widget record shares the
+object pointed to by the \fIobjv\fR value from the call to
+\fBTk_SetOptions\fR. The reference count for this object is incremented
+when a pointer to it is stored in the widget record and decremented when
+the option is modified. When the widget is deleted
+\fBTk_FreeConfigOptions\fR should be invoked; it will free the resources
+associated with all options and decrement reference counts for any
+objects.
+.PP
+However, the widget code is responsible for storing NULL or \fBNone\fR in
+all pointer and token fields before invoking \fBTk_InitOptions\fR.
+This is needed to allow proper cleanup in the rare case where
+an error occurs in \fBTk_InitOptions\fR.
+
+.SH "OBJOFFSET VS. INTERNALOFFSET"
+.PP
+In most cases it is simplest to use the \fIinternalOffset\fR field of
+a Tk_OptionSpec structure and not the \fIobjOffset\fR field. This
+makes the internal form of the value immediately available to the
+widget code so the value doesn't have to be extracted from an object
+each time it is used. However, there are two cases where the
+\fIobjOffset\fR field is useful. The first case is for
+TK_OPTION_PIXELS options. In this case, the internal form is
+an integer pixel value that is valid only for a particular screen.
+If the value of the option is retrieved, it will be returned as a simple
+number. For example, after the command \fB.b configure \-borderwidth 2m\fR,
+the command \fB.b configure \-borderwidth\fR might return 7, which is the
+integer pixel value corresponding to \fB2m\fR. Unfortunately, this loses
+the original screen-independent value. Thus for TK_OPTION_PIXELS options
+it is better to use the \fIobjOffset\fR field. In this case the original
+value of the option is retained in the object and can be returned when
+the option is retrieved. In most cases it is convenient to use the
+\fIinternalOffset\fR field field as well, so that the integer value is
+immediately available for use in the widget code (alternatively,
+\fBTk_GetPixelsFromObj\fR can be used to extract the integer value from
+the object whenever it is needed). Note: the problem of losing information
+on retrievals exists only for TK_OPTION_PIXELS options.
+.PP
+The second reason to use the \fIobjOffset\fR field is in order to
+implement new types of options not supported by these procedures.
+To implement a new type of option, you can use TK_OPTION_STRING as
+the type in the Tk_OptionSpec structure and set the \fIobjOffset\fR field
+but not the \fIinternalOffset\fR field. Then, after calling
+\fBTk_SetOptions\fR, convert the object to internal form yourself.
+
+.SH "CUSTOM OPTION TYPES"
+.PP
+Applications can extend the built-in configuration types with
+additional configuration types by writing procedures to parse, print,
+free, and restore saved copies of the type and creating a structure
+pointing to those procedures:
+.CS
+typedef struct Tk_ObjCustomOption {
+ char *name;
+ Tk_CustomOptionSetProc *\fIsetProc\fR;
+ Tk_CustomOptionGetProc *\fIgetProc\fR;
+ Tk_CustomOptionRestoreProc *\fIrestoreProc\fR;
+ Tk_CustomOptionFreeProc *\fIfreeProc\fR;
+ ClientData \fIclientData\fR;
+} Tk_ObjCustomOption;
+
+typedef int Tk_CustomOptionSetProc(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ Tk_Window \fItkwin\fR,
+ Tcl_Obj **\fIvaluePtr\fR,
+ char *\fIrecordPtr\fR,
+ int \fIinternalOffset\fR,
+ char *\fIsaveInternalPtr\fR,
+ int \fIflags\fR);
+
+typedef Tcl_Obj *Tk_CustomOptionGetProc(
+ ClientData \fIclientData\fR,
+ Tk_Window \fItkwin\fR,
+ char *\fIrecordPtr\fR,
+ int \fIinternalOffset\fR);
+
+typedef void Tk_CustomOptionRestoreProc(
+ ClientData \fIclientData\fR,
+ Tk_Window \fItkwin\fR,
+ char *\fIinternalPtr\fR,
+ char *\fIsaveInternalPtr\fR);
+
+typedef void Tk_CustomOptionFreeProc(
+ ClientData \fIclientData\fR,
+ Tk_Window \fItkwin\fR,
+ char *\fIinternalPtr\fR);
+.CE
+.PP
+The Tk_ObjCustomOption structure contains six fields: a name
+for the custom option type; pointers to the four 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. \fIRestoreProc\fR and \fIfreeProc\fR
+may be NULL, indicating that no function should be called for those
+operations.
+.PP
+The \fIsetProc\fR procedure is invoked by \fBTk_SetOptions\fR to
+convert a Tcl_Obj into an internal representation and store the
+resulting value in the widget record. The arguments are:
+.RS
+.TP
+\fIclientData\fR
+A copy of the \fIclientData\fR field in the Tk_ObjCustomOption
+structure.
+.TP
+\fIinterp\fR
+A pointer to a Tcl interpreter, used for error reporting.
+.TP
+\fITkwin\fR
+A copy of the \fItkwin\fR argument to \fBTk_SetOptions\fR
+.TP
+\fIvaluePtr\fR
+A pointer to a reference to a Tcl_Obj describing the new value for the
+option; it could have been specified explicitly in the call to
+\fBTk_SetOptions\fR or it could come from the option database or a
+default. If the objOffset for the option is non-negative (the option
+value is stored as a (Tcl_Obj *) in the widget record), the Tcl_Obj
+pointer referenced by \fIvaluePtr\fR is the pointer that will be
+stored at the objOffset for the option. \fISetProc\fR may modify the
+value if necessary; for example, \fIsetProc\fR may change the value to
+NULL to support the TK_OPTION_NULL_OK flag.
+.TP
+\fIrecordPtr\fR
+A pointer to the start of the widget record to modify.
+.TP
+\fIinternalOffset\fR
+Offset in bytes from the start of the widget record to the location
+where the internal representation of the option value is to be placed.
+.TP
+\fIsaveInternalPtr\fR
+A pointer to storage allocated in a Tk_SavedOptions structure for the
+internal representation of the original option value. Before setting
+the option to its new value, \fIsetProc\fR should set the value
+referenced by \fIsaveInternalPtr\fR to the original value of the
+option in order to support \fBTk_RestoreSavedOptions\fR.
+.TP
+\fIflags\fR
+A copy of the \fIflags\fR field in the Tk_OptionSpec structure for the
+option
+.RE
+.PP
+\fISetProc\fR returns a standard Tcl result: TCL_OK to indicate successful
+processing, or TCL_ERROR to indicate a failure of any kind. An error
+message may be left in the Tcl interpreter given by \fIinterp\fR in
+the case of an error.
+.PP
+The \fIgetProc\fR procedure is invoked by \fBTk_GetOptionValue\fR and
+\fBTk_GetOptionInfo\fR to retrieve a Tcl_Obj representation of the
+internal representation of an option. The \fIclientData\fR argument
+is a copy of the \fIclientData\fR field in the Tk_ObjCustomOption
+structure. \fITkwin\fR is a copy of the \fItkwin\fR argument to
+\fBTk_GetOptionValue\fR or \fBTk_GetOptionInfo\fR. \fIRecordPtr\fR
+is a pointer to the beginning of the widget record to query.
+\fIInternalOffset\fR is the offset in bytes from the beginning of the
+widget record to the location where the internal representation of the
+option value is stored. \fIGetProc\fR must return a pointer to a
+Tcl_Obj representing the value of the option.
+.PP
+The \fIrestoreProc\fR procedure is invoked by
+\fBTk_RestoreSavedOptions\fR to restore a previously saved internal
+representation of a custom option value. The \fIclientData\fR argument
+is a copy of the \fIclientData\fR field in the Tk_ObjCustomOption
+structure. \fITkwin\fR is a copy of the \fItkwin\fR argument to
+\fBTk_GetOptionValue\fR or \fBTk_GetOptionInfo\fR. \fIInternalPtr\fR
+is a pointer to the location where internal representation of the
+option value is stored.
+\fISaveInternalPtr\fR is a pointer to the saved value.
+\fIRestoreProc\fR must copy the value from \fIsaveInternalPtr\fR to
+\fIinternalPtr\fR to restore the value. \fIRestoreProc\fR need not
+free any memory associated with either \fIinternalPtr\fR or
+\fIsaveInternalPtr\fR; \fIfreeProc\fR will be invoked to free that
+memory if necessary. \fIRestoreProc\fR has no return value.
+.PP
+The \fIfreeProc\fR procedure is invoked by \fBTk_SetOptions\fR and
+\fBTk_FreeSavedOptions\fR to free any storage allocated for the
+internal representation of a custom option. The \fIclientData\fR argument
+is a copy of the \fIclientData\fR field in the Tk_ObjCustomOption
+structure. \fITkwin\fR is a copy of the \fItkwin\fR argument to
+\fBTk_GetOptionValue\fR or \fBTk_GetOptionInfo\fR. \fIInternalPtr\fR
+is a pointer to the location where the internal representation of the
+option value is stored. The \fIfreeProc\fR must free any storage
+associated with the option. \fIFreeProc\fR has no return value.
+
+
+.SH KEYWORDS
+anchor, bitmap, boolean, border, color, configuration option,
+cursor, double, font, integer, justify,
+pixels, relief, screen distance, synonym
diff --git a/tcl/doc/SetVisual.3 b/tcl/doc/SetVisual.3
new file mode 100644
index 00000000000..8895d3a36f9
--- /dev/null
+++ b/tcl/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/tcl/doc/StrictMotif.3 b/tcl/doc/StrictMotif.3
new file mode 100644
index 00000000000..24c99051a2a
--- /dev/null
+++ b/tcl/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/tcl/doc/TextLayout.3 b/tcl/doc/TextLayout.3
new file mode 100644
index 00000000000..ba1273c5c99
--- /dev/null
+++ b/tcl/doc/TextLayout.3
@@ -0,0 +1,280 @@
+'\"
+'\" 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 8.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_ComputeTextLayout, Tk_FreeTextLayout, Tk_DrawTextLayout, Tk_UnderlineTextLayout, Tk_PointToChar, Tk_CharBbox, Tk_DistanceToTextLayout, Tk_IntersectTextLayout, Tk_TextLayoutToPostscript \- routines to measure and display single-font, multi-line, justified text.
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+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
+.VS 8.1
+terminated and uses \fBTcl_NumUtfChars\fR to determine the length of
+\fIstring\fR.
+.VE
+.AP int wrapLength in
+Longest permissible line length, in pixels. Lines in \fIstring\fR will
+automatically be broken at word boundaries and wrapped when they reach
+this length. If \fIwrapLength\fR is too small for even a single
+character to fit on a line, it will be expanded to allow one character to
+fit on each line. If \fIwrapLength\fR is <= 0, there is no automatic
+wrapping; lines will get as long as they need to be and only wrap if a
+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.
+.VS 8.1
+Note that unlike the lower level text display routines, the functions
+described here all operate on character-oriented lengths and indices
+rather than byte-oriented values. See the description of
+\fBTcl_UtfAtIndex\fR for more details on converting between character
+and byte offsets.
+.VE 8.1
+.PP
+The routines described here are built on top of the programming interface
+described in the \fBTk_MeasureChars\fR documentation. Tab characters and
+newline/return characters may be treated specially by these procedures,
+but all other characters are passed through to the lower level.
+.PP
+\fBTk_ComputeTextLayout\fR computes the layout information needed to
+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/tcl/doc/TkInitStubs.3 b/tcl/doc/TkInitStubs.3
new file mode 100644
index 00000000000..3edd93555b4
--- /dev/null
+++ b/tcl/doc/TkInitStubs.3
@@ -0,0 +1,77 @@
+'\"
+'\" Copyright (c) 1999 Scriptics Corportation
+'\"
+'\" 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_InitStubs 3 8.4 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_InitStubs \- initialize the Tk stubs mechanism
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+CONST char *
+\fBTk_InitStubs\fR(\fIinterp, version, exact\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp in
+.AP Tcl_Interp *interp in
+Tcl interpreter handle.
+.AP char *version in
+A version string consisting of one or more decimal numbers
+separated by dots.
+.AP int exact in
+Non-zero means that only the particular Tk version specified by
+\fIversion\fR is acceptable.
+Zero means that versions newer than \fIversion\fR are also
+acceptable as long as they have the same major version number
+as \fIversion\fR.
+.BE
+.SH INTRODUCTION
+.PP
+The Tcl stubs mechanism defines a way to dynamically bind
+extensions to a particular Tcl implementation at run time.
+the stubs mechanism requires no changes to applications
+incoporating Tcl/Tk interpreters. Only developers creating
+C-based Tcl/Tk extensions need to take steps to use the
+stubs mechanism with their extensions.
+See the \fBTcl_InitStubs\fR page for more information.
+.PP
+Enabling the stubs mechanism for a Tcl/Tk extension requires the following
+steps:
+.IP 1) 5
+Call \fBTcl_InitStubs\fR in the extension before calling any other
+Tcl functions.
+.IP 2) 5
+Call \fBTk_InitStubs\fR if the extension before calling any other
+Tk functions.
+.IP 2) 5
+Define the USE_TCL_STUBS symbol. Typically, you would include the
+-DUSE_TCL_STUBS flag when compiling the extension.
+.IP 3) 5
+Link the extension with the Tcl and Tk stubs libraries instead of
+the standard Tcl and Tk libraries. On Unix platforms, the library
+names are \fIlibtclstub8.4.a\fR and \fIlibtkstub8.4.a\fR; on Windows
+platforms, the library names are \fItclstub84.lib\fR and \fItkstub84.lib\fR
+(adjust names with appropriate version number).
+.SH DESCRIPTION
+\fBTk_InitStubs\fR attempts to initialize the Tk stub table pointers
+and ensure that the correct version of Tk is loaded. In addition
+to an interpreter handle, it accepts as arguments a version number
+and a Boolean flag indicating whether the extension requires
+an exact version match or not. If \fIexact\fR is 0, then the
+extension is indicating that newer versions of Tk are acceptable
+as long as they have the same major version number as \fIversion\fR;
+non-zero means that only the specified \fIversion\fR is acceptable.
+\fBTcl_InitStubs\fR returns a string containing the actual version
+of Tk satisfying the request, or NULL if the Tk version is not
+acceptable, does not support the stubs mechansim, or any other
+error condition occurred.
+.SH "SEE ALSO"
+\fBTcl_InitStubs\fR
+.SH KEYWORDS
+stubs
diff --git a/tcl/doc/Tk_Init.3 b/tcl/doc/Tk_Init.3
new file mode 100644
index 00000000000..b9be1e227f5
--- /dev/null
+++ b/tcl/doc/Tk_Init.3
@@ -0,0 +1,88 @@
+'\"
+'\" 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 8.0 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_Init, Tk_SafeInit \- 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)
+.sp
+int
+\fBTk_SafeInit\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.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).
+.PP
+\fBTk_SafeInit\fR is identical to \fBTk_Init\fR except that it removes
+all Tk commands that are considered unsafe. Those commands and the
+reasons for their exclusion are:
+.TP
+\fBbell\fR
+Continuous ringing of the bell is a nuisance.
+.TP
+\fBclipboard\fR
+A malicious script could replace the contents of the clipboard with
+the string \fB"rm -r *"\fR and lead to surprises when the contents of
+the clipboard are pasted.
+.TP
+\fBgrab\fR
+Grab can be used to block the user from using any other applications.
+.TP
+\fBmenu\fR
+Menus can be used to cover the entire screen and to steal input from
+the user.
+.TP
+\fBselection\fR
+See clipboard.
+.TP
+\fBsend\fR
+Send can be used to cause unsafe interpreters to execute commands.
+.TP
+\fBtk\fR
+The tk command recreates the send command, which is unsafe.
+.TP
+\fBtkwait\fR
+Tkwait can block the containing process forever
+.TP
+\fBtoplevel\fR
+Toplevels can be used to cover the entire screen and to steal input
+from the user.
+.TP
+\fBwm\fR
+If toplevels are ever allowed, wm can be used to remove decorations,
+move windows around, etc.
+
+.SH KEYWORDS
+safe, application, initialization, load, main window
diff --git a/tcl/doc/Tk_Main.3 b/tcl/doc/Tk_Main.3
new file mode 100644
index 00000000000..72f506638ed
--- /dev/null
+++ b/tcl/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/tcl/doc/WindowId.3 b/tcl/doc/WindowId.3
new file mode 100644
index 00000000000..c414644597b
--- /dev/null
+++ b/tcl/doc/WindowId.3
@@ -0,0 +1,186 @@
+'\"
+'\" 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 "8.4" 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_IsContainer, Tk_IsEmbedded, Tk_IsMapped, Tk_IsTopLevel, Tk_ReqWidth, Tk_ReqHeight, Tk_MinReqWidth, Tk_MinReqHeight, Tk_InternalBorderLeft, Tk_InternalBorderRight, Tk_InternalBorderTop, Tk_InternalBorderBottom, 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
+CONST 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_IsContainer\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_IsEmbedded\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_MinReqWidth\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_MinReqHeight\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_InternalBorderLeft\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_InternalBorderRight\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_InternalBorderTop\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_InternalBorderBottom\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_IsContainer\fR returns a non-zero value if \fItkwin\fR
+is a container, and that some other application may be embedding
+itself inside \fItkwin\fR.
+.PP
+\fBTk_IsEmbedded\fR returns a non-zero value if \fItkwin\fR
+is is not a free-standing window, but rather is embedded in some
+other application.
+.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_MinReqWidth\fR and \fBTk_MinReqHeight\fR return information about
+the window's minimum requested size. These values correspond to the last
+call to \fBTk_SetMinimumRequestSize\fR for \fItkwin\fR.
+.PP
+\fBTk_InternalBorderLeft\fR, \fBTk_InternalBorderRight\fR,
+\fBTk_InternalBorderTop\fR and \fBTk_InternalBorderBottom\fR
+return the width of one side of the 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 or \fBTk_SetInternalBorderEx\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/tcl/doc/bell.n b/tcl/doc/bell.n
new file mode 100644
index 00000000000..3b0e50cbd86
--- /dev/null
+++ b/tcl/doc/bell.n
@@ -0,0 +1,35 @@
+'\"
+'\" Copyright (c) 1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Ajuba Solutions.
+'\"
+'\" 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 8.4 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? ?\fB\-nice\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
+If \fB\-nice\fR is not specified, 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/tcl/doc/bind.n b/tcl/doc/bind.n
new file mode 100644
index 00000000000..82b3e1b6d67
--- /dev/null
+++ b/tcl/doc/bind.n
@@ -0,0 +1,531 @@
+'\"
+'\" 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 \fBQuadruple\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, \fBTriple\fR and \fBQuadruple\fR modifiers are a
+convenience for specifying double mouse clicks and other repeated
+events. They cause a particular event pattern to be repeated 2, 3 or 4
+times, and also place a time and space requirement on the sequence: for a
+sequence of events to match a \fBDouble\fR, \fBTriple\fR or \fBQuadruple\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
+.ta 5c 10c
+\fBActivate Destroy Map
+ButtonPress, Button Enter MapRequest
+ButtonRelease Expose Motion
+Circulate FocusIn MouseWheel
+CirculateRequest FocusOut Property
+Colormap Gravity Reparent
+Configure KeyPress, Key ResizeRequest
+ConfigureRequest KeyRelease Unmap
+Create Leave Visibility
+Deactivate\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 \fBConfigureRequest\fR events, the string will be one of:
+.DS
+.ta 6c
+\fBAbove Opposite
+Below None
+BottomIf TopIf\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,
+\fBConfigureRequest\fR, \fBCreate\fR, \fBResizeRequest\fR, and
+\fBExpose\fR events.
+.VE
+.IP \fB%i\fR 5
+The \fIwindow\fR field from the event, represented as a hexadecimal
+integer.
+.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 and \fBCirculateRequest\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, \fBConfigureRequest\fR, \fBCreate\fR,
+\fBResizeRequest\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, \fBConfigureRequest\fR, and \fBCreate\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.
+.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.
+(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.
+.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, keysyms
+
+.SH KEYWORDS
+form, manual
diff --git a/tcl/doc/bindtags.n b/tcl/doc/bindtags.n
new file mode 100644
index 00000000000..20e5291f459
--- /dev/null
+++ b/tcl/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/tcl/doc/bitmap.n b/tcl/doc/bitmap.n
new file mode 100644
index 00000000000..0fa1c5afda9
--- /dev/null
+++ b/tcl/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/tcl/doc/button.n b/tcl/doc/button.n
new file mode 100644
index 00000000000..ca07c4827cd
--- /dev/null
+++ b/tcl/doc/button.n
@@ -0,0 +1,198 @@
+'\"
+'\" 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 \-foreground \-repeatdelay
+\-activeforeground \-highlightbackground \-repeatinterval
+\-anchor \-highlightcolor \-takefocus
+\-background \-highlightthickness \-text
+\-bitmap \-image \-textvariable
+\-borderwidth \-justify \-underline
+\-cursor \-padx \-wraplength
+\-disabledforeground \-pady
+\-font \-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.
+.VS 8.4
+.OP \-compound compound Compound
+Specifies whether the button should display both an image and text,
+and if so, where the image should be placed relative to the text.
+Valid values for this option are \fBbottom\fR, \fBcenter\fR,
+\fBleft\fR, \fBnone\fR, \fBright\fR and \fBtop\fR. The default value
+is \fBnone\fR, meaning that the button will display either an image or
+text, depending on the values of the \fB\-image\fR and \fB\-bitmap\fR
+options.
+.VE
+.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.
+.VS 8.4
+.OP \-overrelief overRelief OverRelief
+Specifies an alternative relief for the button, to be used when the
+mouse cursor is over the widget. This option can be used to make
+toolbar buttons, by configuring \fB\-relief flat \-overrelief
+raised\fR. If the value of this option is the empty string, then no
+alternative relief is used when the mouse cursor is over the button.
+The empty string is the default value.
+.VE 8.4
+.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/tcl/doc/canvas.n b/tcl/doc/canvas.n
new file mode 100644
index 00000000000..b67622799a2
--- /dev/null
+++ b/tcl/doc/canvas.n
@@ -0,0 +1,1750 @@
+'\"
+'\" Copyright (c) 1992-1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1997-1999 Scriptics Corporation.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH canvas n 8.3 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 \-insertborderwidth \-selectborderwidth
+\-borderwidth \-insertofftime \-selectforeground
+\-cursor \-insertontime \-takefocus
+\-highlightbackground \-insertwidth \-xscrollcommand
+\-highlightcolor \-relief \-yscrollcommand
+\-highlightthickness \-state
+\-insertbackground \-selectbackground
+.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 \-state state State
+Modifies the default state of the canvas where \fIstate\fR may be set to
+one of: \fBnormal\fR, \fBdisabled\fR, or \fBhidden\fR. Individual canvas
+objects all have their own state option which may override the default
+state. Many options can take separate specifications such that the
+appearance of the item can be different in different situations. The
+options that start with \fBactive\fR control the appearence when the mouse
+pointer is over it, while the option starting with \fBdisabled\fR controls
+the appearence when the state is disabled. Canvas items which are
+\fBdisabled\fR will not react to canvas bindings.
+.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.
+.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.
+.PP
+\fItagOrId\fR may contain a logical expressions of
+tags by using operators: '&&', '||', '^' '!', and parenthezised
+subexpressions. For example:
+.CS
+ .c find withtag {(a&&!b)||(!a&&b)}
+.CE
+or equivalently:
+.CS
+ .c find withtag {a^b}
+.CE
+will find only those items with either "a" or "b" tags, but not both.
+.PP
+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.
+.VS
+Coordinates can be specified either as an even number of parameters,
+or as a single list parameter containing an even number of x and y
+coordinate values.
+.VE
+
+.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.
+In a similar fashion, line and polygon items support \fIindex\fR for
+identifying, inserting and deleting subsets of their coordinates.
+Indices are used for commands such as inserting or deleting
+a range of characters or coordinates, 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.
+Lines and Polygons don't support the insertion cursor
+and the selection. Their indixes are supposed to be even
+always, because coordinates always appear in pairs.
+.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. If indexes are odd for lines and polygons, they will be
+automatically decremented by one.
+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. For
+polygons, numbers less than 0 or greater then the length
+of the coordinate list will be adjusted by adding or substracting
+the length until the result is between zero and the length,
+inclusive.
+.TP 10
+\fBend\fR
+Refers to the character or coordinate just after the last one
+in the item (same as the number of characters or coordinates
+in the item).
+.TP 10
+\fBinsert\fR
+Refers to the character just before which the insertion cursor
+is drawn in this item. Not valid for lines and polygons.
+.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 or coordinate 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 "DASH PATTERNS"
+.PP
+Many items support the notion of an dash pattern for outlines.
+.PP
+The first possible syntax is a list of integers. Each element
+represents the number of pixels of a line segment. Only the odd
+segments are drawn using the "outline" color. The other segments
+are drawn transparant.
+.PP
+The second possible syntax is a character list containing only
+5 possible characters \fB[.,-_ ]\fR. The space can be used
+to enlarge the space between other line elements, and can not
+occur as the first position in the string. Some examples:
+ -dash . = -dash {2 4}
+ -dash - = -dash {6 4}
+ -dash -. = -dash {6 4 2 4}
+ -dash -.. = -dash {6 4 2 4 2 4}
+ -dash {. } = -dash {2 8}
+ -dash , = -dash {4 4}
+.PP
+The main difference of this syntax with the previous is that it
+it shape-conserving. This means that all values in the dash
+list will be multiplied by the line width before display. This
+assures that "." will always be displayed as a dot and "-"
+always as a dash regardless of the line width.
+.PP
+On systems which support only a limited set of dash patterns, the dash
+pattern will be displayed as the closest dash pattern that is available.
+For example, on Windows only the first 4 of the above examples are
+available. The last 2 examples will be displayed identically to the first
+one.
+
+.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
+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.
+.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?
+.TP
+\fIpathName\fR \fBcoords \fItagOrId \fR?\fIcoordList\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?
+.TP
+\fIpathName \fBcreate \fItype coordList \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, or coordinates,
+in the range given by \fIfirst\fR and \fIlast\fR, inclusive.
+If some of the items given by \fItagOrId\fR don't support
+indexing operations then they ignore dchars.
+Text items interpret \fIfirst\fR and \fIlast\fR as indices to a character,
+line and polygon items interpret them indices to a coordinate (an x,y pair).
+Indices are 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.
+Text items interpret \fIindex\fR as an index to a character,
+line and polygon items interpret it as an index to a coordinate (an x,y pair).
+The return value is guaranteed to lie between 0 and the number
+of characters, or coordinates, 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 or coordinate, insertion then \fIstring\fR is inserted into the item's
+text just before the character, or coordinate, whose index is \fIbeforeThis\fR.
+Text items interpret \fIbeforethis\fR as an index to a character,
+line and polygon items interpret it as an index to a coordinate (an x,y pair).
+For lines and polygons the \fIstring\fR must be a valid coordinate
+sequence.
+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.
+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.
+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 ?gain?\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 \fIgain\fR times the
+difference in coordinates, where \fIgain\fR defaults to 10.
+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, text, line and polygon items provide this support.
+For lines and polygons the indexing facility is used to manipulate
+the coordinates of the item.
+
+.SH "COMMON ITEM OPTIONS"
+.PP
+Many items share a common set of options. These options are
+explained here, and then referred to be each widget type for brevity.
+.PP
+.TP
+\fB\-dash \fIpattern\fR
+.TP
+\fB\-activedash \fIpattern\fR
+.TP
+\fB\-disableddash \fIpattern\fR
+This option specifies dash patterns for the normal, active
+state, and disabled state of an item.
+\fIpattern\fR may have any of the forms accepted by \fBTk_GetDash\fR.
+If the dash options are omitted then the default is a solid outline.
+See "DASH PATTERNS" for more information.
+.TP
+\fB\-dashoffset \fIoffset\fR
+The starting \fIoffset\fR in pixels into the pattern provided by the
+\fB\-dash\fR option. \fB\-dashoffset\fR is ignored if there is no
+\fB-dash\fR pattern. The \fIoffset\fR may have any of the forms described
+in the COORDINATES section above.
+.TP
+\fB\-fill \fIcolor\fR
+.TP
+\fB\-activefill \fIcolor\fR
+.TP
+\fB\-disabledfill \fIcolor\fR
+Specifies the color to be used to fill item's area.
+in its normal, active, and disabled states,
+\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 item will not be filled.
+For the line item, it specifies the color of the line drawn.
+For the text item, it specifies the foreground color of the text.
+.TP
+\fB\-outline \fIcolor\fR
+.TP
+\fB\-activeoutline \fIcolor\fR
+.TP
+\fB\-disabledoutline \fIcolor\fR
+This option specifies the color that should be used to draw the
+outline of the item in its normal, active and disabled states.
+\fIColor\fR 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 item.
+.TP
+\fB\-offset \fIoffset\fR
+Specifies the offset of stipples. The offset value can be of the form
+\fBx,y\fR or \fBside\fR, where side can be \fBn\fR, \fBne\fR, \fBe\fR,
+\fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR. In the
+first case the origin is the origin of the toplevel of the current window.
+For the canvas itself and canvas objects the origin is the canvas origin,
+but putting \fB#\fR in front of the coordinate pair indicates using the
+toplevel origin instead. For canvas objects, the \fB-offset\fR option is
+used for stippling as well. For the line and polygon canvas items you can
+also specify an index as argument, which connects the stipple origin to one
+of the coordinate points of the line/polygon.
+.TP
+\fB\-outlinestipple \fIbitmap\fR
+.TP
+\fB\-activeoutlinestipple \fIbitmap\fR
+.TP
+\fB\-disabledoutlinestipple \fIbitmap\fR
+This option specifies stipple patterns that should be used to draw the
+outline of the item in its normal, active and disabled states.
+Indicates that the outline for the item 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\-stipple \fIbitmap\fR
+.TP
+\fB\-activestipple \fIbitmap\fR
+.TP
+\fB\-disabledstipple \fIbitmap\fR
+This option specifies stipple patterns that should be used to fill the
+the item in its normal, active and disabled states.
+\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.
+For the text item, it affects the actual text.
+.TP
+\fB\-state \fIstate\fR
+This allows an item to override the canvas widget's global \fIstate\fR
+option. It takes the same values:
+\fInormal\fR, \fIdisabled\fR or \fIhidden\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.
+.TP
+\fB\-width \fIoutlineWidth\fR
+.TP
+\fB\-activewidth \fIoutlineWidth\fR
+.TP
+\fB\-disabledwidth \fIoutlineWidth\fR
+Specifies the width of the outline to be drawn around
+the item's region, in its normal, active and disabled states.
+\fIoutlineWidth\fR may be 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. This option defaults to 1.0.
+For arcs, wide outlines will be drawn centered on the edges of the
+arc's region.
+
+.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?
+\fIpathName \fBcreate arc \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\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.
+.br
+The following standard options are supported by arcs:
+.CS
+\-dash
+\-activedash
+\-disableddash
+\-dashoffset
+\-fill
+\-activefill
+\-disabledfill
+\-offset
+\-outline
+\-activeoutline
+\-disabledoutline
+\-outlinestipple
+\-activeoutlinestipple
+\-disabledoutlinestipple
+\-stipple
+\-activestipple
+\-disabledstipple
+\-state
+\-tags
+\-width
+\-activewidth
+\-disabledwidth
+.CE
+The following extra 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\-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\-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.
+
+.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?
+\fIpathName \fBcreate bitmap \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR or \fIcoordList\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.
+.br
+The following standard options are supported by bitmaps:
+.CS
+\-state
+\-tags
+.CE
+The following extra 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
+.TP
+\fB\-activebackground \fIbitmap\fR
+.TP
+\fB\-disabledbackground \fIbitmap\fR
+Specifies the color to use for each of the bitmap's '0' valued pixels
+in its normal, active and disabled states.
+\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
+.TP
+\fB\-activebitmap \fIbitmap\fR
+.TP
+\fB\-disabledbitmap \fIbitmap\fR
+Specifies the bitmaps to display in the item in its normal, active and
+disabled states.
+\fIBitmap\fR may have any of the forms accepted by \fBTk_GetBitmap\fR.
+.TP
+\fB\-foreground \fIcolor\fR
+.TP
+\fB\-activeforeground \fIbitmap\fR
+.TP
+\fB\-disabledforeground \fIbitmap\fR
+Specifies the color to use for each of the bitmap's '1' valued pixels
+in its normal, active and disabled states.
+\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR and
+defaults to \fBblack\fR.
+
+.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?
+\fIpathName \fBcreate image \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR or \fIcoordList\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.
+.br
+The following standard options are supported by images:
+.CS
+\-state
+\-tags
+.CE
+The following extra 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
+.TP
+\fB\-activeimage \fIname\fR
+.TP
+\fB\-disabledimage \fIname\fR
+Specifies the name of the images to display in the item in is normal,
+active and disabled states.
+This image must have been created previously with the
+\fBimage create\fR command.
+
+.SH "LINE ITEMS"
+.PP
+Items of type \fBline\fR appear on the display as one or more connected
+line segments or curves.
+Line items support coordinate indexing operations using the canvas
+widget commands: \fBdchars, index, insert.\fR
+Lines are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate line \fIx1 y1... xn yn \fR?\fIoption value option value ...\fR?
+\fIpathName \fBcreate line \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR through \fIyn\fR or \fIcoordList\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.
+.br
+The following standard options are supported by lines:
+.CS
+\-dash
+\-activedash
+\-disableddash
+\-dashoffset
+\-fill
+\-activefill
+\-disabledfill
+\-stipple
+\-activestipple
+\-disabledstipple
+\-state
+\-tags
+\-width
+\-activewidth
+\-disabledwidth
+.CE
+The following extra 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\-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 \fIsmoothMethod\fR
+\fIsmoothMethod\fR must have one of the forms accepted by
+\fBTk_GetBoolean\fR or a line smoothing method. Only \fBbezier\fR is
+supported in the core, but more can be added at runtime. If a boolean
+false value or empty string is given, no smoothing is applied. A boolean
+truth value assume \fBbezier\fR smoothing.
+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.
+
+.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?
+\fIpathName \fBcreate oval \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\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.
+.br
+The following standard options are supported by ovals:
+.CS
+\-dash
+\-activedash
+\-disableddash
+\-dashoffset
+\-fill
+\-activefill
+\-disabledfill
+\-offset
+\-outline
+\-activeoutline
+\-disabledoutline
+\-outlinestipple
+\-activeoutlinestipple
+\-disabledoutlinestipple
+\-stipple
+\-activestipple
+\-disabledstipple
+\-state
+\-tags
+\-width
+\-activewidth
+\-disabledwidth
+.CE
+
+.SH "POLYGON ITEMS"
+.PP
+Items of type \fBpolygon\fR appear as polygonal or curved filled regions
+on the display.
+Polygon items support coordinate indexing operations using the canvas
+widget commands: \fBdchars, index, insert.\fR
+Polygons are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate polygon \fIx1 y1 ... xn yn \fR?\fIoption value option value ...\fR?
+\fIpathName \fBcreate polygon \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR through \fIyn\fR or \fIcoordList\fR specify the coordinates for
+three or more points that define a polygon.
+The first point should not be repeated as the last to
+close the shape; Tk will automatically close the periphery between
+the first and last points.
+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.
+.br
+The following standard options are supported by polygons:
+.CS
+\-dash
+\-activedash
+\-disableddash
+\-dashoffset
+\-fill
+\-activefill
+\-disabledfill
+\-offset
+\-outline
+\-activeoutline
+\-disabledoutline
+\-outlinestipple
+\-activeoutlinestipple
+\-disabledoutlinestipple
+\-stipple
+\-activestipple
+\-disabledstipple
+\-state
+\-tags
+\-width
+\-activewidth
+\-disabledwidth
+.CE
+The following extra options are supported for polygons:
+.TP
+\fB\-joinstyle \fIstyle\fR
+Specifies the ways in which joints are to be drawn at the vertices
+of the outline.
+\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.
+.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.
+.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?
+\fIpathName \fBcreate rectangle \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\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.
+.br
+The following standard options are supported by rectangles:
+.CS
+\-dash
+\-activedash
+\-disableddash
+\-dashoffset
+\-fill
+\-activefill
+\-disabledfill
+\-offset
+\-outline
+\-activeoutline
+\-disabledoutline
+\-outlinestipple
+\-activeoutlinestipple
+\-disabledoutlinestipple
+\-stipple
+\-activestipple
+\-disabledstipple
+\-state
+\-tags
+\-width
+\-activewidth
+\-disabledwidth
+.CE
+
+.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?
+\fIpathName \fBcreate text \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR or \fIcoordList\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.
+.br
+The following standard options are supported by text items:
+.CS
+\-fill
+\-activefill
+\-disabledfill
+\-stipple
+\-activestipple
+\-disabledstipple
+\-state
+\-tags
+.CE
+The following extra 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\-font \fIfontName\fR
+Specifies the font to use for the text item.
+\fIFontName\fR may be any string acceptable to \fBTk_GetFont\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\-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?
+\fIpathName \fBcreate window \fIcoordList\fR ?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR or \fIcoordList\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.
+.br
+The following standard options are supported by window items:
+.CS
+\-state
+\-tags
+.CE
+The following extra 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\-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/tcl/doc/checkbutton.n b/tcl/doc/checkbutton.n
new file mode 100644
index 00000000000..15e457f47c1
--- /dev/null
+++ b/tcl/doc/checkbutton.n
@@ -0,0 +1,260 @@
+'\"
+'\" 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 \-font \-pady
+\-activeforeground \-foreground \-relief
+\-anchor \-highlightbackground \-takefocus
+\-background \-highlightcolor \-text
+\-bitmap \-highlightthickness \-textvariable
+\-borderwidth \-image \-underline
+\-cursor \-justify \-wraplength
+\-disabledforeground \-padx
+.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.
+.VS 8.4
+.OP \-offrelief offRelief OffRelief
+Specifies the relief for the checkbutton when the indicator is not drawn and
+the checkbutton is off. The default value is "raised". By setting this option
+to "flat" and setting -indicatoron to false and -overrelief to raised,
+the effect is achieved
+of having a flat button that raises on mouse-over and which is
+depressed when activated. This is the behavior typically exhibited by
+the Bold, Italic, and Underline checkbuttons on the toolbar of a
+word-processor, for example.
+.VE 8.4
+.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''.
+.VS 8.4
+.OP \-overrelief overRelief OverRelief
+Specifies an alternative relief for the checkbutton, to be used when the
+mouse cursor is over the widget. This option can be used to make
+toolbar buttons, by configuring \fB\-relief flat \-overrelief
+raised\fR. If the value of this option is the empty string, then no
+alternative relief is used when the mouse cursor is over the checkbutton.
+The empty string is the default value.
+.VE 8.4
+.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/tcl/doc/chooseColor.n b/tcl/doc/chooseColor.n
new file mode 100644
index 00000000000..18b5feffe2f
--- /dev/null
+++ b/tcl/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/tcl/doc/chooseDirectory.n b/tcl/doc/chooseDirectory.n
new file mode 100644
index 00000000000..17edd7e5cc3
--- /dev/null
+++ b/tcl/doc/chooseDirectory.n
@@ -0,0 +1,52 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH tk_chooseDirectory n 8.3 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+tk_chooseDirectory \- pops up a dialog box for the user to select a directory.
+.PP
+.SH SYNOPSIS
+\fBtk_chooseDirectory \fR?\fIoption value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The procedure \fBtk_chooseDirectory\fR pops up a dialog box for the
+user to select a directory. The following \fIoption\-value\fR pairs are
+possible as command line arguments:
+.TP
+\fB\-initialdir\fR \fIdirname\fR
+Specifies that the directories in \fIdirectory\fR should be displayed
+when the dialog pops up. If this parameter is not specified, then
+the directories 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\-parent\fR \fIwindow\fR
+Makes \fIwindow\fR the logical parent of the dialog. The 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.
+.TP
+\fB\-mustexist\fR \fIboolean\fR
+Specifies whether the user may specify non-existant directories. If
+this parameter is true, then the user may only select directories that
+already exist. The default value is \fIfalse\fR.
+.LP
+
+.SH "SEE ALSO"
+tk_getOpenFile, tk_getSaveFile
+
+.SH KEYWORDS
+directory selection dialog
diff --git a/tcl/doc/clipboard.n b/tcl/doc/clipboard.n
new file mode 100644
index 00000000000..0825cf8c0ff
--- /dev/null
+++ b/tcl/doc/clipboard.n
@@ -0,0 +1,94 @@
+'\"
+'\" 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 8.4 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
+(via the \fB-selection CLIPBOARD\fR option).
+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
+.TP
+.VS 8.4
+\fBclipboard get\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-type\fR?
+Retrieve data from the clipboard on \fIwindow\fR's display.
+\fIwindow\fR defaults to ".". \fIType\fR specifies the form in which
+the data is to be returned and should be an atom name such as STRING
+or FILE_NAME. \fIType\fR defaults to STRING. This command is
+equivalent to \fBselection get -selection CLIPBOARD\fR.
+.VE 8.4
+
+.SH "SEE ALSO"
+selection
+
+.SH KEYWORDS
+clear, format, clipboard, append, selection, type
diff --git a/tcl/doc/colors.n b/tcl/doc/colors.n
new file mode 100644
index 00000000000..239de5bcd02
--- /dev/null
+++ b/tcl/doc/colors.n
@@ -0,0 +1,782 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\"
+.so man.macros
+.TH colors n 8.3 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+colors \- symbolic color names recognized by Tk
+.BE
+.SH DESCRIPTION
+.PP
+Tk recognizes many symbolic color names (eg, \fBred\fR) when
+specifying colors. The symbolic names recognized by Tk and their
+8-bit RGB values are:
+.CS
+alice blue 240 248 248
+AliceBlue 240 248 248
+antique white 250 235 235
+AntiqueWhite 250 235 235
+AntiqueWhite1 255 239 239
+AntiqueWhite2 238 223 223
+AntiqueWhite3 205 192 192
+AntiqueWhite4 139 131 131
+aquamarine 127 255 255
+aquamarine1 127 255 255
+aquamarine2 118 238 238
+aquamarine3 102 205 205
+aquamarine4 69 139 139
+azure 240 255 255
+azure1 240 255 255
+azure2 224 238 238
+azure3 193 205 205
+azure4 131 139 139
+beige 245 245 245
+bisque 255 228 228
+bisque1 255 228 228
+bisque2 238 213 213
+bisque3 205 183 183
+bisque4 139 125 125
+black 0 0 0
+blanched almond 255 235 235
+BlanchedAlmond 255 235 235
+blue 0 0 255
+blue violet 138 43 43
+blue1 0 0 255
+blue2 0 0 238
+blue3 0 0 205
+blue4 0 0 139
+BlueViolet 138 43 43
+brown 165 42 42
+brown1 255 64 64
+brown2 238 59 59
+brown3 205 51 51
+brown4 139 35 35
+burlywood 222 184 184
+burlywood1 255 211 211
+burlywood2 238 197 197
+burlywood3 205 170 170
+burlywood4 139 115 115
+cadet blue 95 158 158
+CadetBlue 95 158 158
+CadetBlue1 152 245 245
+CadetBlue2 142 229 229
+CadetBlue3 122 197 197
+CadetBlue4 83 134 134
+chartreuse 127 255 255
+chartreuse1 127 255 255
+chartreuse2 118 238 238
+chartreuse3 102 205 205
+chartreuse4 69 139 139
+chocolate 210 105 105
+chocolate1 255 127 127
+chocolate2 238 118 118
+chocolate3 205 102 102
+chocolate4 139 69 69
+coral 255 127 127
+coral1 255 114 114
+coral2 238 106 106
+coral3 205 91 91
+coral4 139 62 62
+cornflower blue 100 149 149
+CornflowerBlue 100 149 149
+cornsilk 255 248 248
+cornsilk1 255 248 248
+cornsilk2 238 232 232
+cornsilk3 205 200 200
+cornsilk4 139 136 136
+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 134
+dark gray 169 169 169
+dark green 0 100 100
+dark grey 169 169 169
+dark khaki 189 183 183
+dark magenta 139 0 0
+dark olive green 85 107 107
+dark orange 255 140 140
+dark orchid 153 50 50
+dark red 139 0 0
+dark salmon 233 150 150
+dark sea green 143 188 188
+dark slate blue 72 61 61
+dark slate gray 47 79 79
+dark slate grey 47 79 79
+dark turquoise 0 206 206
+dark violet 148 0 0
+DarkBlue 0 0 139
+DarkCyan 0 139 139
+DarkGoldenrod 184 134 134
+DarkGoldenrod1 255 185 185
+DarkGoldenrod2 238 173 173
+DarkGoldenrod3 205 149 149
+DarkGoldenrod4 139 101 101
+DarkGray 169 169 169
+DarkGreen 0 100 100
+DarkGrey 169 169 169
+DarkKhaki 189 183 183
+DarkMagenta 139 0 0
+DarkOliveGreen 85 107 107
+DarkOliveGreen1 202 255 255
+DarkOliveGreen2 188 238 238
+DarkOliveGreen3 162 205 205
+DarkOliveGreen4 110 139 139
+DarkOrange 255 140 140
+DarkOrange1 255 127 127
+DarkOrange2 238 118 118
+DarkOrange3 205 102 102
+DarkOrange4 139 69 69
+DarkOrchid 153 50 50
+DarkOrchid1 191 62 62
+DarkOrchid2 178 58 58
+DarkOrchid3 154 50 50
+DarkOrchid4 104 34 34
+DarkRed 139 0 0
+DarkSalmon 233 150 150
+DarkSeaGreen 143 188 188
+DarkSeaGreen1 193 255 255
+DarkSeaGreen2 180 238 238
+DarkSeaGreen3 155 205 205
+DarkSeaGreen4 105 139 139
+DarkSlateBlue 72 61 61
+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 206
+DarkViolet 148 0 0
+deep pink 255 20 20
+deep sky blue 0 191 191
+DeepPink 255 20 20
+DeepPink1 255 20 20
+DeepPink2 238 18 18
+DeepPink3 205 16 16
+DeepPink4 139 10 10
+DeepSkyBlue 0 191 191
+DeepSkyBlue1 0 191 191
+DeepSkyBlue2 0 178 178
+DeepSkyBlue3 0 154 154
+DeepSkyBlue4 0 104 104
+dim gray 105 105 105
+dim grey 105 105 105
+DimGray 105 105 105
+DimGrey 105 105 105
+dodger blue 30 144 144
+DodgerBlue 30 144 144
+DodgerBlue1 30 144 144
+DodgerBlue2 28 134 134
+DodgerBlue3 24 116 116
+DodgerBlue4 16 78 78
+firebrick 178 34 34
+firebrick1 255 48 48
+firebrick2 238 44 44
+firebrick3 205 38 38
+firebrick4 139 26 26
+floral white 255 250 250
+FloralWhite 255 250 250
+forest green 34 139 139
+ForestGreen 34 139 139
+gainsboro 220 220 220
+ghost white 248 248 248
+GhostWhite 248 248 248
+gold 255 215 215
+gold1 255 215 215
+gold2 238 201 201
+gold3 205 173 173
+gold4 139 117 117
+goldenrod 218 165 165
+goldenrod1 255 193 193
+goldenrod2 238 180 180
+goldenrod3 205 155 155
+goldenrod4 139 105 105
+gray 190 190 190
+gray0 0 0 0
+gray1 3 3 3
+gray2 5 5 5
+gray3 8 8 8
+gray4 10 10 10
+gray5 13 13 13
+gray6 15 15 15
+gray7 18 18 18
+gray8 20 20 20
+gray9 23 23 23
+gray10 26 26 26
+gray11 28 28 28
+gray12 31 31 31
+gray13 33 33 33
+gray14 36 36 36
+gray15 38 38 38
+.CE
+.CS
+gray16 41 41 41
+gray17 43 43 43
+gray18 46 46 46
+gray19 48 48 48
+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
+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
+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
+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
+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
+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
+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
+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
+gray100 255 255 255
+green 0 255 255
+green yellow 173 255 255
+green1 0 255 255
+green2 0 238 238
+green3 0 205 205
+green4 0 139 139
+GreenYellow 173 255 255
+grey 190 190 190
+grey0 0 0 0
+grey1 3 3 3
+grey2 5 5 5
+grey3 8 8 8
+grey4 10 10 10
+grey5 13 13 13
+grey6 15 15 15
+grey7 18 18 18
+grey8 20 20 20
+grey9 23 23 23
+grey10 26 26 26
+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
+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
+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
+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
+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
+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
+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
+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
+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
+grey100 255 255 255
+honeydew 240 255 255
+honeydew1 240 255 255
+honeydew2 224 238 238
+honeydew3 193 205 205
+honeydew4 131 139 139
+hot pink 255 105 105
+.CE
+.CS
+HotPink 255 105 105
+HotPink1 255 110 110
+HotPink2 238 106 106
+HotPink3 205 96 96
+HotPink4 139 58 58
+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 255
+ivory1 255 255 255
+ivory2 238 238 238
+ivory3 205 205 205
+ivory4 139 139 139
+khaki 240 230 230
+khaki1 255 246 246
+khaki2 238 230 230
+khaki3 205 198 198
+khaki4 139 134 134
+lavender 230 230 230
+lavender blush 255 240 240
+LavenderBlush 255 240 240
+LavenderBlush1 255 240 240
+LavenderBlush2 238 224 224
+LavenderBlush3 205 193 193
+LavenderBlush4 139 131 131
+lawn green 124 252 252
+LawnGreen 124 252 252
+lemon chiffon 255 250 250
+LemonChiffon 255 250 250
+LemonChiffon1 255 250 250
+LemonChiffon2 238 233 233
+LemonChiffon3 205 201 201
+LemonChiffon4 139 137 137
+light blue 173 216 216
+light coral 240 128 128
+light cyan 224 255 255
+light goldenrod 238 221 221
+light goldenrod yellow 250 250 250
+light gray 211 211 211
+light green 144 238 238
+light grey 211 211 211
+light pink 255 182 182
+light salmon 255 160 160
+light sea green 32 178 178
+light sky blue 135 206 206
+light slate blue 132 112 112
+light slate gray 119 136 136
+light slate grey 119 136 136
+light steel blue 176 196 196
+light yellow 255 255 255
+LightBlue 173 216 216
+LightBlue1 191 239 239
+LightBlue2 178 223 223
+LightBlue3 154 192 192
+LightBlue4 104 131 131
+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 221
+LightGoldenrod1 255 236 236
+LightGoldenrod2 238 220 220
+LightGoldenrod3 205 190 190
+LightGoldenrod4 139 129 129
+LightGoldenrodYellow 250 250 250
+LightGray 211 211 211
+LightGreen 144 238 238
+LightGrey 211 211 211
+LightPink 255 182 182
+LightPink1 255 174 174
+LightPink2 238 162 162
+LightPink3 205 140 140
+LightPink4 139 95 95
+LightSalmon 255 160 160
+LightSalmon1 255 160 160
+LightSalmon2 238 149 149
+LightSalmon3 205 129 129
+LightSalmon4 139 87 87
+LightSeaGreen 32 178 178
+LightSkyBlue 135 206 206
+LightSkyBlue1 176 226 226
+LightSkyBlue2 164 211 211
+LightSkyBlue3 141 182 182
+LightSkyBlue4 96 123 123
+LightSlateBlue 132 112 112
+LightSlateGray 119 136 136
+LightSlateGrey 119 136 136
+LightSteelBlue 176 196 196
+LightSteelBlue1 202 225 225
+LightSteelBlue2 188 210 210
+LightSteelBlue3 162 181 181
+LightSteelBlue4 110 123 123
+LightYellow 255 255 255
+LightYellow1 255 255 255
+LightYellow2 238 238 238
+LightYellow3 205 205 205
+LightYellow4 139 139 139
+lime green 50 205 205
+LimeGreen 50 205 205
+linen 250 240 240
+magenta 255 0 0
+magenta1 255 0 0
+magenta2 238 0 0
+magenta3 205 0 0
+magenta4 139 0 0
+maroon 176 48 48
+maroon1 255 52 52
+maroon2 238 48 48
+maroon3 205 41 41
+maroon4 139 28 28
+medium aquamarine 102 205 205
+medium blue 0 0 205
+medium orchid 186 85 85
+medium purple 147 112 112
+medium sea green 60 179 179
+medium slate blue 123 104 104
+medium spring green 0 250 250
+medium turquoise 72 209 209
+medium violet red 199 21 21
+MediumAquamarine 102 205 205
+MediumBlue 0 0 205
+MediumOrchid 186 85 85
+MediumOrchid1 224 102 102
+MediumOrchid2 209 95 95
+MediumOrchid3 180 82 82
+MediumOrchid4 122 55 55
+MediumPurple 147 112 112
+MediumPurple1 171 130 130
+MediumPurple2 159 121 121
+MediumPurple3 137 104 104
+MediumPurple4 93 71 71
+MediumSeaGreen 60 179 179
+MediumSlateBlue 123 104 104
+MediumSpringGreen 0 250 250
+MediumTurquoise 72 209 209
+MediumVioletRed 199 21 21
+midnight blue 25 25 25
+MidnightBlue 25 25 25
+mint cream 245 255 255
+MintCream 245 255 255
+misty rose 255 228 228
+MistyRose 255 228 228
+MistyRose1 255 228 228
+MistyRose2 238 213 213
+MistyRose3 205 183 183
+MistyRose4 139 125 125
+moccasin 255 228 228
+navajo white 255 222 222
+NavajoWhite 255 222 222
+NavajoWhite1 255 222 222
+NavajoWhite2 238 207 207
+NavajoWhite3 205 179 179
+NavajoWhite4 139 121 121
+navy 0 0 128
+navy blue 0 0 128
+NavyBlue 0 0 128
+old lace 253 245 245
+OldLace 253 245 245
+olive drab 107 142 142
+OliveDrab 107 142 142
+OliveDrab1 192 255 255
+OliveDrab2 179 238 238
+OliveDrab3 154 205 205
+OliveDrab4 105 139 139
+orange 255 165 165
+orange red 255 69 69
+orange1 255 165 165
+orange2 238 154 154
+orange3 205 133 133
+orange4 139 90 90
+OrangeRed 255 69 69
+OrangeRed1 255 69 69
+OrangeRed2 238 64 64
+OrangeRed3 205 55 55
+OrangeRed4 139 37 37
+orchid 218 112 112
+orchid1 255 131 131
+orchid2 238 122 122
+orchid3 205 105 105
+orchid4 139 71 71
+pale goldenrod 238 232 232
+pale green 152 251 251
+pale turquoise 175 238 238
+pale violet red 219 112 112
+PaleGoldenrod 238 232 232
+PaleGreen 152 251 251
+PaleGreen1 154 255 255
+PaleGreen2 144 238 238
+PaleGreen3 124 205 205
+PaleGreen4 84 139 139
+PaleTurquoise 175 238 238
+PaleTurquoise1 187 255 255
+PaleTurquoise2 174 238 238
+PaleTurquoise3 150 205 205
+PaleTurquoise4 102 139 139
+.CE
+.CS
+PaleVioletRed 219 112 112
+PaleVioletRed1 255 130 130
+PaleVioletRed2 238 121 121
+PaleVioletRed3 205 104 104
+PaleVioletRed4 139 71 71
+papaya whip 255 239 239
+PapayaWhip 255 239 239
+peach puff 255 218 218
+PeachPuff 255 218 218
+PeachPuff1 255 218 218
+PeachPuff2 238 203 203
+PeachPuff3 205 175 175
+PeachPuff4 139 119 119
+peru 205 133 133
+pink 255 192 192
+pink1 255 181 181
+pink2 238 169 169
+pink3 205 145 145
+pink4 139 99 99
+plum 221 160 160
+plum1 255 187 187
+plum2 238 174 174
+plum3 205 150 150
+plum4 139 102 102
+powder blue 176 224 224
+PowderBlue 176 224 224
+purple 160 32 32
+purple1 155 48 48
+purple2 145 44 44
+purple3 125 38 38
+purple4 85 26 26
+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 105
+RoyalBlue 65 105 105
+RoyalBlue1 72 118 118
+RoyalBlue2 67 110 110
+RoyalBlue3 58 95 95
+RoyalBlue4 39 64 64
+saddle brown 139 69 69
+SaddleBrown 139 69 69
+salmon 250 128 128
+salmon1 255 140 140
+salmon2 238 130 130
+salmon3 205 112 112
+salmon4 139 76 76
+sandy brown 244 164 164
+SandyBrown 244 164 164
+sea green 46 139 139
+SeaGreen 46 139 139
+SeaGreen1 84 255 255
+SeaGreen2 78 238 238
+SeaGreen3 67 205 205
+SeaGreen4 46 139 139
+seashell 255 245 245
+seashell1 255 245 245
+seashell2 238 229 229
+seashell3 205 197 197
+seashell4 139 134 134
+sienna 160 82 82
+sienna1 255 130 130
+sienna2 238 121 121
+sienna3 205 104 104
+sienna4 139 71 71
+sky blue 135 206 206
+SkyBlue 135 206 206
+SkyBlue1 135 206 206
+SkyBlue2 126 192 192
+SkyBlue3 108 166 166
+SkyBlue4 74 112 112
+slate blue 106 90 90
+slate gray 112 128 128
+slate grey 112 128 128
+SlateBlue 106 90 90
+SlateBlue1 131 111 111
+SlateBlue2 122 103 103
+SlateBlue3 105 89 89
+SlateBlue4 71 60 60
+SlateGray 112 128 128
+SlateGray1 198 226 226
+SlateGray2 185 211 211
+SlateGray3 159 182 182
+SlateGray4 108 123 123
+SlateGrey 112 128 128
+snow 255 250 250
+snow1 255 250 250
+snow2 238 233 233
+snow3 205 201 201
+snow4 139 137 137
+spring green 0 255 255
+SpringGreen 0 255 255
+SpringGreen1 0 255 255
+SpringGreen2 0 238 238
+SpringGreen3 0 205 205
+SpringGreen4 0 139 139
+steel blue 70 130 130
+SteelBlue 70 130 130
+SteelBlue1 99 184 184
+SteelBlue2 92 172 172
+SteelBlue3 79 148 148
+SteelBlue4 54 100 100
+tan 210 180 180
+tan1 255 165 165
+tan2 238 154 154
+tan3 205 133 133
+tan4 139 90 90
+thistle 216 191 191
+thistle1 255 225 225
+thistle2 238 210 210
+thistle3 205 181 181
+thistle4 139 123 123
+tomato 255 99 99
+tomato1 255 99 99
+tomato2 238 92 92
+tomato3 205 79 79
+tomato4 139 54 54
+turquoise 64 224 224
+turquoise1 0 245 245
+turquoise2 0 229 229
+turquoise3 0 197 197
+turquoise4 0 134 134
+violet 238 130 130
+violet red 208 32 32
+VioletRed 208 32 32
+VioletRed1 255 62 62
+VioletRed2 238 58 58
+VioletRed3 205 50 50
+VioletRed4 139 34 34
+wheat 245 222 222
+wheat1 255 231 231
+wheat2 238 216 216
+wheat3 205 186 186
+wheat4 139 126 126
+white 255 255 255
+white smoke 245 245 245
+WhiteSmoke 245 245 245
+yellow 255 255 255
+yellow green 154 205 205
+yellow1 255 255 255
+yellow2 238 238 238
+yellow3 205 205 205
+yellow4 139 139 139
+YellowGreen 154 205 205
+.CE
+
+.SH KEYWORDS
+color, option
diff --git a/tcl/doc/console.n b/tcl/doc/console.n
new file mode 100644
index 00000000000..8b80e4bb52f
--- /dev/null
+++ b/tcl/doc/console.n
@@ -0,0 +1,142 @@
+'\"
+'\" Copyright (c) 2001 Donal K. Fellows
+'\"
+'\" 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 console n 8.4 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+console \- Control the console on systems without a real console
+.SH SYNOPSIS
+\fBconsole title \fR?\fIstring\fR?
+.sp
+\fBconsole hide\fR
+.sp
+\fBconsole show\fR
+.sp
+\fBconsole eval \fIscript\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The console window is a replacement for a real console to allow input
+and output on the standard I/O channels on platforms that do not have
+a real console. It is implemented as a separate interpreter with the
+Tk toolkit loaded, and control over this interpreter is given through
+the \fBconsole\fR command. The behaviour of the console window is
+defined mainly through the contents of the \fIconsole.tcl\fR file in
+the Tk library (or the \fIConsole\fR resource on Macintosh systems.)
+.PP
+.TP
+\fBconsole eval \fIscript\fR
+Evaluate the \fIscript\fR argument as a Tcl script in the console
+interpreter. The normal interpreter is accessed through the
+\fBconsoleinterp\fR command in the console interpreter.
+.TP
+\fBconsole hide\fR
+Hide the console window from view. Precisely equivalent to
+withdrawing the \fB.\fR window in the console interpreter.
+.TP
+\fBconsole show\fR
+Display the console window. Precisely equivalent to deiconifying the
+\fB.\fR window in the console interpreter.
+.TP
+\fBconsole title \fR?\fIstring\fR?
+Query or modify the title of the console window. If \fIstring\fR is
+not specified, queries the title of the console window, and sets the
+title of the console window to \fIstring\fR otherwise. Precisely
+equivalent to using the \fBwm title\fR command in the console
+interpreter.
+
+.SH "ACCESS TO THE MAIN INTERPRETER"
+.PP
+The \fBconsoleinterp\fR command in the console interpreter allows
+scripts to be evaluated in the main interpreter. It supports two
+subcommands: \fBeval\fR and \fBrecord\fR.
+.PP
+.TP
+\fBconsoleinterp eval \fIscript\fR
+Evaluates \fIscript\fR as a Tcl script at the global level in the main
+interpreter.
+.TP
+\fBconsoleinterp record \fIscript\fR
+Records and evaluates \fIscript\fR as a Tcl script at the global level
+in the main interpreter as if \fIscript\fR had been typed in at the
+console.
+
+.SH "ADDITIONAL TRAP CALLS"
+.PP
+There are several additional commands in the console interpreter that
+are called in response to activity in the main interpreter.
+\fIThese are documented here for completeness only; they form part of
+the internal implementation of the console and are likely to change or
+be modified without warning.\fR
+.PP
+Output to the console from the main interpreter via the stdout and
+stderr channels is handled by invoking the \fBtk::ConsoleOutput\fR
+command in the console interpreter with two arguments. The first
+argument is the name of the channel being written to, and the second
+argument is the string being written to the channel (after encoding
+and end-of-line translation processing has been performed.)
+.PP
+When the \fB.\fR window of the main interpreter is destroyed, the
+\fBtk::ConsoleExit\fR command in the console interpreter is called
+(assuming the console interpreter has not already been deleted itself,
+that is.)
+
+.SH "DEFAULT BINDINGS"
+.PP
+The default script creates a console window (implemented using a text
+widget) that has the following behaviour:
+.IP [1]
+Pressing the tab key inserts a TAB character (as defined by the Tcl
+\et escape.)
+.IP [2]
+Pressing the return key causes the current line (if complete by the
+rules of \fBinfo complete\fR) to be passed to the main interpreter for
+evaluation.
+.IP [3]
+Pressing the delete key deletes the selected text (if any text is
+selected) or the character to the right of the cursor (if not at the
+end of the line.)
+.IP [4]
+Pressing the backspace key deletes the selected text (if any text is
+selected) or the character to the left of the cursor (of not at the
+start of the line.)
+.IP [5]
+Pressing either Control+A or the home key causes the cursor to go to
+the start of the line (but after the prompt, if a prompt is present on
+the line.)
+.IP [6]
+Pressing either Control+E or the end key causes the cursor to go to
+the end of the line.
+.IP [7]
+Pressing either Control+P or the up key causes the previous entry in
+the command history to be selected.
+.IP [8]
+Pressing either Control+N or the down key causes the next entry in the
+command history to be selected.
+.IP [9]
+Pressing either Control+B or the left key causes the cursor to move
+one character backward as long as the cursor is not at the prompt.
+.IP [10]
+Pressing either Control+F or the right key causes the cursor to move
+one character forward.
+.IP [11]
+Pressing F9 rebuilds the console window by destroying all its children
+and reloading the Tcl script that defined the console's behaviour.
+.PP
+Most other behaviour is the same as a conventional text widget except
+for the way that the \fI<<Cut>>\fR event is handled identically to the
+\fI<<Copy>>\fR event.
+
+.SH KEYWORDS
+console, interpreter, window, interactive, output channels
+
+.SH "SEE ALSO"
+destroy(n), fconfigure(n), history(n), interp(n), puts(n), text(n), wm(n)
diff --git a/tcl/doc/cursors.n b/tcl/doc/cursors.n
new file mode 100644
index 00000000000..c93d3752597
--- /dev/null
+++ b/tcl/doc/cursors.n
@@ -0,0 +1,154 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\"
+.so man.macros
+.TH cursors n 8.3 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+cursors \- mouse cursors available in Tk
+
+.SH DESCRIPTION
+.PP
+The \fB-cursor\fR widget option allows a Tk programmer to change the
+mouse cursor for a particular widget. The cursor names recognized by
+Tk on all platforms are:
+.CS
+X_cursor
+arrow
+based_arrow_down
+based_arrow_up
+boat
+bogosity
+bottom_left_corner
+bottom_right_corner
+bottom_side
+bottom_tee
+box_spiral
+center_ptr
+circle
+clock
+coffee_mug
+cross
+cross_reverse
+crosshair
+diamond_cross
+dot
+dotbox
+double_arrow
+draft_large
+draft_small
+draped_box
+exchange
+fleur
+gobbler
+gumby
+hand1
+hand2
+heart
+icon
+iron_cross
+left_ptr
+left_side
+left_tee
+leftbutton
+ll_angle
+lr_angle
+man
+middlebutton
+mouse
+pencil
+pirate
+plus
+question_arrow
+right_ptr
+right_side
+right_tee
+rightbutton
+rtl_logo
+sailboat
+sb_down_arrow
+sb_h_double_arrow
+sb_left_arrow
+sb_right_arrow
+sb_up_arrow
+sb_v_double_arrow
+shuttle
+sizing
+spider
+spraycan
+star
+target
+tcross
+top_left_arrow
+top_left_corner
+top_right_corner
+top_side
+top_tee
+trek
+ul_angle
+umbrella
+ur_angle
+watch
+xterm
+.CE
+
+.SH "PORTABILITY ISSUES"
+
+.TP
+\fBWindows\fR
+On Windows systems, the following cursors are mapped to native cursors:
+.RS
+.CS
+arrow
+center_ptr
+crosshair
+fleur
+ibeam
+icon
+sb_h_double_arrow
+sb_v_double_arrow
+watch
+xterm
+.CE
+And the following additional cursors are available:
+.CS
+no
+starting
+size
+size_ne_sw
+size_ns
+size_nw_se
+size_we
+uparrow
+wait
+.CE
+The \fBno\fR cursor can be specified to eliminate the cursor.
+.RE
+
+.TP
+\fBMacintosh\fR
+On Macintosh systems, the following cursors are mapped to native cursors:
+.RS
+.CS
+arrow
+cross
+crosshair
+ibeam
+plus
+watch
+xterm
+.CE
+And the following additional cursors are available:
+.CS
+text
+cross-hair
+.CE
+.RE
+
+.SH KEYWORDS
+cursor, option
diff --git a/tcl/doc/destroy.n b/tcl/doc/destroy.n
new file mode 100644
index 00000000000..f144ad86ebd
--- /dev/null
+++ b/tcl/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/tcl/doc/dialog.n b/tcl/doc/dialog.n
new file mode 100644
index 00000000000..bd30e197b14
--- /dev/null
+++ b/tcl/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/tcl/doc/entry.n b/tcl/doc/entry.n
new file mode 100644
index 00000000000..a00fb6c2fb2
--- /dev/null
+++ b/tcl/doc/entry.n
@@ -0,0 +1,549 @@
+'\"
+'\" Copyright (c) 1990-1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-2000 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 entry n 8.3 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 \-highlightthickness \-selectbackground
+\-borderwidth \-insertbackground \-selectborderwidth
+\-cursor \-insertborderwidth \-selectforeground
+\-exportselection \-insertofftime \-takefocus
+\-font \-insertontime \-textvariable
+\-foreground \-insertwidth \-xscrollcommand
+\-highlightbackground \-justify
+\-highlightcolor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.VS 8.4
+.OP \-disabledbackground disabledBackground DisabledBackground
+Specifies the background color to use when the entry is disabled. If
+this option is the empty string, the normal background color is used.
+.OP \-disabledforeground disabledForeground DisabledForeground
+Specifies the foreground color to use when the entry is disabled. If
+this option is the empty string, the normal foreground color is used.
+.VE 8.4
+.VS 8.3
+.OP "\-invalidcommand or \-invcmd" invalidCommand InvalidCommand
+Specifies a script to eval when \fBvalidateCommand\fR returns 0.
+Setting it to {} disables this feature (the default). The best use
+of this option is to set it to \fIbell\fR. See \fBValidation\fR
+below for more information.
+.VE
+.VS 8.4
+.OP \-readonlybackground readonlyBackground ReadonlyBackground
+Specifies the background color to use when the entry is readonly. If
+this option is the empty string, the normal background color is used.
+.VE
+.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.
+.VS 8.4
+.OP \-state state State
+Specifies one of three states for the entry: \fBnormal\fR,
+\fBdisabled\fR, or \fBreadonly\fR. If the entry is readonly, 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; the
+contents of the widget may still be selected. If the entry is
+disabled, the value may not be changed, no insertion cursor will be
+displayed, the contents will not be selectable, and the entry may
+be displayed in a different color, depending on the values of the
+\fB-disabledforeground\fR and \fB-disabledbackground\fR options.
+.VE 8.4
+.VS 8.3
+.OP \-validate validate Validate
+Specifies the mode in which validation should operate: \fBnone\fR,
+\fBfocus\fR, \fBfocusin\fR, \fBfocusout\fR, \fBkey\fR, or \fBall\fR.
+It defaults to \fBnone\fR. When you want validation, you must explicitly
+state which mode you wish to use. See \fBValidation\fR below for more.
+.OP "\-validatecommand or \-vcmd" validateCommand ValidateCommand
+Specifies a script to eval when you want to validate the input into
+the entry widget. Setting it to {} disables this feature (the default).
+This command must return a valid tcl boolean value. If it returns 0 (or
+the valid tcl boolean equivalent) then it means you reject the new edition
+and it will not occur and the \fBinvalidCommand\fR will be evaluated if it
+is set. If it returns 1, then the new edition occurs.
+See \fBValidation\fR below for more information.
+.VE
+.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.
+
+.VS 8.3
+.SH VALIDATION
+.PP
+Validation works by setting the \fBvalidateCommand\fR
+option to a script which will be evaluated according to the \fBvalidate\fR
+option as follows:
+.PP
+.IP \fBnone\fR 10
+Default. This means no validation will occur.
+.IP \fBfocus\fR 10
+\fBvalidateCommand\fR will be called when the entry receives or
+loses focus.
+.IP \fBfocusin\fR 10
+\fBvalidateCommand\fR will be called when the entry receives focus.
+.IP \fBfocusout\fR 10
+\fBvalidateCommand\fR will be called when the entry loses focus.
+.IP \fBkey\fR 10
+\fBvalidateCommand\fR will be called when the entry is edited.
+.IP \fBall\fR 10
+\fBvalidateCommand\fR will be called for all above conditions.
+.PP
+It is possible to perform percent substitutions on the \fBvalidateCommand\fR
+and \fBinvalidCommand\fR,
+just as you would in a \fBbind\fR script. The following substitutions
+are recognized:
+.PP
+.IP \fB%d\fR 5
+Type of action: 1 for \fBinsert\fR, 0 for \fBdelete\fR,
+or -1 for focus, forced or textvariable validation.
+.IP \fB%i\fR 5
+Index of char string to be inserted/deleted, if any, otherwise -1.
+.IP \fB%P\fR 5
+The value of the entry should edition occur. If you are configuring the
+entry widget to have a new textvariable, this will be the value of that
+textvariable.
+.IP \fB%s\fR 5
+The current value of entry before edition.
+.IP \fB%S\fR 5
+The text string being inserted/deleted, if any, {} otherwise.
+.IP \fB%v\fR 5
+The type of validation currently set.
+.IP \fB%V\fR 5
+The type of validation that triggered the callback
+(key, focusin, focusout, forced).
+.IP \fB%W\fR 5
+The name of the entry widget.
+.PP
+In general, the \fBtextVariable\fR and \fBvalidateCommand\fR can be
+dangerous to mix. Any problems have been overcome so that using the
+\fBvalidateCommand\fR will not interfere with the traditional behavior of
+the entry widget. Using the \fBtextVariable\fR for read-only purposes will
+never cause problems. The danger comes when you try set the
+\fBtextVariable\fR to something that the \fBvalidateCommand\fR would not
+accept, which causes \fBvalidate\fR to become \fInone\fR (the
+\fBinvalidCommand\fR will not be triggered). The same happens
+when an error occurs evaluating the \fBvalidateCommand\fR.
+.PP
+Primarily, an error will occur when the \fBvalidateCommand\fR or
+\fBinvalidCommand\fR encounters an error in its script while evaluating or
+\fBvalidateCommand\fR does not return a valid tcl boolean value. The
+\fBvalidate\fR option will also set itself to \fBnone\fR when you edit the
+entry widget from within either the \fBvalidateCommand\fR or the
+\fBinvalidCommand\fR. Such editions will override the one that was being
+validated. If you wish to edit the entry widget (for example set it to {})
+during validation and still have the \fBvalidate\fR option set, you should
+include the command
+.CS
+ \fIafter idle {%W config -validate %v}\fR
+.CE
+in the \fBvalidateCommand\fR or \fBinvalidCommand\fR (whichever one you
+were editing the entry widget from). It is also recommended to not set an
+associated \fBtextVariable\fR during validation, as that can cause the
+entry widget to become out of sync with the \fBtextVariable\fR.
+.VE
+
+.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
+.VS 8.3
+\fIpathName \fBvalidate\fR
+This command is used to force an evaluation of the \fBvalidateCommand\fR
+independent of the conditions specified by the \fBvalidate\fR option.
+This is done by temporarily setting the \fBvalidate\fR option to \fBall\fR.
+It returns 0 or 1.
+.VE
+.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
+.VS
+except if the entry is linked to a variable using the \fB\-textvariable\fR
+option, in which case any changes to the variable are reflected by the
+entry whatever the value of its \fB\-state\fR option.
+.VE
+.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/tcl/doc/event.n b/tcl/doc/event.n
new file mode 100644
index 00000000000..1df47c4ada5
--- /dev/null
+++ b/tcl/doc/event.n
@@ -0,0 +1,366 @@
+'\"
+'\" Copyright (c) 1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-2000 Ajuba Solutions.
+'\"
+'\" 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.3 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 8.3
+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.
+If \fIWindow\fR is empty the whole screen is meant, and coordinates
+are relative to the screen.
+\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. Certain events, such as key events, require
+that the window has focus to receive the event properly.
+.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
+\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.
+.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\-warp\fI boolean\fR
+\fIboolean\fR must be a boolean value; it specifies whether
+the screen pointer should be warped as well.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, and \fBMotion\fR events. The pointer will
+only warp to a window if it is mapped.
+.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.
+If \fIWindow\fR is empty the coordinate is relative to the
+screen, and this option corresponds to 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.
+If \fIWindow\fR is empty the coordinate is relative to the
+screen, and this option corresponds to 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/tcl/doc/focus.n b/tcl/doc/focus.n
new file mode 100644
index 00000000000..496563c943f
--- /dev/null
+++ b/tcl/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/tcl/doc/focusNext.n b/tcl/doc/focusNext.n
new file mode 100644
index 00000000000..a98e0fc56ad
--- /dev/null
+++ b/tcl/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/tcl/doc/font.n b/tcl/doc/font.n
new file mode 100644
index 00000000000..e644ebeb13c
--- /dev/null
+++ b/tcl/doc/font.n
@@ -0,0 +1,287 @@
+'\"
+'\" 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
+.ta 3c 6c
+\fBsystem ansi device
+systemfixed ansifixed oemfixed\fR
+.DE
+.TP
+Macintosh:
+.DS
+.ta 3c 6c
+\fBsystem application\fR
+.DE
+.RE
+.SH "SEE ALSO"
+options
+
+.SH KEYWORDS
+font
diff --git a/tcl/doc/frame.n b/tcl/doc/frame.n
new file mode 100644
index 00000000000..b2e88d472f0
--- /dev/null
+++ b/tcl/doc/frame.n
@@ -0,0 +1,136 @@
+'\"
+'\" 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.4 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 \-highlightcolor \-pady
+\-cursor \-highlightthickness \-relief
+\-highlightbackground \-padx \-takefocus
+.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.
+.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.
+.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 "SEE ALSO"
+labelframe(n), toplevel(n)
+
+.SH KEYWORDS
+frame, widget
diff --git a/tcl/doc/getOpenFile.n b/tcl/doc/getOpenFile.n
new file mode 100644
index 00000000000..3c12dc1a7c5
--- /dev/null
+++ b/tcl/doc/getOpenFile.n
@@ -0,0 +1,171 @@
+'\"
+'\" 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.
+.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,
+.VS 8.4
+and the UNIX implementation guesses reasonable values for this from
+the \fB\-filetypes\fR option when this is not supplied.
+.VE 8.4
+.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 on the Macintosh platform.
+.TP
+\fB\-multiple\fR
+Allows the user to choose multiple files from the Open dialog.
+On the Macintosh, this is only available when Navigation Services are
+installed.
+.TP
+\fB\-message\fR \fIstring\fR
+Specifies a message to include in the client area of the dialog.
+This is only available on the Macintosh, and only when Navigation
+Services are installed.
+.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.
+.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 "SEE ALSO"
+tk_chooseDirectory
+
+.SH KEYWORDS
+file selection dialog
diff --git a/tcl/doc/grab.n b/tcl/doc/grab.n
new file mode 100644
index 00000000000..2d261d9c723
--- /dev/null
+++ b/tcl/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/tcl/doc/grid.n b/tcl/doc/grid.n
new file mode 100644
index 00000000000..ee40d2169c9
--- /dev/null
+++ b/tcl/doc/grid.n
@@ -0,0 +1,379 @@
+'\"
+'\" 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 8.4 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 suitable as the first slave
+argument to \fBgrid configure\fR, either a window name (any value
+starting with \fB.\fP) or one of the characters \fBx\fP or \fB^\fP
+(see the ``RELATIVE PLACEMENT'' section below), 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.
+.VS 8.4
+The valid options are \fB\-minsize\fP, \fB\-weight\fP, \fB\-uniform\fP
+and \fB-pad\fP.
+.VE
+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.
+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.
+.VS 8.4
+The \fB-uniform\fP option, when a non-empty value is supplied, places
+the column in a \fIuniform group\fP with other columns that have the
+same value for \fB-uniform\fP. The space for columns belonging to a
+uniform group is allocated so that their sizes are always in strict
+proportion to their \fB-weight\fP values. See
+``THE GRID ALGORITHM'' below for further details.
+.VE
+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.
+\fIAmount\fR may be a list
+of two values to specify padding for left and right separately.
+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.
+\fIAmount\fR may be a list
+of two values to specify padding for top and bottom separately.
+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.
+.VS 8.4
+The valid options are \fB\-minsize\fP, \fB\-weight\fP, \fB\-uniform\fP
+and \fB-pad\fP.
+.VE
+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.
+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.
+.VS 8.4
+The \fB-uniform\fP option, when a non-empty value is supplied, places
+the row in a \fIuniform group\fP with other rows that have the
+same value for \fB-uniform\fP. The space for rows belonging to a
+uniform group is allocated so that their sizes are always in strict
+proportion to their \fB-weight\fP values. See
+``THE GRID ALGORITHM'' below for further details.
+.VE
+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, \fBx\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, nor may it be the first \fIslave\fP
+argument to \fBgrid configure\fR.
+.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. After that
+the rows or columns in each uniform group adapt to each other. 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
+When multiple rows or columns belong to a uniform group, the space
+allocated to them is always in proportion to their weights. (A weight
+of zero is considered to be 1.) In other words, a row or column
+configured with \fB-weight 1 -uniform a\fP will have exactly the same
+size as any other row or column configured with \fB-weight 1 -uniform
+a\fP. A row or column configured with \fB-weight 2 -uniform b\fR will
+be exactly twice as large as one that is configured with \fB-weight 1
+-uniform b\fP.
+.PP
+More technically, each row or column in the group will have a size
+equal to \fIk*weight\fP for some constant \fIk\fP. The constant
+\fIk\fP is chosen so that no row or column becomes smaller than its
+minimum size. For example, if all rows or columns in a group have the
+same weight, then each row or column will have the same size as the
+largest row or column in the group.
+.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/tcl/doc/image.n b/tcl/doc/image.n
new file mode 100644
index 00000000000..7f26cbf94a0
--- /dev/null
+++ b/tcl/doc/image.n
@@ -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 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.
+It is important to note that the image command will silently overwrite any
+procedure that may currently be defined by the given name, so choose the
+name wisely. It is recommended to use a separate namespace for image names
+(e.g., \fB::img::logo\fR, \fB::img::large\fR).
+.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 inuse \fIname\fR
+Returns a boolean value indicating whether or not the image given by
+\fIname\fR is in use by any widgets.
+.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/tcl/doc/keysyms.n b/tcl/doc/keysyms.n
new file mode 100644
index 00000000000..0746d54357b
--- /dev/null
+++ b/tcl/doc/keysyms.n
@@ -0,0 +1,930 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\"
+.so man.macros
+.TH keysyms n 8.3 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+keysyms \- keysyms recognized by Tk
+.BE
+
+.SH DESCRIPTION
+.PP
+Tk recognizes many keysyms when specifying key bindings (eg,
+\fBbind . <Key-\fR\fIkeysym\fR\fB>\fR). The following list enumerates the
+keysyms that will be recognized by Tk. Note that not all keysyms will
+be valid on all platforms. For example, on Unix systems, the presence
+of a particular keysym is dependant on the configuration of the
+keyboard modifier map. This list shows keysyms along with their
+decimal and hexidecimal values.
+.PP
+.CS
+space 32 0x0020
+exclam 33 0x0021
+quotedbl 34 0x0022
+numbersign 35 0x0023
+dollar 36 0x0024
+percent 37 0x0025
+ampersand 38 0x0026
+quoteright 39 0x0027
+parenleft 40 0x0028
+parenright 41 0x0029
+asterisk 42 0x002a
+plus 43 0x002b
+comma 44 0x002c
+minus 45 0x002d
+period 46 0x002e
+slash 47 0x002f
+0 48 0x0030
+1 49 0x0031
+2 50 0x0032
+3 51 0x0033
+4 52 0x0034
+5 53 0x0035
+6 54 0x0036
+7 55 0x0037
+8 56 0x0038
+9 57 0x0039
+colon 58 0x003a
+semicolon 59 0x003b
+less 60 0x003c
+equal 61 0x003d
+greater 62 0x003e
+question 63 0x003f
+at 64 0x0040
+A 65 0x0041
+B 66 0x0042
+C 67 0x0043
+D 68 0x0044
+E 69 0x0045
+F 70 0x0046
+G 71 0x0047
+H 72 0x0048
+I 73 0x0049
+J 74 0x004a
+K 75 0x004b
+L 76 0x004c
+M 77 0x004d
+N 78 0x004e
+O 79 0x004f
+P 80 0x0050
+Q 81 0x0051
+R 82 0x0052
+S 83 0x0053
+T 84 0x0054
+U 85 0x0055
+V 86 0x0056
+W 87 0x0057
+X 88 0x0058
+Y 89 0x0059
+Z 90 0x005a
+bracketleft 91 0x005b
+backslash 92 0x005c
+bracketright 93 0x005d
+asciicircum 94 0x005e
+underscore 95 0x005f
+quoteleft 96 0x0060
+a 97 0x0061
+b 98 0x0062
+c 99 0x0063
+d 100 0x0064
+e 101 0x0065
+f 102 0x0066
+g 103 0x0067
+h 104 0x0068
+i 105 0x0069
+j 106 0x006a
+k 107 0x006b
+l 108 0x006c
+m 109 0x006d
+n 110 0x006e
+o 111 0x006f
+p 112 0x0070
+q 113 0x0071
+r 114 0x0072
+s 115 0x0073
+t 116 0x0074
+u 117 0x0075
+v 118 0x0076
+w 119 0x0077
+x 120 0x0078
+y 121 0x0079
+z 122 0x007a
+braceleft 123 0x007b
+bar 124 0x007c
+braceright 125 0x007d
+asciitilde 126 0x007e
+nobreakspace 160 0x00a0
+exclamdown 161 0x00a1
+cent 162 0x00a2
+sterling 163 0x00a3
+currency 164 0x00a4
+yen 165 0x00a5
+brokenbar 166 0x00a6
+section 167 0x00a7
+diaeresis 168 0x00a8
+copyright 169 0x00a9
+ordfeminine 170 0x00aa
+guillemotleft 171 0x00ab
+notsign 172 0x00ac
+hyphen 173 0x00ad
+registered 174 0x00ae
+macron 175 0x00af
+degree 176 0x00b0
+plusminus 177 0x00b1
+twosuperior 178 0x00b2
+threesuperior 179 0x00b3
+acute 180 0x00b4
+mu 181 0x00b5
+paragraph 182 0x00b6
+periodcentered 183 0x00b7
+cedilla 184 0x00b8
+onesuperior 185 0x00b9
+masculine 186 0x00ba
+guillemotright 187 0x00bb
+onequarter 188 0x00bc
+onehalf 189 0x00bd
+threequarters 190 0x00be
+questiondown 191 0x00bf
+Agrave 192 0x00c0
+Aacute 193 0x00c1
+Acircumflex 194 0x00c2
+Atilde 195 0x00c3
+Adiaeresis 196 0x00c4
+Aring 197 0x00c5
+AE 198 0x00c6
+Ccedilla 199 0x00c7
+Egrave 200 0x00c8
+Eacute 201 0x00c9
+Ecircumflex 202 0x00ca
+Ediaeresis 203 0x00cb
+Igrave 204 0x00cc
+Iacute 205 0x00cd
+Icircumflex 206 0x00ce
+Idiaeresis 207 0x00cf
+Eth 208 0x00d0
+Ntilde 209 0x00d1
+Ograve 210 0x00d2
+Oacute 211 0x00d3
+Ocircumflex 212 0x00d4
+Otilde 213 0x00d5
+Odiaeresis 214 0x00d6
+multiply 215 0x00d7
+Ooblique 216 0x00d8
+Ugrave 217 0x00d9
+Uacute 218 0x00da
+Ucircumflex 219 0x00db
+Udiaeresis 220 0x00dc
+Yacute 221 0x00dd
+Thorn 222 0x00de
+ssharp 223 0x00df
+agrave 224 0x00e0
+aacute 225 0x00e1
+acircumflex 226 0x00e2
+atilde 227 0x00e3
+adiaeresis 228 0x00e4
+aring 229 0x00e5
+ae 230 0x00e6
+ccedilla 231 0x00e7
+egrave 232 0x00e8
+eacute 233 0x00e9
+ecircumflex 234 0x00ea
+ediaeresis 235 0x00eb
+igrave 236 0x00ec
+iacute 237 0x00ed
+icircumflex 238 0x00ee
+idiaeresis 239 0x00ef
+eth 240 0x00f0
+ntilde 241 0x00f1
+ograve 242 0x00f2
+oacute 243 0x00f3
+ocircumflex 244 0x00f4
+otilde 245 0x00f5
+odiaeresis 246 0x00f6
+division 247 0x00f7
+oslash 248 0x00f8
+ugrave 249 0x00f9
+uacute 250 0x00fa
+ucircumflex 251 0x00fb
+udiaeresis 252 0x00fc
+yacute 253 0x00fd
+thorn 254 0x00fe
+ydiaeresis 255 0x00ff
+Aogonek 417 0x01a1
+breve 418 0x01a2
+Lstroke 419 0x01a3
+Lcaron 421 0x01a5
+Sacute 422 0x01a6
+Scaron 425 0x01a9
+Scedilla 426 0x01aa
+Tcaron 427 0x01ab
+Zacute 428 0x01ac
+.CE
+.CS
+Zcaron 430 0x01ae
+Zabovedot 431 0x01af
+aogonek 433 0x01b1
+ogonek 434 0x01b2
+lstroke 435 0x01b3
+lcaron 437 0x01b5
+sacute 438 0x01b6
+caron 439 0x01b7
+scaron 441 0x01b9
+scedilla 442 0x01ba
+tcaron 443 0x01bb
+zacute 444 0x01bc
+doubleacute 445 0x01bd
+zcaron 446 0x01be
+zabovedot 447 0x01bf
+Racute 448 0x01c0
+Abreve 451 0x01c3
+Cacute 454 0x01c6
+Ccaron 456 0x01c8
+Eogonek 458 0x01ca
+Ecaron 460 0x01cc
+Dcaron 463 0x01cf
+Nacute 465 0x01d1
+Ncaron 466 0x01d2
+Odoubleacute 469 0x01d5
+Rcaron 472 0x01d8
+Uring 473 0x01d9
+Udoubleacute 475 0x01db
+Tcedilla 478 0x01de
+racute 480 0x01e0
+abreve 483 0x01e3
+cacute 486 0x01e6
+ccaron 488 0x01e8
+eogonek 490 0x01ea
+ecaron 492 0x01ec
+dcaron 495 0x01ef
+nacute 497 0x01f1
+ncaron 498 0x01f2
+odoubleacute 501 0x01f5
+rcaron 504 0x01f8
+uring 505 0x01f9
+udoubleacute 507 0x01fb
+tcedilla 510 0x01fe
+abovedot 511 0x01ff
+Hstroke 673 0x02a1
+Hcircumflex 678 0x02a6
+Iabovedot 681 0x02a9
+Gbreve 683 0x02ab
+Jcircumflex 684 0x02ac
+hstroke 689 0x02b1
+hcircumflex 694 0x02b6
+idotless 697 0x02b9
+gbreve 699 0x02bb
+jcircumflex 700 0x02bc
+Cabovedot 709 0x02c5
+Ccircumflex 710 0x02c6
+Gabovedot 725 0x02d5
+Gcircumflex 728 0x02d8
+Ubreve 733 0x02dd
+Scircumflex 734 0x02de
+cabovedot 741 0x02e5
+ccircumflex 742 0x02e6
+gabovedot 757 0x02f5
+gcircumflex 760 0x02f8
+ubreve 765 0x02fd
+scircumflex 766 0x02fe
+kappa 930 0x03a2
+Rcedilla 931 0x03a3
+Itilde 933 0x03a5
+Lcedilla 934 0x03a6
+Emacron 938 0x03aa
+Gcedilla 939 0x03ab
+Tslash 940 0x03ac
+rcedilla 947 0x03b3
+itilde 949 0x03b5
+lcedilla 950 0x03b6
+emacron 954 0x03ba
+gacute 955 0x03bb
+tslash 956 0x03bc
+ENG 957 0x03bd
+eng 959 0x03bf
+Amacron 960 0x03c0
+Iogonek 967 0x03c7
+Eabovedot 972 0x03cc
+Imacron 975 0x03cf
+Ncedilla 977 0x03d1
+Omacron 978 0x03d2
+Kcedilla 979 0x03d3
+Uogonek 985 0x03d9
+Utilde 989 0x03dd
+Umacron 990 0x03de
+amacron 992 0x03e0
+iogonek 999 0x03e7
+eabovedot 1004 0x03ec
+imacron 1007 0x03ef
+ncedilla 1009 0x03f1
+omacron 1010 0x03f2
+kcedilla 1011 0x03f3
+uogonek 1017 0x03f9
+utilde 1021 0x03fd
+umacron 1022 0x03fe
+overline 1150 0x047e
+kana_fullstop 1185 0x04a1
+kana_openingbracket 1186 0x04a2
+kana_closingbracket 1187 0x04a3
+kana_comma 1188 0x04a4
+kana_middledot 1189 0x04a5
+kana_WO 1190 0x04a6
+kana_a 1191 0x04a7
+kana_i 1192 0x04a8
+kana_u 1193 0x04a9
+kana_e 1194 0x04aa
+kana_o 1195 0x04ab
+kana_ya 1196 0x04ac
+kana_yu 1197 0x04ad
+kana_yo 1198 0x04ae
+kana_tu 1199 0x04af
+prolongedsound 1200 0x04b0
+kana_A 1201 0x04b1
+kana_I 1202 0x04b2
+kana_U 1203 0x04b3
+kana_E 1204 0x04b4
+kana_O 1205 0x04b5
+kana_KA 1206 0x04b6
+kana_KI 1207 0x04b7
+kana_KU 1208 0x04b8
+kana_KE 1209 0x04b9
+kana_KO 1210 0x04ba
+kana_SA 1211 0x04bb
+kana_SHI 1212 0x04bc
+kana_SU 1213 0x04bd
+kana_SE 1214 0x04be
+kana_SO 1215 0x04bf
+kana_TA 1216 0x04c0
+kana_TI 1217 0x04c1
+kana_TU 1218 0x04c2
+kana_TE 1219 0x04c3
+kana_TO 1220 0x04c4
+kana_NA 1221 0x04c5
+kana_NI 1222 0x04c6
+kana_NU 1223 0x04c7
+kana_NE 1224 0x04c8
+kana_NO 1225 0x04c9
+kana_HA 1226 0x04ca
+kana_HI 1227 0x04cb
+kana_HU 1228 0x04cc
+kana_HE 1229 0x04cd
+kana_HO 1230 0x04ce
+kana_MA 1231 0x04cf
+kana_MI 1232 0x04d0
+kana_MU 1233 0x04d1
+kana_ME 1234 0x04d2
+kana_MO 1235 0x04d3
+kana_YA 1236 0x04d4
+kana_YU 1237 0x04d5
+kana_YO 1238 0x04d6
+kana_RA 1239 0x04d7
+kana_RI 1240 0x04d8
+kana_RU 1241 0x04d9
+kana_RE 1242 0x04da
+kana_RO 1243 0x04db
+kana_WA 1244 0x04dc
+kana_N 1245 0x04dd
+voicedsound 1246 0x04de
+semivoicedsound 1247 0x04df
+Arabic_comma 1452 0x05ac
+Arabic_semicolon 1467 0x05bb
+Arabic_question_mark 1471 0x05bf
+Arabic_hamza 1473 0x05c1
+Arabic_maddaonalef 1474 0x05c2
+Arabic_hamzaonalef 1475 0x05c3
+Arabic_hamzaonwaw 1476 0x05c4
+Arabic_hamzaunderalef 1477 0x05c5
+Arabic_hamzaonyeh 1478 0x05c6
+Arabic_alef 1479 0x05c7
+Arabic_beh 1480 0x05c8
+Arabic_tehmarbuta 1481 0x05c9
+Arabic_teh 1482 0x05ca
+Arabic_theh 1483 0x05cb
+Arabic_jeem 1484 0x05cc
+Arabic_hah 1485 0x05cd
+Arabic_khah 1486 0x05ce
+Arabic_dal 1487 0x05cf
+Arabic_thal 1488 0x05d0
+Arabic_ra 1489 0x05d1
+Arabic_zain 1490 0x05d2
+Arabic_seen 1491 0x05d3
+Arabic_sheen 1492 0x05d4
+Arabic_sad 1493 0x05d5
+Arabic_dad 1494 0x05d6
+Arabic_tah 1495 0x05d7
+Arabic_zah 1496 0x05d8
+Arabic_ain 1497 0x05d9
+Arabic_ghain 1498 0x05da
+Arabic_tatweel 1504 0x05e0
+Arabic_feh 1505 0x05e1
+Arabic_qaf 1506 0x05e2
+Arabic_kaf 1507 0x05e3
+Arabic_lam 1508 0x05e4
+Arabic_meem 1509 0x05e5
+.CE
+.CS
+Arabic_noon 1510 0x05e6
+Arabic_heh 1511 0x05e7
+Arabic_waw 1512 0x05e8
+Arabic_alefmaksura 1513 0x05e9
+Arabic_yeh 1514 0x05ea
+Arabic_fathatan 1515 0x05eb
+Arabic_dammatan 1516 0x05ec
+Arabic_kasratan 1517 0x05ed
+Arabic_fatha 1518 0x05ee
+Arabic_damma 1519 0x05ef
+Arabic_kasra 1520 0x05f0
+Arabic_shadda 1521 0x05f1
+Arabic_sukun 1522 0x05f2
+Serbian_dje 1697 0x06a1
+Macedonia_gje 1698 0x06a2
+Cyrillic_io 1699 0x06a3
+Ukranian_je 1700 0x06a4
+Macedonia_dse 1701 0x06a5
+Ukranian_i 1702 0x06a6
+Ukranian_yi 1703 0x06a7
+Serbian_je 1704 0x06a8
+Serbian_lje 1705 0x06a9
+Serbian_nje 1706 0x06aa
+Serbian_tshe 1707 0x06ab
+Macedonia_kje 1708 0x06ac
+Byelorussian_shortu 1710 0x06ae
+Serbian_dze 1711 0x06af
+numerosign 1712 0x06b0
+Serbian_DJE 1713 0x06b1
+Macedonia_GJE 1714 0x06b2
+Cyrillic_IO 1715 0x06b3
+Ukranian_JE 1716 0x06b4
+Macedonia_DSE 1717 0x06b5
+Ukranian_I 1718 0x06b6
+Ukranian_YI 1719 0x06b7
+Serbian_JE 1720 0x06b8
+Serbian_LJE 1721 0x06b9
+Serbian_NJE 1722 0x06ba
+Serbian_TSHE 1723 0x06bb
+Macedonia_KJE 1724 0x06bc
+Byelorussian_SHORTU 1726 0x06be
+Serbian_DZE 1727 0x06bf
+Cyrillic_yu 1728 0x06c0
+Cyrillic_a 1729 0x06c1
+Cyrillic_be 1730 0x06c2
+Cyrillic_tse 1731 0x06c3
+Cyrillic_de 1732 0x06c4
+Cyrillic_ie 1733 0x06c5
+Cyrillic_ef 1734 0x06c6
+Cyrillic_ghe 1735 0x06c7
+Cyrillic_ha 1736 0x06c8
+Cyrillic_i 1737 0x06c9
+Cyrillic_shorti 1738 0x06ca
+Cyrillic_ka 1739 0x06cb
+Cyrillic_el 1740 0x06cc
+Cyrillic_em 1741 0x06cd
+Cyrillic_en 1742 0x06ce
+Cyrillic_o 1743 0x06cf
+Cyrillic_pe 1744 0x06d0
+Cyrillic_ya 1745 0x06d1
+Cyrillic_er 1746 0x06d2
+Cyrillic_es 1747 0x06d3
+Cyrillic_te 1748 0x06d4
+Cyrillic_u 1749 0x06d5
+Cyrillic_zhe 1750 0x06d6
+Cyrillic_ve 1751 0x06d7
+Cyrillic_softsign 1752 0x06d8
+Cyrillic_yeru 1753 0x06d9
+Cyrillic_ze 1754 0x06da
+Cyrillic_sha 1755 0x06db
+Cyrillic_e 1756 0x06dc
+Cyrillic_shcha 1757 0x06dd
+Cyrillic_che 1758 0x06de
+Cyrillic_hardsign 1759 0x06df
+Cyrillic_YU 1760 0x06e0
+Cyrillic_A 1761 0x06e1
+Cyrillic_BE 1762 0x06e2
+Cyrillic_TSE 1763 0x06e3
+Cyrillic_DE 1764 0x06e4
+Cyrillic_IE 1765 0x06e5
+Cyrillic_EF 1766 0x06e6
+Cyrillic_GHE 1767 0x06e7
+Cyrillic_HA 1768 0x06e8
+Cyrillic_I 1769 0x06e9
+Cyrillic_SHORTI 1770 0x06ea
+Cyrillic_KA 1771 0x06eb
+Cyrillic_EL 1772 0x06ec
+Cyrillic_EM 1773 0x06ed
+Cyrillic_EN 1774 0x06ee
+Cyrillic_O 1775 0x06ef
+Cyrillic_PE 1776 0x06f0
+Cyrillic_YA 1777 0x06f1
+Cyrillic_ER 1778 0x06f2
+Cyrillic_ES 1779 0x06f3
+Cyrillic_TE 1780 0x06f4
+Cyrillic_U 1781 0x06f5
+Cyrillic_ZHE 1782 0x06f6
+Cyrillic_VE 1783 0x06f7
+Cyrillic_SOFTSIGN 1784 0x06f8
+Cyrillic_YERU 1785 0x06f9
+Cyrillic_ZE 1786 0x06fa
+Cyrillic_SHA 1787 0x06fb
+Cyrillic_E 1788 0x06fc
+Cyrillic_SHCHA 1789 0x06fd
+Cyrillic_CHE 1790 0x06fe
+Cyrillic_HARDSIGN 1791 0x06ff
+Greek_ALPHAaccent 1953 0x07a1
+Greek_EPSILONaccent 1954 0x07a2
+Greek_ETAaccent 1955 0x07a3
+Greek_IOTAaccent 1956 0x07a4
+Greek_IOTAdiaeresis 1957 0x07a5
+Greek_IOTAaccentdiaeresis 1958 0x07a6
+Greek_OMICRONaccent 1959 0x07a7
+Greek_UPSILONaccent 1960 0x07a8
+Greek_UPSILONdieresis 1961 0x07a9
+Greek_UPSILONaccentdieresis 1962 0x07aa
+Greek_OMEGAaccent 1963 0x07ab
+Greek_alphaaccent 1969 0x07b1
+Greek_epsilonaccent 1970 0x07b2
+Greek_etaaccent 1971 0x07b3
+Greek_iotaaccent 1972 0x07b4
+Greek_iotadieresis 1973 0x07b5
+Greek_iotaaccentdieresis 1974 0x07b6
+Greek_omicronaccent 1975 0x07b7
+Greek_upsilonaccent 1976 0x07b8
+Greek_upsilondieresis 1977 0x07b9
+Greek_upsilonaccentdieresis 1978 0x07ba
+Greek_omegaaccent 1979 0x07bb
+Greek_ALPHA 1985 0x07c1
+Greek_BETA 1986 0x07c2
+Greek_GAMMA 1987 0x07c3
+Greek_DELTA 1988 0x07c4
+Greek_EPSILON 1989 0x07c5
+Greek_ZETA 1990 0x07c6
+Greek_ETA 1991 0x07c7
+Greek_THETA 1992 0x07c8
+Greek_IOTA 1993 0x07c9
+Greek_KAPPA 1994 0x07ca
+Greek_LAMBDA 1995 0x07cb
+Greek_MU 1996 0x07cc
+Greek_NU 1997 0x07cd
+Greek_XI 1998 0x07ce
+Greek_OMICRON 1999 0x07cf
+Greek_PI 2000 0x07d0
+Greek_RHO 2001 0x07d1
+Greek_SIGMA 2002 0x07d2
+Greek_TAU 2004 0x07d4
+Greek_UPSILON 2005 0x07d5
+Greek_PHI 2006 0x07d6
+Greek_CHI 2007 0x07d7
+Greek_PSI 2008 0x07d8
+Greek_OMEGA 2009 0x07d9
+Greek_alpha 2017 0x07e1
+Greek_beta 2018 0x07e2
+Greek_gamma 2019 0x07e3
+Greek_delta 2020 0x07e4
+Greek_epsilon 2021 0x07e5
+Greek_zeta 2022 0x07e6
+Greek_eta 2023 0x07e7
+Greek_theta 2024 0x07e8
+Greek_iota 2025 0x07e9
+Greek_kappa 2026 0x07ea
+Greek_lambda 2027 0x07eb
+Greek_mu 2028 0x07ec
+Greek_nu 2029 0x07ed
+Greek_xi 2030 0x07ee
+Greek_omicron 2031 0x07ef
+Greek_pi 2032 0x07f0
+Greek_rho 2033 0x07f1
+Greek_sigma 2034 0x07f2
+Greek_finalsmallsigma 2035 0x07f3
+Greek_tau 2036 0x07f4
+Greek_upsilon 2037 0x07f5
+Greek_phi 2038 0x07f6
+Greek_chi 2039 0x07f7
+Greek_psi 2040 0x07f8
+Greek_omega 2041 0x07f9
+leftradical 2209 0x08a1
+topleftradical 2210 0x08a2
+horizconnector 2211 0x08a3
+topintegral 2212 0x08a4
+botintegral 2213 0x08a5
+vertconnector 2214 0x08a6
+topleftsqbracket 2215 0x08a7
+botleftsqbracket 2216 0x08a8
+toprightsqbracket 2217 0x08a9
+botrightsqbracket 2218 0x08aa
+topleftparens 2219 0x08ab
+botleftparens 2220 0x08ac
+toprightparens 2221 0x08ad
+botrightparens 2222 0x08ae
+leftmiddlecurlybrace 2223 0x08af
+rightmiddlecurlybrace 2224 0x08b0
+topleftsummation 2225 0x08b1
+botleftsummation 2226 0x08b2
+topvertsummationconnector 2227 0x08b3
+botvertsummationconnector 2228 0x08b4
+toprightsummation 2229 0x08b5
+botrightsummation 2230 0x08b6
+rightmiddlesummation 2231 0x08b7
+.CE
+.CS
+lessthanequal 2236 0x08bc
+notequal 2237 0x08bd
+greaterthanequal 2238 0x08be
+integral 2239 0x08bf
+therefore 2240 0x08c0
+variation 2241 0x08c1
+infinity 2242 0x08c2
+nabla 2245 0x08c5
+approximate 2248 0x08c8
+similarequal 2249 0x08c9
+ifonlyif 2253 0x08cd
+implies 2254 0x08ce
+identical 2255 0x08cf
+radical 2262 0x08d6
+includedin 2266 0x08da
+includes 2267 0x08db
+intersection 2268 0x08dc
+union 2269 0x08dd
+logicaland 2270 0x08de
+logicalor 2271 0x08df
+partialderivative 2287 0x08ef
+function 2294 0x08f6
+leftarrow 2299 0x08fb
+uparrow 2300 0x08fc
+rightarrow 2301 0x08fd
+downarrow 2302 0x08fe
+blank 2527 0x09df
+soliddiamond 2528 0x09e0
+checkerboard 2529 0x09e1
+ht 2530 0x09e2
+ff 2531 0x09e3
+cr 2532 0x09e4
+lf 2533 0x09e5
+nl 2536 0x09e8
+vt 2537 0x09e9
+lowrightcorner 2538 0x09ea
+uprightcorner 2539 0x09eb
+upleftcorner 2540 0x09ec
+lowleftcorner 2541 0x09ed
+crossinglines 2542 0x09ee
+horizlinescan1 2543 0x09ef
+horizlinescan3 2544 0x09f0
+horizlinescan5 2545 0x09f1
+horizlinescan7 2546 0x09f2
+horizlinescan9 2547 0x09f3
+leftt 2548 0x09f4
+rightt 2549 0x09f5
+bott 2550 0x09f6
+topt 2551 0x09f7
+vertbar 2552 0x09f8
+emspace 2721 0x0aa1
+enspace 2722 0x0aa2
+em3space 2723 0x0aa3
+em4space 2724 0x0aa4
+digitspace 2725 0x0aa5
+punctspace 2726 0x0aa6
+thinspace 2727 0x0aa7
+hairspace 2728 0x0aa8
+emdash 2729 0x0aa9
+endash 2730 0x0aaa
+signifblank 2732 0x0aac
+ellipsis 2734 0x0aae
+doubbaselinedot 2735 0x0aaf
+onethird 2736 0x0ab0
+twothirds 2737 0x0ab1
+onefifth 2738 0x0ab2
+twofifths 2739 0x0ab3
+threefifths 2740 0x0ab4
+fourfifths 2741 0x0ab5
+onesixth 2742 0x0ab6
+fivesixths 2743 0x0ab7
+careof 2744 0x0ab8
+figdash 2747 0x0abb
+leftanglebracket 2748 0x0abc
+decimalpoint 2749 0x0abd
+rightanglebracket 2750 0x0abe
+marker 2751 0x0abf
+oneeighth 2755 0x0ac3
+threeeighths 2756 0x0ac4
+fiveeighths 2757 0x0ac5
+seveneighths 2758 0x0ac6
+trademark 2761 0x0ac9
+signaturemark 2762 0x0aca
+trademarkincircle 2763 0x0acb
+leftopentriangle 2764 0x0acc
+rightopentriangle 2765 0x0acd
+emopencircle 2766 0x0ace
+emopenrectangle 2767 0x0acf
+leftsinglequotemark 2768 0x0ad0
+rightsinglequotemark 2769 0x0ad1
+leftdoublequotemark 2770 0x0ad2
+rightdoublequotemark 2771 0x0ad3
+prescription 2772 0x0ad4
+minutes 2774 0x0ad6
+seconds 2775 0x0ad7
+latincross 2777 0x0ad9
+hexagram 2778 0x0ada
+filledrectbullet 2779 0x0adb
+filledlefttribullet 2780 0x0adc
+filledrighttribullet 2781 0x0add
+emfilledcircle 2782 0x0ade
+emfilledrect 2783 0x0adf
+enopencircbullet 2784 0x0ae0
+enopensquarebullet 2785 0x0ae1
+openrectbullet 2786 0x0ae2
+opentribulletup 2787 0x0ae3
+opentribulletdown 2788 0x0ae4
+openstar 2789 0x0ae5
+enfilledcircbullet 2790 0x0ae6
+enfilledsqbullet 2791 0x0ae7
+filledtribulletup 2792 0x0ae8
+filledtribulletdown 2793 0x0ae9
+leftpointer 2794 0x0aea
+rightpointer 2795 0x0aeb
+club 2796 0x0aec
+diamond 2797 0x0aed
+heart 2798 0x0aee
+maltesecross 2800 0x0af0
+dagger 2801 0x0af1
+doubledagger 2802 0x0af2
+checkmark 2803 0x0af3
+ballotcross 2804 0x0af4
+musicalsharp 2805 0x0af5
+musicalflat 2806 0x0af6
+malesymbol 2807 0x0af7
+femalesymbol 2808 0x0af8
+telephone 2809 0x0af9
+telephonerecorder 2810 0x0afa
+phonographcopyright 2811 0x0afb
+caret 2812 0x0afc
+singlelowquotemark 2813 0x0afd
+doublelowquotemark 2814 0x0afe
+cursor 2815 0x0aff
+leftcaret 2979 0x0ba3
+rightcaret 2982 0x0ba6
+downcaret 2984 0x0ba8
+upcaret 2985 0x0ba9
+overbar 3008 0x0bc0
+downtack 3010 0x0bc2
+upshoe 3011 0x0bc3
+downstile 3012 0x0bc4
+underbar 3014 0x0bc6
+jot 3018 0x0bca
+quad 3020 0x0bcc
+uptack 3022 0x0bce
+circle 3023 0x0bcf
+upstile 3027 0x0bd3
+downshoe 3030 0x0bd6
+rightshoe 3032 0x0bd8
+leftshoe 3034 0x0bda
+lefttack 3036 0x0bdc
+righttack 3068 0x0bfc
+hebrew_aleph 3296 0x0ce0
+hebrew_beth 3297 0x0ce1
+hebrew_gimmel 3298 0x0ce2
+hebrew_daleth 3299 0x0ce3
+hebrew_he 3300 0x0ce4
+hebrew_waw 3301 0x0ce5
+hebrew_zayin 3302 0x0ce6
+hebrew_het 3303 0x0ce7
+hebrew_teth 3304 0x0ce8
+hebrew_yod 3305 0x0ce9
+hebrew_finalkaph 3306 0x0cea
+hebrew_kaph 3307 0x0ceb
+hebrew_lamed 3308 0x0cec
+hebrew_finalmem 3309 0x0ced
+hebrew_mem 3310 0x0cee
+hebrew_finalnun 3311 0x0cef
+hebrew_nun 3312 0x0cf0
+hebrew_samekh 3313 0x0cf1
+hebrew_ayin 3314 0x0cf2
+hebrew_finalpe 3315 0x0cf3
+hebrew_pe 3316 0x0cf4
+hebrew_finalzadi 3317 0x0cf5
+hebrew_zadi 3318 0x0cf6
+hebrew_kuf 3319 0x0cf7
+hebrew_resh 3320 0x0cf8
+hebrew_shin 3321 0x0cf9
+hebrew_taf 3322 0x0cfa
+BackSpace 65288 0xff08
+Tab 65289 0xff09
+Linefeed 65290 0xff0a
+Clear 65291 0xff0b
+Return 65293 0xff0d
+Pause 65299 0xff13
+Scroll_Lock 65300 0xff14
+Sys_Req 65301 0xff15
+Escape 65307 0xff1b
+Multi_key 65312 0xff20
+Kanji 65313 0xff21
+Home 65360 0xff50
+Left 65361 0xff51
+Up 65362 0xff52
+Right 65363 0xff53
+Down 65364 0xff54
+Prior 65365 0xff55
+Next 65366 0xff56
+End 65367 0xff57
+Begin 65368 0xff58
+Win_L 65371 0xff5b
+Win_R 65372 0xff5c
+.CE
+.CS
+App 65373 0xff5d
+Select 65376 0xff60
+Print 65377 0xff61
+Execute 65378 0xff62
+Insert 65379 0xff63
+Undo 65381 0xff65
+Redo 65382 0xff66
+Menu 65383 0xff67
+Find 65384 0xff68
+Cancel 65385 0xff69
+Help 65386 0xff6a
+Break 65387 0xff6b
+Hebrew_switch 65406 0xff7e
+Num_Lock 65407 0xff7f
+KP_Space 65408 0xff80
+KP_Tab 65417 0xff89
+KP_Enter 65421 0xff8d
+KP_F1 65425 0xff91
+KP_F2 65426 0xff92
+KP_F3 65427 0xff93
+KP_F4 65428 0xff94
+KP_Multiply 65450 0xffaa
+KP_Add 65451 0xffab
+KP_Separator 65452 0xffac
+KP_Subtract 65453 0xffad
+KP_Decimal 65454 0xffae
+KP_Divide 65455 0xffaf
+KP_0 65456 0xffb0
+KP_1 65457 0xffb1
+KP_2 65458 0xffb2
+KP_3 65459 0xffb3
+KP_4 65460 0xffb4
+KP_5 65461 0xffb5
+KP_6 65462 0xffb6
+KP_7 65463 0xffb7
+KP_8 65464 0xffb8
+KP_9 65465 0xffb9
+KP_Equal 65469 0xffbd
+F1 65470 0xffbe
+F2 65471 0xffbf
+F3 65472 0xffc0
+F4 65473 0xffc1
+F5 65474 0xffc2
+F6 65475 0xffc3
+F7 65476 0xffc4
+F8 65477 0xffc5
+F9 65478 0xffc6
+F10 65479 0xffc7
+L1 65480 0xffc8
+L2 65481 0xffc9
+L3 65482 0xffca
+L4 65483 0xffcb
+L5 65484 0xffcc
+L6 65485 0xffcd
+L7 65486 0xffce
+L8 65487 0xffcf
+L9 65488 0xffd0
+L10 65489 0xffd1
+R1 65490 0xffd2
+R2 65491 0xffd3
+R3 65492 0xffd4
+R4 65493 0xffd5
+R5 65494 0xffd6
+R6 65495 0xffd7
+R7 65496 0xffd8
+R8 65497 0xffd9
+R9 65498 0xffda
+R10 65499 0xffdb
+R11 65500 0xffdc
+R12 65501 0xffdd
+F33 65502 0xffde
+R14 65503 0xffdf
+R15 65504 0xffe0
+Shift_L 65505 0xffe1
+Shift_R 65506 0xffe2
+Control_L 65507 0xffe3
+Control_R 65508 0xffe4
+Caps_Lock 65509 0xffe5
+Shift_Lock 65510 0xffe6
+Meta_L 65511 0xffe7
+Meta_R 65512 0xffe8
+Alt_L 65513 0xffe9
+Alt_R 65514 0xffea
+Super_L 65515 0xffeb
+Super_R 65516 0xffec
+Hyper_L 65517 0xffed
+Hyper_R 65518 0xffee
+Delete 65535 0xffff
+.CE
+
+.SH "SEE ALSO"
+bind
+
+.SH KEYWORDS
+keysym, bind, binding
diff --git a/tcl/doc/label.n b/tcl/doc/label.n
new file mode 100644
index 00000000000..274592d1e79
--- /dev/null
+++ b/tcl/doc/label.n
@@ -0,0 +1,114 @@
+'\"
+'\" 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
+\-activebackground \-font \-pady
+\-activeforeground \-foreground \-relief
+\-anchor \-highlightbackground \-takefocus
+\-background \-highlightcolor \-text
+\-bitmap \-highlightthickness \-textvariable
+\-borderwidth \-image \-underline
+\-cursor \-justify \-wraplength
+\-disabledforeground \-padx
+.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 \-state state State
+Specifies one of three states for the label: \fBnormal\fR, \fBactive\fR,
+or \fBdisabled\fR. In normal state the button is displayed using the
+\fBforeground\fR and \fBbackground\fR options. In active state
+the label is displayed using the \fBactiveForeground\fR and
+\fBactiveBackground\fR options. In the disabled state the
+\fBdisabledForeground\fR and \fBbackground\fR options determine how
+the button is displayed.
+.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/tcl/doc/labelframe.n b/tcl/doc/labelframe.n
new file mode 100644
index 00000000000..29ac99c29c6
--- /dev/null
+++ b/tcl/doc/labelframe.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 labelframe n 8.4 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+labelframe \- Create and manipulate labelframe widgets
+.SH SYNOPSIS
+\fBlabelframe\fR \fIpathName\fR ?\fIoptions\fR?
+.SO
+\-borderwidth \-highlightbackground \-pady
+\-cursor \-highlightcolor \-relief
+\-font \-highlightthickness \-takefocus
+\-foreground \-padx \-text
+.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.
+.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.
+.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 \-labelanchor labelAnchor LabelAnchor
+Specifies where to place the label. A label is only displayed if the
+\fB\-text\fR option is not the empty string.
+Valid values for this option are (listing them clockwise)
+\fBnw\fR, \fBn\fR, \fBne\fR, \fBen\fR, \fBe\fR, \fBes\fR,
+\fBse\fR, \fBs\fR,\fBsw\fR, \fBws\fR, \fBw\fR and \fBwn\fR.
+The default value is \fBnw\fR.
+.OP \-labelwidget labelWidget LabelWidget
+Specifies a widget to use as label. This overrides any \fB\-text\fR
+option. The widget must exist before being used as \fB\-labelwidget\fR
+and if it is not a descendant of this window, it will be raised
+above it in the stacking order.
+.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 \fBlabelframe\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 background color
+and relief. The \fBlabelframe\fR command returns the
+path name of the new window.
+.PP
+A labelframe is a simple widget. Its primary purpose is to act as a
+spacer or container for complex window layouts. It has the features
+of a \fBframe\fR plus the ability to display a label.
+.SH "WIDGET COMMAND"
+.PP
+The \fBlabelframe\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:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\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 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 \fBlabelframe\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 \fBlabelframe\fR
+command.
+
+.SH BINDINGS
+.PP
+When a new labelframe is created, it has no default event bindings:
+labelframes are not intended to be interactive.
+
+.SH "SEE ALSO"
+frame(n), label(n)
+
+.SH KEYWORDS
+labelframe, widget
diff --git a/tcl/doc/license.terms b/tcl/doc/license.terms
index f1dcaa5245c..03ca6fcb319 100644
--- a/tcl/doc/license.terms
+++ b/tcl/doc/license.terms
@@ -1,8 +1,7 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
+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
@@ -37,4 +36,4 @@ 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.
+terms specified in this license.
diff --git a/tcl/doc/listbox.n b/tcl/doc/listbox.n
new file mode 100644
index 00000000000..ad86edf567c
--- /dev/null
+++ b/tcl/doc/listbox.n
@@ -0,0 +1,556 @@
+'\"
+'\" 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.4 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
+\-activestyle \-height \-selectforeground
+\-background \-highlightbackground \-setgrid
+\-borderwidth \-highlightcolor \-state
+\-cursor \-highlightthickness \-takefocus
+\-disabledforeground \-relief \-width
+\-exportselection \-selectbackground \-xscrollcommand
+\-font \-selectborderwidth \-yscrollcommand
+\-foreground
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.VS 8.4
+.OP \-activestyle activeStyle ActiveStyle
+Specifies the style in which to draw the active element. This must be
+one of \fBdotbox\fR (show a focus ring around the active element),
+\fBnone\fR (nospecial indication of active element) or
+\fBunderline\fR (underline the active element).
+The default is \fBunderline\fR.
+.VS 8.4
+.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 \-listvariable listVariable Variable
+Specifies the name of a variable. The value of the variable is a list to
+be displayed inside the widget; if the variable value changes then the
+widget will automatically update itself to reflect the new value. Attempts
+to assign a variable with an invalid list value to \fB\-listvariable\fR
+will cause an error. Attempts to unset a variable in use as a
+\fB\-listvariable\fR will fail but will not generate an error.
+.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 \-state state State
+Specifies one of two states for the listbox: \fBnormal\fR or \fBdisabled\fR.
+If the listbox is disabled then items may not be inserted or deleted,
+items are drawn in the \fB-disabledforeground\fR color, and selection
+cannot be modified and is not shown (though selection information is retained).
+.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 as specified by \fB\-activestyle\fR 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 as specified by \fB\-activestyle\fR 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 \fBitemcget \fIindex option\fR
+Returns the current value of the item configuration option given
+by \fIoption\fR. \fIOption\fR may have any of the values accepted
+by the \fBlistbox itemconfigure\fR command.
+.TP
+\fIpathName \fBitemconfigure \fIindex\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+Query or modify the configuration options of an item in the listbox.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for the item (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. The following options
+are currently supported for items:
+.RS
+.TP
+\fB\-background \fIcolor\fR
+\fIColor\fR specifies the background color to use when displaying the
+item. It may have any of the forms accepted by \fBTk_GetColor\fR.
+.TP
+\fB\-foreground \fIcolor\fR
+\fIColor\fR specifies the foreground color to use when displaying the
+item. It may have any of the forms accepted by \fBTk_GetColor\fR.
+.TP
+\fB\-selectbackground \fIcolor\fR
+\fIcolor\fR specifies the background color to use when displaying the
+item while it is selected. It may have any of the forms accepted by
+\fBTk_GetColor\fR.
+.TP
+\fB\-selectforeground \fIcolor\fR
+\fIcolor\fR specifies the foreground color to use when displaying the
+item while it is selected. It may have any of the forms accepted by
+\fBTk_GetColor\fR.
+.RE
+.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
+Any time the selection changes in the listbox, the virtual event
+\fB<<ListboxSelect>>\fR will be generated. It is easiest to bind
+to this event to be made aware of any changes to listbox selection.
+.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/tcl/doc/loadTk.n b/tcl/doc/loadTk.n
new file mode 100644
index 00000000000..4a1ca940b5d
--- /dev/null
+++ b/tcl/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 ``.''
+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 ``.'' 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/tcl/doc/lower.n b/tcl/doc/lower.n
new file mode 100644
index 00000000000..8738c23e465
--- /dev/null
+++ b/tcl/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/tcl/doc/menu.n b/tcl/doc/menu.n
new file mode 100644
index 00000000000..b14c6a050f1
--- /dev/null
+++ b/tcl/doc/menu.n
@@ -0,0 +1,784 @@
+'\"
+'\" 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, tk_menuSetFocus \- Create and manipulate menu widgets
+.SH SYNOPSIS
+.nf
+\fBmenu\fR \fIpathName \fR?\fIoptions\fR?
+\fBtk_menuSetFocus\fR \fIpathName\fR
+.SO
+\-activebackground \-borderwidth \-foreground
+\-activeborderwidth \-cursor \-relief
+\-activeforeground \-disabledforeground \-takefocus
+\-background \-font
+
+.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.
+.PP
+As noted, menubars may behave differently on different platforms. One
+example of this concerns the handling of checkbuttons and radiobuttons
+within the menu. While it is permitted to put these menu elements on
+menubars, they may not be drawn with indicators on some platforms, due
+to system restrictions.
+.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
+.VS 8.4
+\fB\-compound \fIvalue\fR
+Specifies whether the menu entry should display both an image and text,
+and if so, where the image should be placed relative to the text.
+Valid values for this option are \fBbottom\fR, \fBcenter\fR,
+\fBleft\fR, \fBnone\fR, \fBright\fR and \fBtop\fR. The default value
+is \fBnone\fR, meaning that the button will display either an image or
+text, depending on the values of the \fB\-image\fR and \fB\-bitmap\fR
+options.
+.VE
+.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
+.VS 8.4
+Several of the bindings make use of the command \fBtk_menuSetFocus\fR.
+It saves the current focus and sets the focus to its \fIpathName\fR
+argument, which is a menu widget.
+.VE
+.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/tcl/doc/menubar.n b/tcl/doc/menubar.n
new file mode 100644
index 00000000000..59fc252860e
--- /dev/null
+++ b/tcl/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/tcl/doc/menubutton.n b/tcl/doc/menubutton.n
new file mode 100644
index 00000000000..c0cb46625ce
--- /dev/null
+++ b/tcl/doc/menubutton.n
@@ -0,0 +1,203 @@
+'\"
+'\" 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 \-font \-pady
+\-activeforeground \-foreground \-relief
+\-anchor \-highlightbackground \-takefocus
+\-background \-highlightcolor \-text
+\-bitmap \-highlightthickness \-textvariable
+\-borderwidth \-image \-underline
+\-cursor \-justify \-wraplength
+\-disabledforeground \-padx
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-compound compound Compound
+Specifies whether the menubutton should display both an image and text,
+and if so, where the image should be placed relative to the text.
+Valid values for this option are \fBbottom\fR, \fBcenter\fR,
+\fBleft\fR, \fBnone\fR, \fBright\fR and \fBtop\fR. The default value
+is \fBnone\fR, meaning that the menubutton will display either an image or
+text, depending on the values of the \fB\-image\fR and \fB\-bitmap\fR
+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/tcl/doc/message.n b/tcl/doc/message.n
new file mode 100644
index 00000000000..dedbf7e899e
--- /dev/null
+++ b/tcl/doc/message.n
@@ -0,0 +1,149 @@
+'\"
+'\" 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 \-highlightbackground \-takefocus
+\-background \-highlightcolor \-text
+\-borderwidth \-highlightthickness \-textvariable
+\-cursor \-padx \-width
+\-font \-pady
+\-foreground \-relief
+.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/tcl/doc/messageBox.n b/tcl/doc/messageBox.n
new file mode 100644
index 00000000000..e06ee514548
--- /dev/null
+++ b/tcl/doc/messageBox.n
@@ -0,0 +1,89 @@
+'\"
+'\" 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 this option is not specified,
+the first button in the dialog will be made the default.
+.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 the info 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]
+switch -- $answer {
+ yes exit
+ no {tk_messageBox \-message "I know you like this application!" \-type ok}
+}
+.CE
+
+.SH KEYWORDS
+message box
diff --git a/tcl/doc/option.n b/tcl/doc/option.n
new file mode 100644
index 00000000000..8f0dd6ad5de
--- /dev/null
+++ b/tcl/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/tcl/doc/optionMenu.n b/tcl/doc/optionMenu.n
new file mode 100644
index 00000000000..9dd7147ed16
--- /dev/null
+++ b/tcl/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/tcl/doc/options.n b/tcl/doc/options.n
new file mode 100644
index 00000000000..16e9a49eddd
--- /dev/null
+++ b/tcl/doc/options.n
@@ -0,0 +1,333 @@
+'\"
+'\" 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.
+The value may have any of the forms accepted by \fBTk_GetFont\fR.
+.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. This option is ignored for
+scrollbars on Windows (native widget doesn't recognize this option).
+.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 "SEE ALSO"
+colors, cursors, font
+
+.SH KEYWORDS
+class, name, standard option, switch
diff --git a/tcl/doc/pack-old.n b/tcl/doc/pack-old.n
new file mode 100644
index 00000000000..902fcc5970e
--- /dev/null
+++ b/tcl/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/tcl/doc/pack.n b/tcl/doc/pack.n
new file mode 100644
index 00000000000..2ece2c92951
--- /dev/null
+++ b/tcl/doc/pack.n
@@ -0,0 +1,268 @@
+'\"
+'\" 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 may be a list
+of two values to specify padding for left and right separately.
+\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 may be a list
+of two values to specify padding for top and bottom separtely.
+\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/tcl/doc/palette.n b/tcl/doc/palette.n
new file mode 100644
index 00000000000..a0a3433e362
--- /dev/null
+++ b/tcl/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/tcl/doc/panedwindow.n b/tcl/doc/panedwindow.n
new file mode 100644
index 00000000000..23edc37b2c5
--- /dev/null
+++ b/tcl/doc/panedwindow.n
@@ -0,0 +1,246 @@
+'\"
+'\" 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 panedwindow n 8.4 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+panedwindow \- Create and manipulate panedwindow widgets
+.SH SYNOPSIS
+\fBpanedwindow\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-background \-height \-width
+\-borderwidth \-orient
+\-cursor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-handlepad handlePad HandlePad
+When sash handles are drawn, specifies the distance from the top or
+left end of the sash (depending on the orientation of the widget) at
+which to draw the handle. May be any value accepted by \fBTk_GetPixels\fR.
+.OP \-handlesize handleSize HandleSize
+Specifies the side length of a sash handle. Handles are always
+drawn as squares. May be any value accepted by \fBTk_GetPixels\fR.
+.OP \-opaqueresize opaqueResize OpaqueResize
+Specifies whether panes should be resized as a sash is moved (true),
+or if resizing should be deferred until the sash is placed (false).
+.OP \-sashcursor sashCursor SashCursor
+Mouse cursor to use when over a sash. If null,
+\fBsb_h_double_arrow\fR will be used for horizontal panedwindows, and
+\fBsb_v_double_arrow\fR will be used for vertical panedwindows.
+.OP \-sashpad sashPad SashPad
+Specifies the amount of padding to leave of each side of a sash. May
+be any value accepted by \fBTk_GetPixels\fR.
+.OP \-sashrelief sashRelief SashRelief
+Relief to use when drawing a sash. May be any of the standard Tk
+relief values.
+.OP \-sashwidth sashWidth SashWidth
+Specifies the width of each sash. May be any value accepted by
+\fBTk_GetPixels\fR.
+.OP \-showhandle showHandle ShowHandle
+Specifies whether sash handles should be shown. May be any valid Tcl
+boolean value.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBpanedwindow\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
+such as its default background color and relief. The
+\fBpanedwindow\fR command returns the path name of the new window.
+.PP
+A panedwindow widget contains any number of panes, arranged
+horizontally or vertically, according to the value of the
+\fB\-orient\fR option. Each pane contains one widget, and each pair of
+panes is separated by a moveable (via mouse movements) sash. Moving a
+sash causes the widgets on either side of the sash to be resized.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBpanedwindow\fR command creates a new Tcl command whose name is
+the same as the path name of the panedwindow'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 panedwindow 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 \fIwindow ?window ...? ?option value ...?\fR
+Add one or more windows to the panedwindow, each in a separate pane.
+The arguments consist of the names of one or more windows
+followed by pairs of arguments that specify how to manage the windows.
+\fIOption\fR may have any of the values accepted by the
+\fBconfigure\fR subcommand.
+.TP
+\fIpathName \fBcget \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 \fBconfigure \fI?option? ?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 \fBpanedwindow\fR command.
+.TP
+\fIpathName \fBforget \fIwindow ?window ...?\fR
+Remove the pane containing \fIwindow\fR from the panedwindow. All
+geometry management options for \fIwindow\fR will be forgotten.
+.TP
+\fIpathName \fBidentify \fIx y\fR
+Identify the panedwindow component underneath the point given by
+\fIx\fR and \fIy\fR, in window coordinates. If the point is over a
+sash or a sash handle, the result is a two element list containing the
+index of the sash or handle, and a word indicating whether it is over
+a sash or a handle, such as {0 sash} or {2 handle}. If the point is
+over any other part of the panedwindow, the result is an empty list.
+.TP
+\fIpathName \fBproxy \fI?args?\fR
+This command is used to query and change the position of the sash
+proxy, used for rubberband-style pane resizing. It can take any of
+the following forms:
+.RS
+.TP
+\fIpathName \fBproxy coord\fR
+Return a list containing the x and y coordinates of the most recent
+proxy location.
+.TP
+\fIpathname \fBproxy forget\fR
+Remove the proxy from the display.
+.TP
+\fIpathName \fBproxy place \fIx y\fR
+Place the proxy at the given \fIx\fR and \fIy\fR coordinates.
+.RE
+.TP
+\fIpathName \fBsash \fI?args?\fR
+This command is used to query and change the position of sashes in the
+panedwindow. It can take any of the following forms:
+.RS
+.TP
+\fIpathName \fBsash coord \fIindex\fR
+Return the current x and y coordinate pair for the sash given by
+\fIindex\fR. \fIIndex\fR must be an integer between 0 and 1 less than
+the number of panes in the panedwindow. The coordinates given are
+those of the top left corner of the region containing the sash.
+\fIpathName \fBsash dragto \fIindex x y\fR
+This command computes the difference between the given coordinates and the
+coordinates given to the last \fBsash coord\fR command for the given
+sash. It then moves that sash the computed difference. The return
+value is the empty string.
+.TP
+\fIpathName \fBsash mark \fIindex x y\fR
+Records \fIx\fR and \fIy\fR for the sash given by \fIindex\fR; used in
+conjunction with later dragto commands to move the sash.
+.TP
+\fIpathName \fBsash place \fIindex x y\fR
+Place the sash given by \fIindex\fR at the given coordinates.
+.RE
+.TP
+\fIpathName \fBpanecget \fIwindow option\fR
+Query a management option for \fIwindow\fR. \fIOption\fR may be any
+value allowed by the \fBpaneconfigure\fR subcommand.
+.TP
+\fIpathName \fBpaneconfigure \fIwindow ?option? ?value option value ...?\fR
+Query or modify the management options for \fIwindow\fR. 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. The following options
+are supported:
+.RS
+.TP
+\fB\-after \fIwindow\fR
+Insert the window after the window specified. \fIwindow\fR should be the
+name of a window already managed by \fIpathName\fR.
+.TP
+\fB\-before \fIwindow\fR
+Insert the window before the window specified. \fIwindow\fR should be
+the name of a window already managed by \fIpathName\fR.
+.TP
+\fB\-height \fIsize\fR
+Specify a height for the window. The height will be the outer
+dimension of the window including its border, if any. If \fIsize\fR
+is an empty string, or if \fB\-height\fR is not specified, then the
+height requested internally by the window will be used initially; the
+height may later be adjusted by the movement of sashes in the
+panedwindow. \fISize\fR may be any value accepted by \fBTk_GetPixels\fR.
+.TP
+\fB\-minsize \fIn\fR
+Specifies that the size of the window cannot be made less than
+\fIn\fR. This constraint only affects the size of the widget in the
+paned dimension -- the x dimension for horizontal panedwindows, the y
+dimension for vertical panedwindows. May be any value accepted by
+\fBTk_GetPixels\fR.
+.TP
+\fB\-padx \fIn\fR
+Specifies a non-negative value indicating how much extra space to
+leave on each side of the window in the X-direction. The value may
+have any of the forms accepted by \fBTk_GetPixels\fR.
+.TP
+\fB\-pady \fIn\fR
+Specifies a non-negative value indicating how much extra space to
+leave on each side of the window in the Y-direction. The value may
+have any of the forms accepted by \fBTk_GetPixels\fR.
+.TP
+\fB\-sticky \fIstyle\fR
+If a window's pane is larger than the requested dimensions of the
+window, this option may be used to position (or stretch) the window
+within its pane. \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 window
+will "stick" to. If both \fBn\fP and \fBs\fP (or \fBe\fP and \fBw\fP)
+are specified, the window will be stretched to fill the entire height
+(or width) of its cavity.
+.TP
+\fB\-width \fIsize\fR
+Specify a width for the window. The width will be the outer
+dimension of the window including its border, if any. If \fIsize\fR
+is an empty string, or if \fB\-width\fR is not specified, then the
+width requested internally by the window will be used initially; the
+width may later be adjusted by the movement of sashes in the
+panedwindow. \fISize\fR may be any value accepted by \fBTk_GetPixels\fR.
+.RE
+.TP
+\fIpathName \fBpanes\fR
+Returns an ordered list of the widgets managed by \fIpathName\fR.
+
+.SH "RESIZING PANES"
+
+A pane is resized by grabbing the sash (or sash handle if present) and
+dragging with the mouse. This is accomplished via mouse motion
+bindings on the widget. When a sash is moved, the sizes of the panes
+on each side of the sash, and thus the widgets in those panes, are
+adjusted.
+.PP
+When a pane is resized from outside (eg, it is packed to expand and
+fill, and the containing toplevel is resized), space is added to the final
+(rightmost or bottommost) pane in the window.
+
+.SH KEYWORDS
+panedwindow, widget, geometry management
diff --git a/tcl/doc/photo.n b/tcl/doc/photo.n
new file mode 100644
index 00000000000..e66d34e3eda
--- /dev/null
+++ b/tcl/doc/photo.n
@@ -0,0 +1,443 @@
+'\"
+'\" 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 (32
+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
+.VS 8.4
+or where it has been set transparent by the \fBtransparency set\fR
+subcommand.
+.VE 8.4
+
+.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 string can
+contain base64 encoded data or binary data. 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.
+.TP
+\fB\-compositingrule \fIrule\fR
+.VS 8.4
+Specifies how transparent pixels in the source image are combined with
+the destination image. When a compositing rule of \fIoverlay\fR is
+set, the old contents of the destination image are visible, as if the
+source image were printed on a piece of transparent film and placed
+over the top of the destination. When a compositing rule of \fIset\fR
+is set, the old contents of the destination image are discarded and
+the source image is used as-is. The default compositing rule is
+\fIoverlay\fR.
+.VE 8.4
+.RE
+.TP
+\fIimageName \fBdata ?\fIoption value(s) ...\fR?
+Returns image data in the form of a string. The following options
+may be specified:
+.RS
+.TP
+\fB\-background\fI color\fR
+If the color is specified, the data will not contain any transparency
+information. In all transparent pixels the color will be replaced by
+the specified color.
+.TP
+\fB\-format\fI format-name\fR
+Specifies the name of the image file format handler to be used.
+Specifically, this subcommand searches
+for the first handler whose name matches a initial substring of
+\fIformat-name\fR and which has the capability to read this image data.
+If this option is not given, this subcommand uses the first
+handler that has the capability to read the image data.
+.TP
+\fB\-from \fIx1 y1 x2 y2\fR
+Specifies a rectangular region of \fIimageName\fR to be returned.
+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, including x1,y1
+and excluding x2,y2. The default, if this option is not given, is the
+whole image.
+.TP
+\fB\-grayscale\fR
+If this options is specified, the data will not contain color
+information. All pixel data will be transformed into grayscale.
+.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\fR \fIdata\fR ?\fIoption value(s) ...\fR?
+Sets pixels in \fI imageName\fR to the data specified in
+\fIdata\fR. This command first searches the list of image file
+format handlers for a handler that can interpret the data
+in \fIdata\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 \fIdata\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
+returned. 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.
+.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 \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 \fBtransparency \fIsubcommand ?arg arg ...?\fR
+.VS 8.4
+Allows examination and manipulation of the transparency information in
+the photo image. Several subcommands are available:
+.RS
+.TP
+\fIimageName \fBtransparency get \fIx y\fR
+Returns a boolean indicating if the pixel at (\fIx\fR,\fIy\fR) is
+transparent.
+\fIimageName \fBtransparency set \fIx y boolean\fR
+Makes the pixel at (\fIx\fR,\fIy\fR) transparent if \fIboolean\fR is
+true, and makes that pixel opaque otherwise.
+.RE
+.VE 8.4
+.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\-background\fI color\fR
+If the color is specified, the data will not contain any transparency
+information. In all transparent pixels the color will be replaced by
+the specified color.
+.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.
+.TP
+\fB\-grayscale\fR
+If this options is specified, the data will not contain color
+information. All pixel data will be transformed into grayscale.
+.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.
+.VS 8.4
+Note that not all image handlers may support writing transparency data
+to a file, even where the target image format does.
+.VE 8.4
+
+.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/tcl/doc/place.n b/tcl/doc/place.n
new file mode 100644
index 00000000000..4c21d72edf6
--- /dev/null
+++ b/tcl/doc/place.n
@@ -0,0 +1,250 @@
+'\"
+'\" 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 \fR?\fIoption\fR? ?\fIvalue option 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
+.TP
+\fBplace \fIwindow option value \fR?\fIoption value ...\fR?
+Arrange for the placer to manage the geometry of a slave whose
+pathName 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. \fIOption\fR may have any of the
+values accepted by the \fBplace configure\fR command.
+.TP
+\fBplace configure \fIwindow \fR?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the geometry options of the slave given by
+\fIwindow\fR. If no \fIoption\fR is specified, this command returns a
+list describing 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.
+
+The following \fIoption\-value\fR pairs are supported:
+.RS
+.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\-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.
+.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\-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\-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\-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\-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\-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\-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\-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\-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.
+.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.
+.RE
+.TP
+\fBplace forget \fIwindow\fR
+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. This command returns an
+empty string.
+.TP
+\fBplace info \fIwindow\fR
+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.
+.TP
+\fBplace slaves \fIwindow\fR
+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.
+
+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/tcl/doc/popup.n b/tcl/doc/popup.n
new file mode 100644
index 00000000000..8f574c85ead
--- /dev/null
+++ b/tcl/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/tcl/doc/radiobutton.n b/tcl/doc/radiobutton.n
new file mode 100644
index 00000000000..db33fe66a68
--- /dev/null
+++ b/tcl/doc/radiobutton.n
@@ -0,0 +1,256 @@
+'\"
+'\" 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 \-font \-pady
+\-activeforeground \-foreground \-relief
+\-anchor \-highlightbackground \-takefocus
+\-background \-highlightcolor \-text
+\-bitmap \-highlightthickness \-textvariable
+\-borderwidth \-image \-underline
+\-cursor \-justify \-wraplength
+\-disabledforeground \-padx
+.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.
+.VS 8.4
+.OP \-offrelief offRelief OffRelief
+Specifies the relief for the checkbutton when the indicator is not drawn and
+the checkbutton is off. The default value is "raised". By setting this option
+to "flat" and setting -indicatoron to false and -overrelief to raised,
+the effect is achieved
+of having a flat button that raises on mouse-over and which is
+depressed when activated. This is the behavior typically exhibited by
+the Align-Left, Align-Right, and Center radiobuttons on the toolbar of a
+word-processor, for example.
+
+.VE 8.4
+.VS 8.4
+.OP \-overrelief overRelief OverRelief
+Specifies an alternative relief for the radiobutton, to be used when the
+mouse cursor is over the widget. This option can be used to make
+toolbar buttons, by configuring \fB\-relief flat \-overrelief
+raised\fR. If the value of this option is the empty string, then no
+alternative relief is used when the mouse cursor is over the radiobutton.
+The empty string is the default value.
+.VE 8.4
+.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/tcl/doc/raise.n b/tcl/doc/raise.n
new file mode 100644
index 00000000000..550e0914eba
--- /dev/null
+++ b/tcl/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/tcl/doc/scale.n b/tcl/doc/scale.n
new file mode 100644
index 00000000000..9c21d8fa91e
--- /dev/null
+++ b/tcl/doc/scale.n
@@ -0,0 +1,247 @@
+'\"
+'\" 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 \-foreground \-relief
+\-background \-highlightbackground \-repeatdelay
+\-borderwidth \-highlightcolor \-repeatinterval
+\-cursor \-highlightthickness \-takefocus
+\-font \-orient \-troughcolor
+.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/tcl/doc/scrollbar.n b/tcl/doc/scrollbar.n
new file mode 100644
index 00000000000..744889dec5d
--- /dev/null
+++ b/tcl/doc/scrollbar.n
@@ -0,0 +1,341 @@
+'\"
+'\" 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 \-highlightcolor \-repeatdelay
+\-background \-highlightthickness \-repeatinterval
+\-borderwidth \-jump \-takefocus
+\-cursor \-orient \-troughcolor
+\-highlightbackground \-relief
+.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/tcl/doc/selection.n b/tcl/doc/selection.n
new file mode 100644
index 00000000000..3c41f88fd72
--- /dev/null
+++ b/tcl/doc/selection.n
@@ -0,0 +1,136 @@
+'\"
+'\" 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 8.1 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
+Note that for management of the CLIPBOARD selection (see below), the
+\fBclipboard\fR command may also be used.
+.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
+.VS
+are \fIoffset\fR and \fImaxChars\fR: \fIoffset\fR specifies a starting
+character position in the selection and \fImaxChars\fR gives the maximum
+number of characters to retrieve. The command should return a value consisting
+of at most \fImaxChars\fR of the selection, starting at position
+\fIoffset\fR. For very large selections (larger than \fImaxChars\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 \fImaxChars\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 \fImaxChars\fR then
+\fIcommand\fR will be invoked again, until it eventually
+returns a result shorter than \fImaxChars\fR. The value of \fImaxChars\fR
+will always be relatively large (thousands of characters).
+.VE
+.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 "SEE ALSO"
+clipboard
+
+.SH KEYWORDS
+clear, format, handler, ICCCM, own, selection, target, type
diff --git a/tcl/doc/send.n b/tcl/doc/send.n
new file mode 100644
index 00000000000..96056777d25
--- /dev/null
+++ b/tcl/doc/send.n
@@ -0,0 +1,97 @@
+'\"
+'\" 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. On Unix,
+any application that can connect to your X server can send
+scripts to your applications.
+These incoming scripts can use Tcl to read and
+write your files and invoke subprocesses under your name.
+Host-based access control such as that provided by \fBxhost\fR
+is particularly insecure, since it allows anyone with an account
+on particular hosts to connect to your server, and if disabled it
+allows anyone anywhere to connect to your server.
+In order to provide at least a small amount of
+security, Tk checks the access control being used by the server
+and rejects incoming sends unless (a) \fBxhost\fR-style access control
+is enabled (i.e. only certain hosts can establish connections) and (b) the
+list of enabled hosts is empty.
+This means that applications cannot connect to your server unless
+they use some other form of authorization
+such as that provide by \fBxauth\fR.
+.VS
+Under Windows, \fBsend\fR is currently disabled. Most of the
+functionality is provided by the \fBdde\fR command instead.
+.VE
+.SH KEYWORDS
+.VS
+application, dde, name, remote execution, security, send
+.VE
diff --git a/tcl/doc/spinbox.n b/tcl/doc/spinbox.n
new file mode 100644
index 00000000000..7fe92995576
--- /dev/null
+++ b/tcl/doc/spinbox.n
@@ -0,0 +1,582 @@
+'\"
+'\" Copyright (c) 2000 Jeffrey Hobbs.
+'\" Copyright (c) 2000 Ajuba Solutions.
+'\"
+'\" 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 spinbox n 8.4 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+spinbox \- Create and manipulate spinbox widgets
+.SH SYNOPSIS
+\fBspinbox\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-highlightthickness \-repeatinterval
+\-background \-insertbackground \-selectbackground
+\-borderwidth \-insertborderwidth \-selectborderwidth
+\-cursor \-insertontime \-selectforeground
+\-exportselection \-insertwidth \-takefocus
+\-font \-insertofftime \-textvariable
+\-foreground \-justify \-xscrollcommand
+\-highlightbackground \-relief
+\-highlightcolor \-repeatdelay
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-buttonbackground buttonBackground Background
+The background color to be used for the spin buttons.
+.OP \-buttoncursor buttonCursor Cursor
+The cursor to be used when over the spin buttons. If this is empty
+(the default), a default cursor will be used.
+.OP \-buttondownrelief buttonDownRelief Relief
+The relief to be used for the upper spin button.
+.OP \-buttonuprelief buttonUpRelief Relief
+The relief to be used for the lower spin button.
+.OP \-command command Command
+Specifies a Tcl command to invoke whenever a spinbutton is invoked.
+The command recognizes several percent substitutions: \fB%W\fR for
+the widget path, \fB%s\fR for the current value of the widget, and
+\fB%d\fR for the direction of the button pressed (\fBup\fR or \fBdown\fR).
+.OP \-disabledbackground disabledBackground DisabledBackground
+Specifies the background color to use when the spinbox is disabled. If
+this option is the empty string, the normal background color is used.
+.OP \-disabledforeground disabledForeground DisabledForeground
+Specifies the foreground color to use when the spinbox is disabled. If
+this option is the empty string, the normal foreground color is used.
+.OP \-format format Format
+Specifies an alternate format to use when setting the string value
+when using the \fB\-from\fR and \fB\-to\fR range.
+This must be a format specifier of the form \fB%<pad>.<pad>f\fR,
+as it will format a floating-point number.
+.OP \-from from From
+A floating-point value corresponding to the lowest value for a spinbox, to
+be used in conjunction with \fB\-to\fR and \fB\-increment\fR. When all
+are specified correctly, the spinbox will use these values to control its
+contents. This value must be less than the \fB\-to\fR option.
+If \fB\-values\fR is specified, it supercedes this option.
+.OP "\-invalidcommand or \-invcmd" invalidCommand InvalidCommand
+Specifies a script to eval when \fBvalidateCommand\fR returns 0. Setting
+it to an empty string disables this feature (the default). The best use of
+this option is to set it to \fIbell\fR. See \fBValidation\fR below for
+more information.
+.OP \-increment increment Increment
+A floating-point value specifying the increment. When used with
+\fB\-from\fR and \fB\-to\fR, the value in the widget will be adjusted by
+\fB\-increment\fR when a spin button is pressed (up adds the value,
+down subtracts the value).
+.OP \-readonlybackground readonlyBackground ReadonlyBackground
+Specifies the background color to use when the spinbox is readonly. If
+this option is the empty string, the normal background color is used.
+.OP \-state state State
+Specifies one of three states for the spinbox: \fBnormal\fR,
+\fBdisabled\fR, or \fBreadonly\fR. If the spinbox is readonly, 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; the
+contents of the widget may still be selected. If the spinbox is
+disabled, the value may not be changed, no insertion cursor will be
+displayed, the contents will not be selectable, and the spinbox may
+be displayed in a different color, depending on the values of the
+\fB-disabledforeground\fR and \fB-disabledbackground\fR options.
+.OP \-to to To
+A floating-point value corresponding to the highest value for the spinbox,
+to be used in conjunction with \fB\-from\fR and \fB\-increment\fR. When
+all are specified correctly, the spinbox will use these values to control
+its contents. This value must be greater than the \fB\-from\fR option.
+If \fB\-values\fR is specified, it supercedes this option.
+.OP \-validate validate Validate
+Specifies the mode in which validation should operate: \fBnone\fR,
+\fBfocus\fR, \fBfocusin\fR, \fBfocusout\fR, \fBkey\fR, or \fBall\fR.
+It defaults to \fBnone\fR. When you want validation, you must explicitly
+state which mode you wish to use. See \fBValidation\fR below for more.
+.OP "\-validatecommand or \-vcmd" validateCommand ValidateCommand
+Specifies a script to evaluate when you want to validate the input in the
+widget. Setting it to an empty string disables this feature (the default).
+Validation occurs according to the value of \fB\-validate\fR.
+This command must return a valid Tcl boolean value. If it returns 0 (or
+the valid Tcl boolean equivalent) then the value of the widget will not
+change and the \fBinvalidCommand\fR will be evaluated if it is set. If it
+returns 1, then value will be changed.
+See \fBValidation\fR below for more information.
+.OP \-values values Values
+Must be a proper list value. If specified, the spinbox will use these
+values as to control its contents, starting with the first value. This
+option has precedence over the \fB\-from\fR and \fB\-to\fR range.
+.OP \-width width Width
+Specifies an integer value indicating the desired width of the spinbox 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.
+.OP \-wrap wrap wrap
+Must be a proper boolean value. If on, the spinbox will wrap around the
+values of data in the widget.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBspinbox\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a spinbox widget.
+Additional options, described above, may be specified on the
+command line or in the option database
+to configure aspects of the spinbox such as its colors, font,
+and relief. The \fBspinbox\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 \fBspinbox\fR is an extended \fBentry\fR widget that allows he user
+to move, or spin, through a fixed set of ascending or descending values
+such as times or dates in addition to editing the value as in an
+\fBentry\fR. When first created, a spinbox's string is empty.
+A portion of the spinbox may be selected as described below.
+If a spinbox is exporting its selection (see the \fBexportSelection\fR
+option), then it will observe the standard protocols for handling the
+selection; spinbox selections are available as type \fBSTRING\fR.
+Spinboxes also observe the standard Tk rules for dealing with the
+input focus. When a spinbox has the input focus it displays an
+\fIinsertion cursor\fR to indicate where new characters will be
+inserted.
+.PP
+Spinboxes 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. Spinboxes 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 VALIDATION
+.PP
+Validation works by setting the \fBvalidateCommand\fR
+option to a script which will be evaluated according to the \fBvalidate\fR
+option as follows:
+.PP
+.IP \fBnone\fR 10
+Default. This means no validation will occur.
+.IP \fBfocus\fR 10
+\fBvalidateCommand\fR will be called when the spinbox receives or
+loses focus.
+.IP \fBfocusin\fR 10
+\fBvalidateCommand\fR will be called when the spinbox receives focus.
+.IP \fBfocusout\fR 10
+\fBvalidateCommand\fR will be called when the spinbox loses focus.
+.IP \fBkey\fR 10
+\fBvalidateCommand\fR will be called when the spinbox is edited.
+.IP \fBall\fR 10
+\fBvalidateCommand\fR will be called for all above conditions.
+.PP
+It is posible to perform percent substitutions on the \fBvalidateCommand\fR
+and \fBinvalidCommand\fR, just as you would in a \fBbind\fR script. The
+following substitutions are recognized:
+.PP
+.IP \fB%d\fR 5
+Type of action: 1 for \fBinsert\fR, 0 for \fBdelete\fR,
+or -1 for focus, forced or textvariable validation.
+.IP \fB%i\fR 5
+Index of char string to be inserted/deleted, if any, otherwise -1.
+.IP \fB%P\fR 5
+The value of the spinbox should edition occur. If you are configuring the
+spinbox widget to have a new textvariable, this will be the value of that
+textvariable.
+.IP \fB%s\fR 5
+The current value of spinbox before edition.
+.IP \fB%S\fR 5
+The text string being inserted/deleted, if any.
+Otherwise it is an empty string.
+.IP \fB%v\fR 5
+The type of validation currently set.
+.IP \fB%V\fR 5
+The type of validation that triggered the callback
+(key, focusin, focusout, forced).
+.IP \fB%W\fR 5
+The name of the spinbox widget.
+.PP
+In general, the \fBtextVariable\fR and \fBvalidateCommand\fR can be
+dangerous to mix. Any problems have been overcome so that using the
+\fBvalidateCommand\fR will not interfere with the traditional behavior of
+the spinbox widget. Using the \fBtextVariable\fR for read-only purposes will
+never cause problems. The danger comes when you try set the
+\fBtextVariable\fR to something that the \fBvalidateCommand\fR would not
+accept, which causes \fBvalidate\fR to become \fInone\fR (the
+\fBinvalidCommand\fR will not be triggered). The same happens
+when an error occurs evaluating the \fBvalidateCommand\fR.
+.PP
+Primarily, an error will occur when the \fBvalidateCommand\fR or
+\fBinvalidCommand\fR encounters an error in its script while evaluating or
+\fBvalidateCommand\fR does not return a valid Tcl boolean value. The
+\fBvalidate\fR option will also set itself to \fBnone\fR when you edit the
+spinbox widget from within either the \fBvalidateCommand\fR or the
+\fBinvalidCommand\fR. Such editions will override the one that was being
+validated. If you wish to edit the value of the widget
+during validation and still have the \fBvalidate\fR option set, you should
+include the command
+.CS
+ \fI%W config -validate %v\fR
+.CE
+in the \fBvalidateCommand\fR or \fBinvalidCommand\fR (whichever one you
+were editing the spinbox widget from). It is also recommended to not set an
+associated \fBtextVariable\fR during validation, as that can cause the
+spinbox widget to become out of sync with the \fBtextVariable\fR.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBspinbox\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 spinboxes take one or more indices as
+arguments. An index specifies a particular character in the spinbox'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 spinbox's string.
+This is equivalent to specifying a numerical index equal to the length
+of the spinbox'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 spinbox 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
+spinbox window.
+.TP 12
+\fB@\fInumber\fR
+In this form, \fInumber\fR is treated as an x-coordinate in the
+spinbox'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 spinbox 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 \fBspinbox\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 \fBspinbox\fR
+command.
+.TP
+\fIpathName \fBdelete \fIfirst \fR?\fIlast\fR?
+Delete one or more elements of the spinbox.
+\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 spinbox'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 \fBidentify\fI x y\fR
+Returns the name of the window element corresponding to coordinates
+\fIx\fR and \fIy\fR in the spinbox. Return value is one of:
+\fBnone\fR, \fBbuttondown\fR, \fBbuttonup\fR, \fBentry\fR.
+.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 \fBinvoke\fI element\fR
+Causes the specified element, either \fBbuttondown\fR or \fBbuttonup\fR,
+to be invoked, triggering the action associated with it.
+.TP
+\fIpathName \fBscan\fR \fIoption args\fR
+This command is used to implement scanning on spinboxes. It has
+two forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBscan mark \fIx\fR
+Records \fIx\fR and the current view in the spinbox 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 spinbox 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 a spinbox. 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 spinbox, 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 element\fR ?\fIelement\fR?
+Sets or gets the currently selected element. If a spinbutton element
+is specified, it will be displayed depressed.
+.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 spinbox,
+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 spinbox'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 \fBset\fR ?\fIstring\fR?
+If \fIstring\fR is specified, the spinbox will try and set it to this
+value, otherwise it just returns the spinbox's string.
+If validation is on, it will occur when setting the string.
+.TP
+\fIpathName \fBvalidate\fR
+This command is used to force an evaluation of the \fBvalidateCommand\fR
+independent of the conditions specified by the \fBvalidate\fR option.
+This is done by temporarily setting the \fBvalidate\fR option to \fBall\fR.
+It returns 0 or 1.
+.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 spinbox'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 spinboxes 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
+spinbox 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 spinbox without affecting the selection.
+.IP [6]
+If any normal printing characters are typed in a spinbox, they are
+inserted at the point of the insertion cursor.
+.IP [7]
+The view in the spinbox 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 spinbox at the position of the mouse cursor.
+.IP [8]
+If the mouse is dragged out of the spinbox on the left or right sides
+while button 1 is pressed, the spinbox 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 spinbox 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 spinbox and clear any selection in the spinbox.
+Shift-Home moves the insertion cursor to the beginning of the spinbox
+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 spinbox and clear any selection in the spinbox.
+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 spinbox.
+.IP [14]
+Control-\e clears any selection in the spinbox.
+.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 spinbox.
+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 spinbox.
+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 spinbox is disabled using the \fB\-state\fR option, then the spinbox's
+view can still be adjusted and text in the spinbox can still be selected,
+but no insertion cursor will be displayed and no text modifications will
+take place.
+.PP
+The behavior of spinboxes can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+spinbox, entry, widget
diff --git a/tcl/doc/text.n b/tcl/doc/text.n
new file mode 100644
index 00000000000..5cf8d9603c8
--- /dev/null
+++ b/tcl/doc/text.n
@@ -0,0 +1,1776 @@
+'\"
+'\" 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 8.4 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+text, tk_textCopy, tk_textCut, tk_textPaste \- Create and manipulate text widgets
+.SH SYNOPSIS
+.nf
+\fBtext\fR \fIpathName \fR?\fIoptions\fR?
+.VS 8.4
+\fBtk_textCopy\fR \fIpathName\fR
+\fBtk_textCut\fR \fIpathName\fR
+\fBtk_textPaste\fR \fIpathName\fR
+.VE 8.4
+.SO
+\-background \-highlightthickness \-relief
+\-borderwidth \-insertbackground \-selectbackground
+\-cursor \-insertborderwidth \-selectborderwidth
+\-exportselection \-insertofftime \-selectforeground
+\-font \-insertontime \-setgrid
+\-foreground \-insertwidth \-takefocus
+\-highlightbackground \-padx \-xscrollcommand
+\-highlightcolor \-pady \-yscrollcommand
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-autoseparators autoSeparators AutoSeparators
+.VS 8.4
+Specifies a boolean that says whether separators are automatically
+inserted in the undo stack. Only meaningful when the \fB\-undo\fR
+option is true.
+.VE 8.4
+.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 \-maxundo maxUndo MaxUndo
+.VS 8.4
+Specifies the maximum number of compound undo actions on the undo
+stack. A zero or a negative value imply an unlimited undo stack.
+.VE 8.4
+.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 \-undo undo Undo
+.VS 8.4
+Specifies a boolean that says whether the undo mechanism is active or
+not.
+.VE 8.4
+.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.
+Text widgets support four different kinds of annotations on the
+text, called tags, marks, embedded windows or embedded images.
+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
+The fourth form of annotation allows Tk images to be embedded in a text
+widget.
+See EMBEDDED IMAGES below for more details.
+.PP
+.VS 8.4
+The text widget also has a built-in undo/redo mechanism.
+See UNDO MECHANISM below for more details.
+.VE 8.4
+
+.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
+\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.
+.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\-elide \fIboolean\fR
+\fIElide\fR specifies whether the data should be elided.
+Elided data is not displayed and takes no space on screen, but further
+on behaves just as normal data.
+.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_GetFont\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 left of the mark (so that the mark
+remains rightmost). 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.
+
+.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.
+
+.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.
+.IP [4]
+Whenever the \fBsel\fR tag range changes a virtual event
+\fB<<Selection>>\fR is generated.
+.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 "THE MODIFIED FLAG"
+The text widget can keep track of changes to the content of the widget
+by means of the modified flag. Inserting or deleting text will set
+this flag. The flag can be queried, set and cleared programatically
+as well. Whenever the flag changes state a \fB<<Modified>>\fR virtual
+event is generated. See the \fBedit modified\fR widget command for
+more details.
+
+.SH "THE UNDO MECHANISM"
+.PP
+.VS 8.4
+The text widget has an unlimited undo and redo mechanism (when the
+\fB-undo\fR widget option is true) which records every insert and
+delete action on a stack.
+.PP
+Boundaries (called "separators") are inserted between edit actions.
+The purpose of these separators is to group inserts and deletes into
+one compound edit action. When undoing a change everything between
+two separators will be undone. The undone changes are then moved to
+the redo stack, so that an undone edit can be redone again. The redo
+stack is cleared whenever new edit actions are recorded on the undo
+stack. The undo and redo stacks can be cleared to keep their depth
+under control.
+.PP
+Separators are inserted automatically when the \fB-autoseparators\fR
+widget option is true. You can insert separators programatically as
+well. If a separator is already present at the top of the undo stack
+no other will be inserted. That means that two separators on the undo
+stack are always separated by at least one insert or delete action.
+.PP
+The undo mechanism is also linked to the modified flag. This means
+that undoing or redoing changes can take a modified text widget back
+to the unmodified state or vice versa. The modified flag will be set
+automatically to the appropriate state. This automatic coupling
+does not work when the modified flag has been set by the user, until
+the flag has been reset again.
+.PP
+See below for the \fBedit\fR widget command that controls the undo
+mechanism.
+.VE 8.4
+
+.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.
+.PP
+.VS 8.4
+When debugging is turned on, the drawing routines of the text widget
+set the global variables \fBtk_textRedraw\fR and \fBtk_textRelayout\fR
+to the lists of indices that are redrawn. The values of these variables
+are tested by Tk's test suite.
+.VE 8.4
+.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.
+.VS 8.4
+If more indices are given, multiple ranges of text will be deleted.
+All indices are first checked for validity before any deletions are made.
+They are sorted and the text is removed from the last range to the
+first range to deleted text does not cause a undesired index shifting
+side-effects. If multiple ranges with the same start index are given,
+then the longest range is used. If overlapping ranges are given, then
+they will be merged into spans that do not cause deletion of text
+outside the given ranges due to text shifted during deletion.
+.VE 8.4
+.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, images 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\-image\fR
+Include information about images in the dump results.
+.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 \fBedit \fIoption \fR?\fIarg arg ...\fR?
+.VS 8.4
+This command controls the undo mechanism and the modified flag. The
+exact behavior of the command depends on the \fIoption\fR argument
+that follows the \fBedit\fR argument. The following forms of the
+command are currently supported:
+.RS
+.TP
+\fIpathName \fBedit modified ?\fIboolean\fR?
+If \fIboolean\fR is not specified, returns the modified flag of the
+widget. The insert, delete, edit undo and edit redo commands or the
+user can set or clear the modified flag. If \fIboolean\fR is
+specified, sets the modified flag of the widget to \fIboolean\fR.
+.TP
+\fIpathName \fBedit redo\fR
+When the \fB-undo\fR option is true, reapplies the last undone edits
+provided no other edits were done since then. Generates an error when
+the redo stack is empty. Does nothing when the \fB-undo\fR option is
+false.
+.TP
+\fIpathName \fBedit reset\fR
+Clears the undo and redo stacks.
+.TP
+\fIpathName \fBedit separator\fR
+Inserts a separator (boundary) on the undo stack. Does nothing when
+the \fB-undo\fR option is false.
+.TP
+\fIpathName \fBedit undo\fR
+Undoes the last edit action when the \fB-undo\fR option is true. An
+edit action is defined as all the insert and delete commands that are
+recorded on the undo stack in between two separators. Generates an
+error when the undo stack is empty. Does nothing when the \fB-undo\fR
+option is false.
+.RE
+.VE 8.4
+.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.
+.VS 8.4
+If multiple index pairs are given, multiple ranges of text will be returned
+in a list. Invalid ranges will not be represented with empty strings in
+the list. The ranges are returned in the order passed to \fBget\fR.
+.VE 8.4
+.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 index positions between beginning and
+end of the matching range will be stored in the variable. If there are no
+embedded images or windows in the matching range, this is equivalent to the
+number of characters matched. In either case, the range \fImatchIdx\fR to
+\fImatchIdx + $count chars\fR will return the entire matched text.
+.TP
+\fB\-elide\fR
+Find elidden (hidden) text as well. By default only displayed text is
+searched.
+.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'' is dependent on the value of
+the \fBtcl_wordchars\fR variable. See tclvars(n).
+.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.
+.VS 8.4
+This action is carried out by the command \fBtk_textCopy\fR.
+.VE 8.4
+.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.
+.VS 8.4
+This action is carried out by the command \fBtk_textCut\fR.
+.VE 8.4
+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.
+.VS 8.4
+This action is carried out by the command \fBtk_textPaste\fR.
+.VE 8.4
+.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.
+.IP [32]
+.VS 8.4
+Control-z (and Control-underscore on UNIX when \fBtk_strictMotif\fR is
+true) undoes the last edit action if the \fB-undo\fR option is true.
+Does nothing otherwise.
+.IP [33]
+Control-Z (or Control-y on Windows) reapplies the last undone edit
+action if the \fB-undo\fR option is true. Does nothing otherwise.
+.VE 8.4
+.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, tkvars
diff --git a/tcl/doc/tk.n b/tcl/doc/tk.n
new file mode 100644
index 00000000000..b60aa9e9e0c
--- /dev/null
+++ b/tcl/doc/tk.n
@@ -0,0 +1,104 @@
+'\"
+'\" 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 8.4 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 8.4
+.TP
+\fBtk caret window \fR?\fB\-x \fIx\fR? ?\fB\-y \fIy\fR? ?\fB\-height \fIheight\fR?
+.
+Sets and queries the caret location for the display of the specified
+Tk window \fIwindow\fR. The caret is the per-display cursor location
+used for indicating global focus (e.g. to comply with Microsoft
+Accessibility guidelines), as well as for location of the over-the-spot
+XIM (X Input Methods) or Windows IME windows. If no options are specified,
+the last values used for setting the caret are return in option-value pair
+format. \fI\-x\fR and \fI\-y\fR represent window-relative coordinates, and
+\fI\-height\fR is the height of the current cursor location, or the height
+of the specified \fIwindow\fR if none is given.
+.VE
+.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
+.VS 8.3
+.TP
+\fBtk useinputmethods \fR?\fB\-displayof \fIwindow\fR? ?\fIboolean\fR?
+.
+Sets and queries the state of whether Tk should use XIM (X Input Methods)
+for filtering events. The resulting state is returned. XIM is used in
+some locales (ie: Japanese, Korean), to handle special input devices. This
+feature is only significant on X. If XIM support is not available, this
+will always return 0. If the \fIwindow\fR argument is omitted, it defaults
+to the main window. If the \fIboolean\fR argument is omitted, the current
+state is returned. This is turned on by default for the main display.
+.VE
+.VS 8.4
+.TP
+\fBtk windowingsystem\fR
+.
+Returns the current Tk windowing system, one of
+\fBx11\fR (X11-based), \fBwin32\fR (MS Windows),
+\fBclassic\fR (Mac OS Classic), or \fBaqua\fR (Mac OS X Aqua).
+.VE
+.SH KEYWORDS
+application name, send
diff --git a/tcl/doc/tkerror.n b/tcl/doc/tkerror.n
new file mode 100644
index 00000000000..9ccee96b1bc
--- /dev/null
+++ b/tcl/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/tcl/doc/tkvars.n b/tcl/doc/tkvars.n
new file mode 100644
index 00000000000..fe8b2e7d611
--- /dev/null
+++ b/tcl/doc/tkvars.n
@@ -0,0 +1,80 @@
+'\"
+'\" 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
+\fBtk::Priv\fR
+This variable is an array containing several pieces of information
+that are private to Tk. The elements of \fBtk::Priv\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
+\fBtk_textRedraw\fR
+.TP
+\fBtk_textRelayout\fR
+These variables are set by text widgets when they have debugging
+turned on. The values written to these variables can be used to
+test or debug text widget operations. These variables are mostly
+used by Tk's test suite.
+.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, text
diff --git a/tcl/doc/tkwait.n b/tcl/doc/tkwait.n
new file mode 100644
index 00000000000..0c39f384975
--- /dev/null
+++ b/tcl/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/tcl/doc/toplevel.n b/tcl/doc/toplevel.n
new file mode 100644
index 00000000000..070da077132
--- /dev/null
+++ b/tcl/doc/toplevel.n
@@ -0,0 +1,161 @@
+'\"
+'\" 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.4 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 \-highlightcolor \-pady
+\-cursor \-highlightthickness \-relief
+\-highlightbackground \-padx \-takefocus
+.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.
+.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.
+.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 \-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.
+.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.
+.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.
+.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 "SEE ALSO"
+frame(n)
+
+.SH KEYWORDS
+toplevel, widget
diff --git a/tcl/doc/winfo.n b/tcl/doc/winfo.n
new file mode 100644
index 00000000000..2d1303e2b21
--- /dev/null
+++ b/tcl/doc/winfo.n
@@ -0,0 +1,332 @@
+'\"
+'\" 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. Top-level windows are returned as children
+of their logical parents. The list is in stacking order, with
+the lowest window first, except for Top-level windows which
+are not returned in stacking order. Use the \fBwm stackorder\fR
+command to query the stacking order of Top-level windows.
+.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/tcl/doc/wish.1 b/tcl/doc/wish.1
new file mode 100644
index 00000000000..4afc2be5dff
--- /dev/null
+++ b/tcl/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/tcl/doc/wm.n b/tcl/doc/wm.n
new file mode 100644
index 00000000000..ab21e01afef
--- /dev/null
+++ b/tcl/doc/wm.n
@@ -0,0 +1,556 @@
+'\"
+'\" 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 8.4 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).
+.VS 8.4
+.TP
+\fBwm attributes \fIwindow\fR
+.TP
+\fBwm attributes \fIwindow\fR ?\fBoption\fR?
+.TP
+\fBwm attributes \fIwindow\fR ?\fBoption value option value...\fR?
+.RS
+This subcommand returns or sets platform specific attributes associated
+with a window. The first form returns a list of the platform specific
+flags and their values. The second form returns the value for the
+specific option. The third form sets one or more of the values. The
+values are as follows:
+.PP
+On Windows, \fB-disabled\fR gets or sets whether the window is in a
+disabled state. \fB-toolwindow\fR gets or sets the style of the window
+to toolwindow (as defined in the MSDN). \fB-topmost\fR gets or sets
+whether this is a topmost window (displays above all other windows).
+.PP
+On Macintosh,
+.PP
+On Unix, there are currently no special attribute values.
+.RE
+.VE 8.4
+.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. On Windows, a deiconified window will also be
+raised and be given the focus (made the active window).
+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. On the Windows operating
+system, an additional flag is supported:
+\fBwm iconbitmap \fIwindow\fR ?\fI-default\fR? ?\fIimage\fR?.
+If the \fI-default\fR
+flag is given, the icon is applied to all toplevel windows (existing
+and future) to which no other specific icon has yet been applied.
+In addition to bitmap image types, a full path specification to
+any file which contains a valid
+Windows icon is also accepted (usually .ico or .icr files), or any
+file for which the shell has assigned an icon. Tcl will
+first test if the file contains an icon, then if it has an assigned
+icon, and finally, if that fails, test for
+a 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 \fBprogram\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 stackorder \fIwindow\fR ?\fIisabove|isbelow window\fR?
+The stackorder command returns a list of toplevel windows
+in stacking order, from lowest to highest. When a single toplevel
+window is passed, the returned list recursively includes all of the
+window's children that are toplevels. Only those toplevels
+that are currently mapped to the screen are returned.
+The stackorder command can also be used to determine if one
+toplevel is positioned above or below a second toplevel.
+When two window arguments separated by either \fIisabove\fR or
+\fIisbelow\fR are passed, a boolean result indicates whether
+or not the first window is currently above or below the second
+window in the stacking order.
+.TP
+\fBwm state \fIwindow\fR ?newstate?
+If \fInewstate\fR is specified, the window will be set to the new state,
+otherwise it returns the current state of \fIwindow\fR: either
+\fBnormal\fR, \fBiconic\fR, \fBwithdrawn\fR, \fBicon\fR, or (Windows only)
+\fBzoomed\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). The \fBicon\fR state cannot be set.
+.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). If \fImaster\fR
+is specified as an empty string then \fIwindow\fR is marked as not
+being a transient window any more. 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.
+A transient window will mirror state changes in the master and
+inherit the state of the master when initially mapped. It is an
+error to attempt to make a window a transient of itself.
+.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/tcl/generic/README b/tcl/generic/README
index b7d94230b29..1a77e83f9f3 100644
--- a/tcl/generic/README
+++ b/tcl/generic/README
@@ -1,5 +1,5 @@
-This directory contains Tcl source files that work on all the platforms
-where Tcl runs (e.g. UNIX, PCs, and Macintoshes). Platform-specific
+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$
+RCS ID: @(#) $Id$
diff --git a/tcl/generic/default.h b/tcl/generic/default.h
new file mode 100644
index 00000000000..73e76864fc8
--- /dev/null
+++ b/tcl/generic/default.h
@@ -0,0 +1,32 @@
+/*
+ * 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) || \
+ defined(__CYGWIN__) || defined(__MINGW32__)
+# include "tkWinDefault.h"
+#else
+# if defined(MAC_OSX_TK)
+# include "tkMacOSXDefault.h"
+# elif defined(MAC_TCL)
+# include "tkMacDefault.h"
+# else
+# include "tkUnixDefault.h"
+# endif
+#endif
+
+#endif /* _DEFAULT */
diff --git a/tcl/generic/ks_names.h b/tcl/generic/ks_names.h
new file mode 100644
index 00000000000..75b914981b5
--- /dev/null
+++ b/tcl/generic/ks_names.h
@@ -0,0 +1,923 @@
+/*
+ * 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 },
+{ "Scroll_Lock", 0xFF14 },
+{ "Sys_Req", 0xFF15 },
+{ "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/tcl/generic/prolog.ps b/tcl/generic/prolog.ps
new file mode 100644
index 00000000000..546408a34e6
--- /dev/null
+++ b/tcl/generic/prolog.ps
@@ -0,0 +1,284 @@
+%%BeginProlog
+50 dict begin
+
+% This is a standard prolog for Postscript generated by Tk's canvas
+% widget.
+% RCS: @(#) $Id$
+
+% The definitions below just define all of the variables used in
+% any of the procedures here. This is needed for obscure reasons
+% explained on p. 716 of the Postscript manual (Section H.2.7,
+% "Initializing Variables," in the section on Encapsulated Postscript).
+
+/baseline 0 def
+/stipimage 0 def
+/height 0 def
+/justify 0 def
+/lineLength 0 def
+/spacing 0 def
+/stipple 0 def
+/strings 0 def
+/xoffset 0 def
+/yoffset 0 def
+/tmpstip null def
+
+% Define the array ISOLatin1Encoding (which specifies how characters are
+% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript
+% level 2 is supposed to define it, but level 1 doesn't).
+
+systemdict /ISOLatin1Encoding known not {
+ /ISOLatin1Encoding [
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /space /exclam /quotedbl /numbersign /dollar /percent /ampersand
+ /quoteright
+ /parenleft /parenright /asterisk /plus /comma /minus /period /slash
+ /zero /one /two /three /four /five /six /seven
+ /eight /nine /colon /semicolon /less /equal /greater /question
+ /at /A /B /C /D /E /F /G
+ /H /I /J /K /L /M /N /O
+ /P /Q /R /S /T /U /V /W
+ /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
+ /quoteleft /a /b /c /d /e /f /g
+ /h /i /j /k /l /m /n /o
+ /p /q /r /s /t /u /v /w
+ /x /y /z /braceleft /bar /braceright /asciitilde /space
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
+ /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron
+ /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
+ /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
+ /registered /macron
+ /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
+ /periodcentered
+ /cedillar /onesuperior /ordmasculine /guillemotright /onequarter
+ /onehalf /threequarters /questiondown
+ /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
+ /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex
+ /Idieresis
+ /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
+ /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
+ /germandbls
+ /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
+ /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex
+ /idieresis
+ /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
+ /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn
+ /ydieresis
+ ] def
+} if
+
+% font ISOEncode font
+% This procedure changes the encoding of a font from the default
+% Postscript encoding to ISOLatin1. It's typically invoked just
+% before invoking "setfont". The body of this procedure comes from
+% Section 5.6.1 of the Postscript book.
+
+/ISOEncode {
+ dup length dict begin
+ {1 index /FID ne {def} {pop pop} ifelse} forall
+ /Encoding ISOLatin1Encoding def
+ currentdict
+ end
+
+ % I'm not sure why it's necessary to use "definefont" on this new
+ % font, but it seems to be important; just use the name "Temporary"
+ % for the font.
+
+ /Temporary exch definefont
+} bind def
+
+% StrokeClip
+%
+% This procedure converts the current path into a clip area under
+% the assumption of stroking. It's a bit tricky because some Postscript
+% interpreters get errors during strokepath for dashed lines. If
+% this happens then turn off dashes and try again.
+
+/StrokeClip {
+ {strokepath} stopped {
+ (This Postscript printer gets limitcheck overflows when) =
+ (stippling dashed lines; lines will be printed solid instead.) =
+ [] 0 setdash strokepath} if
+ clip
+} bind def
+
+% desiredSize EvenPixels closestSize
+%
+% The procedure below is used for stippling. Given the optimal size
+% of a dot in a stipple pattern in the current user coordinate system,
+% compute the closest size that is an exact multiple of the device's
+% pixel size. This allows stipple patterns to be displayed without
+% aliasing effects.
+
+/EvenPixels {
+ % Compute exact number of device pixels per stipple dot.
+ dup 0 matrix currentmatrix dtransform
+ dup mul exch dup mul add sqrt
+
+ % Round to an integer, make sure the number is at least 1, and compute
+ % user coord distance corresponding to this.
+ dup round dup 1 lt {pop 1} if
+ exch div mul
+} bind def
+
+% width height string StippleFill --
+%
+% Given a path already set up and a clipping region generated from
+% it, this procedure will fill the clipping region with a stipple
+% pattern. "String" contains a proper image description of the
+% stipple pattern and "width" and "height" give its dimensions. Each
+% stipple dot is assumed to be about one unit across in the current
+% user coordinate system. This procedure trashes the graphics state.
+
+/StippleFill {
+ % The following code is needed to work around a NeWSprint bug.
+
+ /tmpstip 1 index def
+
+ % Change the scaling so that one user unit in user coordinates
+ % corresponds to the size of one stipple dot.
+ 1 EvenPixels dup scale
+
+ % Compute the bounding box occupied by the path (which is now
+ % the clipping region), and round the lower coordinates down
+ % to the nearest starting point for the stipple pattern. Be
+ % careful about negative numbers, since the rounding works
+ % differently on them.
+
+ pathbbox
+ 4 2 roll
+ 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll
+ 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll
+
+ % Stack now: width height string y1 y2 x1 x2
+ % Below is a doubly-nested for loop to iterate across this area
+ % in units of the stipple pattern size, going up columns then
+ % across rows, blasting out a stipple-pattern-sized rectangle at
+ % each position
+
+ 6 index exch {
+ 2 index 5 index 3 index {
+ % Stack now: width height string y1 y2 x y
+
+ gsave
+ 1 index exch translate
+ 5 index 5 index true matrix tmpstip imagemask
+ grestore
+ } for
+ pop
+ } for
+ pop pop pop pop pop
+} bind def
+
+% -- AdjustColor --
+% Given a color value already set for output by the caller, adjusts
+% that value to a grayscale or mono value if requested by the CL
+% variable.
+
+/AdjustColor {
+ CL 2 lt {
+ currentgray
+ CL 0 eq {
+ .5 lt {0} {1} ifelse
+ } if
+ setgray
+ } if
+} bind def
+
+% x y strings spacing xoffset yoffset justify stipple DrawText --
+% This procedure does all of the real work of drawing text. The
+% color and font must already have been set by the caller, and the
+% following arguments must be on the stack:
+%
+% x, y - Coordinates at which to draw text.
+% strings - An array of strings, one for each line of the text item,
+% in order from top to bottom.
+% spacing - Spacing between lines.
+% xoffset - Horizontal offset for text bbox relative to x and y: 0 for
+% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.
+% yoffset - Vertical offset for text bbox relative to x and y: 0 for
+% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.
+% justify - 0 for left justification, 0.5 for center, 1 for right justify.
+% stipple - Boolean value indicating whether or not text is to be
+% drawn in stippled fashion. If text is stippled,
+% procedure StippleText must have been defined to call
+% StippleFill in the right way.
+%
+% Also, when this procedure is invoked, the color and font must already
+% have been set for the text.
+
+/DrawText {
+ /stipple exch def
+ /justify exch def
+ /yoffset exch def
+ /xoffset exch def
+ /spacing exch def
+ /strings exch def
+
+ % First scan through all of the text to find the widest line.
+
+ /lineLength 0 def
+ strings {
+ stringwidth pop
+ dup lineLength gt {/lineLength exch def} {pop} ifelse
+ newpath
+ } forall
+
+ % Compute the baseline offset and the actual font height.
+
+ 0 0 moveto (TXygqPZ) false charpath
+ pathbbox dup /baseline exch def
+ exch pop exch sub /height exch def pop
+ newpath
+
+ % Translate coordinates first so that the origin is at the upper-left
+ % corner of the text's bounding box. Remember that x and y for
+ % positioning are still on the stack.
+
+ translate
+ lineLength xoffset mul
+ strings length 1 sub spacing mul height add yoffset mul translate
+
+ % Now use the baseline and justification information to translate so
+ % that the origin is at the baseline and positioning point for the
+ % first line of text.
+
+ justify lineLength mul baseline neg translate
+
+ % Iterate over each of the lines to output it. For each line,
+ % compute its width again so it can be properly justified, then
+ % display it.
+
+ strings {
+ dup stringwidth pop
+ justify neg mul 0 moveto
+ stipple {
+
+ % The text is stippled, so turn it into a path and print
+ % by calling StippledText, which in turn calls StippleFill.
+ % Unfortunately, many Postscript interpreters will get
+ % overflow errors if we try to do the whole string at
+ % once, so do it a character at a time.
+
+ gsave
+ /char (X) def
+ {
+ char 0 3 -1 roll put
+ currentpoint
+ gsave
+ char true charpath clip StippleText
+ grestore
+ char stringwidth translate
+ moveto
+ } forall
+ grestore
+ } {show} ifelse
+ 0 spacing neg translate
+ } forall
+} bind def
+
+%%EndProlog
diff --git a/tcl/generic/tk.decls b/tcl/generic/tk.decls
new file mode 100644
index 00000000000..b35dbe16516
--- /dev/null
+++ b/tcl/generic/tk.decls
@@ -0,0 +1,1384 @@
+# tk.decls --
+#
+# This file contains the declarations for all supported public
+# functions that are exported by the Tk library via the stubs table.
+# This file is used to generate the tkDecls.h, tkPlatDecls.h,
+# tkStub.c, and tkPlatStub.c files.
+#
+#
+# Copyright (c) 1998-2000 Ajuba Solutions.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+library tk
+
+# Define the tk interface with 3 sub interfaces:
+# tkPlat - platform specific public
+# tkInt - generic private
+# tkPlatInt - platform specific private
+
+interface tk
+hooks {tkPlat tkInt tkIntPlat tkIntXlib}
+
+# Declare each of the functions in the public Tk interface. Note that
+# the an index should never be reused for a different function in order
+# to preserve backwards compatibility.
+
+declare 0 generic {
+ void Tk_MainLoop (void)
+}
+
+declare 1 generic {
+ XColor *Tk_3DBorderColor (Tk_3DBorder border)
+}
+
+declare 2 generic {
+ GC Tk_3DBorderGC (Tk_Window tkwin, Tk_3DBorder border,
+ int which)
+}
+
+declare 3 generic {
+ void Tk_3DHorizontalBevel (Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int leftIn,
+ int rightIn, int topBevel, int relief)
+}
+
+declare 4 generic {
+ void Tk_3DVerticalBevel (Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int leftBevel,
+ int relief)
+}
+
+declare 5 generic {
+ void Tk_AddOption (Tk_Window tkwin, CONST char *name,
+ CONST char *value, int priority)
+}
+
+declare 6 generic {
+ void Tk_BindEvent (Tk_BindingTable bindingTable,
+ XEvent *eventPtr, Tk_Window tkwin, int numObjects,
+ ClientData *objectPtr)
+}
+
+declare 7 generic {
+ void Tk_CanvasDrawableCoords (Tk_Canvas canvas,
+ double x, double y, short *drawableXPtr,
+ short *drawableYPtr)
+}
+
+declare 8 generic {
+ void Tk_CanvasEventuallyRedraw (Tk_Canvas canvas, int x1, int y1,
+ int x2, int y2)
+}
+
+declare 9 generic {
+ int Tk_CanvasGetCoord (Tcl_Interp *interp,
+ Tk_Canvas canvas, CONST char *str, double *doublePtr)
+}
+
+declare 10 generic {
+ Tk_CanvasTextInfo *Tk_CanvasGetTextInfo (Tk_Canvas canvas)
+}
+
+declare 11 generic {
+ int Tk_CanvasPsBitmap (Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap, int x, int y,
+ int width, int height)
+}
+
+declare 12 generic {
+ int Tk_CanvasPsColor (Tcl_Interp *interp,
+ Tk_Canvas canvas, XColor *colorPtr)
+}
+
+declare 13 generic {
+ int Tk_CanvasPsFont (Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Font font)
+}
+
+declare 14 generic {
+ void Tk_CanvasPsPath (Tcl_Interp *interp,
+ Tk_Canvas canvas, double *coordPtr, int numPoints)
+}
+
+declare 15 generic {
+ int Tk_CanvasPsStipple (Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap)
+}
+
+declare 16 generic {
+ double Tk_CanvasPsY (Tk_Canvas canvas, double y)
+}
+
+declare 17 generic {
+ void Tk_CanvasSetStippleOrigin (Tk_Canvas canvas, GC gc)
+}
+
+declare 18 generic {
+ int Tk_CanvasTagsParseProc (ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value, char *widgRec, int offset)
+}
+
+declare 19 generic {
+ char * Tk_CanvasTagsPrintProc (ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+
+declare 20 generic {
+ Tk_Window Tk_CanvasTkwin (Tk_Canvas canvas)
+}
+
+declare 21 generic {
+ void Tk_CanvasWindowCoords (Tk_Canvas canvas, double x, double y,
+ short *screenXPtr, short *screenYPtr)
+}
+
+declare 22 generic {
+ void Tk_ChangeWindowAttributes (Tk_Window tkwin, unsigned long valueMask,
+ XSetWindowAttributes *attsPtr)
+}
+
+declare 23 generic {
+ int Tk_CharBbox (Tk_TextLayout layout, int index, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr)
+}
+
+declare 24 generic {
+ void Tk_ClearSelection (Tk_Window tkwin, Atom selection)
+}
+
+declare 25 generic {
+ int Tk_ClipboardAppend (Tcl_Interp *interp,Tk_Window tkwin,
+ Atom target, Atom format, char* buffer)
+}
+
+declare 26 generic {
+ int Tk_ClipboardClear (Tcl_Interp *interp, Tk_Window tkwin)
+}
+
+declare 27 generic {
+ int Tk_ConfigureInfo (Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specs,
+ char *widgRec, CONST char *argvName, int flags)
+}
+
+declare 28 generic {
+ int Tk_ConfigureValue (Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specs,
+ char *widgRec, CONST char *argvName, int flags)
+}
+
+declare 29 generic {
+ int Tk_ConfigureWidget (Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specs,
+ int argc, CONST84 char **argv, char *widgRec,
+ int flags)
+}
+
+declare 30 generic {
+ void Tk_ConfigureWindow (Tk_Window tkwin,
+ unsigned int valueMask, XWindowChanges *valuePtr)
+}
+
+declare 31 generic {
+ Tk_TextLayout Tk_ComputeTextLayout (Tk_Font font,
+ CONST char *str, int numChars, int wrapLength,
+ Tk_Justify justify, int flags, int *widthPtr,
+ int *heightPtr)
+}
+
+declare 32 generic {
+ Tk_Window Tk_CoordsToWindow (int rootX, int rootY, Tk_Window tkwin)
+}
+
+declare 33 generic {
+ unsigned long Tk_CreateBinding (Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ CONST char *eventStr, CONST char *command, int append)
+}
+
+declare 34 generic {
+ Tk_BindingTable Tk_CreateBindingTable (Tcl_Interp *interp)
+}
+
+declare 35 generic {
+ Tk_ErrorHandler Tk_CreateErrorHandler (Display *display,
+ int errNum, int request, int minorCode,
+ Tk_ErrorProc *errorProc, ClientData clientData)
+}
+
+declare 36 generic {
+ void Tk_CreateEventHandler (Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData)
+}
+
+declare 37 generic {
+ void Tk_CreateGenericHandler (Tk_GenericProc *proc, ClientData clientData)
+}
+
+declare 38 generic {
+ void Tk_CreateImageType (Tk_ImageType *typePtr)
+}
+
+declare 39 generic {
+ void Tk_CreateItemType (Tk_ItemType *typePtr)
+}
+
+declare 40 generic {
+ void Tk_CreatePhotoImageFormat (Tk_PhotoImageFormat *formatPtr)
+}
+
+declare 41 generic {
+ void Tk_CreateSelHandler (Tk_Window tkwin,
+ Atom selection, Atom target,
+ Tk_SelectionProc *proc, ClientData clientData,
+ Atom format)
+}
+
+declare 42 generic {
+ Tk_Window Tk_CreateWindow (Tcl_Interp *interp,
+ Tk_Window parent, CONST char *name, CONST char *screenName)
+}
+
+declare 43 generic {
+ Tk_Window Tk_CreateWindowFromPath (Tcl_Interp *interp, Tk_Window tkwin,
+ CONST char *pathName, CONST char *screenName)
+}
+
+declare 44 generic {
+ int Tk_DefineBitmap (Tcl_Interp *interp, CONST char *name,
+ CONST char *source, int width, int height)
+}
+
+declare 45 generic {
+ void Tk_DefineCursor (Tk_Window window, Tk_Cursor cursor)
+}
+
+declare 46 generic {
+ void Tk_DeleteAllBindings (Tk_BindingTable bindingTable, ClientData object)
+}
+
+declare 47 generic {
+ int Tk_DeleteBinding (Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ CONST char *eventStr)
+}
+
+declare 48 generic {
+ void Tk_DeleteBindingTable (Tk_BindingTable bindingTable)
+}
+
+declare 49 generic {
+ void Tk_DeleteErrorHandler (Tk_ErrorHandler handler)
+}
+
+declare 50 generic {
+ void Tk_DeleteEventHandler (Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData)
+}
+
+declare 51 generic {
+ void Tk_DeleteGenericHandler (Tk_GenericProc *proc, ClientData clientData)
+}
+
+declare 52 generic {
+ void Tk_DeleteImage (Tcl_Interp *interp, CONST char *name)
+}
+
+declare 53 generic {
+ void Tk_DeleteSelHandler (Tk_Window tkwin, Atom selection, Atom target)
+}
+
+declare 54 generic {
+ void Tk_DestroyWindow (Tk_Window tkwin)
+}
+
+declare 55 generic {
+ CONST84_RETURN char * Tk_DisplayName (Tk_Window tkwin)
+}
+
+declare 56 generic {
+ int Tk_DistanceToTextLayout (Tk_TextLayout layout, int x, int y)
+}
+
+declare 57 generic {
+ void Tk_Draw3DPolygon (Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint *pointPtr, int numPoints, int borderWidth,
+ int leftRelief)
+}
+
+declare 58 generic {
+ void Tk_Draw3DRectangle (Tk_Window tkwin, Drawable drawable,
+ Tk_3DBorder border, int x, int y, int width, int height,
+ int borderWidth, int relief)
+}
+
+declare 59 generic {
+ void Tk_DrawChars (Display *display, Drawable drawable, GC gc,
+ Tk_Font tkfont, CONST char *source, int numBytes, int x, int y)
+}
+
+declare 60 generic {
+ void Tk_DrawFocusHighlight (Tk_Window tkwin, GC gc, int width,
+ Drawable drawable)
+}
+
+declare 61 generic {
+ void Tk_DrawTextLayout (Display *display,
+ Drawable drawable, GC gc, Tk_TextLayout layout,
+ int x, int y, int firstChar, int lastChar)
+}
+
+declare 62 generic {
+ void Tk_Fill3DPolygon (Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint *pointPtr, int numPoints, int borderWidth,
+ int leftRelief)
+}
+
+declare 63 generic {
+ void Tk_Fill3DRectangle (Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int borderWidth,
+ int relief)
+}
+
+declare 64 generic {
+ Tk_PhotoHandle Tk_FindPhoto (Tcl_Interp *interp, CONST char *imageName)
+}
+
+declare 65 generic {
+ Font Tk_FontId (Tk_Font font)
+}
+
+declare 66 generic {
+ void Tk_Free3DBorder (Tk_3DBorder border)
+}
+
+declare 67 generic {
+ void Tk_FreeBitmap (Display *display, Pixmap bitmap)
+}
+
+declare 68 generic {
+ void Tk_FreeColor (XColor *colorPtr)
+}
+
+declare 69 generic {
+ void Tk_FreeColormap (Display *display, Colormap colormap)
+}
+
+declare 70 generic {
+ void Tk_FreeCursor (Display *display, Tk_Cursor cursor)
+}
+
+declare 71 generic {
+ void Tk_FreeFont (Tk_Font f)
+}
+
+declare 72 generic {
+ void Tk_FreeGC (Display *display, GC gc)
+}
+
+declare 73 generic {
+ void Tk_FreeImage (Tk_Image image)
+}
+
+declare 74 generic {
+ void Tk_FreeOptions (Tk_ConfigSpec *specs,
+ char *widgRec, Display *display, int needFlags)
+}
+
+declare 75 generic {
+ void Tk_FreePixmap (Display *display, Pixmap pixmap)
+}
+
+declare 76 generic {
+ void Tk_FreeTextLayout (Tk_TextLayout textLayout)
+}
+
+declare 77 generic {
+ void Tk_FreeXId (Display *display, XID xid)
+}
+
+declare 78 generic {
+ GC Tk_GCForColor (XColor *colorPtr, Drawable drawable)
+}
+
+declare 79 generic {
+ void Tk_GeometryRequest (Tk_Window tkwin, int reqWidth, int reqHeight)
+}
+
+declare 80 generic {
+ Tk_3DBorder Tk_Get3DBorder (Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_Uid colorName)
+}
+
+declare 81 generic {
+ void Tk_GetAllBindings (Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object)
+}
+
+declare 82 generic {
+ int Tk_GetAnchor (Tcl_Interp *interp,
+ CONST char *str, Tk_Anchor *anchorPtr)
+}
+
+declare 83 generic {
+ CONST84_RETURN char * Tk_GetAtomName (Tk_Window tkwin, Atom atom)
+}
+
+declare 84 generic {
+ CONST84_RETURN char * Tk_GetBinding (Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ CONST char *eventStr)
+}
+
+declare 85 generic {
+ Pixmap Tk_GetBitmap (Tcl_Interp *interp, Tk_Window tkwin, CONST char * str)
+}
+
+declare 86 generic {
+ Pixmap Tk_GetBitmapFromData (Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *source, int width, int height)
+}
+
+declare 87 generic {
+ int Tk_GetCapStyle (Tcl_Interp *interp, CONST char *str, int *capPtr)
+}
+
+declare 88 generic {
+ XColor * Tk_GetColor (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid name)
+}
+
+declare 89 generic {
+ XColor * Tk_GetColorByValue (Tk_Window tkwin, XColor *colorPtr)
+}
+
+declare 90 generic {
+ Colormap Tk_GetColormap (Tcl_Interp *interp, Tk_Window tkwin,
+ CONST char *str)
+}
+
+declare 91 generic {
+ Tk_Cursor Tk_GetCursor (Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_Uid str)
+}
+
+declare 92 generic {
+ Tk_Cursor Tk_GetCursorFromData (Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *source, CONST char *mask,
+ int width, int height, int xHot, int yHot,
+ Tk_Uid fg, Tk_Uid bg)
+}
+
+declare 93 generic {
+ Tk_Font Tk_GetFont (Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *str)
+}
+
+declare 94 generic {
+ Tk_Font Tk_GetFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 95 generic {
+ void Tk_GetFontMetrics (Tk_Font font, Tk_FontMetrics *fmPtr)
+}
+
+declare 96 generic {
+ GC Tk_GetGC (Tk_Window tkwin, unsigned long valueMask, XGCValues *valuePtr)
+}
+
+declare 97 generic {
+ Tk_Image Tk_GetImage (Tcl_Interp *interp, Tk_Window tkwin, CONST char *name,
+ Tk_ImageChangedProc *changeProc, ClientData clientData)
+}
+
+declare 98 generic {
+ ClientData Tk_GetImageMasterData (Tcl_Interp *interp,
+ CONST char *name, Tk_ImageType **typePtrPtr)
+}
+
+declare 99 generic {
+ Tk_ItemType * Tk_GetItemTypes (void)
+}
+
+declare 100 generic {
+ int Tk_GetJoinStyle (Tcl_Interp *interp, CONST char *str, int *joinPtr)
+}
+
+declare 101 generic {
+ int Tk_GetJustify (Tcl_Interp *interp,
+ CONST char *str, Tk_Justify *justifyPtr)
+}
+
+declare 102 generic {
+ int Tk_GetNumMainWindows (void)
+}
+
+declare 103 generic {
+ Tk_Uid Tk_GetOption (Tk_Window tkwin, CONST char *name,
+ CONST char *className)
+}
+
+declare 104 generic {
+ int Tk_GetPixels (Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *str, int *intPtr)
+}
+
+declare 105 generic {
+ Pixmap Tk_GetPixmap (Display *display, Drawable d,
+ int width, int height, int depth)
+}
+
+declare 106 generic {
+ int Tk_GetRelief (Tcl_Interp *interp, CONST char *name, int *reliefPtr)
+}
+
+declare 107 generic {
+ void Tk_GetRootCoords (Tk_Window tkwin, int *xPtr, int *yPtr)
+}
+
+declare 108 generic {
+ int Tk_GetScrollInfo (Tcl_Interp *interp,
+ int argc, CONST84 char **argv, double *dblPtr, int *intPtr)
+}
+
+declare 109 generic {
+ int Tk_GetScreenMM (Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *str, double *doublePtr)
+}
+
+declare 110 generic {
+ int Tk_GetSelection (Tcl_Interp *interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc *proc, ClientData clientData)
+}
+
+declare 111 generic {
+ Tk_Uid Tk_GetUid (CONST char *str)
+}
+
+declare 112 generic {
+ Visual * Tk_GetVisual (Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *str, int *depthPtr,
+ Colormap *colormapPtr)
+}
+
+declare 113 generic {
+ void Tk_GetVRootGeometry (Tk_Window tkwin,
+ int *xPtr, int *yPtr, int *widthPtr, int *heightPtr)
+}
+
+declare 114 generic {
+ int Tk_Grab (Tcl_Interp *interp, Tk_Window tkwin, int grabGlobal)
+}
+
+declare 115 generic {
+ void Tk_HandleEvent (XEvent *eventPtr)
+}
+
+declare 116 generic {
+ Tk_Window Tk_IdToWindow (Display *display, Window window)
+}
+
+declare 117 generic {
+ void Tk_ImageChanged (Tk_ImageMaster master, int x, int y,
+ int width, int height, int imageWidth, int imageHeight)
+}
+
+declare 118 generic {
+ int Tk_Init (Tcl_Interp *interp)
+}
+
+declare 119 generic {
+ Atom Tk_InternAtom (Tk_Window tkwin, CONST char *name)
+}
+
+declare 120 generic {
+ int Tk_IntersectTextLayout (Tk_TextLayout layout, int x, int y,
+ int width, int height)
+}
+
+declare 121 generic {
+ void Tk_MaintainGeometry (Tk_Window slave,
+ Tk_Window master, int x, int y, int width, int height)
+}
+
+declare 122 generic {
+ Tk_Window Tk_MainWindow (Tcl_Interp *interp)
+}
+
+declare 123 generic {
+ void Tk_MakeWindowExist (Tk_Window tkwin)
+}
+
+declare 124 generic {
+ void Tk_ManageGeometry (Tk_Window tkwin,
+ Tk_GeomMgr *mgrPtr, ClientData clientData)
+}
+
+declare 125 generic {
+ void Tk_MapWindow (Tk_Window tkwin)
+}
+
+declare 126 generic {
+ int Tk_MeasureChars (Tk_Font tkfont,
+ CONST char *source, int numBytes, int maxPixels,
+ int flags, int *lengthPtr)
+}
+
+declare 127 generic {
+ void Tk_MoveResizeWindow (Tk_Window tkwin,
+ int x, int y, int width, int height)
+}
+
+declare 128 generic {
+ void Tk_MoveWindow (Tk_Window tkwin, int x, int y)
+}
+
+declare 129 generic {
+ void Tk_MoveToplevelWindow (Tk_Window tkwin, int x, int y)
+}
+
+declare 130 generic {
+ CONST84_RETURN char * Tk_NameOf3DBorder (Tk_3DBorder border)
+}
+
+declare 131 generic {
+ CONST84_RETURN char * Tk_NameOfAnchor (Tk_Anchor anchor)
+}
+
+declare 132 generic {
+ CONST84_RETURN char * Tk_NameOfBitmap (Display *display, Pixmap bitmap)
+}
+
+declare 133 generic {
+ CONST84_RETURN char * Tk_NameOfCapStyle (int cap)
+}
+
+declare 134 generic {
+ CONST84_RETURN char * Tk_NameOfColor (XColor *colorPtr)
+}
+
+declare 135 generic {
+ CONST84_RETURN char * Tk_NameOfCursor (Display *display, Tk_Cursor cursor)
+}
+
+declare 136 generic {
+ CONST84_RETURN char * Tk_NameOfFont (Tk_Font font)
+}
+
+declare 137 generic {
+ CONST84_RETURN char * Tk_NameOfImage (Tk_ImageMaster imageMaster)
+}
+
+declare 138 generic {
+ CONST84_RETURN char * Tk_NameOfJoinStyle (int join)
+}
+
+declare 139 generic {
+ CONST84_RETURN char * Tk_NameOfJustify (Tk_Justify justify)
+}
+
+declare 140 generic {
+ CONST84_RETURN char * Tk_NameOfRelief (int relief)
+}
+
+declare 141 generic {
+ Tk_Window Tk_NameToWindow (Tcl_Interp *interp,
+ CONST char *pathName, Tk_Window tkwin)
+}
+
+declare 142 generic {
+ void Tk_OwnSelection (Tk_Window tkwin,
+ Atom selection, Tk_LostSelProc *proc,
+ ClientData clientData)
+}
+
+declare 143 generic {
+ int Tk_ParseArgv (Tcl_Interp *interp,
+ Tk_Window tkwin, int *argcPtr, CONST84 char **argv,
+ Tk_ArgvInfo *argTable, int flags)
+}
+
+declare 144 generic {
+ void Tk_PhotoPutBlock_NoComposite (Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height)
+}
+
+declare 145 generic {
+ void Tk_PhotoPutZoomedBlock_NoComposite (Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY)
+}
+
+declare 146 generic {
+ int Tk_PhotoGetImage (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr)
+}
+
+declare 147 generic {
+ void Tk_PhotoBlank (Tk_PhotoHandle handle)
+}
+
+declare 148 generic {
+ void Tk_PhotoExpand (Tk_PhotoHandle handle, int width, int height )
+}
+
+declare 149 generic {
+ void Tk_PhotoGetSize (Tk_PhotoHandle handle, int *widthPtr, int *heightPtr)
+}
+
+declare 150 generic {
+ void Tk_PhotoSetSize (Tk_PhotoHandle handle, int width, int height)
+}
+
+declare 151 generic {
+ int Tk_PointToChar (Tk_TextLayout layout, int x, int y)
+}
+
+declare 152 generic {
+ int Tk_PostscriptFontName (Tk_Font tkfont, Tcl_DString *dsPtr)
+}
+
+declare 153 generic {
+ void Tk_PreserveColormap (Display *display, Colormap colormap)
+}
+
+declare 154 generic {
+ void Tk_QueueWindowEvent (XEvent *eventPtr, Tcl_QueuePosition position)
+}
+
+declare 155 generic {
+ void Tk_RedrawImage (Tk_Image image, int imageX,
+ int imageY, int width, int height,
+ Drawable drawable, int drawableX, int drawableY)
+}
+
+declare 156 generic {
+ void Tk_ResizeWindow (Tk_Window tkwin, int width, int height)
+}
+
+declare 157 generic {
+ int Tk_RestackWindow (Tk_Window tkwin, int aboveBelow, Tk_Window other)
+}
+
+declare 158 generic {
+ Tk_RestrictProc *Tk_RestrictEvents (Tk_RestrictProc *proc,
+ ClientData arg, ClientData *prevArgPtr)
+}
+
+declare 159 generic {
+ int Tk_SafeInit (Tcl_Interp *interp)
+}
+
+declare 160 generic {
+ CONST char * Tk_SetAppName (Tk_Window tkwin, CONST char *name)
+}
+
+declare 161 generic {
+ void Tk_SetBackgroundFromBorder (Tk_Window tkwin, Tk_3DBorder border)
+}
+
+declare 162 generic {
+ void Tk_SetClass (Tk_Window tkwin, CONST char *className)
+}
+
+declare 163 generic {
+ void Tk_SetGrid (Tk_Window tkwin, int reqWidth, int reqHeight,
+ int gridWidth, int gridHeight)
+}
+
+declare 164 generic {
+ void Tk_SetInternalBorder (Tk_Window tkwin, int width)
+}
+
+declare 165 generic {
+ void Tk_SetWindowBackground (Tk_Window tkwin, unsigned long pixel)
+}
+
+declare 166 generic {
+ void Tk_SetWindowBackgroundPixmap (Tk_Window tkwin, Pixmap pixmap)
+}
+
+declare 167 generic {
+ void Tk_SetWindowBorder (Tk_Window tkwin, unsigned long pixel)
+}
+
+declare 168 generic {
+ void Tk_SetWindowBorderWidth (Tk_Window tkwin, int width)
+}
+
+declare 169 generic {
+ void Tk_SetWindowBorderPixmap (Tk_Window tkwin, Pixmap pixmap)
+}
+
+declare 170 generic {
+ void Tk_SetWindowColormap (Tk_Window tkwin, Colormap colormap)
+}
+
+declare 171 generic {
+ int Tk_SetWindowVisual (Tk_Window tkwin, Visual *visual, int depth,
+ Colormap colormap)
+}
+
+declare 172 generic {
+ void Tk_SizeOfBitmap (Display *display, Pixmap bitmap, int *widthPtr,
+ int *heightPtr)
+}
+
+declare 173 generic {
+ void Tk_SizeOfImage (Tk_Image image, int *widthPtr, int *heightPtr)
+}
+
+declare 174 generic {
+ int Tk_StrictMotif (Tk_Window tkwin)
+}
+
+declare 175 generic {
+ void Tk_TextLayoutToPostscript (Tcl_Interp *interp, Tk_TextLayout layout)
+}
+
+declare 176 generic {
+ int Tk_TextWidth (Tk_Font font, CONST char *str, int numBytes)
+}
+
+declare 177 generic {
+ void Tk_UndefineCursor (Tk_Window window)
+}
+
+declare 178 generic {
+ void Tk_UnderlineChars (Display *display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ CONST char *source, int x, int y, int firstByte,
+ int lastByte)
+}
+
+declare 179 generic {
+ void Tk_UnderlineTextLayout (Display *display, Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int underline)
+}
+
+declare 180 generic {
+ void Tk_Ungrab (Tk_Window tkwin)
+}
+
+declare 181 generic {
+ void Tk_UnmaintainGeometry (Tk_Window slave, Tk_Window master)
+}
+
+declare 182 generic {
+ void Tk_UnmapWindow (Tk_Window tkwin)
+}
+
+declare 183 generic {
+ void Tk_UnsetGrid (Tk_Window tkwin)
+}
+
+declare 184 generic {
+ void Tk_UpdatePointer (Tk_Window tkwin, int x, int y, int state)
+}
+
+# new functions for 8.1
+
+declare 185 generic {
+ Pixmap Tk_AllocBitmapFromObj (Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+
+declare 186 generic {
+ Tk_3DBorder Tk_Alloc3DBorderFromObj (Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+
+declare 187 generic {
+ XColor * Tk_AllocColorFromObj (Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+
+declare 188 generic {
+ Tk_Cursor Tk_AllocCursorFromObj (Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+
+declare 189 generic {
+ Tk_Font Tk_AllocFontFromObj (Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+
+}
+
+declare 190 generic {
+ Tk_OptionTable Tk_CreateOptionTable (Tcl_Interp *interp,
+ CONST Tk_OptionSpec *templatePtr)
+}
+
+declare 191 generic {
+ void Tk_DeleteOptionTable (Tk_OptionTable optionTable)
+}
+
+declare 192 generic {
+ void Tk_Free3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 193 generic {
+ void Tk_FreeBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 194 generic {
+ void Tk_FreeColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 195 generic {
+ void Tk_FreeConfigOptions (char *recordPtr, Tk_OptionTable optionToken,
+ Tk_Window tkwin)
+
+}
+
+declare 196 generic {
+ void Tk_FreeSavedOptions (Tk_SavedOptions *savePtr)
+}
+
+declare 197 generic {
+ void Tk_FreeCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 198 generic {
+ void Tk_FreeFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 199 generic {
+ Tk_3DBorder Tk_Get3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 200 generic {
+ int Tk_GetAnchorFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Tk_Anchor *anchorPtr)
+}
+
+declare 201 generic {
+ Pixmap Tk_GetBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 202 generic {
+ XColor * Tk_GetColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 203 generic {
+ Tk_Cursor Tk_GetCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 204 generic {
+ Tcl_Obj * Tk_GetOptionInfo (Tcl_Interp *interp,
+ char *recordPtr, Tk_OptionTable optionTable,
+ Tcl_Obj *namePtr, Tk_Window tkwin)
+}
+
+declare 205 generic {
+ Tcl_Obj * Tk_GetOptionValue (Tcl_Interp *interp, char *recordPtr,
+ Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin)
+}
+
+declare 206 generic {
+ int Tk_GetJustifyFromObj (Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tk_Justify *justifyPtr)
+}
+
+declare 207 generic {
+ int Tk_GetMMFromObj (Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr)
+}
+
+declare 208 generic {
+ int Tk_GetPixelsFromObj (Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr)
+}
+
+declare 209 generic {
+ int Tk_GetReliefFromObj (Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *resultPtr)
+}
+
+declare 210 generic {
+ int Tk_GetScrollInfoObj (Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[], double *dblPtr, int *intPtr)
+}
+
+declare 211 generic {
+ int Tk_InitOptions (Tcl_Interp *interp, char *recordPtr,
+ Tk_OptionTable optionToken, Tk_Window tkwin)
+}
+
+declare 212 generic {
+ void Tk_MainEx (int argc, char **argv, Tcl_AppInitProc *appInitProc,
+ Tcl_Interp *interp)
+}
+
+declare 213 generic {
+ void Tk_RestoreSavedOptions (Tk_SavedOptions *savePtr)
+}
+
+declare 214 generic {
+ int Tk_SetOptions (Tcl_Interp *interp, char *recordPtr,
+ Tk_OptionTable optionTable, int objc,
+ Tcl_Obj *CONST objv[], Tk_Window tkwin,
+ Tk_SavedOptions *savePtr, int *maskPtr)
+}
+
+declare 215 generic {
+ void Tk_InitConsoleChannels (Tcl_Interp *interp)
+}
+
+declare 216 generic {
+ int Tk_CreateConsoleWindow (Tcl_Interp *interp)
+}
+
+declare 217 generic {
+ void Tk_CreateSmoothMethod (Tcl_Interp *interp, Tk_SmoothMethod *method)
+}
+
+#declare 218 generic {
+# void Tk_CreateCanvasVisitor (Tcl_Interp *interp, VOID *typePtr)
+#}
+
+#declare 219 generic {
+# VOID *Tk_GetCanvasVisitor (Tcl_Interp *interp, CONST char *name)
+#}
+
+declare 220 generic {
+ int Tk_GetDash (Tcl_Interp *interp, CONST char *value, Tk_Dash *dash)
+}
+declare 221 generic {
+ void Tk_CreateOutline (Tk_Outline *outline)
+}
+declare 222 generic {
+ void Tk_DeleteOutline (Display *display, Tk_Outline *outline)
+}
+declare 223 generic {
+ int Tk_ConfigOutlineGC (XGCValues *gcValues, Tk_Canvas canvas,
+ Tk_Item *item, Tk_Outline *outline)
+}
+declare 224 generic {
+ int Tk_ChangeOutlineGC (Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline)
+}
+declare 225 generic {
+ int Tk_ResetOutlineGC (Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline)
+}
+declare 226 generic {
+ int Tk_CanvasPsOutline (Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline)
+}
+declare 227 generic {
+ void Tk_SetTSOrigin (Tk_Window tkwin, GC gc, int x, int y)
+}
+declare 228 generic {
+ int Tk_CanvasGetCoordFromObj (Tcl_Interp *interp, Tk_Canvas canvas,
+ Tcl_Obj *obj, double *doublePtr)
+}
+declare 229 generic {
+ void Tk_CanvasSetOffset (Tk_Canvas canvas, GC gc, Tk_TSOffset *offset)
+}
+declare 230 generic {
+ void Tk_DitherPhoto (Tk_PhotoHandle handle, int x, int y, int width,
+ int height)
+}
+declare 231 generic {
+ int Tk_PostscriptBitmap (Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, Pixmap bitmap, int startX,
+ int startY, int width, int height)
+}
+declare 232 generic {
+ int Tk_PostscriptColor (Tcl_Interp *interp, Tk_PostscriptInfo psInfo,
+ XColor *colorPtr)
+}
+declare 233 generic {
+ int Tk_PostscriptFont (Tcl_Interp *interp, Tk_PostscriptInfo psInfo,
+ Tk_Font font)
+}
+declare 234 generic {
+ int Tk_PostscriptImage (Tk_Image image, Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_PostscriptInfo psinfo, int x, int y,
+ int width, int height, int prepass)
+}
+declare 235 generic {
+ void Tk_PostscriptPath (Tcl_Interp *interp, Tk_PostscriptInfo psInfo,
+ double *coordPtr, int numPoints)
+}
+declare 236 generic {
+ int Tk_PostscriptStipple (Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, Pixmap bitmap)
+}
+declare 237 generic {
+ double Tk_PostscriptY (double y, Tk_PostscriptInfo psInfo)
+}
+declare 238 generic {
+ int Tk_PostscriptPhoto (Tcl_Interp *interp,
+ Tk_PhotoImageBlock *blockPtr, Tk_PostscriptInfo psInfo,
+ int width, int height)
+}
+
+# New in 8.4a1
+#
+declare 239 generic {
+ void Tk_CreateClientMessageHandler (Tk_ClientMessageProc *proc)
+}
+declare 240 generic {
+ void Tk_DeleteClientMessageHandler (Tk_ClientMessageProc *proc)
+}
+
+# New in 8.4a2
+#
+declare 241 generic {
+ Tk_Window Tk_CreateAnonymousWindow (Tcl_Interp *interp,
+ Tk_Window parent, CONST char *screenName)
+}
+declare 242 generic {
+ void Tk_SetClassProcs (Tk_Window tkwin,
+ Tk_ClassProcs *procs, ClientData instanceData)
+}
+
+# New in 8.4a4
+#
+declare 243 generic {
+ void Tk_SetInternalBorderEx (Tk_Window tkwin, int left, int right,
+ int top, int bottom)
+}
+declare 244 generic {
+ void Tk_SetMinimumRequestSize (Tk_Window tkwin,
+ int minWidth, int minHeight)
+}
+
+# New in 8.4a5
+#
+declare 245 generic {
+ void Tk_SetCaretPos (Tk_Window tkwin, int x, int y, int height)
+}
+
+declare 246 generic {
+ void Tk_PhotoPutBlock (Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int compRule)
+}
+declare 247 generic {
+ void Tk_PhotoPutZoomedBlock (Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY, int compRule)
+}
+
+declare 248 generic {
+ int Tk_CollapseMotionEvents (Display *display, int collapse)
+}
+
+# Style engine
+declare 249 generic {
+ Tk_StyleEngine Tk_RegisterStyleEngine (CONST char *name,
+ Tk_StyleEngine parent)
+}
+declare 250 generic {
+ Tk_StyleEngine Tk_GetStyleEngine (CONST char *name)
+}
+declare 251 generic {
+ int Tk_RegisterStyledElement (Tk_StyleEngine engine,
+ Tk_ElementSpec *templatePtr)
+}
+declare 252 generic {
+ int Tk_GetElementId (CONST char *name)
+}
+declare 253 generic {
+ Tk_Style Tk_CreateStyle (CONST char *name, Tk_StyleEngine engine,
+ ClientData clientData)
+}
+declare 254 generic {
+ Tk_Style Tk_GetStyle (Tcl_Interp *interp, CONST char *name)
+}
+declare 255 generic {
+ void Tk_FreeStyle (Tk_Style style)
+}
+declare 256 generic {
+ CONST char * Tk_NameOfStyle (Tk_Style style)
+}
+declare 257 generic {
+ Tk_Style Tk_AllocStyleFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 258 generic {
+ Tk_Style Tk_GetStyleFromObj (Tcl_Obj *objPtr)
+}
+declare 259 generic {
+ void Tk_FreeStyleFromObj (Tcl_Obj *objPtr)
+}
+declare 260 generic {
+ Tk_StyledElement Tk_GetStyledElement (Tk_Style style, int elementId,
+ Tk_OptionTable optionTable)
+}
+declare 261 generic {
+ void Tk_GetElementSize (Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin, int width, int height,
+ int inner, int *widthPtr, int *heightPtr)
+}
+declare 262 generic {
+ void Tk_GetElementBox (Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin, int x, int y, int width,
+ int height, int inner, int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr)
+}
+declare 263 generic {
+ int Tk_GetElementBorderWidth (Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin)
+}
+declare 264 generic {
+ void Tk_DrawElement (Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin, Drawable d, int x, int y,
+ int width, int height, int state)
+}
+
+
+# Define the platform specific public Tk interface. These functions are
+# only available on the designated platform.
+
+interface tkPlat
+
+# Unix specific functions
+# (none)
+
+# Windows specific functions
+
+declare 0 win {
+ Window Tk_AttachHWND (Tk_Window tkwin, HWND hwnd)
+}
+
+declare 1 win {
+ HINSTANCE Tk_GetHINSTANCE (void)
+}
+
+declare 2 win {
+ HWND Tk_GetHWND (Window window)
+}
+
+declare 3 win {
+ Tk_Window Tk_HWNDToWindow (HWND hwnd)
+}
+
+declare 4 win {
+ void Tk_PointerEvent (HWND hwnd, int x, int y)
+}
+
+declare 5 win {
+ int Tk_TranslateWinEvent (HWND hwnd,
+ UINT message, WPARAM wParam, LPARAM lParam, LRESULT *result)
+}
+
+# Mac specific functions
+
+declare 0 mac {
+ void Tk_MacSetEmbedHandler (
+ Tk_MacEmbedRegisterWinProc *registerWinProcPtr,
+ Tk_MacEmbedGetGrafPortProc *getPortProcPtr,
+ Tk_MacEmbedMakeContainerExistProc *containerExistProcPtr,
+ Tk_MacEmbedGetClipProc *getClipProc,
+ Tk_MacEmbedGetOffsetInParentProc *getOffsetProc)
+}
+
+declare 1 mac {
+ void Tk_MacTurnOffMenus (void)
+}
+
+declare 2 mac {
+ void Tk_MacTkOwnsCursor (int tkOwnsIt)
+}
+
+declare 3 mac {
+ void TkMacInitMenus (Tcl_Interp *interp)
+}
+
+declare 4 mac {
+ void TkMacInitAppleEvents (Tcl_Interp *interp)
+}
+
+declare 5 mac {
+ int TkMacConvertEvent (EventRecord *eventPtr)
+}
+
+declare 6 mac {
+ int TkMacConvertTkEvent (EventRecord *eventPtr, Window window)
+}
+
+declare 7 mac {
+ void TkGenWMConfigureEvent (Tk_Window tkwin,
+ int x, int y, int width, int height, int flags)
+}
+
+declare 8 mac {
+ void TkMacInvalClipRgns (TkWindow *winPtr)
+}
+
+declare 9 mac {
+ int TkMacHaveAppearance (void)
+}
+
+declare 10 mac {
+ GWorldPtr TkMacGetDrawablePort (Drawable drawable)
+}
+
+# Mac OS X specific functions
+
+declare 0 aqua {
+ void Tk_MacOSXSetEmbedHandler ( \
+ Tk_MacOSXEmbedRegisterWinProc *registerWinProcPtr, \
+ Tk_MacOSXEmbedGetGrafPortProc *getPortProcPtr, \
+ Tk_MacOSXEmbedMakeContainerExistProc *containerExistProcPtr, \
+ Tk_MacOSXEmbedGetClipProc *getClipProc, \
+ Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc)
+}
+
+declare 1 aqua {
+ void Tk_MacOSXTurnOffMenus (void)
+}
+
+declare 2 aqua {
+ void Tk_MacOSXTkOwnsCursor (int tkOwnsIt)
+}
+
+declare 3 aqua {
+ void TkMacOSXInitMenus (Tcl_Interp *interp)
+}
+
+declare 4 aqua {
+ void TkMacOSXInitAppleEvents (Tcl_Interp *interp)
+}
+
+declare 5 aqua {
+ void TkGenWMConfigureEvent (Tk_Window tkwin, \
+ int x, int y, int width, int height, int flags)
+}
+
+declare 6 aqua {
+ void TkMacOSXInvalClipRgns (TkWindow *winPtr)
+}
+
+declare 7 aqua {
+ GWorldPtr TkMacOSXGetDrawablePort (Drawable drawable)
+}
+
+declare 8 aqua {
+ ControlRef TkMacOSXGetRootControl (Drawable drawable)
+}
+
+declare 9 aqua {
+ void Tk_MacOSXSetupTkNotifier (void)
+}
+
+declare 10 aqua {
+ int Tk_MacOSXIsAppInFront (void)
+}
diff --git a/tcl/generic/tk.h b/tcl/generic/tk.h
new file mode 100644
index 00000000000..49f7940a736
--- /dev/null
+++ b/tcl/generic/tk.h
@@ -0,0 +1,1619 @@
+/*
+ * tk.h --
+ *
+ * Declarations for Tk-related things that are visible
+ * outside of the Tk module itself.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ *
+ * 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
+
+/*
+ * For C++ compilers, use extern "C"
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * When version numbers change here, you must also go into the following files
+ * and update the version numbers:
+ *
+ * library/tk.tcl (only if Major.minor changes, not patchlevel)
+ * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch)
+ * win/configure.in (as above)
+ * win/makefile.vc (not patchlevel)
+ * README (sections 0 and 1)
+ * mac/README (not patchlevel)
+ * win/README (not patchlevel)
+ * unix/README (not patchlevel)
+ * unix/tk.spec (3 LOC Major/Minor, 2 LOC patch)
+ * win/tcl.m4 (not patchlevel)
+ *
+ * You may also need to update some of these files when the numbers change
+ * for the version of Tcl that this release of Tk is compiled against.
+ */
+
+#define TK_MAJOR_VERSION 8
+#define TK_MINOR_VERSION 4
+#define TK_RELEASE_LEVEL TCL_FINAL_RELEASE
+#define TK_RELEASE_SERIAL 0
+
+#define TK_VERSION "8.4"
+#define TK_PATCH_LEVEL "8.4.0"
+
+/*
+ * A special define for MacOS & MacOS X, allows us to use the header
+ * in the resource compiler without having it choke on the more complex
+ * C preprocessor constructs.
+ */
+
+#ifndef RESOURCE_INCLUDED
+
+/*
+ * The following definitions set up the proper options for Macintosh
+ * compilers. We use this method because there is no autoconf equivalent.
+ */
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+# ifndef REDO_KEYSYM_LOOKUP
+# define REDO_KEYSYM_LOOKUP
+# endif
+#endif
+
+#ifndef _TCL
+# include <tcl.h>
+# if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION != 4)
+# error Tk 8.4 must be compiled with tcl.h from Tcl 8.4
+# endif
+#endif
+
+/*
+ * A special definition used to allow this header file to be included
+ * in resource files.
+ */
+
+#ifndef RC_INVOKED
+
+#ifndef _XLIB_H
+# if defined (MAC_TCL)
+# include <Xlib.h>
+# include <X.h>
+# elif defined(MAC_OSX_TK)
+# include <X11/Xlib.h>
+# include <X11/X.h>
+# else
+# include <X11/Xlib.h>
+# endif
+#endif
+#ifdef __STDC__
+# include <stddef.h>
+#endif
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Decide whether or not to use input methods.
+ */
+
+#ifdef XNQueryInputStyle
+#define TK_USE_INPUT_METHODS
+#endif
+
+/*
+ * Dummy types that are used by clients:
+ */
+
+typedef struct Tk_BindingTable_ *Tk_BindingTable;
+typedef struct Tk_Canvas_ *Tk_Canvas;
+typedef struct Tk_Cursor_ *Tk_Cursor;
+typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler;
+typedef struct Tk_Font_ *Tk_Font;
+typedef struct Tk_Image__ *Tk_Image;
+typedef struct Tk_ImageMaster_ *Tk_ImageMaster;
+typedef struct Tk_OptionTable_ *Tk_OptionTable;
+typedef struct Tk_PostscriptInfo_ *Tk_PostscriptInfo;
+typedef struct Tk_TextLayout_ *Tk_TextLayout;
+typedef struct Tk_Window_ *Tk_Window;
+typedef struct Tk_3DBorder_ *Tk_3DBorder;
+typedef struct Tk_Style_ *Tk_Style;
+typedef struct Tk_StyleEngine_ *Tk_StyleEngine;
+typedef struct Tk_StyledElement_ *Tk_StyledElement;
+
+/*
+ * Additional types exported to clients.
+ */
+
+typedef CONST char *Tk_Uid;
+
+/*
+ * The enum below defines the valid types for Tk configuration options
+ * as implemented by Tk_InitOptions, Tk_SetOptions, etc.
+ */
+
+typedef enum {
+ TK_OPTION_BOOLEAN,
+ TK_OPTION_INT,
+ TK_OPTION_DOUBLE,
+ TK_OPTION_STRING,
+ TK_OPTION_STRING_TABLE,
+ TK_OPTION_COLOR,
+ TK_OPTION_FONT,
+ TK_OPTION_BITMAP,
+ TK_OPTION_BORDER,
+ TK_OPTION_RELIEF,
+ TK_OPTION_CURSOR,
+ TK_OPTION_JUSTIFY,
+ TK_OPTION_ANCHOR,
+ TK_OPTION_SYNONYM,
+ TK_OPTION_PIXELS,
+ TK_OPTION_WINDOW,
+ TK_OPTION_END,
+ TK_OPTION_CUSTOM,
+ TK_OPTION_STYLE
+} Tk_OptionType;
+
+/*
+ * Structures of the following type are used by widgets to specify
+ * their configuration options. Typically each widget has a static
+ * array of these structures, where each element of the array describes
+ * a single configuration option. The array is passed to
+ * Tk_CreateOptionTable.
+ */
+
+typedef struct Tk_OptionSpec {
+ Tk_OptionType type; /* Type of option, such as TK_OPTION_COLOR;
+ * see definitions above. Last option in
+ * table must have type TK_OPTION_END. */
+ char *optionName; /* Name used to specify option in Tcl
+ * commands. */
+ char *dbName; /* Name for option in option database. */
+ char *dbClass; /* Class for option in database. */
+ char *defValue; /* Default value for option if not specified
+ * in command line, the option database,
+ * or the system. */
+ int objOffset; /* Where in record to store a Tcl_Obj * that
+ * holds the value of this option, specified
+ * as an offset in bytes from the start of
+ * the record. Use the Tk_Offset macro to
+ * generate values for this. -1 means don't
+ * store the Tcl_Obj in the record. */
+ int internalOffset; /* Where in record to store the internal
+ * representation of the value of this option,
+ * such as an int or XColor *. This field
+ * is specified as an offset in bytes
+ * from the start of the record. Use the
+ * Tk_Offset macro to generate values for it.
+ * -1 means don't store the internal
+ * representation in the record. */
+ int flags; /* Any combination of the values defined
+ * below. */
+ ClientData clientData; /* An alternate place to put option-specific
+ * data. Used for the monochrome default value
+ * for colors, etc. */
+ int typeMask; /* An arbitrary bit mask defined by the
+ * class manager; typically bits correspond
+ * to certain kinds of options such as all
+ * those that require a redisplay when they
+ * change. Tk_SetOptions returns the bit-wise
+ * OR of the typeMasks of all options that
+ * were changed. */
+} Tk_OptionSpec;
+
+/*
+ * Flag values for Tk_OptionSpec structures. These flags are shared by
+ * Tk_ConfigSpec structures, so be sure to coordinate any changes
+ * carefully.
+ */
+
+#define TK_OPTION_NULL_OK (1 << 0)
+#define TK_OPTION_DONT_SET_DEFAULT (1 << 3)
+
+/*
+ * The following structure and function types are used by TK_OPTION_CUSTOM
+ * options; the structure holds pointers to the functions needed by the Tk
+ * option config code to handle a custom option.
+ */
+
+typedef int (Tk_CustomOptionSetProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj **value, char *widgRec,
+ int offset, char *saveInternalPtr, int flags));
+typedef Tcl_Obj *(Tk_CustomOptionGetProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset));
+typedef void (Tk_CustomOptionRestoreProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *internalPtr, char *saveInternalPtr));
+typedef void (Tk_CustomOptionFreeProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *internalPtr));
+
+typedef struct Tk_ObjCustomOption {
+ char *name; /* Name of the custom option. */
+ Tk_CustomOptionSetProc *setProc; /* Function to use to set a record's
+ * option value from a Tcl_Obj */
+ Tk_CustomOptionGetProc *getProc; /* Function to use to get a Tcl_Obj
+ * representation from an internal
+ * representation of an option. */
+ Tk_CustomOptionRestoreProc *restoreProc; /* Function to use to restore a
+ * saved value for the internal
+ * representation. */
+ Tk_CustomOptionFreeProc *freeProc; /* Function to use to free the internal
+ * representation of an option. */
+ ClientData clientData; /* Arbitrary one-word value passed to
+ * the handling procs. */
+} Tk_ObjCustomOption;
+
+
+/*
+ * Macro to use to fill in "offset" fields of the Tk_OptionSpec.
+ * struct. Computes number of bytes from beginning of structure
+ * to a given field.
+ */
+
+#ifdef offsetof
+#define Tk_Offset(type, field) ((int) offsetof(type, field))
+#else
+#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field))
+#endif
+
+/*
+ * The following two structures are used for error handling. When
+ * configuration options are being modified, the old values are
+ * saved in a Tk_SavedOptions structure. If an error occurs, then the
+ * contents of the structure can be used to restore all of the old
+ * values. The contents of this structure are for the private use
+ * Tk. No-one outside Tk should ever read or write any of the fields
+ * of these structures.
+ */
+
+typedef struct Tk_SavedOption {
+ struct TkOption *optionPtr; /* Points to information that describes
+ * the option. */
+ Tcl_Obj *valuePtr; /* The old value of the option, in
+ * the form of a Tcl object; may be
+ * NULL if the value wasn't saved as
+ * an object. */
+ double internalForm; /* The old value of the option, in
+ * some internal representation such
+ * as an int or (XColor *). Valid
+ * only if optionPtr->specPtr->objOffset
+ * is < 0. The space must be large
+ * enough to accommodate a double, a
+ * long, or a pointer; right now it
+ * looks like a double is big
+ * enough. Also, using a double
+ * guarantees that the field is
+ * properly aligned for storing large
+ * values. */
+} Tk_SavedOption;
+
+#ifdef TCL_MEM_DEBUG
+# define TK_NUM_SAVED_OPTIONS 2
+#else
+# define TK_NUM_SAVED_OPTIONS 20
+#endif
+
+typedef struct Tk_SavedOptions {
+ char *recordPtr; /* The data structure in which to
+ * restore configuration options. */
+ Tk_Window tkwin; /* Window associated with recordPtr;
+ * needed to restore certain options. */
+ int numItems; /* The number of valid items in
+ * items field. */
+ Tk_SavedOption items[TK_NUM_SAVED_OPTIONS];
+ /* Items used to hold old values. */
+ struct Tk_SavedOptions *nextPtr; /* Points to next structure in list;
+ * needed if too many options changed
+ * to hold all the old values in a
+ * single structure. NULL means no
+ * more structures. */
+} Tk_SavedOptions;
+
+/*
+ * Structure used to describe application-specific configuration
+ * options: indicates procedures to call to parse an option and
+ * to return a text string describing an option. THESE ARE
+ * DEPRECATED; PLEASE USE THE NEW STRUCTURES LISTED ABOVE.
+ */
+
+/*
+ * This is a temporary flag used while tkObjConfig and new widgets
+ * are in development.
+ */
+
+#ifndef __NO_OLD_CONFIG
+
+typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, CONST84 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. */
+ Tk_Uid dbName; /* Name for option in option database. */
+ Tk_Uid dbClass; /* Class for option in database. */
+ Tk_Uid 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.
+ */
+
+typedef enum {
+ TK_CONFIG_BOOLEAN, TK_CONFIG_INT, TK_CONFIG_DOUBLE, TK_CONFIG_STRING,
+ TK_CONFIG_UID, TK_CONFIG_COLOR, TK_CONFIG_FONT, TK_CONFIG_BITMAP,
+ TK_CONFIG_BORDER, TK_CONFIG_RELIEF, TK_CONFIG_CURSOR,
+ TK_CONFIG_ACTIVE_CURSOR, TK_CONFIG_JUSTIFY, TK_CONFIG_ANCHOR,
+ TK_CONFIG_SYNONYM, TK_CONFIG_CAP_STYLE, TK_CONFIG_JOIN_STYLE,
+ TK_CONFIG_PIXELS, TK_CONFIG_MM, TK_CONFIG_WINDOW, TK_CONFIG_CUSTOM,
+ TK_CONFIG_END
+} Tk_ConfigTypes;
+
+/*
+ * Possible values for flags argument to Tk_ConfigureWidget:
+ */
+
+#define TK_CONFIG_ARGV_ONLY 1
+#define TK_CONFIG_OBJS 0x80
+
+/*
+ * Possible flag values for Tk_ConfigSpec structures. Any bits at
+ * or above TK_CONFIG_USER_BIT may be used by clients for selecting
+ * certain entries. Before changing any values here, coordinate with
+ * tkOldConfig.c (internal-use-only flags are defined there).
+ */
+
+#define TK_CONFIG_NULL_OK (1 << 0)
+#define TK_CONFIG_COLOR_ONLY (1 << 1)
+#define TK_CONFIG_MONO_ONLY (1 << 2)
+#define TK_CONFIG_DONT_SET_DEFAULT (1 << 3)
+#define TK_CONFIG_OPTION_SPECIFIED (1 << 4)
+#define TK_CONFIG_USER_BIT 0x100
+#endif /* __NO_OLD_CONFIG */
+
+/*
+ * Structure used to specify how to handle argv options.
+ */
+
+typedef struct {
+ char *key; /* The key string that flags the option in the
+ * argv array. */
+ int type; /* Indicates option type; see below. */
+ char *src; /* Value to be used in setting dst; usage
+ * depends on type. */
+ char *dst; /* Address of value to be modified; usage
+ * depends on type. */
+ char *help; /* Documentation message describing this option. */
+} Tk_ArgvInfo;
+
+/*
+ * Legal values for the type field of a Tk_ArgvInfo: see the user
+ * documentation for details.
+ */
+
+#define TK_ARGV_CONSTANT 15
+#define TK_ARGV_INT 16
+#define TK_ARGV_STRING 17
+#define TK_ARGV_UID 18
+#define TK_ARGV_REST 19
+#define TK_ARGV_FLOAT 20
+#define TK_ARGV_FUNC 21
+#define TK_ARGV_GENFUNC 22
+#define TK_ARGV_HELP 23
+#define TK_ARGV_CONST_OPTION 24
+#define TK_ARGV_OPTION_VALUE 25
+#define TK_ARGV_OPTION_NAME_VALUE 26
+#define TK_ARGV_END 27
+
+/*
+ * Flag bits for passing to Tk_ParseArgv:
+ */
+
+#define TK_ARGV_NO_DEFAULTS 0x1
+#define TK_ARGV_NO_LEFTOVERS 0x2
+#define TK_ARGV_NO_ABBREV 0x4
+#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8
+
+/*
+ * Enumerated type for describing actions to be taken in response
+ * to a restrictProc established by Tk_RestrictEvents.
+ */
+
+typedef enum {
+ 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_NULL -1
+#define TK_RELIEF_FLAT 0
+#define TK_RELIEF_GROOVE 1
+#define TK_RELIEF_RAISED 2
+#define TK_RELIEF_RIDGE 3
+#define TK_RELIEF_SOLID 4
+#define TK_RELIEF_SUNKEN 5
+
+/*
+ * "Which" argument values for Tk_3DBorderGC:
+ */
+
+#define TK_3D_FLAT_GC 1
+#define TK_3D_LIGHT_GC 2
+#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
+
+/*
+ * Widget class procedures used to implement platform specific widget
+ * behavior.
+ */
+
+typedef Window (Tk_ClassCreateProc) _ANSI_ARGS_((Tk_Window tkwin,
+ Window parent, ClientData instanceData));
+typedef void (Tk_ClassWorldChangedProc) _ANSI_ARGS_((ClientData instanceData));
+typedef void (Tk_ClassModalProc) _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent *eventPtr));
+
+typedef struct Tk_ClassProcs {
+ unsigned int size;
+ Tk_ClassWorldChangedProc *worldChangedProc;
+ /* Procedure to invoke when the widget needs to
+ * respond in some way to a change in the
+ * world (font changes, etc.) */
+ Tk_ClassCreateProc *createProc;
+ /* Procedure to invoke when the
+ * platform-dependent window needs to be
+ * created. */
+ Tk_ClassModalProc *modalProc;
+ /* Procedure to invoke after all bindings on a
+ * widget have been triggered in order to
+ * handle a modal loop. */
+} Tk_ClassProcs;
+
+/*
+ * Simple accessor for Tk_ClassProcs structure. Checks that the structure
+ * is not NULL, then checks the size field and returns either the requested
+ * field, if present, or NULL if the structure is too small to have the field
+ * (or NULL if the structure is NULL).
+ *
+ * A more general version of this function may be useful if other
+ * size-versioned structure pop up in the future:
+ *
+ * #define Tk_GetField(name, who, which) \
+ * (((who) == NULL) ? NULL :
+ * (((who)->size <= Tk_Offset(name, which)) ? NULL :(name)->which))
+ */
+
+#define Tk_GetClassProc(procs, which) \
+ (((procs) == NULL) ? NULL : \
+ (((procs)->size <= Tk_Offset(Tk_ClassProcs, which)) ? NULL:(procs)->which))
+
+/*
+ * 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_HasWrapper(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_HAS_WRAPPER)
+#define Tk_WinManaged(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_WIN_MANAGED)
+#define Tk_TopWinHierarchy(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_HIERARCHY)
+#define Tk_ReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->reqWidth)
+#define Tk_ReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->reqHeight)
+/* Tk_InternalBorderWidth is deprecated */
+#define Tk_InternalBorderWidth(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderLeft)
+#define Tk_InternalBorderLeft(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderLeft)
+#define Tk_InternalBorderRight(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderRight)
+#define Tk_InternalBorderTop(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderTop)
+#define Tk_InternalBorderBottom(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderBottom)
+#define Tk_MinReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->minReqWidth)
+#define Tk_MinReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->minReqHeight)
+#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; /* dispPtr */
+ int screenNum;
+ Visual *visual;
+ int depth;
+ Window window;
+ char *dummy2; /* childList */
+ char *dummy3; /* lastChildPtr */
+ Tk_Window parentPtr; /* parentPtr */
+ char *dummy4; /* nextPtr */
+ char *dummy5; /* mainPtr */
+ char *pathName;
+ Tk_Uid nameUid;
+ Tk_Uid classUid;
+ XWindowChanges changes;
+ unsigned int dummy6; /* dirtyChanges */
+ XSetWindowAttributes atts;
+ unsigned long dummy7; /* dirtyAtts */
+ unsigned int flags;
+ char *dummy8; /* handlerList */
+#ifdef TK_USE_INPUT_METHODS
+ XIC dummy9; /* inputContext */
+#endif /* TK_USE_INPUT_METHODS */
+ ClientData *dummy10; /* tagPtr */
+ int dummy11; /* numTags */
+ int dummy12; /* optionLevel */
+ char *dummy13; /* selHandlerList */
+ char *dummy14; /* geomMgrPtr */
+ ClientData dummy15; /* geomData */
+ int reqWidth, reqHeight;
+ int internalBorderLeft;
+ char *dummy16; /* wmInfoPtr */
+ char *dummy17; /* classProcPtr */
+ ClientData dummy18; /* instanceData */
+ char *dummy19; /* privatePtr */
+ int internalBorderRight;
+ int internalBorderTop;
+ int internalBorderBottom;
+ int minReqWidth;
+ int minReqHeight;
+} 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 widget.
+ * 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.
+ * TK_ANONYMOUS_WINDOW: 1 means that this window has no name, and is
+ * thus not accessible from Tk.
+ * TK_HAS_WRAPPER 1 means that this window has a wrapper window
+ * TK_WIN_MANAGED 1 means that this window is a child of the
+ * root window, and is managed by the window
+ * manager.
+ * TK_TOP_HIERARCHY 1 means this window is at the top of a
+ * physical window hierarchy within this
+ * process, i.e. the window's parent
+ * either doesn't exist or is not owned by
+ * this Tk application.
+ * TK_PROP_PROPCHANGE 1 means that PropertyNotify events in
+ * this window's children should propagate
+ * up to this window.
+ */
+
+
+#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
+#define TK_ANONYMOUS_WINDOW 0x4000
+#define TK_HAS_WRAPPER 0x8000
+#define TK_WIN_MANAGED 0x10000
+#define TK_TOP_HIERARCHY 0x20000
+#define TK_PROP_PROPCHANGE 0x40000
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for defining new canvas
+ * items:
+ *
+ *--------------------------------------------------------------
+ */
+
+typedef enum {
+ TK_STATE_NULL = -1, TK_STATE_ACTIVE, TK_STATE_DISABLED,
+ TK_STATE_NORMAL, TK_STATE_HIDDEN
+} Tk_State;
+
+typedef struct Tk_SmoothMethod {
+ char *name;
+ int (*coordProc) _ANSI_ARGS_((Tk_Canvas canvas,
+ double *pointPtr, int numPoints, int numSteps,
+ XPoint xPoints[], double dblPoints[]));
+ void (*postscriptProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, double *coordPtr,
+ int numPoints, int numSteps));
+} Tk_SmoothMethod;
+
+/*
+ * 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. */
+ Tk_State state; /* state of item */
+ char *reserved1; /* reserved for future use */
+ int redraw_flags; /* some flags used in the canvas */
+
+ /*
+ *------------------------------------------------------------------
+ * 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;
+
+/*
+ * Flag bits for canvases (redraw_flags):
+ *
+ * TK_ITEM_STATE_DEPENDANT - 1 means that object needs to be
+ * redrawn if the canvas state changes.
+ * TK_ITEM_DONT_REDRAW - 1 means that the object redraw is already
+ * been prepared, so the general canvas code
+ * doesn't need to do that any more.
+ */
+
+#define TK_ITEM_STATE_DEPENDANT 1
+#define TK_ITEM_DONT_REDRAW 2
+
+/*
+ * 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.
+ */
+
+#ifdef USE_OLD_CANVAS
+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));
+#else
+typedef int Tk_ItemCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *CONST objv[]));
+typedef int Tk_ItemConfigureProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *CONST objv[], int flags));
+typedef int Tk_ItemCoordProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *CONST argv[]));
+#endif
+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));
+
+#ifndef __NO_OLD_CONFIG
+
+typedef struct Tk_ItemType {
+ char *name; /* The name of this type of item, such
+ * as "line". */
+ int itemSize; /* Total amount of space needed for
+ * item's record. */
+ Tk_ItemCreateProc *createProc; /* Procedure to create a new item of
+ * 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;
+
+#endif
+
+/*
+ * The following structure provides information about the selection and
+ * the insertion cursor. It is needed by only a few items, such as
+ * those that display text. It is shared by the generic canvas code
+ * and the item-specific code, but most of the fields should be written
+ * only by the canvas generic code.
+ */
+
+typedef struct Tk_CanvasTextInfo {
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. Read-only to items.*/
+ int selBorderWidth; /* Width of border around selection.
+ * Read-only to items. */
+ XColor *selFgColorPtr; /* Foreground color for selected text.
+ * Read-only to items. */
+ Tk_Item *selItemPtr; /* Pointer to selected item. NULL means
+ * selection isn't in this canvas.
+ * Writable by items. */
+ int selectFirst; /* Character index of first selected
+ * character. Writable by items. */
+ int selectLast; /* Character index of last selected
+ * character. Writable by items. */
+ Tk_Item *anchorItemPtr; /* Item corresponding to "selectAnchor":
+ * not necessarily selItemPtr. Read-only
+ * to items. */
+ int selectAnchor; /* Character index of fixed end of
+ * selection (i.e. "select to" operation will
+ * use this as one end of the selection).
+ * Writable by items. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. Read-only to items. */
+ int insertWidth; /* Total width of insertion cursor. Read-only
+ * to items. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor.
+ * Read-only to items. */
+ Tk_Item *focusItemPtr; /* Item that currently has the input focus,
+ * 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;
+
+/*
+ * Structures used for Dashing and Outline.
+ */
+
+typedef struct Tk_Dash {
+ int number;
+ union {
+ char *pt;
+ char array[sizeof(char *)];
+ } pattern;
+} Tk_Dash;
+
+typedef struct Tk_TSOffset {
+ int flags; /* flags; see below for possible values */
+ int xoffset; /* x offset */
+ int yoffset; /* y offset */
+} Tk_TSOffset;
+
+/*
+ * Bit fields in Tk_Offset->flags:
+ */
+
+#define TK_OFFSET_INDEX 1
+#define TK_OFFSET_RELATIVE 2
+#define TK_OFFSET_LEFT 4
+#define TK_OFFSET_CENTER 8
+#define TK_OFFSET_RIGHT 16
+#define TK_OFFSET_TOP 32
+#define TK_OFFSET_MIDDLE 64
+#define TK_OFFSET_BOTTOM 128
+
+typedef struct Tk_Outline {
+ GC gc; /* Graphics context. */
+ double width; /* Width of outline. */
+ double activeWidth; /* Width of outline. */
+ double disabledWidth; /* Width of outline. */
+ int offset; /* Dash offset */
+ Tk_Dash dash; /* Dash pattern */
+ Tk_Dash activeDash; /* Dash pattern if state is active*/
+ Tk_Dash disabledDash; /* Dash pattern if state is disabled*/
+ VOID *reserved1; /* reserved for future expansion */
+ VOID *reserved2;
+ VOID *reserved3;
+ Tk_TSOffset tsoffset; /* stipple offset for outline*/
+ XColor *color; /* Outline color. */
+ XColor *activeColor; /* Outline color if state is active. */
+ XColor *disabledColor; /* Outline color if state is disabled. */
+ Pixmap stipple; /* Outline Stipple pattern. */
+ Pixmap activeStipple; /* Outline Stipple pattern if state is active. */
+ Pixmap disabledStipple; /* Outline Stipple pattern if state is disabled. */
+} Tk_Outline;
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for managing images:
+ *
+ *--------------------------------------------------------------
+ */
+
+typedef struct Tk_ImageType Tk_ImageType;
+#ifdef USE_OLD_IMAGE
+typedef int (Tk_ImageCreateProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, char **argv, Tk_ImageType *typePtr,
+ Tk_ImageMaster master, ClientData *masterDataPtr));
+#else
+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));
+#endif
+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));
+typedef int (Tk_ImagePostscriptProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo,
+ int x, int y, int width, int height, int prepass));
+
+/*
+ * 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. */
+ Tk_ImagePostscriptProc *postscriptProc;
+ /* Procedure to call to produce postscript
+ * output for 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[4]; /* Address differences between the red, green,
+ * blue and alpha components of the pixel and
+ * the pixel as a whole. */
+} Tk_PhotoImageBlock;
+
+/*
+ * The following values control how blocks are combined into photo
+ * images when the alpha component of a pixel is not 255, a.k.a. the
+ * compositing rule.
+ */
+
+#define TK_PHOTO_COMPOSITE_OVERLAY 0
+#define TK_PHOTO_COMPOSITE_SET 1
+
+/*
+ * Procedure prototypes and structures used in reading and
+ * writing photo images:
+ */
+
+typedef struct Tk_PhotoImageFormat Tk_PhotoImageFormat;
+#ifdef USE_OLD_IMAGE
+typedef int (Tk_ImageFileMatchProc) _ANSI_ARGS_((Tcl_Channel chan,
+ char *fileName, char *formatString, int *widthPtr, int *heightPtr));
+typedef int (Tk_ImageStringMatchProc) _ANSI_ARGS_((char *string,
+ 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,
+ char *string, 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));
+#else
+typedef int (Tk_ImageFileMatchProc) _ANSI_ARGS_((Tcl_Channel chan,
+ CONST char *fileName, Tcl_Obj *format, int *widthPtr,
+ int *heightPtr, Tcl_Interp *interp));
+typedef int (Tk_ImageStringMatchProc) _ANSI_ARGS_((Tcl_Obj *dataObj,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp));
+typedef int (Tk_ImageFileReadProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, CONST char *fileName, Tcl_Obj *format,
+ 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, Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height, int srcX, int srcY));
+typedef int (Tk_ImageFileWriteProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *fileName, Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr));
+typedef int (Tk_ImageStringWriteProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr));
+#endif
+
+/*
+ * 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. */
+};
+
+EXTERN void Tk_CreateOldImageType _ANSI_ARGS_((
+ Tk_ImageType *typePtr));
+EXTERN void Tk_CreateOldPhotoImageFormat _ANSI_ARGS_((
+ Tk_PhotoImageFormat *formatPtr));
+
+#if !defined(USE_TK_STUBS) && defined(USE_OLD_IMAGE)
+#define Tk_CreateImageType Tk_CreateOldImageType
+#define Tk_CreatePhotoImageFormat Tk_CreateOldPhotoImageFormat
+#endif
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for managing styles:
+ *
+ *--------------------------------------------------------------
+ */
+
+/*
+ * Style support version tag.
+ */
+#define TK_STYLE_VERSION_1 0x1
+#define TK_STYLE_VERSION TK_STYLE_VERSION_1
+
+/*
+ * The following structures and prototypes are used as static templates to
+ * declare widget elements.
+ */
+
+typedef void (Tk_GetElementSizeProc) _ANSI_ARGS_((ClientData clientData,
+ char *recordPtr, CONST Tk_OptionSpec **optionsPtr, Tk_Window tkwin,
+ int width, int height, int inner, int *widthPtr, int *heightPtr));
+typedef void (Tk_GetElementBoxProc) _ANSI_ARGS_((ClientData clientData,
+ char *recordPtr, CONST Tk_OptionSpec **optionsPtr, Tk_Window tkwin,
+ int x, int y, int width, int height, int inner, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr));
+typedef int (Tk_GetElementBorderWidthProc) _ANSI_ARGS_((ClientData clientData,
+ char *recordPtr, CONST Tk_OptionSpec **optionsPtr, Tk_Window tkwin));
+typedef void (Tk_DrawElementProc) _ANSI_ARGS_((ClientData clientData,
+ char *recordPtr, CONST Tk_OptionSpec **optionsPtr, Tk_Window tkwin,
+ Drawable d, int x, int y, int width, int height, int state));
+
+typedef struct Tk_ElementOptionSpec {
+ char *name; /* Name of the required option. */
+ Tk_OptionType type; /* Accepted option type. TK_OPTION_END means
+ * any. */
+} Tk_ElementOptionSpec;
+
+typedef struct Tk_ElementSpec {
+ int version; /* Version of the style support. */
+ char *name; /* Name of element. */
+ Tk_ElementOptionSpec *options;
+ /* List of required options. Last one's name
+ * must be NULL. */
+
+ /*
+ * Hooks
+ */
+
+ Tk_GetElementSizeProc *getSize;
+ /* Compute the external (resp. internal) size of
+ * the element from its desired internal (resp.
+ * external) size. */
+ Tk_GetElementBoxProc *getBox;
+ /* Compute the inscribed or bounding boxes
+ * within a given area. */
+ Tk_GetElementBorderWidthProc *getBorderWidth;
+ /* Return the element's internal border width.
+ * Mostly useful for widgets. */
+ Tk_DrawElementProc *draw; /* Draw the element in the given bounding box.*/
+} Tk_ElementSpec;
+
+/*
+ * Element state flags. Can be OR'ed.
+ */
+
+#define TK_ELEMENT_STATE_ACTIVE 1<<0
+#define TK_ELEMENT_STATE_DISABLED 1<<1
+#define TK_ELEMENT_STATE_FOCUS 1<<2
+#define TK_ELEMENT_STATE_PRESSED 1<<3
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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
+
+/* Additional stuff that has moved to Tcl: */
+
+#define Tk_EventuallyFree Tcl_EventuallyFree
+#define Tk_FreeProc Tcl_FreeProc
+#define Tk_Preserve Tcl_Preserve
+#define Tk_Release Tcl_Release
+
+/* Removed Tk_Main, use macro instead */
+#define Tk_Main(argc, argv, proc) \
+ Tk_MainEx(argc, argv, proc, Tcl_CreateInterp())
+
+CONST char *Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version, int exact));
+
+#ifndef USE_TK_STUBS
+
+#define Tk_InitStubs(interp, version, exact) \
+ Tcl_PkgRequire(interp, "Tk", version, exact)
+
+#endif
+
+void Tk_InitImageArgs _ANSI_ARGS_((Tcl_Interp *interp, int argc, char ***argv));
+
+#if !defined(USE_TK_STUBS) || !defined(USE_OLD_IMAGE)
+
+#define Tk_InitImageArgs(interp, argc, argv) /**/
+
+#endif
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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_ClientMessageProc) _ANSI_ARGS_((Tk_Window tkwin,
+ 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));
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Platform independant exported procedures and variables.
+ *
+ *--------------------------------------------------------------
+ */
+
+#include "tkDecls.h"
+
+/*
+ * Allow users to say that they don't want to alter their source to
+ * add the extra argument to Tk_PhotoPutBlock(); DO NOT DEFINE THIS
+ * WHEN BUILDING TK.
+ *
+ * This goes after the inclusion of the stubbed-decls so that the
+ * declarations of what is actually there can be correct.
+ */
+
+#ifdef USE_COMPOSITELESS_PHOTO_PUT_BLOCK
+# ifdef Tk_PhotoPutBlock
+# undef Tk_PhotoPutBlock
+# endif
+# define Tk_PhotoPutBlock Tk_PhotoPutBlock_NoComposite
+# ifdef Tk_PhotoPutZoomedBlock
+# undef Tk_PhotoPutZoomedBlock
+# endif
+# define Tk_PhotoPutZoomedBlock Tk_PhotoPutZoomedBlock_NoComposite
+#endif /* USE_COMPOSITELESS_PHOTO_PUT_BLOCK */
+
+/*
+ * Tcl commands exported by Tk:
+ */
+
+
+#endif /* RC_INVOKED */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* RESOURCE_INCLUDED */
+
+/*
+ * end block for C++
+ */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _TK */
diff --git a/tcl/generic/tk3d.c b/tcl/generic/tk3d.c
new file mode 100644
index 00000000000..670b002f7a4
--- /dev/null
+++ b/tcl/generic/tk3d.c
@@ -0,0 +1,1410 @@
+/*
+ * 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"
+
+/*
+ * The following table defines the string values for reliefs, which are
+ * used by Tk_GetReliefFromObj.
+ */
+
+static CONST char *reliefStrings[] = {"flat", "groove", "raised",
+ "ridge", "solid", "sunken",
+ (char *) NULL};
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void BorderInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupBorderObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeBorderObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int Intersect _ANSI_ARGS_((XPoint *a1Ptr, XPoint *a2Ptr,
+ XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr));
+static void InitBorderObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr,
+ int distance, XPoint *p3Ptr));
+
+/*
+ * The following structure defines the implementation of the "border" Tcl
+ * object, used for drawing. The border object remembers the hash table entry
+ * associated with a border. The actual allocation and deallocation of the
+ * border should be done by the configuration package when the border option
+ * is set.
+ */
+
+Tcl_ObjType tkBorderObjType = {
+ "border", /* name */
+ FreeBorderObjProc, /* freeIntRepProc */
+ DupBorderObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Alloc3DBorderFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * Tk_3DBorder structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is a token for a data structure describing a
+ * 3-D border. This token may be passed to procedures such as
+ * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented
+ * the border from being created then NULL is returned and an error
+ * message will be left in the interp's result.
+ *
+ * Side effects:
+ * The border is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to FreeBorderObjProc so that the database is
+ * cleaned up when borders aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for error results. */
+ Tk_Window tkwin; /* Need the screen the border is used on.*/
+ Tcl_Obj *objPtr; /* Object giving name of color for window
+ * background. */
+{
+ TkBorder *borderPtr;
+
+ if (objPtr->typePtr != &tkBorderObjType) {
+ InitBorderObj(objPtr);
+ }
+ borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkBorder, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (borderPtr != NULL) {
+ if (borderPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a border that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeBorderObjProc(objPtr);
+ borderPtr = NULL;
+ } else if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+
+ /*
+ * The object didn't point to the border that we wanted. Search
+ * the list of borders with the same name to see if one of the
+ * others is the right one.
+ */
+
+ /*
+ * If the cached value is NULL, either the object type was not a
+ * color going in, or the object is a color type but had
+ * previously been freed.
+ *
+ * If the value is not NULL, the internal rep is the value
+ * of the color the last time this object was accessed. Check
+ * the screen and colormap of the last access, and if they
+ * match, we are done.
+ */
+
+ if (borderPtr != NULL) {
+ TkBorder *firstBorderPtr =
+ (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr);
+ FreeBorderObjProc(objPtr);
+ for (borderPtr = firstBorderPtr ; borderPtr != NULL;
+ borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ borderPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call Tk_Get3DBorder to allocate a new border.
+ */
+
+ borderPtr = (TkBorder *) Tk_Get3DBorder(interp, tkwin,
+ Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount++;
+ }
+ return (Tk_3DBorder) borderPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Get3DBorder --
+ *
+ * Create a data structure for displaying a 3-D border.
+ *
+ * Results:
+ * The return value is a token for a data structure describing a
+ * 3-D border. This token may be passed to procedures such as
+ * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented
+ * the border from being created then NULL is returned and an error
+ * message will be left in the interp's result.
+ *
+ * Side effects:
+ * Data structures, graphics contexts, etc. are allocated.
+ * It is the caller's responsibility to eventually call
+ * Tk_Free3DBorder to release the resources.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorder(interp, tkwin, colorName)
+ Tcl_Interp *interp; /* Place to store an error message. */
+ Tk_Window tkwin; /* Token for window in which border will
+ * be drawn. */
+ Tk_Uid colorName; /* String giving name of color
+ * for window background. */
+{
+ Tcl_HashEntry *hashPtr;
+ TkBorder *borderPtr, *existingBorderPtr;
+ int new;
+ XGCValues gcValues;
+ XColor *bgColorPtr;
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->borderInit) {
+ BorderInit(dispPtr);
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&dispPtr->borderTable, colorName, &new);
+ if (!new) {
+ existingBorderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ for (borderPtr = existingBorderPtr; borderPtr != NULL;
+ borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+ } else {
+ existingBorderPtr = NULL;
+ }
+
+ /*
+ * No satisfactory border exists yet. Initialize a new one.
+ */
+
+ bgColorPtr = Tk_GetColor(interp, tkwin, colorName);
+ if (bgColorPtr == NULL) {
+ if (new) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ return NULL;
+ }
+
+ borderPtr = TkpGetBorder();
+ borderPtr->screen = Tk_Screen(tkwin);
+ borderPtr->visual = Tk_Visual(tkwin);
+ borderPtr->depth = Tk_Depth(tkwin);
+ borderPtr->colormap = Tk_Colormap(tkwin);
+ borderPtr->resourceRefCount = 1;
+ borderPtr->objRefCount = 0;
+ borderPtr->bgColorPtr = bgColorPtr;
+ borderPtr->darkColorPtr = NULL;
+ borderPtr->lightColorPtr = NULL;
+ borderPtr->shadow = None;
+ borderPtr->bgGC = None;
+ borderPtr->darkGC = None;
+ borderPtr->lightGC = None;
+ borderPtr->hashPtr = hashPtr;
+ borderPtr->nextPtr = existingBorderPtr;
+ Tcl_SetHashValue(hashPtr, borderPtr);
+
+ /*
+ * Create the information for displaying the background color,
+ * but delay the allocation of shadows until they are actually
+ * needed for drawing.
+ */
+
+ gcValues.foreground = borderPtr->bgColorPtr->pixel;
+ borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return (Tk_3DBorder) borderPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DRectangle --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOf3DBorder(border)
+ Tk_3DBorder border; /* Token for border. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+
+ return borderPtr->hashPtr->key.string;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * 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. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ Display *display = DisplayOfScreen(borderPtr->screen);
+ TkBorder *prevPtr;
+
+ borderPtr->resourceRefCount--;
+ if (borderPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ prevPtr = (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr);
+ TkpFreeBorder(borderPtr);
+ if (borderPtr->bgColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->bgColorPtr);
+ }
+ if (borderPtr->darkColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->darkColorPtr);
+ }
+ if (borderPtr->lightColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->lightColorPtr);
+ }
+ if (borderPtr->shadow != None) {
+ Tk_FreeBitmap(display, borderPtr->shadow);
+ }
+ if (borderPtr->bgGC != None) {
+ Tk_FreeGC(display, borderPtr->bgGC);
+ }
+ if (borderPtr->darkGC != None) {
+ Tk_FreeGC(display, borderPtr->darkGC);
+ }
+ if (borderPtr->lightGC != None) {
+ Tk_FreeGC(display, borderPtr->lightGC);
+ }
+ if (prevPtr == borderPtr) {
+ if (borderPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(borderPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(borderPtr->hashPtr, borderPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != borderPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = borderPtr->nextPtr;
+ }
+ if (borderPtr->objRefCount == 0) {
+ ckfree((char *) borderPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Free3DBorderFromObj --
+ *
+ * This procedure is called to release a border allocated by
+ * Tk_Alloc3DBorderFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this border
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the border represented by
+ * objPtr is decremented, and the border's resources are released
+ * to X if there are no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Free3DBorderFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this border lives in. Needed
+ * for the screen and colormap values. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ Tk_Free3DBorder(Tk_Get3DBorderFromObj(tkwin, objPtr));
+ FreeBorderObjProc(objPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeBorderObjProc --
+ *
+ * This proc is called to release an object reference to a border.
+ * Called when the object's internal rep is released or when
+ * the cached borderPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the border's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeBorderObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkBorder *borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount--;
+ if ((borderPtr->objRefCount == 0)
+ && (borderPtr->resourceRefCount == 0)) {
+ ckfree((char *) borderPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupBorderObjProc --
+ *
+ * When a cached border object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupBorderObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkBorder *borderPtr = (TkBorder *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetBackgroundFromBorder --
+ *
+ * Change the background of a window to one appropriate for a given
+ * 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_GetReliefFromObj --
+ *
+ * Return an integer value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetReliefFromObj(interp, objPtr, resultPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *objPtr; /* The object we are trying to get the
+ * value from. */
+ int *resultPtr; /* Where to place the answer. */
+{
+ return Tcl_GetIndexFromObj(interp, objPtr, reliefStrings, "relief", 0,
+ resultPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRelief --
+ *
+ * Parse a relief description and return the corresponding
+ * 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. */
+ CONST 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 {
+ char buf[200];
+
+ sprintf(buf, "bad relief type \"%.50s\": must be %s",
+ name, "flat, groove, raised, ridge, solid, or sunken");
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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 if (relief == TK_RELIEF_NULL) {
+ return "";
+ } 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;
+ } else {
+ /*
+ * We need to make this extra check, otherwise we will leave
+ * garbage in thin frames [Bug: 3596]
+ */
+ if (width < 2*borderWidth) {
+ borderWidth = width/2;
+ }
+ if (height < 2*borderWidth) {
+ borderWidth = height/2;
+ }
+ }
+ 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(dispPtr)
+ TkDisplay * dispPtr; /* Used to access thread-specific data. */
+{
+ dispPtr->borderInit = 1;
+ Tcl_InitHashTable(&dispPtr->borderTable, TCL_STRING_KEYS);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Get3DBorderFromObj --
+ *
+ * Returns the border referred to by a Tcl object. The border must
+ * already have been allocated via a call to Tk_Alloc3DBorderFromObj
+ * or Tk_Get3DBorder.
+ *
+ * Results:
+ * Returns the Tk_3DBorder that matches the tkwin and the string rep
+ * of the name of the border given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a border, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorderFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object whose string value selects
+ * a border. */
+{
+ TkBorder *borderPtr = NULL;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkBorderObjType) {
+ InitBorderObj(objPtr);
+ }
+
+ /*
+ * If we are lucky (and the user doesn't use too many different
+ * displays, screens, or colormaps...) then the TkBorder
+ * structure we need will be cached in the internal
+ * representation of the Tcl_Obj. Check it out...
+ */
+
+ borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+ if ((borderPtr != NULL)
+ && (borderPtr->resourceRefCount > 0)
+ && (Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ /*
+ * The object already points to the right border structure.
+ * Just return it.
+ */
+ return (Tk_3DBorder) borderPtr;
+ }
+
+ /*
+ * If we make it here, it means we aren't so lucky. Either there
+ * was no cached TkBorder in the Tcl_Obj, or the TkBorder that was
+ * there is for the wrong screen/colormap. Either way, we have
+ * to search for the right TkBorder. For each color name, there is
+ * linked list of TkBorder structures, one structure for each
+ * screen/colormap combination. The head of the linked list is
+ * recorded in a hash table (where the key is the color name)
+ * attached to the TkDisplay structure. Walk this list to find
+ * the right TkBorder structure.
+ */
+
+ hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ for (borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ FreeBorderObjProc(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ borderPtr->objRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+
+ error:
+ panic("Tk_Get3DBorderFromObj called with non-existent border!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitBorderObj --
+ *
+ * Attempt to generate a border internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a blank internal format for a border value
+ * is intialized. The final form cannot be done without a Tk_Window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitBorderObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkBorderObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugBorder --
+ *
+ * This procedure returns debugging information about a border.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkBorder
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkBorder structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugBorder(tkwin, name)
+ Tk_Window tkwin; /* The window in which the border will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkBorder *borderPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, name);
+ if (hashPtr != NULL) {
+ borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ if (borderPtr == NULL) {
+ panic("TkDebugBorder found empty hash table entry");
+ }
+ for ( ; (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(borderPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(borderPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
diff --git a/tcl/generic/tk3d.h b/tcl/generic/tk3d.h
new file mode 100644
index 00000000000..babc7844293
--- /dev/null
+++ b/tcl/generic/tk3d.h
@@ -0,0 +1,102 @@
+/*
+ * tk3d.h --
+ *
+ * Declarations of types and functions shared by the 3d border
+ * module.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TK3D
+#define _TK3D
+
+#include <tkInt.h>
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * One of the following data structures is allocated for each 3-D border
+ * currently in use. Structures of this type are indexed by
+ * borderTable, so that a single structure can be shared for several
+ * uses.
+ */
+
+typedef struct TkBorder {
+ Screen *screen; /* Screen on which the border will be used. */
+ Visual *visual; /* Visual for all windows and pixmaps using
+ * the border. */
+ int depth; /* Number of bits per pixel of drawables where
+ * the border will be used. */
+ Colormap colormap; /* Colormap out of which pixels are
+ * allocated. */
+ int resourceRefCount; /* Number of active uses of this color (each
+ * active use corresponds to a call to
+ * Tk_Alloc3DBorderFromObj or Tk_Get3DBorder).
+ * If this count is 0, then this structure
+ * is no longer valid and it isn't present
+ * in borderTable: it is being kept around
+ * only because there are objects referring
+ * to it. The structure is freed when
+ * resourceRefCount and objRefCount are
+ * both 0. */
+ int objRefCount; /* The number of Tcl objects that reference
+ * this structure. */
+ XColor *bgColorPtr; /* Background color (intensity
+ * between lightColorPtr and
+ * darkColorPtr). */
+ XColor *darkColorPtr; /* Color for darker areas (must free when
+ * deleting structure). NULL means shadows
+ * haven't been allocated yet.*/
+ XColor *lightColorPtr; /* Color used for lighter areas of border
+ * (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). */
+ struct TkBorder *nextPtr; /* Points to the next TkBorder structure with
+ * the same color name. Borders with the
+ * same name but different screens or
+ * colormaps are chained together off a
+ * single entry in borderTable. */
+} TkBorder;
+
+
+/*
+ * Maximum intensity for a color:
+ */
+
+#define MAX_INTENSITY 65535
+
+/*
+ * Declarations for platform specific interfaces used by this module.
+ */
+
+EXTERN TkBorder * TkpGetBorder _ANSI_ARGS_((void));
+EXTERN void TkpGetShadows _ANSI_ARGS_((TkBorder *borderPtr,
+ Tk_Window tkwin));
+EXTERN void TkpFreeBorder _ANSI_ARGS_((TkBorder *borderPtr));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TK3D */
diff --git a/tcl/generic/tkArgv.c b/tcl/generic/tkArgv.c
new file mode 100644
index 00000000000..d62bc082f08
--- /dev/null
+++ b/tcl/generic/tkArgv.c
@@ -0,0 +1,438 @@
+/*
+ * tkArgv.c --
+ *
+ * This file contains a procedure that handles table-based
+ * argv-argc parsing.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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"},
+ {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 the interp's result.
+ * Under normal conditions, both *argcPtr and *argv are modified
+ * to return the arguments that couldn't be processed here (they
+ * didn't match the option table, or followed an TK_ARGV_REST
+ * argument).
+ *
+ * Side effects:
+ * Variables may be modified, resources may be entered for tkwin,
+ * 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. */
+ CONST 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. */
+ CONST 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 {
+ *((CONST 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 *,
+ CONST 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, CONST 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;
+ default: {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "bad argument type %d in Tk_ArgvInfo",
+ infoPtr->type);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /*
+ * If we broke out of the loop because of an OPT_REST argument,
+ * copy the remaining arguments down.
+ */
+
+ 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:
+ * The interp's result will be modified to hold a help string
+ * describing all the options in argTable, plus all those
+ * in the default table unless TK_ARGV_NO_DEFAULTS is
+ * specified in flags.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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[TCL_DOUBLE_SPACE];
+
+ /*
+ * 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/tcl/generic/tkAtom.c b/tcl/generic/tkAtom.c
new file mode 100644
index 00000000000..e095183427a
--- /dev/null
+++ b/tcl/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. */
+ CONST 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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 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/tcl/generic/tkBind.c b/tcl/generic/tkBind.c
new file mode 100644
index 00000000000..143af5a2e7b
--- /dev/null
+++ b/tcl/generic/tkBind.c
@@ -0,0 +1,4644 @@
+/*
+ * tkBind.c --
+ *
+ * This file provides procedures that associate Tcl commands
+ * with X events or sequences of X events.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* UNIX */
+#include "tkUnixInt.h"
+#endif
+
+
+/*
+ * 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 tk::Priv 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. */
+ int deleted; /* 1 the application has been deleted but
+ * the structure has been preserved. */
+} BindInfo;
+
+/*
+ * In X11R4 and earlier versions, XStringToKeysym is ridiculously
+ * slow. The data structure and hash table below, along with the
+ * code that uses them, implement a fast mapping from strings to
+ * keysyms. In X11R5 and later releases XStringToKeysym is plenty
+ * 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;
+TCL_DECLARE_MUTEX(bindMutex)
+
+/*
+ * A hash table is kept to map from the string names of event
+ * modifiers to information about those modifiers. The structure
+ * for storing this information, and the hash table built at
+ * initialization time, are defined below.
+ */
+
+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.
+ * QUADRUPLE - Non-zero means quadruple this event,
+ * e.g. for 4-fold-clicks.
+ * MULT_CLICKS - Combination of all of above.
+ */
+
+#define DOUBLE 1
+#define TRIPLE 2
+#define QUADRUPLE 4
+#define MULT_CLICKS 7
+
+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},
+ {"Quadruple", 0, QUADRUPLE},
+ {"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},
+ {"CirculateRequest", CirculateRequest, SubstructureRedirectMask},
+ {"ConfigureRequest", ConfigureRequest, SubstructureRedirectMask},
+ {"Create", CreateNotify, SubstructureNotifyMask},
+ {"MapRequest", MapRequest, SubstructureRedirectMask},
+ {"ResizeRequest", ResizeRequest, ResizeRedirectMask},
+ {(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 MAPREQ 0x80000
+#define CONFIGREQ 0x100000
+#define RESIZEREQ 0x200000
+#define CIRCREQ 0x400000
+
+#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 */ MAPREQ,
+ /* ReparentNotify */ REPARENT,
+ /* ConfigureNotify */ CONFIG,
+ /* ConfigureRequest */ CONFIGREQ,
+ /* GravityNotify */ GRAVITY,
+ /* ResizeRequest */ RESIZEREQ,
+ /* 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 table is used to map between the location where an
+ * generated event should be queued and the string used to specify the
+ * location.
+ */
+
+static TkStateMap queuePosition[] = {
+ {-1, "now"},
+ {TCL_QUEUE_HEAD, "head"},
+ {TCL_QUEUE_MARK, "mark"},
+ {TCL_QUEUE_TAIL, "tail"},
+ {-2, NULL}
+};
+
+/*
+ * The following tables are used as a two-way map between X's internal
+ * numeric values for fields in an XEvent and the strings used in Tcl. The
+ * tables are used both when constructing an XEvent from user input and
+ * when providing data from an XEvent to the user.
+ */
+
+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}
+};
+
+static TkStateMap configureRequestDetail[] = {
+ {None, "None"},
+ {Above, "Above"},
+ {Below, "Below"},
+ {BottomIf, "BottomIf"},
+ {TopIf, "TopIf"},
+ {Opposite, "Opposite"},
+ {-1, NULL}
+};
+
+static TkStateMap propNotify[] = {
+ {PropertyNewValue, "NewValue"},
+ {PropertyDelete, "Delete"},
+ {-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,
+ CONST 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,
+ CONST 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 void GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
+ Tcl_DString *dsPtr));
+static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString));
+static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
+ char *virtString));
+static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window main, int objc,
+ Tcl_Obj *CONST objv[]));
+static void InitVirtualEventTable _ANSI_ARGS_((
+ VirtualEventTable *vetPtr));
+static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
+ BindingTable *bindPtr, PatSeq *psPtr,
+ PatSeq *bestPtr, ClientData *objectPtr,
+ PatSeq **sourcePtrPtr));
+static int NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window main, Tcl_Obj *objPtr,
+ Tk_Window *tkwinPtr));
+static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char **eventStringPtr, Pattern *patPtr,
+ unsigned long *eventMaskPtr));
+static void DoWarp _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * 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_MutexLock(&bindMutex);
+ if (!initialized) {
+ Tcl_HashEntry *hPtr;
+ ModInfo *modPtr;
+ EventInfo *eiPtr;
+ int dummy;
+
+#ifdef REDO_KEYSYM_LOOKUP
+ KeySymInfo *kPtr;
+
+ Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
+ for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
+ hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->value);
+ hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
+ &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->name);
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+
+ Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
+ for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
+ hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, modPtr);
+ }
+
+ Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, eiPtr);
+ }
+ initialized = 1;
+ }
+ Tcl_MutexUnlock(&bindMutex);
+ }
+
+ mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
+
+ bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
+ InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->screenInfo.curDispPtr = NULL;
+ bindInfoPtr->screenInfo.curScreenIndex = -1;
+ bindInfoPtr->screenInfo.bindingDepth = 0;
+ bindInfoPtr->pendingList = NULL;
+ bindInfoPtr->deleted = 0;
+ mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
+
+ TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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);
+ bindInfoPtr->deleted = 1;
+ Tcl_EventuallyFree((ClientData) bindInfoPtr, TCL_DYNAMIC);
+ 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_CreateBinding.
+ *
+ * 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 the interp's result. If all went well then the return
+ * value is a mask of the event types that must be made
+ * available to Tk_BindEvent in order to properly detect when
+ * this binding triggers. This value can be used to determine
+ * what events to select for in a window, for example.
+ *
+ * Side effects:
+ * An existing binding on the same event sequence may be
+ * 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. */
+ CONST char *eventString; /* String describing event sequence that
+ * triggers binding. */
+ CONST 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 the interp's result. If all went well then the return
+ * value is a mask of the event types that must be made
+ * available to Tk_BindEvent in order to properly detect when
+ * this binding triggers. This value can be used to determine
+ * what events to select for in a window, for example.
+ *
+ * Side effects:
+ * Any existing binding on the same event sequence will be
+ * 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. */
+ CONST 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 the interp's 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. */
+ CONST 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
+ * the interp's result. The return value is semi-static: it
+ * will persist until the binding is changed or deleted.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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. */
+ CONST 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 (CONST 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. The interp's result is modified to
+ * hold a Tcl list with one entry for each binding associated
+ * with object in bindingTable. Each entry in the list
+ * contains the event string associated with one binding.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+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;
+ ScreenInfo *screenPtr;
+ BindInfo *bindInfoPtr;
+ TkDisplay *oldDispPtr;
+ XEvent *ringPtr;
+ PatSeq *vMatchDetailList, *vMatchNoDetailList;
+ int flags, oldScreen, i, deferModal;
+ unsigned int matchCount, matchSpace;
+ Tcl_Interp *interp;
+ Tcl_DString scripts, savedResult;
+ Detail detail;
+ char *p, *end;
+ PendingBinding *pendingPtr;
+ PendingBinding staticPending;
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ PatternTableKey key;
+ Tk_ClassModalProc *modalProc;
+ /*
+ * 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 = TkpGetKeySym(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 the interp's result is significant (for example, a widget
+ * might be deleted because of an error in creating it, so the
+ * result contains an error message that is eventually going to
+ * be returned by the creating command). To preserve the result,
+ * we save it in a dynamic string.
+ * 2. The binding's action can potentially delete the binding,
+ * so bindPtr may not point to anything valid once the action
+ * completes. Thus we have to save bindPtr->interp in a
+ * 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) {
+ /*
+ * Remember the list of pending C binding callbacks, so we can mark
+ * them as deleted and not call them if the act of evaluating a C
+ * or Tcl binding deletes a C binding callback or even the whole
+ * window.
+ */
+
+ pendingPtr->nextPtr = bindInfoPtr->pendingList;
+ pendingPtr->tkwin = tkwin;
+ pendingPtr->deleted = 0;
+ bindInfoPtr->pendingList = pendingPtr;
+ }
+
+ /*
+ * Save the current value of the TK_DEFER_MODAL flag so we can
+ * restore it at the end of the loop. Clear the flag so we can
+ * detect any recursive requests for a modal loop.
+ */
+
+ flags = winPtr->flags;
+ winPtr->flags &= ~TK_DEFER_MODAL;
+
+ p = Tcl_DStringValue(&scripts);
+ end = p + Tcl_DStringLength(&scripts);
+ i = 0;
+
+ /*
+ * Be carefule when dereferencing screenPtr or bindInfoPtr. If we
+ * evaluate something that destroys ".", bindInfoPtr would have been
+ * freed, but we can tell that by first checking to see if
+ * winPtr->mainPtr == NULL.
+ */
+
+ Tcl_Preserve((ClientData) bindInfoPtr);
+ while (p < end) {
+ int code;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth++;
+ }
+ Tcl_AllowExceptions(interp);
+
+ if (*p == '\0') {
+ PatSeq *psPtr;
+
+ psPtr = pendingPtr->matchArray[i];
+ i++;
+ 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++;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth--;
+ }
+ if (code != TCL_OK) {
+ if (code == TCL_CONTINUE) {
+ /*
+ * Do nothing: just go on to the next command.
+ */
+ } else if (code == TCL_BREAK) {
+ break;
+ } 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) {
+ modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc);
+ if (modalProc != NULL) {
+ (*modalProc)(tkwin, eventPtr);
+ }
+ }
+ }
+
+ if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
+ && ((oldDispPtr != screenPtr->curDispPtr)
+ || (oldScreen != screenPtr->curScreenIndex))) {
+
+ /*
+ * Some other binding script is currently executing, but its
+ * screen is no longer current. Change the current display
+ * back again.
+ */
+
+ screenPtr->curDispPtr = oldDispPtr;
+ screenPtr->curScreenIndex = oldScreen;
+ ChangeScreen(interp, oldDispPtr->name, oldScreen);
+ }
+ Tcl_DStringResult(interp, &savedResult);
+ Tcl_DStringFree(&scripts);
+
+ if (matchCount > 0) {
+ if (!bindInfoPtr->deleted) {
+ /*
+ * Delete the pending list from the list of pending scripts
+ * for this window.
+ */
+
+ PendingBinding **curPtrPtr;
+
+ for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
+ if (*curPtrPtr == pendingPtr) {
+ *curPtrPtr = pendingPtr->nextPtr;
+ break;
+ }
+ curPtrPtr = &(*curPtrPtr)->nextPtr;
+ }
+ }
+ if (pendingPtr != &staticPending) {
+ ckfree((char *) pendingPtr);
+ }
+ }
+ Tcl_Release((ClientData) bindInfoPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindDeadWindow --
+ *
+ * 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;
+
+ /*
+ * Certain special windows like those used for send and clipboard
+ * have no mainPtr.
+ */
+ if (winPtr->mainPtr == NULL)
+ return;
+
+ 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.type == CreateNotify
+ && eventPtr->xcreatewindow.parent != window) {
+ goto nextSequence;
+ } else
+ 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 & META_MASK) && (dispPtr->metaModMask != 0)) {
+ state = (state & ~META_MASK) | dispPtr->metaModMask;
+ }
+ if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) {
+ state = (state & ~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. */
+ CONST 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
+ CONST char *string;
+ Tcl_DString buf;
+ char numStorage[NUM_SIZE+1];
+
+ Tcl_DStringInit(&buf);
+
+ if (eventPtr->type < TK_LASTEVENT) {
+ flags = flagArray[eventPtr->type];
+ } else {
+ flags = 0;
+ }
+ while (1) {
+ /*
+ * 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, (int) (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':
+ if (flags & CONFIG) {
+ TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
+ string = numStorage;
+ }
+ goto doString;
+ case 'b':
+ number = eventPtr->xbutton.button;
+ goto doNumber;
+ case 'c':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.count;
+ }
+ goto doNumber;
+ case 'd':
+ if (flags & (CROSSING|FOCUS)) {
+ if (flags & FOCUS) {
+ number = eventPtr->xfocus.detail;
+ } else {
+ number = eventPtr->xcrossing.detail;
+ }
+ string = TkFindStateString(notifyDetail, number);
+ }
+ else if (flags & CONFIGREQ) {
+ if (eventPtr->xconfigurerequest.value_mask & CWStackMode) {
+ string = TkFindStateString(configureRequestDetail,
+ eventPtr->xconfigurerequest.detail);
+ } else {
+ string = "";
+ }
+ }
+ 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;
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.height;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.height;
+ } else if (flags & RESIZEREQ) {
+ number = eventPtr->xresizerequest.height;
+ }
+ goto doNumber;
+ case 'i':
+ if (flags & CREATE) {
+ TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window);
+ } else if (flags & CONFIGREQ) {
+ TkpPrintWindowId(numStorage, eventPtr->xconfigurerequest.window);
+ } else if (flags & MAPREQ) {
+ TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window);
+ } else {
+ TkpPrintWindowId(numStorage, eventPtr->xany.window);
+ }
+ string = numStorage;
+ goto doString;
+ 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':
+ if (flags & CIRC) {
+ string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
+ } else if (flags & CIRCREQ) {
+ string = TkFindStateString(circPlace, eventPtr->xcirculaterequest.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 & PROP) {
+ string = TkFindStateString(propNotify,
+ eventPtr->xproperty.state);
+ goto doString;
+ } 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;
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.width;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.width;
+ } else if (flags & RESIZEREQ) {
+ number = eventPtr->xresizerequest.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;
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.x;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.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;
+
+ }
+ else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.y;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.y;
+ }
+ goto doNumber;
+ case 'A':
+ if (flags & KEY) {
+ Tcl_DStringFree(&buf);
+ string = TkpGetString(winPtr, eventPtr, &buf);
+ }
+ goto doString;
+ case 'B':
+ if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.border_width;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.border_width;
+ } else {
+ number = eventPtr->xconfigure.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 'P':
+ if (flags & PROP) {
+ string = Tk_GetAtomName((Tk_Window) winPtr, eventPtr->xproperty.atom);
+ }
+ goto doString;
+ 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;
+ }
+ Tcl_DStringFree(&buf);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeScreen --
+ *
+ * This procedure is invoked whenever the current screen changes
+ * in an application. It invokes a Tcl procedure named
+ * "tk::ScreenChanged", passing it the screen name as argument.
+ * tk::ScreenChanged does things like making the tk::Priv variable
+ * point to an array for the current display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what tk::ScreenChanged does. If an error occurs
+ * them bgerror 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[TCL_INTEGER_SPACE];
+
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18);
+ 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_EventObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index;
+ Tk_Window tkwin;
+ VirtualEventTable *vetPtr;
+ TkBindInfo bindInfo;
+ static CONST char *optionStrings[] = {
+ "add", "delete", "generate", "info",
+ NULL
+ };
+ enum options {
+ EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
+ };
+
+ tkwin = (Tk_Window) clientData;
+ bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
+ vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case EVENT_ADD: {
+ int i;
+ char *name, *event;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "virtual sequence ?sequence ...?");
+ return TCL_ERROR;
+ }
+ name = Tcl_GetStringFromObj(objv[2], NULL);
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetStringFromObj(objv[i], NULL);
+ if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
+ }
+ case EVENT_DELETE: {
+ int i;
+ char *name, *event;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "virtual ?sequence sequence ...?");
+ return TCL_ERROR;
+ }
+ name = Tcl_GetStringFromObj(objv[2], NULL);
+ if (objc == 3) {
+ return DeleteVirtualEvent(interp, vetPtr, name, NULL);
+ }
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetStringFromObj(objv[i], NULL);
+ if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
+ }
+ case EVENT_GENERATE: {
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?");
+ return TCL_ERROR;
+ }
+ return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
+ }
+ case EVENT_INFO: {
+ if (objc == 2) {
+ GetAllVirtualEvents(interp, vetPtr);
+ return TCL_OK;
+ } else if (objc == 3) {
+ return GetVirtualEvent(interp, vetPtr,
+ Tcl_GetStringFromObj(objv[2], NULL));
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 the interp's result. If all went well then the
+ * return value is TCL_OK.
+ *
+ * Side effects:
+ * The virtual event may cause future calls to Tk_BindEvent to
+ * behave differently than they did previously.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 the interp's result will contain an error message.
+ * It is not an error to attempt to delete a virtual event that
+ * does not exist or a definition that does not exist.
+ *
+ * Side effects:
+ * The virtual event given by virtString may be removed from the
+ * virtual event table.
+ *
+ *--------------------------------------------------------------
+ */
+
+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) {
+ CONST char *string;
+
+ string = Tcl_GetStringResult(interp);
+ return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
+ }
+ }
+
+ for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
+ PatSeq *psPtr = poPtr->patSeqs[iPhys];
+ if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
+ int iVirt;
+ 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("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 the interp's result is filled with the
+ * string representation of the physical events associated with the
+ * virtual event; if there are no physical events for the given virtual
+ * event, the interp's result is filled with and empty string. If the
+ * virtual event string is improperly formed, then TCL_ERROR is
+ * returned and an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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. The interp's 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, objc, objv)
+ Tcl_Interp *interp; /* Interp for errors return and name lookup. */
+ Tk_Window mainWin; /* Main window associated with interp. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ XEvent event;
+ CONST char *p;
+ char *name, *windowName;
+ int count, flags, synch, i, number, warp;
+ Tcl_QueuePosition pos;
+ Pattern pat;
+ Tk_Window tkwin, tkwin2;
+ TkWindow *mainPtr;
+ unsigned long eventMask;
+ static CONST char *fieldStrings[] = {
+ "-when", "-above", "-borderwidth", "-button",
+ "-count", "-delta", "-detail", "-focus",
+ "-height",
+ "-keycode", "-keysym", "-mode", "-override",
+ "-place", "-root", "-rootx", "-rooty",
+ "-sendevent", "-serial", "-state", "-subwindow",
+ "-time", "-warp", "-width", "-window",
+ "-x", "-y", NULL
+ };
+ enum field {
+ EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON,
+ EVENT_COUNT, EVENT_DELTA, EVENT_DETAIL, EVENT_FOCUS,
+ EVENT_HEIGHT,
+ EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE,
+ EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY,
+ EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW,
+ EVENT_TIME, EVENT_WARP, EVENT_WIDTH, EVENT_WINDOW,
+ EVENT_X, EVENT_Y
+ };
+
+ windowName = Tcl_GetStringFromObj(objv[0], NULL);
+ if (!windowName[0]) {
+ tkwin = mainWin;
+ } else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ mainPtr = (TkWindow *) mainWin;
+ if ((tkwin == NULL)
+ || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ char *name;
+
+ name = Tcl_GetStringFromObj(objv[0], NULL);
+ Tcl_AppendResult(interp, "window id \"", name,
+ "\" doesn't exist in this application", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[1], NULL);
+
+ p = name;
+ eventMask = 0;
+ count = ParseEventDescription(interp, &p, &pat, &eventMask);
+ if (count == 0) {
+ return TCL_ERROR;
+ }
+ if (count != 1) {
+ Tcl_SetResult(interp, "Double or Triple modifier not allowed",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (*p != '\0') {
+ Tcl_SetResult(interp, "only one event specification allowed",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = pat.eventType;
+ event.xany.serial = NextRequest(Tk_Display(tkwin));
+ event.xany.send_event = False;
+ if (windowName[0]) {
+ event.xany.window = Tk_WindowId(tkwin);
+ } else {
+ event.xany.window = RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(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)) {
+ TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event);
+ } else if (flags & BUTTON) {
+ event.xbutton.button = pat.detail.button;
+ } else if (flags & VIRTUAL) {
+ ((XVirtualEvent *) &event)->name = pat.detail.name;
+ }
+ }
+ if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
+ event.xcreatewindow.window = event.xany.window;
+ }
+
+ /*
+ * Process the remaining arguments to fill in additional fields
+ * of the event.
+ */
+
+ synch = 1;
+ warp = 0;
+ pos = TCL_QUEUE_TAIL;
+ for (i = 2; i < objc; i += 2) {
+ Tcl_Obj *optionPtr, *valuePtr;
+ int index;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc & 1) {
+ /*
+ * This test occurs after Tcl_GetIndexFromObj() so that
+ * "event generate <Button> -xyz" will return the error message
+ * that "-xyz" is a bad option, rather than that the value
+ * for "-xyz" is missing.
+ */
+
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetStringFromObj(optionPtr, NULL), "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum field) index) {
+ case EVENT_WARP: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!(flags & (KEY_BUTTON_MOTION_VIRTUAL))) {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_WHEN: {
+ pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr,
+ queuePosition, valuePtr);
+ if ((int) pos < -1) {
+ return TCL_ERROR;
+ }
+ synch = 0;
+ if ((int) pos == -1) {
+ synch = 1;
+ }
+ break;
+ }
+ case EVENT_ABOVE: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CONFIG) {
+ event.xconfigure.above = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_BORDER: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.border_width = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_BUTTON: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & BUTTON) {
+ event.xbutton.button = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_COUNT: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.count = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_DELTA: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_DETAIL: {
+ number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & FOCUS) {
+ event.xfocus.detail = number;
+ } else if (flags & CROSSING) {
+ event.xcrossing.detail = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_FOCUS: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.focus = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_HEIGHT: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.height = number;
+ } else if (flags & CONFIG) {
+ event.xconfigure.height = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_KEYCODE: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_KEYSYM: {
+ KeySym keysym;
+ char *value;
+
+ value = Tcl_GetStringFromObj(valuePtr, NULL);
+ keysym = TkStringToKeysym(value);
+ if (keysym == NoSymbol) {
+ Tcl_AppendResult(interp, "unknown keysym \"", value, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ TkpSetKeycodeAndState(tkwin, keysym, &event);
+ if (event.xkey.keycode == 0) {
+ Tcl_AppendResult(interp, "no keycode for keysym \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_MODE: {
+ number = TkFindStateNumObj(interp, optionPtr, notifyMode,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.mode = number;
+ } else if (flags & FOCUS) {
+ event.xfocus.mode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_OVERRIDE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CREATE) {
+ event.xcreatewindow.override_redirect = number;
+ } else if (flags & MAP) {
+ event.xmap.override_redirect = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.override_redirect = number;
+ } else if (flags & CONFIG) {
+ event.xconfigure.override_redirect = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_PLACE: {
+ number = TkFindStateNumObj(interp, optionPtr, circPlace,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CIRC) {
+ event.xcirculate.place = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_ROOT: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.root = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_ROOTX: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_ROOTY: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_SEND: {
+ CONST char *value;
+
+ value = Tcl_GetStringFromObj(valuePtr, NULL);
+ if (isdigit(UCHAR(value[0]))) {
+ /*
+ * Allow arbitrary integer values for the field; they
+ * are needed by a few of the tests in the Tk test suite.
+ */
+
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ event.xany.send_event = number;
+ break;
+ }
+ case EVENT_SERIAL: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ event.xany.serial = number;
+ break;
+ }
+ case EVENT_STATE: {
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ event.xkey.state = number;
+ } else {
+ event.xcrossing.state = number;
+ }
+ } else if (flags & VISIBILITY) {
+ number = TkFindStateNumObj(interp, optionPtr, visNotify,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ event.xvisibility.state = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_SUBWINDOW: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.subwindow = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_TIME: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.time = (Time) number;
+ } else if (flags & PROP) {
+ event.xproperty.time = (Time) number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_WIDTH: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.width = number;
+ } else if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.width = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_WINDOW: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
+ |GRAVITY|CIRC)) {
+ event.xcreatewindow.window = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_X: {
+ int rootX, rootY;
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootX += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x = number;
+ event.xkey.x_root = rootX;
+ } else if (flags & EXPOSE) {
+ event.xexpose.x = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.x = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.x = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_Y: {
+ int rootX, rootY;
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootY += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y = number;
+ event.xkey.y_root = rootY;
+ } else if (flags & EXPOSE) {
+ event.xexpose.y = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.y = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.y = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ }
+ continue;
+
+ badopt:
+ Tcl_AppendResult(interp, name, " event doesn't accept \"",
+ Tcl_GetStringFromObj(optionPtr, NULL), "\" option", NULL);
+ return TCL_ERROR;
+ }
+ if (synch != 0) {
+ Tk_HandleEvent(&event);
+ } else {
+ Tk_QueueWindowEvent(&event, pos);
+ }
+ /*
+ * We only allow warping if the window is mapped
+ */
+ if ((warp != 0) && Tk_IsMapped(tkwin)) {
+ TkDisplay *dispPtr;
+ dispPtr = TkGetDisplay(event.xmotion.display);
+ if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
+ Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr);
+ dispPtr->flags |= TK_DISPLAY_IN_WARP;
+ }
+ dispPtr->warpWindow = event.xany.window;
+ dispPtr->warpX = event.xkey.x;
+ dispPtr->warpY = event.xkey.y;
+ }
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+
+}
+static int
+NameToWindow(interp, mainWin, objPtr, tkwinPtr)
+ Tcl_Interp *interp; /* Interp for error return and name lookup. */
+ Tk_Window mainWin; /* Main window of application. */
+ Tcl_Obj *objPtr; /* Contains name or id string of window. */
+ Tk_Window *tkwinPtr; /* Filled with token for window. */
+{
+ char *name;
+ Tk_Window tkwin;
+ Window id;
+
+ name = Tcl_GetStringFromObj(objPtr, NULL);
+ if (name[0] == '.') {
+ tkwin = Tk_NameToWindow(interp, name, mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ *tkwinPtr = tkwin;
+ } else {
+ /*
+ * Check for the winPtr being valid, even if it looks ok to
+ * TkpScanWindowId. [Bug #411307]
+ */
+
+ if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) ||
+ ((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), id))
+ == NULL)) {
+ Tcl_AppendResult(interp, "bad window name/identifier \"",
+ name, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * DoWarp --
+ *
+ * Perform Warping of X pointer. Executed as an idle handler only.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * X Pointer will move to a new location.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+DoWarp(clientData)
+ ClientData clientData;
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+
+ XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow,
+ 0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY);
+ XForceScreenSaver(dispPtr->display, ScreenSaverReset);
+ dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetVirtualEventUid --
+ *
+ * Determine if the given string is in the proper format for a
+ * virtual event.
+ *
+ * Results:
+ * The return value is NULL if the virtual event string was
+ * not in the proper format. In this case, an error message
+ * will be left in the interp's result. Otherwise the return
+ * value is a Tk_Uid that represents the virtual event.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+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 the interp's result contains a message describing the problem.
+ * If no pattern sequence previously existed for eventString, then
+ * a new one is created with a NULL command field. In a successful
+ * return, *maskPtr is filled in with a mask of the event types
+ * on which the pattern sequence depends.
+ *
+ * Side effects:
+ * A new pattern sequence may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ CONST 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;
+ CONST 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) {
+ Tcl_SetResult(interp,
+ "virtual event not allowed in definition of another virtual event",
+ TCL_STATIC);
+ return NULL;
+ }
+ virtualFound = 1;
+ }
+
+ /*
+ * Replicate events for DOUBLE, TRIPLE, QUADRUPLE.
+ */
+
+ while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ flags |= PAT_NEARBY;
+ 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) {
+ Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
+ return NULL;
+ }
+ if ((numPats > 1) && (virtualFound != 0)) {
+ Tcl_SetResult(interp, "virtual events may not be composed",
+ TCL_STATIC);
+ return NULL;
+ }
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
+ memset(&key, 0, sizeof(key));
+ key.object = object;
+ key.type = patPtr->eventType;
+ 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);
+ }
+ /*
+ * No binding exists for the sequence, so return an empty error.
+ * This is a special error that the caller will check for in order
+ * to silently ignore this case. This is a hack that maintains
+ * backward compatibility for Tk_GetBinding but the various "bind"
+ * commands silently ignore missing bindings.
+ */
+
+ return NULL;
+ }
+ psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
+ + (numPats-1)*sizeof(Pattern)));
+ psPtr->numPats = numPats;
+ psPtr->eventProc = NULL;
+ psPtr->freeProc = NULL;
+ 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. */
+ CONST 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;
+ Tcl_DString copy;
+
+ Tcl_DStringInit(&copy);
+ p = Tcl_DStringAppend(&copy, *eventStringPtr, -1);
+
+ 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 {
+ char buf[64];
+
+ sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ count = 0;
+ goto done;
+ }
+ }
+ 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) {
+ Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ if ((p == NULL) || (p[1] != '>')) {
+ Tcl_SetResult(interp, "missing \">\" in virtual binding",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ *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 & (MULT_CLICKS)) {
+ int i = modPtr->flags & MULT_CLICKS;
+ count = 2;
+ while (i >>= 1) count++;
+ }
+ 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);
+ count = 0;
+ goto done;
+ }
+ 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);
+ count = 0;
+ goto done;
+ }
+ 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);
+ count = 0;
+ goto done;
+ }
+ }
+ } else if (eventFlags == 0) {
+ Tcl_SetResult(interp, "no event type or button # or keysym",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p != '>') {
+ while (*p != '\0') {
+ p++;
+ if (*p == '>') {
+ Tcl_SetResult(interp,
+ "extra characters after detail in binding",
+ TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ }
+ Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
+ count = 0;
+ goto done;
+ }
+ p++;
+
+end:
+ *eventStringPtr += (p - Tcl_DStringValue(&copy));
+ *eventMaskPtr |= eventMask;
+done:
+ Tcl_DStringFree(&copy);
+ 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[TCL_INTEGER_SPACE];
+ int patsLeft, needMods;
+ ModInfo *modPtr;
+ EventInfo *eiPtr;
+
+ /*
+ * The order of the patterns in the sequence is backwards from the order
+ * in which they must be output.
+ */
+
+ 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", "Triple", "Quadruple", 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--;
+ if ((patsLeft > 1) && (memcmp((char *) patPtr,
+ (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ Tcl_DStringAppend(dsPtr, "Quadruple-", 10);
+ } else {
+ 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);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 the interp's 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/tcl/generic/tkBitmap.c b/tcl/generic/tkBitmap.c
new file mode 100644
index 00000000000..4d2b6749c80
--- /dev/null
+++ b/tcl/generic/tkBitmap.c
@@ -0,0 +1,1190 @@
+/*
+ * tkBitmap.c --
+ *
+ * This file maintains a database of read-only bitmaps for the Tk
+ * toolkit. This allows bitmaps to be shared between widgets and
+ * also avoids interactions with the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 TkBitmap {
+ Pixmap bitmap; /* X identifier for bitmap. None means this
+ * bitmap was created by Tk_DefineBitmap
+ * and it isn't currently in use. */
+ int width, height; /* Dimensions of bitmap. */
+ Display *display; /* Display for which bitmap is valid. */
+ int screenNum; /* Screen on which bitmap is valid */
+ int resourceRefCount; /* Number of active uses of this bitmap (each
+ * active use corresponds to a call to
+ * Tk_AllocBitmapFromObj or Tk_GetBitmap).
+ * If this count is 0, then this TkBitmap
+ * structure is no longer valid and it isn't
+ * present in nameTable: it is being kept
+ * around only because there are objects
+ * referring to it. The structure is freed
+ * when resourceRefCount and objRefCount
+ * are both 0. */
+ int objRefCount; /* Number of Tcl_Obj's that reference
+ * this structure. */
+ Tcl_HashEntry *nameHashPtr; /* Entry in nameTable for this structure
+ * (needed when deleting). */
+ Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure
+ * (needed when deleting). */
+ struct TkBitmap *nextPtr; /* Points to the next TkBitmap structure with
+ * the same name. All bitmaps with the
+ * same name (but different displays or
+ * screens) are chained together off a
+ * single entry in nameTable. */
+} TkBitmap;
+
+/*
+ * Used in bitmapDataTable, stored in the TkDisplay structure, to map
+ * between in-core data about a bitmap to its TkBitmap structure.
+ */
+
+typedef struct {
+ CONST char *source; /* Bitmap bits. */
+ int width, height; /* Dimensions of bitmap. */
+} DataKey;
+
+typedef struct ThreadSpecificData {
+ int initialized; /* 0 means table below needs initializing. */
+ Tcl_HashTable predefBitmapTable;
+ /* Hash table created by Tk_DefineBitmap
+ * to map from a name to a collection
+ * of in-core data about a bitmap. The
+ * table is indexed by the address of the
+ * data for the bitmap, and the entries
+ * contain pointers to TkPredefBitmap
+ * structures. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void BitmapInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupBitmapObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeBitmap _ANSI_ARGS_((TkBitmap *bitmapPtr));
+static void FreeBitmapObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static TkBitmap * GetBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *name));
+static TkBitmap * GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj *objPtr));
+static void InitBitmapObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "bitmap" Tcl
+ * object, which maps a string bitmap name to a TkBitmap object. The
+ * ptr1 field of the Tcl_Obj points to a TkBitmap object.
+ */
+
+Tcl_ObjType tkBitmapObjType = {
+ "bitmap", /* name */
+ FreeBitmapObjProc, /* freeIntRepProc */
+ DupBitmapObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocBitmapFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * Pixmap structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (i.e. a Pixmap with a single plane), unless string couldn't be
+ * parsed correctly. In this case, None is returned and an error
+ * message is left in the interp's result. The caller should never
+ * modify the bitmap that is returned, and should eventually call
+ * Tk_FreeBitmapFromObj when the bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmapFromObj, so that the database can be cleaned up
+ * when bitmaps aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_AllocBitmapFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for error results. This may
+ * be NULL. */
+ Tk_Window tkwin; /* Need the screen the bitmap is used on.*/
+ Tcl_Obj *objPtr; /* Object describing bitmap; see manual
+ * entry for legal syntax of string value. */
+{
+ TkBitmap *bitmapPtr;
+
+ if (objPtr->typePtr != &tkBitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+ bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkBitmap, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (bitmapPtr != NULL) {
+ if (bitmapPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkBitmap that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeBitmapObjProc(objPtr);
+ bitmapPtr = NULL;
+ } else if ( (Tk_Display(tkwin) == bitmapPtr->display)
+ && (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum) ) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr->bitmap;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkBitmap that we wanted. Search
+ * the list of TkBitmaps with the same name to see if one of the
+ * others is the right one.
+ */
+
+ if (bitmapPtr != NULL) {
+ TkBitmap *firstBitmapPtr =
+ (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr);
+ FreeBitmapObjProc(objPtr);
+ for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if ( (Tk_Display(tkwin) == bitmapPtr->display) &&
+ (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum) ) {
+ bitmapPtr->resourceRefCount++;
+ bitmapPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ return bitmapPtr->bitmap;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call GetBitmap to allocate a new TkBitmap object.
+ */
+
+ bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ if (bitmapPtr == NULL) {
+ return None;
+ }
+ bitmapPtr->objRefCount++;
+ return bitmapPtr->bitmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmap --
+ *
+ * Given a string describing a bitmap, locate (or create if necessary)
+ * a bitmap that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (i.e. a Pixmap with a single plane), unless string couldn't be
+ * parsed correctly. In this case, None is returned and an error
+ * message is left in the interp's result. The caller should never
+ * modify the bitmap that is returned, and should eventually call
+ * Tk_FreeBitmap when the bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting,
+ * this may be NULL. */
+ Tk_Window tkwin; /* Window in which bitmap will be used. */
+ CONST char *string; /* Description of bitmap. See manual entry
+ * for details on legal syntax. */
+{
+ TkBitmap *bitmapPtr = GetBitmap(interp, tkwin, string);
+ if (bitmapPtr == NULL) {
+ return None;
+ }
+ return bitmapPtr->bitmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBitmap --
+ *
+ * Given a string describing a bitmap, locate (or create if necessary)
+ * a bitmap that fits the description. This routine returns the
+ * internal data structure for the bitmap. This avoids extra
+ * hash table lookups in Tk_AllocBitmapFromObj.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (i.e. a Pixmap with a single plane), unless string couldn't be
+ * parsed correctly. In this case, None is returned and an error
+ * message is left in the interp's result. The caller should never
+ * modify the bitmap that is returned, and should eventually call
+ * Tk_FreeBitmap when the bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap or Tk_FreeBitmapFromObj, so that the database can
+ * be cleaned up when bitmaps aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkBitmap *
+GetBitmap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting,
+ * this may be NULL. */
+ Tk_Window tkwin; /* Window in which bitmap will be used. */
+ CONST char *string; /* Description of bitmap. See manual entry
+ * for details on legal syntax. */
+{
+ Tcl_HashEntry *nameHashPtr, *predefHashPtr;
+ TkBitmap *bitmapPtr, *existingBitmapPtr;
+ TkPredefBitmap *predefPtr;
+ int new;
+ Pixmap bitmap;
+ int width, height;
+ int dummy2;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!dispPtr->bitmapInit) {
+ BitmapInit(dispPtr);
+ }
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &new);
+ if (!new) {
+ existingBitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr);
+ for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if ( (Tk_Display(tkwin) == bitmapPtr->display) &&
+ (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum) ) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr;
+ }
+ }
+ } else {
+ existingBitmapPtr = NULL;
+ }
+
+ /*
+ * No suitable bitmap exists. Create a new bitmap from the
+ * information contained in the string. If the string starts
+ * with "@" then the rest of the string is a file name containing
+ * the bitmap. Otherwise the string must refer to a bitmap
+ * defined by a call to Tk_DefineBitmap.
+ */
+
+ if (*string == '@') { /* INTL: ISO char */
+ Tcl_DString buffer;
+ int result;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't specify bitmap with '@' in a",
+ " safe interpreter", (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * Note that we need to cast away the CONST from the string because
+ * Tcl_TranslateFileName is non const, even though it doesn't modify
+ * the string.
+ */
+
+ string = Tcl_TranslateFileName(interp, (char *) string + 1, &buffer);
+ if (string == NULL) {
+ goto error;
+ }
+ result = TkReadBitmapFile(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), string,
+ (unsigned int *) &width, (unsigned int *) &height,
+ &bitmap, &dummy2, &dummy2);
+ if (result != BitmapSuccess) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "error reading bitmap file \"", string,
+ "\"", (char *) NULL);
+ }
+ Tcl_DStringFree(&buffer);
+ goto error;
+ }
+ Tcl_DStringFree(&buffer);
+ } else {
+ predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable,
+ string);
+ if (predefHashPtr == NULL) {
+ /*
+ * The following platform specific call allows the user to
+ * define bitmaps that may only exist during run time. If
+ * it returns None nothing was found and we return the error.
+ */
+ bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string,
+ &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(Tk_Screen(tkwin)),
+ predefPtr->source,
+ (unsigned) width, (unsigned) height);
+ }
+ }
+ }
+
+ /*
+ * Add information about this bitmap to our database.
+ */
+
+ bitmapPtr = (TkBitmap *) ckalloc(sizeof(TkBitmap));
+ bitmapPtr->bitmap = bitmap;
+ bitmapPtr->width = width;
+ bitmapPtr->height = height;
+ bitmapPtr->display = Tk_Display(tkwin);
+ bitmapPtr->screenNum = Tk_ScreenNumber(tkwin);
+ bitmapPtr->resourceRefCount = 1;
+ bitmapPtr->objRefCount = 0;
+ bitmapPtr->nameHashPtr = nameHashPtr;
+ bitmapPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapIdTable,
+ (char *) bitmap, &new);
+ if (!new) {
+ panic("bitmap already registered in Tk_GetBitmap");
+ }
+ bitmapPtr->nextPtr = existingBitmapPtr;
+ Tcl_SetHashValue(nameHashPtr, bitmapPtr);
+ Tcl_SetHashValue(bitmapPtr->idHashPtr, bitmapPtr);
+ return bitmapPtr;
+
+ error:
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DefineBitmap --
+ *
+ * This procedure associates a textual name with a binary bitmap
+ * description, so that the name may be used to refer to the
+ * bitmap in future calls to Tk_GetBitmap.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs then TCL_ERROR is
+ * returned and a message is left in the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_DefineBitmap(interp, name, source, width, height)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ CONST char *name; /* Name to use for bitmap. Must not already
+ * be defined as a bitmap. */
+ CONST char *source; /* Address of bits for bitmap. */
+ int width; /* Width of bitmap. */
+ int height; /* Height of bitmap. */
+{
+ int new;
+ Tcl_HashEntry *predefHashPtr;
+ TkPredefBitmap *predefPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Initialize the Bitmap module if not initialized already for this
+ * thread. Since the current TkDisplay structure cannot be
+ * introspected from here, pass a NULL pointer to BitmapInit,
+ * which will know to initialize only the data in the
+ * ThreadSpecificData structure for the current thread.
+ */
+
+ if (!tsdPtr->initialized) {
+ BitmapInit((TkDisplay *) NULL);
+ }
+
+ predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable,
+ name, &new);
+ if (!new) {
+ Tcl_AppendResult(interp, "bitmap \"", name,
+ "\" is already defined", (char *) NULL);
+ return TCL_ERROR;
+ }
+ predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
+ predefPtr->source = source;
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfBitmap(display, bitmap)
+ Display *display; /* Display for which bitmap was
+ * allocated. */
+ Pixmap bitmap; /* Bitmap whose name is wanted. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (dispPtr == NULL || !dispPtr->bitmapInit) {
+ unknown:
+ panic("Tk_NameOfBitmap received unknown bitmap argument");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ goto unknown;
+ }
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
+ return bitmapPtr->nameHashPtr->key.string;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SizeOfBitmap --
+ *
+ * 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. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->bitmapInit) {
+ unknownBitmap:
+ panic("Tk_SizeOfBitmap received unknown bitmap argument");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ goto unknownBitmap;
+ }
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
+ *widthPtr = bitmapPtr->width;
+ *heightPtr = bitmapPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeBitmap --
+ *
+ * This procedure does all the work of releasing a bitmap allocated by
+ * Tk_GetBitmap or TkGetBitmapFromData. It is invoked by both
+ * Tk_FreeBitmap and Tk_FreeBitmapFromObj
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with bitmap is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeBitmap(bitmapPtr)
+ TkBitmap *bitmapPtr; /* Bitmap to be released. */
+{
+ TkBitmap *prevPtr;
+
+ bitmapPtr->resourceRefCount--;
+ if (bitmapPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap);
+ Tcl_DeleteHashEntry(bitmapPtr->idHashPtr);
+ prevPtr = (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr);
+ if (prevPtr == bitmapPtr) {
+ if (bitmapPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(bitmapPtr->nameHashPtr);
+ } else {
+ Tcl_SetHashValue(bitmapPtr->nameHashPtr, bitmapPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != bitmapPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = bitmapPtr->nextPtr;
+ }
+ if (bitmapPtr->objRefCount == 0) {
+ ckfree((char *) bitmapPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeBitmap --
+ *
+ * This procedure is called to release a bitmap allocated by
+ * 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;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->bitmapInit) {
+ panic("Tk_FreeBitmap called before Tk_GetBitmap");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeBitmap received unknown bitmap argument");
+ }
+ FreeBitmap((TkBitmap *) Tcl_GetHashValue(idHashPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeBitmapFromObj --
+ *
+ * This procedure is called to release a bitmap allocated by
+ * Tk_AllocBitmapFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this bitmap
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the bitmap represented by
+ * objPtr is decremented, and the bitmap is released to X if there are
+ * no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this bitmap lives in. Needed
+ * for the display value. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ FreeBitmap(GetBitmapFromObj(tkwin, objPtr));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeBitmapObjProc --
+ *
+ * This proc is called to release an object reference to a bitmap.
+ * Called when the object's internal rep is released or when
+ * the cached bitmapPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the color's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeBitmapObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkBitmap *bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (bitmapPtr != NULL) {
+ bitmapPtr->objRefCount--;
+ if ((bitmapPtr->objRefCount == 0)
+ && (bitmapPtr->resourceRefCount == 0)) {
+ ckfree((char *) bitmapPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupBitmapObjProc --
+ *
+ * When a cached bitmap object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The color's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupBitmapObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkBitmap *bitmapPtr = (TkBitmap *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+
+ if (bitmapPtr != NULL) {
+ bitmapPtr->objRefCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmapFromData --
+ *
+ * Given a description of the bits for a bitmap, make a bitmap that
+ * has the given properties. *** NOTE: this procedure is obsolete
+ * and really shouldn't be used anymore. ***
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (a one-plane Pixmap), unless it couldn't be created properly.
+ * In this case, None is returned and an error message is left in
+ * the interp's result. The caller should never modify the bitmap that
+ * is returned, and should eventually call Tk_FreeBitmap when the
+ * bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * 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. */
+ CONST char *source; /* Bitmap data for bitmap shape. */
+ int width, height; /* Dimensions of bitmap. */
+{
+ DataKey nameKey;
+ Tcl_HashEntry *dataHashPtr;
+ int new;
+ char string[16 + TCL_INTEGER_SPACE];
+ char *name;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ BitmapInit(dispPtr);
+
+ nameKey.source = source;
+ nameKey.width = width;
+ nameKey.height = height;
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable,
+ (char *) &nameKey, &new);
+ if (!new) {
+ name = (char *) Tcl_GetHashValue(dataHashPtr);
+ } else {
+ dispPtr->bitmapAutoNumber++;
+ sprintf(string, "_tk%d", dispPtr->bitmapAutoNumber);
+ name = string;
+ Tcl_SetHashValue(dataHashPtr, name);
+ if (Tk_DefineBitmap(interp, name, source, width, height) != TCL_OK) {
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return TCL_ERROR;
+ }
+ }
+ return Tk_GetBitmap(interp, tkwin, name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmapFromObj --
+ *
+ * Returns the bitmap referred to by a Tcl object. The bitmap must
+ * already have been allocated via a call to Tk_AllocBitmapFromObj
+ * or Tk_GetBitmap.
+ *
+ * Results:
+ * Returns the Pixmap that matches the tkwin and the string rep
+ * of objPtr.
+ *
+ * Side effects:
+ * If the object is not already a bitmap, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+{
+ TkBitmap *bitmapPtr = GetBitmapFromObj(tkwin, objPtr);
+ return bitmapPtr->bitmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBitmapFromObj --
+ *
+ * Returns the bitmap referred to by a Tcl object. The bitmap must
+ * already have been allocated via a call to Tk_AllocBitmapFromObj
+ * or Tk_GetBitmap.
+ *
+ * Results:
+ * Returns the TkBitmap * that matches the tkwin and the string rep
+ * of objPtr.
+ *
+ * Side effects:
+ * If the object is not already a bitmap, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkBitmap *
+GetBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* Window in which the bitmap will be used. */
+ Tcl_Obj *objPtr; /* The object that describes the desired
+ * bitmap. */
+{
+ TkBitmap *bitmapPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkBitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+
+ bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
+ if (bitmapPtr != NULL) {
+ if ((bitmapPtr->resourceRefCount > 0)
+ && (Tk_Display(tkwin) == bitmapPtr->display)) {
+ return bitmapPtr;
+ }
+ hashPtr = bitmapPtr->nameHashPtr;
+ FreeBitmapObjProc(objPtr);
+ } else {
+ hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ }
+
+ /*
+ * At this point we've got a hash table entry, off of which hang
+ * one or more TkBitmap structures. See if any of them will work.
+ */
+
+ for (bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr);
+ bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) {
+ if (Tk_Display(tkwin) == bitmapPtr->display) {
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ bitmapPtr->objRefCount++;
+ return bitmapPtr;
+ }
+ }
+
+ error:
+ panic("GetBitmapFromObj called with non-existent bitmap!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitBitmapObj --
+ *
+ * Bookeeping procedure to change an objPtr to a bitmap type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old internal rep of the object is freed. The internal
+ * rep is cleared. The final form of the object is set
+ * by either Tk_AllocBitmapFromObj or GetBitmapFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitBitmapObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkBitmapObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BitmapInit --
+ * Initializes hash tables used by this module. Initializes
+ * tables stored in TkDisplay structure if a TkDisplay pointer
+ * is passed in. Iinitializes the thread-local data
+ * in the current thread's ThreadSpecificData structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BitmapInit(dispPtr)
+ TkDisplay *dispPtr; /* TkDisplay structure encapsulating
+ * thread-specific data used by this
+ * module, or NULL if unavailable. */
+{
+ Tcl_Interp *dummy;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * First initialize the data in the ThreadSpecificData strucuture,
+ * if needed.
+ */
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ dummy = Tcl_CreateInterp();
+ Tcl_InitHashTable(&tsdPtr->predefBitmapTable, TCL_STRING_KEYS);
+
+ Tk_DefineBitmap(dummy, "error", (char *) error_bits,
+ error_width, error_height);
+ Tk_DefineBitmap(dummy, "gray75", (char *) gray75_bits,
+ gray75_width, gray75_height);
+ Tk_DefineBitmap(dummy, "gray50", (char *) gray50_bits,
+ gray50_width, gray50_height);
+ Tk_DefineBitmap(dummy, "gray25", (char *) gray25_bits,
+ gray25_width, gray25_height);
+ Tk_DefineBitmap(dummy, "gray12", (char *) gray12_bits,
+ gray12_width, gray12_height);
+ Tk_DefineBitmap(dummy, "hourglass", (char *) hourglass_bits,
+ hourglass_width, hourglass_height);
+ Tk_DefineBitmap(dummy, "info", (char *) info_bits,
+ info_width, info_height);
+ Tk_DefineBitmap(dummy, "questhead", (char *) questhead_bits,
+ questhead_width, questhead_height);
+ Tk_DefineBitmap(dummy, "question", (char *) question_bits,
+ question_width, question_height);
+ Tk_DefineBitmap(dummy, "warning", (char *) warning_bits,
+ warning_width, warning_height);
+
+ TkpDefineNativeBitmaps();
+ Tcl_DeleteInterp(dummy);
+ }
+
+ /*
+ * Was a valid TkDisplay pointer passed? If so, initialize the
+ * Bitmap module tables in that structure.
+ */
+
+ if (dispPtr != NULL) {
+ dispPtr->bitmapInit = 1;
+ Tcl_InitHashTable(&dispPtr->bitmapNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->bitmapDataTable, sizeof(DataKey)
+ /sizeof(int));
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it
+ * gets padded with extra unpredictable bytes on some 64-bit
+ * machines.
+ */
+
+ /*
+ * The comment above doesn't make sense...
+ */
+ Tcl_InitHashTable(&dispPtr->bitmapIdTable, TCL_ONE_WORD_KEYS);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkReadBitmapFile --
+ *
+ * Loads a bitmap image in X bitmap format into the specified
+ * drawable. This is equivelent to the XReadBitmapFile in X.
+ *
+ * Results:
+ * Sets the size, hotspot, and bitmap on success.
+ *
+ * Side effects:
+ * Creates a new bitmap from the file data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkReadBitmapFile(display, d, filename, width_return, height_return,
+ bitmap_return, x_hot_return, y_hot_return)
+ Display* display;
+ Drawable d;
+ CONST char* filename;
+ unsigned int* width_return;
+ unsigned int* height_return;
+ Pixmap* bitmap_return;
+ int* x_hot_return;
+ int* y_hot_return;
+{
+ char *data;
+
+ data = TkGetBitmapData(NULL, NULL, (char *) filename,
+ (int *) width_return, (int *) height_return, x_hot_return,
+ y_hot_return);
+ if (data == NULL) {
+ return BitmapFileInvalid;
+ }
+
+ *bitmap_return = XCreateBitmapFromData(display, d, data, *width_return,
+ *height_return);
+
+ ckfree(data);
+ return BitmapSuccess;
+ }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugBitmap --
+ *
+ * This procedure returns debugging information about a bitmap.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkBitmap
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkBitmap structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugBitmap(tkwin, name)
+ Tk_Window tkwin; /* The window in which the bitmap will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkBitmap *bitmapPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, name);
+ if (hashPtr != NULL) {
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr);
+ if (bitmapPtr == NULL) {
+ panic("TkDebugBitmap found empty hash table entry");
+ }
+ for ( ; (bitmapPtr != NULL); bitmapPtr = bitmapPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(bitmapPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(bitmapPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetBitmapPredefTable --
+ * This procedure is used by tkMacBitmap.c to access the thread-
+ * specific predefBitmap table that maps from the names of
+ * the predefined bitmaps to data associated with those
+ * bitmaps. It is required because the table is allocated in
+ * thread-local storage and is not visible outside this file.
+
+ * Results:
+ * Returns a pointer to the predefined bitmap hash table for
+ * the current thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_HashTable *
+TkGetBitmapPredefTable()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return &tsdPtr->predefBitmapTable;
+}
diff --git a/tcl/generic/tkButton.c b/tcl/generic/tkButton.c
new file mode 100644
index 00000000000..2d74fffee9f
--- /dev/null
+++ b/tcl/generic/tkButton.c
@@ -0,0 +1,1761 @@
+/*
+ * tkButton.c --
+ *
+ * This module implements a collection of button-like
+ * widgets for the Tk toolkit. The widgets implemented
+ * include labels, buttons, checkbuttons, and radiobuttons.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkButton.h"
+#include "default.h"
+
+typedef struct ThreadSpecificData {
+ int defaultsInitialized;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Class names for buttons, indexed by one of the type values defined
+ * in tkButton.h.
+ */
+
+static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"};
+
+/*
+ * The following table defines the legal values for the -default option.
+ * It is used together with the "enum defaultValue" declaration in tkButton.h.
+ */
+
+static char *defaultStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -state option.
+ * It is used together with the "enum state" declaration in tkButton.h.
+ */
+
+static char *stateStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -compound option.
+ * It is used with the "enum compound" declaration in tkButton.h
+ */
+
+static char *compoundStrings[] = {
+ "bottom", "center", "left", "none", "right", "top", (char *) NULL
+};
+
+/*
+ * Information used for parsing configuration options. There is a
+ * separate table for each of the four widget classes.
+ */
+
+static Tk_OptionSpec labelOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_BUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_LABEL_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, 0}
+};
+
+static Tk_OptionSpec buttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_BUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-default", "default", "Default",
+ DEF_BUTTON_DEFAULT, -1, Tk_Offset(TkButton, defaultState),
+ 0, (ClientData) defaultStrings, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_BUTTON_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_BUTTON_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, relief),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_BUTTON_REPEAT_DELAY, -1, Tk_Offset(TkButton, repeatDelay),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_BUTTON_REPEAT_INTERVAL, -1, Tk_Offset(TkButton, repeatInterval),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+static Tk_OptionSpec checkbuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn), 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-offrelief", "offRelief", "OffRelief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, offRelief), 0, 0, 0},
+ {TK_OPTION_STRING, "-offvalue", "offValue", "Value",
+ DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-onvalue", "onValue", "Value",
+ DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},
+ {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
+ DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+static Tk_OptionSpec radiobuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn),
+ 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-offrelief", "offRelief", "OffRelief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, offRelief), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},
+ {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
+ DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-value", "value", "Value",
+ DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following table maps from one of the type values defined in
+ * tkButton.h, such as TYPE_LABEL, to the option template for that
+ * class of widgets.
+ */
+
+static Tk_OptionSpec *optionSpecs[] = {
+ labelOptionSpecs,
+ buttonOptionSpecs,
+ checkbuttonOptionSpecs,
+ radiobuttonOptionSpecs
+};
+
+/*
+ * The following tables define the widget commands supported by
+ * each of the classes, and map the indexes into the string tables
+ * into a single enumerated type used to dispatch the widget command.
+ */
+
+static CONST char *commandNames[][8] = {
+ {"cget", "configure", (char *) NULL},
+ {"cget", "configure", "flash", "invoke", (char *) NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select",
+ "toggle", (char *) NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select",
+ (char *) NULL}
+};
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE
+};
+static enum command map[][8] = {
+ {COMMAND_CGET, COMMAND_CONFIGURE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_FLASH, COMMAND_INVOKE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ButtonCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ButtonCreate _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], int type));
+static void ButtonEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void ButtonImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight));
+static void ButtonSelectImageProc _ANSI_ARGS_((
+ ClientData clientData, int x, int y, int width,
+ int height, int imgWidth, int imgHeight));
+static char * ButtonTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static char * ButtonVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static int ButtonWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ConfigureButton _ANSI_ARGS_((Tcl_Interp *interp,
+ TkButton *butPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static void DestroyButton _ANSI_ARGS_((TkButton *butPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ButtonCmd, Tk_CheckbuttonCmd, Tk_LabelCmd, Tk_RadiobuttonCmd --
+ *
+ * These procedures are invoked to process the "button", "label",
+ * "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_ButtonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_BUTTON);
+}
+
+int
+Tk_CheckbuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_CHECK_BUTTON);
+}
+
+int
+Tk_LabelObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_LABEL);
+}
+
+int
+Tk_RadiobuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_RADIO_BUTTON);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonCreate --
+ *
+ * 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, objc, objv, type)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+ int type; /* Type of button to create: TYPE_LABEL,
+ * TYPE_BUTTON, TYPE_CHECK_BUTTON, or
+ * TYPE_RADIO_BUTTON. */
+{
+ TkButton *butPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->defaultsInitialized) {
+ TkpButtonSetDefaults(optionSpecs[type]);
+ tsdPtr->defaultsInitialized = 1;
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the new window.
+ */
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
+
+ Tk_SetClass(tkwin, classNames[type]);
+ butPtr = TkpCreateButton(tkwin);
+
+ Tk_SetClassProcs(tkwin, &tkpButtonProcs, (ClientData) butPtr);
+
+ /*
+ * Initialize the data structure for the button.
+ */
+
+ butPtr->tkwin = tkwin;
+ butPtr->display = Tk_Display(tkwin);
+ butPtr->interp = interp;
+ butPtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
+ ButtonWidgetObjCmd, (ClientData) butPtr, ButtonCmdDeletedProc);
+ butPtr->type = type;
+ butPtr->optionTable = optionTable;
+ butPtr->textPtr = NULL;
+ butPtr->underline = -1;
+ butPtr->textVarNamePtr = NULL;
+ butPtr->bitmap = None;
+ butPtr->imagePtr = NULL;
+ butPtr->image = NULL;
+ butPtr->selectImagePtr = NULL;
+ butPtr->selectImage = NULL;
+ butPtr->state = STATE_NORMAL;
+ butPtr->normalBorder = NULL;
+ butPtr->activeBorder = NULL;
+ butPtr->borderWidthPtr = NULL;
+ butPtr->borderWidth = 0;
+ butPtr->relief = TK_RELIEF_FLAT;
+ butPtr->highlightWidthPtr = NULL;
+ butPtr->highlightWidth = 0;
+ butPtr->highlightBorder = NULL;
+ butPtr->highlightColorPtr = NULL;
+ butPtr->inset = 0;
+ butPtr->tkfont = NULL;
+ butPtr->normalFg = NULL;
+ butPtr->activeFg = NULL;
+ butPtr->disabledFg = NULL;
+ butPtr->normalTextGC = None;
+ butPtr->activeTextGC = None;
+ butPtr->disabledGC = None;
+ butPtr->gray = None;
+ butPtr->copyGC = None;
+ butPtr->widthPtr = NULL;
+ butPtr->width = 0;
+ butPtr->heightPtr = NULL;
+ butPtr->height = 0;
+ butPtr->wrapLengthPtr = NULL;
+ butPtr->wrapLength = 0;
+ butPtr->padXPtr = NULL;
+ butPtr->padX = 0;
+ butPtr->padYPtr = NULL;
+ butPtr->padY = 0;
+ butPtr->anchor = TK_ANCHOR_CENTER;
+ butPtr->justify = TK_JUSTIFY_CENTER;
+ butPtr->indicatorOn = 0;
+ butPtr->selectBorder = NULL;
+ butPtr->textWidth = 0;
+ butPtr->textHeight = 0;
+ butPtr->textLayout = NULL;
+ butPtr->indicatorSpace = 0;
+ butPtr->indicatorDiameter = 0;
+ butPtr->defaultState = DEFAULT_DISABLED;
+ butPtr->selVarNamePtr = NULL;
+ butPtr->onValuePtr = NULL;
+ butPtr->offValuePtr = NULL;
+ butPtr->cursor = None;
+ butPtr->takeFocusPtr = NULL;
+ butPtr->commandPtr = NULL;
+ butPtr->flags = 0;
+
+ Tk_CreateEventHandler(butPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ButtonEventProc, (ClientData) butPtr);
+
+ if (Tk_InitOptions(interp, (char *) butPtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ return TCL_ERROR;
+ }
+ if (ConfigureButton(interp, butPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(butPtr->tkwin),
+ -1);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonWidgetCmd --
+ *
+ * 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
+ButtonWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ int index;
+ int result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames[butPtr->type],
+ "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve((ClientData) butPtr);
+
+ switch (map[butPtr->type][index]) {
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) butPtr,
+ butPtr->optionTable, objv[2], butPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+
+ case COMMAND_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) butPtr,
+ butPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ butPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureButton(interp, butPtr, objc-2, objv+2);
+ }
+ break;
+ }
+
+ case COMMAND_DESELECT: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "deselect");
+ goto error;
+ }
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ } else if (butPtr->flags & SELECTED) {
+ if (Tcl_ObjSetVar2(interp,
+ butPtr->selVarNamePtr, NULL, Tcl_NewObj(),
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case COMMAND_FLASH: {
+ int i;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "flash");
+ goto error;
+ }
+ if (butPtr->state != STATE_DISABLED) {
+ for (i = 0; i < 4; i++) {
+ if (butPtr->state == STATE_NORMAL) {
+ butPtr->state = STATE_ACTIVE;
+ Tk_SetBackgroundFromBorder(butPtr->tkwin,
+ butPtr->activeBorder);
+ } else {
+ butPtr->state = STATE_NORMAL;
+ Tk_SetBackgroundFromBorder(butPtr->tkwin,
+ butPtr->normalBorder);
+ }
+ TkpDisplayButton((ClientData) butPtr);
+
+ /*
+ * Special note: must cancel any existing idle handler
+ * for TkpDisplayButton; it's no longer needed, and
+ * TkpDisplayButton cleared the REDRAW_PENDING flag.
+ */
+
+ Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
+ XFlush(butPtr->display);
+ Tcl_Sleep(50);
+ }
+ }
+ break;
+ }
+
+ case COMMAND_INVOKE: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+ goto error;
+ }
+ if (butPtr->state != STATE_DISABLED) {
+ result = TkInvokeButton(butPtr);
+ }
+ break;
+ }
+
+ case COMMAND_SELECT: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "select");
+ goto error;
+ }
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ break;
+ }
+
+ case COMMAND_TOGGLE: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "toggle");
+ goto error;
+ }
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ (butPtr->flags & SELECTED) ? butPtr->offValuePtr
+ : butPtr->onValuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ break;
+ }
+ }
+ Tcl_Release((ClientData) butPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) butPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyButton --
+ *
+ * This procedure is invoked by ButtonEventProc to free all the
+ * resources of a button and clean up its state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the widget is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyButton(butPtr)
+ TkButton *butPtr; /* Info about button widget. */
+{
+ butPtr->flags |= BUTTON_DELETED;
+ TkpDestroyButton(butPtr);
+
+ if (butPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd);
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->textVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ if (butPtr->gray != None) {
+ Tk_FreeBitmap(butPtr->display, butPtr->gray);
+ }
+ if (butPtr->copyGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->copyGC);
+ }
+ if (butPtr->textLayout != NULL) {
+ Tk_FreeTextLayout(butPtr->textLayout);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->selVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+ Tk_FreeConfigOptions((char *) butPtr, butPtr->optionTable,
+ butPtr->tkwin);
+ butPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) butPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureButton --
+ *
+ * This procedure is called to process an objc/objv list to set
+ * configuration options for a button widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then an error message is left in interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for butPtr; old resources get freed, if there
+ * were any. The button is redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureButton(interp, butPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkButton *butPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error, haveImage;
+ Tk_Image image;
+
+ /*
+ * Eliminate any existing trace on variables monitored by the button.
+ */
+
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_UntraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_UntraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+
+ /*
+ * The following loop is potentially executed twice. During the
+ * first pass configuration options get set to their new values.
+ * If there is an error in this pass, we execute a second pass
+ * to restore all the options to their previous values.
+ */
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) butPtr,
+ butPtr->optionTable, objc, objv,
+ butPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border, or filling in complicated
+ * defaults that couldn't be specified to Tk_SetOptions.
+ */
+
+ if ((butPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(butPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);
+ }
+ if (butPtr->borderWidth < 0) {
+ butPtr->borderWidth = 0;
+ }
+ if (butPtr->highlightWidth < 0) {
+ butPtr->highlightWidth = 0;
+ }
+ if (butPtr->padX < 0) {
+ butPtr->padX = 0;
+ }
+ if (butPtr->padY < 0) {
+ butPtr->padY = 0;
+ }
+
+ if (butPtr->type >= TYPE_CHECK_BUTTON) {
+ Tcl_Obj *valuePtr, *namePtr;
+
+ if (butPtr->selVarNamePtr == NULL) {
+ butPtr->selVarNamePtr = Tcl_NewStringObj(
+ Tk_Name(butPtr->tkwin), -1);
+ Tcl_IncrRefCount(butPtr->selVarNamePtr);
+ }
+ namePtr = butPtr->selVarNamePtr;
+
+ /*
+ * Select the button if the associated variable has the
+ * appropriate value, initialize the variable if it doesn't
+ * exist, then set a trace on the variable to monitor future
+ * changes to its value.
+ */
+
+ valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
+ butPtr->flags &= ~SELECTED;
+ if (valuePtr != NULL) {
+ if (strcmp(Tcl_GetString(valuePtr),
+ Tcl_GetString(butPtr->onValuePtr)) == 0) {
+ butPtr->flags |= SELECTED;
+ }
+ } else {
+ if (Tcl_ObjSetVar2(interp, namePtr, NULL,
+ (butPtr->type == TYPE_CHECK_BUTTON)
+ ? butPtr->offValuePtr : Tcl_NewObj(),
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+
+ /*
+ * If a radiobutton has the empty string as value
+ * it should be selected.
+ */
+
+ if ((butPtr->type == TYPE_RADIO_BUTTON) &&
+ (*Tcl_GetString(butPtr->onValuePtr) == 0)) {
+ butPtr->flags |= SELECTED;
+ }
+ }
+ }
+
+ /*
+ * Get the images for the widget, if there are any. Allocate the
+ * new images before freeing the old ones, so that the reference
+ * counts don't go to zero and cause image data to be discarded.
+ */
+
+ if (butPtr->imagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->imagePtr), ButtonImageProc,
+ (ClientData) butPtr);
+ if (image == NULL) {
+ continue;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ butPtr->image = image;
+ if (butPtr->selectImagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->selectImagePtr),
+ ButtonSelectImageProc, (ClientData) butPtr);
+ if (image == NULL) {
+ continue;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ butPtr->selectImage = image;
+
+ haveImage = 0;
+ if (butPtr->imagePtr != NULL || butPtr->bitmap != None) {
+ haveImage = 1;
+ }
+ if ((!haveImage || butPtr->compound != COMPOUND_NONE)
+ && (butPtr->textVarNamePtr != NULL)) {
+ /*
+ * The button must display the value of a variable: set up a trace
+ * on the variable's value, create the variable if it doesn't
+ * exist, and fetch its current value.
+ */
+
+ Tcl_Obj *valuePtr, *namePtr;
+
+ namePtr = butPtr->textVarNamePtr;
+ valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ if (Tcl_ObjSetVar2(interp, namePtr, NULL, butPtr->textPtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+ } else {
+ if (butPtr->textPtr != NULL) {
+ Tcl_DecrRefCount(butPtr->textPtr);
+ }
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
+ }
+ }
+
+ if ((butPtr->bitmap != None) || (butPtr->imagePtr != NULL)) {
+ /*
+ * The button must display the contents of an image or
+ * bitmap.
+ */
+
+ if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->widthPtr,
+ &butPtr->width) != TCL_OK) {
+ widthError:
+ Tcl_AddErrorInfo(interp, "\n (processing -width option)");
+ continue;
+ }
+ if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->heightPtr,
+ &butPtr->height) != TCL_OK) {
+ heightError:
+ Tcl_AddErrorInfo(interp, "\n (processing -height option)");
+ continue;
+ }
+ } else {
+ /*
+ * The button displays an ordinary text string.
+ */
+
+ if (Tcl_GetIntFromObj(interp, butPtr->widthPtr, &butPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetIntFromObj(interp, butPtr->heightPtr, &butPtr->height)
+ != TCL_OK) {
+ goto heightError;
+ }
+ }
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * Reestablish the variable traces, if they're needed.
+ */
+
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_TraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_TraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+
+ TkButtonWorldChanged((ClientData) butPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkButtonWorldChanged --
+ *
+ * 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_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ butPtr->normalTextGC = newGC;
+
+ if (butPtr->activeFg != NULL) {
+ gcValues.foreground = butPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ butPtr->activeTextGC = newGC;
+ }
+
+ /*
+ * Allocate the disabled graphics context, for drawing the widget in
+ * its disabled state
+ */
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+ if ((butPtr->disabledFg != NULL) && (butPtr->imagePtr == NULL)) {
+ gcValues.foreground = butPtr->disabledFg->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ } else {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (butPtr->compound != COMPOUND_NONE) {
+ mask |= GCFont;
+ }
+ if (butPtr->gray == None) {
+ butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, "gray50");
+ }
+ if (butPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = butPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ }
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ 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) {
+ 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;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted or because the command
+ * was deleted, and then this procedure destroys the widget. The
+ * BUTTON_DELETED flag distinguishes these cases.
+ */
+
+ if (!(butPtr->flags & BUTTON_DELETED)) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInvokeButton --
+ *
+ * This procedure is called to carry out the actions associated
+ * with a button, such as invoking a Tcl command or setting a
+ * variable. This procedure is invoked, for example, when the
+ * button is invoked via the mouse.
+ *
+ * Results:
+ * A standard Tcl return value. Information is also left in
+ * the interp's result.
+ *
+ * Side effects:
+ * Depends on the button and its associated command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkInvokeButton(butPtr)
+ TkButton *butPtr; /* Information about button. */
+{
+ Tcl_Obj *namePtr = butPtr->selVarNamePtr;
+
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (butPtr->flags & SELECTED) {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
+ butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
+ butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ } else if (butPtr->type == TYPE_RADIO_BUTTON) {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL, butPtr->onValuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if ((butPtr->type != TYPE_LABEL) && (butPtr->commandPtr != NULL)) {
+ return Tcl_EvalObjEx(butPtr->interp, butPtr->commandPtr,
+ TCL_EVAL_GLOBAL);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+ char *name, *value;
+ Tcl_Obj *valuePtr;
+
+ name = Tcl_GetString(butPtr->selVarNamePtr);
+
+ /*
+ * If the variable is being unset, then just re-establish the
+ * trace unless the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ butPtr->flags &= ~SELECTED;
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_TraceVar(interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, clientData);
+ }
+ goto redisplay;
+ }
+
+ /*
+ * Use the value of the variable to update the selected status of
+ * the button.
+ */
+
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ value = "";
+ } else {
+ value = Tcl_GetString(valuePtr);
+ }
+ if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) {
+ if (butPtr->flags & SELECTED) {
+ return (char *) NULL;
+ }
+ butPtr->flags |= SELECTED;
+ } else if (butPtr->flags & SELECTED) {
+ butPtr->flags &= ~SELECTED;
+ } else {
+ 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. */
+ CONST char *name1; /* Not used. */
+ CONST char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ char *name;
+ Tcl_Obj *valuePtr;
+
+ if (butPtr->flags & BUTTON_DELETED) {
+ return (char *) NULL;
+ }
+
+ name = Tcl_GetString(butPtr->textVarNamePtr);
+
+ /*
+ * If the variable is unset, then immediately recreate it unless
+ * the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2Ex(interp, name, NULL, butPtr->textPtr,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_DecrRefCount(butPtr->textPtr);
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
+ TkpComputeButtonGeometry(butPtr);
+
+ if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size or contents
+ * of an image displayed in a button.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 or contents
+ * of the image displayed in a button when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May arrange for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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/tcl/generic/tkButton.h b/tcl/generic/tkButton.h
new file mode 100644
index 00000000000..e9a78c32f84
--- /dev/null
+++ b/tcl/generic/tkButton.h
@@ -0,0 +1,322 @@
+/*
+ * tkButton.h --
+ *
+ * Declarations of types and functions used to implement
+ * button-like widgets.
+ *
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKBUTTON
+#define _TKBUTTON
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Legal values for the "compound" field of TkButton records.
+ */
+
+enum compound {
+ COMPOUND_BOTTOM, COMPOUND_CENTER, COMPOUND_LEFT, COMPOUND_NONE,
+ COMPOUND_RIGHT, COMPOUND_TOP
+};
+
+/*
+ * Legal values for the "state" field of TkButton records.
+ */
+
+enum state {
+ STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
+};
+
+/*
+ * Legal values for the "defaultState" field of TkButton records.
+ */
+
+enum defaultState {
+ DEFAULT_ACTIVE, DEFAULT_DISABLED, DEFAULT_NORMAL
+};
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the button. NULL
+ * means that the window has been destroyed. */
+ Display *display; /* Display containing widget. Needed to
+ * free up resources after tkwin is gone. */
+ Tcl_Interp *interp; /* Interpreter associated with button. */
+ Tcl_Command widgetCmd; /* Token for button's widget command. */
+ int type; /* Type of widget, such as TYPE_LABEL:
+ * restricts operations that may be performed
+ * on widget. See below for legal values. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+
+ /*
+ * Information about what's in the button.
+ */
+
+ Tcl_Obj *textPtr; /* Value of -text option: specifies text to
+ * display in button. */
+ int underline; /* Value of -underline option: specifies
+ * index of character to underline. < 0 means
+ * don't underline anything. */
+ Tcl_Obj *textVarNamePtr; /* Value of -textvariable option: specifies
+ * name of variable or NULL. If non-NULL,
+ * button displays the contents of this
+ * variable. */
+ Pixmap bitmap; /* Value of -bitmap option. If not None,
+ * specifies bitmap to display and text and
+ * textVar are ignored. */
+ Tcl_Obj *imagePtr; /* Value of -image option: specifies image
+ * to display in window, or NULL if none.
+ * If non-NULL, bitmap, text, and textVarName
+ * are ignored.*/
+ Tk_Image image; /* Derived from imagePtr by calling
+ * Tk_GetImage, or NULL if imagePtr is NULL. */
+ Tcl_Obj *selectImagePtr; /* Value of -selectimage option: specifies
+ * image to display in window when selected,
+ * or NULL if none. Ignored if imagePtr is
+ * NULL. */
+ Tk_Image selectImage; /* Derived from selectImagePtr by calling
+ * Tk_GetImage, or NULL if selectImagePtr
+ * is NULL. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ enum state state; /* Value of -state option: specifies
+ * state of button for display purposes.*/
+ Tk_3DBorder normalBorder; /* Value of -background option: specifies
+ * color for background (and border) when
+ * window isn't active. */
+ Tk_3DBorder activeBorder; /* Value of -activebackground option:
+ * this is the color used to draw 3-D border
+ * and background when widget is active. */
+ Tcl_Obj *borderWidthPtr; /* Value of -borderWidth option: specifies
+ * width of border in pixels. */
+ int borderWidth; /* Integer value corresponding to
+ * borderWidthPtr. Always >= 0. */
+ int relief; /* Value of -relief option: specifies 3-d
+ * effect for border, such as
+ * TK_RELIEF_RAISED. */
+ int overRelief; /* Value of -overrelief option: specifies a 3-d
+ * effect for the border, such as
+ * TK_RELIEF_RAISED, to be used when the mouse
+ * is over the button. */
+ int offRelief; /* Value of -offrelief option: specifies a 3-d
+ * effect for the border, such as
+ * TK_RELIEF_RAISED, to be used when a
+ * checkbutton or radiobutton without
+ * indicator is off */
+ Tcl_Obj *highlightWidthPtr; /* Value of -highlightthickness option:
+ * specifies width in pixels of highlight to
+ * draw around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ int highlightWidth; /* Integer value corresponding to
+ * highlightWidthPtr. Always >= 0. */
+ Tk_3DBorder highlightBorder;/* Value of -highlightbackground option:
+ * specifies background with which to draw 3-D
+ * default ring and focus highlight area when
+ * highlight is off. */
+ XColor *highlightColorPtr; /* Value of -highlightcolor option:
+ * specifies color for drawing traversal
+ * highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ Tk_Font tkfont; /* Value of -font option: specifies font
+ * to use for display text. */
+ XColor *normalFg; /* Value of -font option: specifies foreground
+ * color in normal mode. */
+ XColor *activeFg; /* Value of -activeforeground option:
+ * foreground color in active mode. NULL
+ * means use -foreground instead. */
+ XColor *disabledFg; /* Value of -disabledforeground option:
+ * foreground color when disabled. NULL
+ * means use normalFg with a 50% stipple
+ * instead. */
+ GC normalTextGC; /* GC for drawing text in normal mode. Also
+ * used to copy from off-screen pixmap onto
+ * screen. */
+ GC activeTextGC; /* GC for drawing text in active mode (NULL
+ * means use normalTextGC). */
+ GC disabledGC; /* Used to produce disabled effect. If
+ * disabledFg isn't NULL, this GC is used to
+ * draw button text or icon. Otherwise
+ * text or icon is drawn with normalGC and
+ * this GC is used to stipple background
+ * across it. For labels this is None. */
+ Pixmap gray; /* Pixmap for displaying disabled text if
+ * disabledFg is NULL. */
+ GC copyGC; /* Used for copying information from an
+ * off-screen pixmap to the screen. */
+ Tcl_Obj *widthPtr; /* Value of -width option. */
+ int width; /* Integer value corresponding to widthPtr. */
+ Tcl_Obj *heightPtr; /* Value of -height option. */
+ int height; /* Integer value corresponding to heightPtr. */
+ Tcl_Obj *wrapLengthPtr; /* Value of -wraplength option: specifies
+ * line length (in pixels) at which to wrap
+ * onto next line. <= 0 means don't wrap
+ * except at newlines. */
+ int wrapLength; /* Integer value corresponding to
+ * wrapLengthPtr. */
+ Tcl_Obj *padXPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave on left and
+ * right of text. Ignored for bitmaps and
+ * images. */
+ int padX; /* Integer value corresponding to padXPtr. */
+ Tcl_Obj *padYPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave above and
+ * below text. Ignored for bitmaps and
+ * images. */
+ int padY; /* Integer value corresponding to padYPtr. */
+ Tk_Anchor anchor; /* Value of -anchor option: specifies where
+ * text/bitmap should be displayed inside
+ * button region. */
+ Tk_Justify justify; /* Value of -justify option: specifies how
+ * to align lines of multi-line text. */
+ int indicatorOn; /* Value of -indicatoron option: 1 means
+ * draw indicator in checkbuttons and
+ * radiobuttons, 0 means don't draw it. */
+ Tk_3DBorder selectBorder; /* Value of -selectcolor option: specifies
+ * color for drawing indicator background, or
+ * perhaps widget background, when selected. */
+ int textWidth; /* Width needed to display text as requested,
+ * in pixels. */
+ int textHeight; /* Height needed to display text as requested,
+ * in pixels. */
+ Tk_TextLayout textLayout; /* Saved text layout information. */
+ int indicatorSpace; /* Horizontal space (in pixels) allocated for
+ * display of indicator. */
+ int indicatorDiameter; /* Diameter of indicator, in pixels. */
+ enum defaultState defaultState;
+ /* Value of -default option, such as
+ * DEFAULT_NORMAL: specifies state
+ * of default ring for buttons (normal,
+ * active, or disabled). NULL for other
+ * classes. */
+
+ /*
+ * For check and radio buttons, the fields below are used
+ * to manage the variable indicating the button's state.
+ */
+
+ Tcl_Obj *selVarNamePtr; /* Value of -variable option: specifies name
+ * of variable used to control selected
+ * state of button. */
+ Tcl_Obj *onValuePtr; /* Value of -offvalue option: specifies value
+ * to store in variable when this button is
+ * selected. */
+ Tcl_Obj *offValuePtr; /* Value of -offvalue option: specifies value
+ * to store in variable when this button
+ * isn't selected. Used only by
+ * checkbuttons. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Value of -cursor option: if not None,
+ * specifies current cursor for window. */
+ Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. */
+ Tcl_Obj *commandPtr; /* Value of -command option: specifies script
+ * to execute when button is invoked. If
+ * widget is label or has no command, this
+ * is NULL. */
+ int compound; /* Value of -compound option; specifies whether
+ * the button should show both an image and
+ * text, and, if so, how. */
+ int repeatDelay; /* Value of -repeatdelay option; specifies
+ * the number of ms after which the button will
+ * start to auto-repeat its command. */
+ int repeatInterval; /* Value of -repeatinterval option; specifies
+ * the number of ms between auto-repeat
+ * invocataions of the button command. */
+ 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.
+ * BUTTON_DELETED: Non-zero needs that this button has been
+ * deleted, or is in the process of being
+ * deleted.
+ */
+
+#define REDRAW_PENDING (1 << 0)
+#define SELECTED (1 << 1)
+#define GOT_FOCUS (1 << 2)
+#define BUTTON_DELETED (1 << 3)
+/*
+ * Declaration of variables shared between the files in the button module.
+ */
+
+extern Tk_ClassProcs tkpButtonProcs;
+
+/*
+ * Declaration of procedures used in the implementation of the button
+ * widget.
+ */
+
+#ifndef TkpButtonSetDefaults
+EXTERN void TkpButtonSetDefaults _ANSI_ARGS_((
+ Tk_OptionSpec *specPtr));
+#endif
+EXTERN void TkButtonWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+EXTERN void TkpComputeButtonGeometry _ANSI_ARGS_((
+ TkButton *butPtr));
+EXTERN TkButton * TkpCreateButton _ANSI_ARGS_((Tk_Window tkwin));
+#ifndef TkpDestroyButton
+EXTERN void TkpDestroyButton _ANSI_ARGS_((TkButton *butPtr));
+#endif
+#ifndef TkpDisplayButton
+EXTERN void TkpDisplayButton _ANSI_ARGS_((ClientData clientData));
+#endif
+EXTERN int TkInvokeButton _ANSI_ARGS_((TkButton *butPtr));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKBUTTON */
diff --git a/tcl/generic/tkCanvArc.c b/tcl/generic/tkCanvArc.c
new file mode 100644
index 00000000000..a229d3fc250
--- /dev/null
+++ b/tcl/generic/tkCanvArc.c
@@ -0,0 +1,2145 @@
+/*
+ * tkCanvArc.c --
+ *
+ * This file implements arc items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkCanvas.h"
+/*
+ * The structure below defines the record for each arc item.
+ */
+
+typedef enum {
+ PIESLICE_STYLE, CHORD_STYLE, ARC_STYLE
+} Style;
+
+typedef struct ArcItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline 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. */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc"). NULL
+ * means don't fill arc. */
+ XColor *activeFillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc" and state
+ * is "active"). NULL means use fillColor. */
+ XColor *disabledFillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc" and state
+ * is "disabled". NULL means use fillColor */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling item if state
+ * is active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling item if state
+ * is disabled. */
+ Style style; /* How to draw arc: arc, chord, or pieslice. */
+ 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 int StyleParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value,
+ char *widgRec, int offset));
+static char * StylePrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption styleOption = {
+ (Tk_OptionParseProc *) StyleParseProc,
+ StylePrintProc, (ClientData) NULL
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption dashOption = {
+ (Tk_OptionParseProc *) TkCanvasDashParseProc,
+ TkCanvasDashPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc, (ClientData) (TK_OFFSET_RELATIVE)
+};
+static Tk_CustomOption pixelOption = {
+ (Tk_OptionParseProc *) TkPixelParseProc,
+ TkPixelPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, activeFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.activeColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, activeFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(ArcItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(ArcItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, disabledFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, disabledFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(ArcItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {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_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(ArcItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(ArcItem, outline.color), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(ArcItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outline.stipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-start", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-style", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT,
+ &styleOption},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", (char *) NULL, (char *) NULL,
+ "1.0", Tk_Offset(ArcItem, outline.width), TK_CONFIG_DONT_SET_DEFAULT,
+ &pixelOption},
+ {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 objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateArc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+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 objc,
+ Tcl_Obj *CONST objv[]));
+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_((Tk_Canvas canvas,
+ 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 */
+ TK_CONFIG_OBJS, /* flags */
+ 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
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateArc --
+ *
+ * This procedure is invoked to create a new arc item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new arc item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateArc(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing arc. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ int i = 4;
+
+ if (objc == 1) {
+ i = 1;
+ } else if (objc > 1) {
+ char *arg = Tcl_GetString(objv[1]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+
+ if (objc < i) {
+ 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.
+ */
+
+ Tk_CreateOutline(&(arcPtr->outline));
+ arcPtr->start = 0;
+ arcPtr->extent = 90;
+ arcPtr->outlinePtr = NULL;
+ arcPtr->numOutlinePoints = 0;
+ arcPtr->tsoffset.flags = 0;
+ arcPtr->tsoffset.xoffset = 0;
+ arcPtr->tsoffset.yoffset = 0;
+ arcPtr->fillColor = NULL;
+ arcPtr->activeFillColor = NULL;
+ arcPtr->disabledFillColor = NULL;
+ arcPtr->fillStipple = None;
+ arcPtr->activeFillStipple = None;
+ arcPtr->disabledFillStipple = None;
+ arcPtr->style = PIESLICE_STYLE;
+ arcPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((ArcCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureArc(interp, canvas, itemPtr, objc-4, objv+4, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+ error:
+ DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on arcs. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcCoords(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(arcPtr->bbox[0]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(arcPtr->bbox[1]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(arcPtr->bbox[2]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(arcPtr->bbox[3]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if ((objc == 1)||(objc == 4)) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 4) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 4, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &arcPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2],
+ &arcPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3],
+ &arcPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeArcBbox(canvas, arcPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArc --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a arc item, such as its outline and fill colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureArc(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Arc item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* 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;
+ Tk_TSOffset *tsoffset;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) arcPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ state = itemPtr->state;
+
+ /*
+ * A few of the options require additional processing, such as
+ * style and graphics contexts.
+ */
+
+ if (arcPtr->outline.activeWidth > arcPtr->outline.width ||
+ arcPtr->outline.activeDash.number != 0 ||
+ arcPtr->outline.activeColor != NULL ||
+ arcPtr->outline.activeStipple != None ||
+ arcPtr->activeFillColor != NULL ||
+ arcPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ tsoffset = &arcPtr->outline.tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((arcPtr->bbox[0]+arcPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((arcPtr->bbox[1]+arcPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+
+ 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;
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr,
+ &(arcPtr->outline));
+ if (mask) {
+ gcValues.cap_style = CapButt;
+ mask |= GCCapStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (arcPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->outline.gc);
+ }
+ arcPtr->outline.gc = newGC;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
+ }
+
+ color = arcPtr->fillColor;
+ stipple = arcPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->activeFillColor!=NULL) {
+ color = arcPtr->activeFillColor;
+ }
+ if (arcPtr->activeFillStipple!=None) {
+ stipple = arcPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->disabledFillColor!=NULL) {
+ color = arcPtr->disabledFillColor;
+ }
+ if (arcPtr->disabledFillStipple!=None) {
+ stipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ if (arcPtr->style == ARC_STYLE) {
+ newGC = None;
+ } else if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ if (arcPtr->style == CHORD_STYLE) {
+ gcValues.arc_mode = ArcChord;
+ } else {
+ gcValues.arc_mode = ArcPieSlice;
+ }
+ mask = GCForeground|GCArcMode;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->fillGC);
+ }
+ arcPtr->fillGC = newGC;
+
+ tsoffset = &arcPtr->tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((arcPtr->bbox[0]+arcPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((arcPtr->bbox[1]+arcPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[3] + 0.5);
+ }
+
+ 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;
+
+ Tk_DeleteOutline(display, &(arcPtr->outline));
+ if (arcPtr->numOutlinePoints != 0) {
+ ckfree((char *) arcPtr->outlinePtr);
+ }
+ if (arcPtr->fillColor != NULL) {
+ Tk_FreeColor(arcPtr->fillColor);
+ }
+ if (arcPtr->activeFillColor != NULL) {
+ Tk_FreeColor(arcPtr->activeFillColor);
+ }
+ if (arcPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(arcPtr->disabledFillColor);
+ }
+ if (arcPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->fillStipple);
+ }
+ if (arcPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->activeFillStipple);
+ }
+ if (arcPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->disabledFillStipple);
+ }
+ 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];
+ double width;
+ Tk_State state = arcPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = arcPtr->outline.width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ arcPtr->header.x1 = arcPtr->header.x2 =
+ arcPtr->header.y1 = arcPtr->header.y2 = -1;
+ return;
+ } else if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *) arcPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = arcPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = arcPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * 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(canvas,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 == PIESLICE_STYLE) {
+ 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->outline.gc == None) {
+ tmp = 1;
+ } else {
+ tmp = (int) ((width + 1.0)/2.0 + 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, dashnumber;
+ double lineWidth;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ lineWidth = arcPtr->outline.width;
+ if (lineWidth < 1.0) {
+ lineWidth = 1.0;
+ }
+ dashnumber = arcPtr->outline.dash.number;
+ stipple = arcPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>lineWidth) {
+ lineWidth = arcPtr->outline.activeWidth;
+ }
+ if (arcPtr->outline.activeDash.number != 0) {
+ dashnumber = arcPtr->outline.activeDash.number;
+ }
+ if (arcPtr->activeFillStipple != None) {
+ stipple = arcPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth > 0) {
+ lineWidth = arcPtr->outline.disabledWidth;
+ }
+ if (arcPtr->outline.disabledDash.number != 0) {
+ dashnumber = arcPtr->outline.disabledDash.number;
+ }
+ if (arcPtr->disabledFillStipple != None) {
+ stipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ /*
+ * 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 (stipple != None) {
+ int w=0; int h=0;
+ Tk_TSOffset *tsoffset = &arcPtr->tsoffset;
+ int flags = tsoffset->flags;
+ if (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE)) {
+ Tk_SizeOfBitmap(display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, arcPtr->fillGC, tsoffset);
+ if (tsoffset) {
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ }
+ XFillArc(display, drawable, arcPtr->fillGC, x1, y1, (unsigned) (x2-x1),
+ (unsigned) (y2-y1), start, extent);
+ if (stipple != None) {
+ XSetTSOrigin(display, arcPtr->fillGC, 0, 0);
+ }
+ }
+ if (arcPtr->outline.gc != None) {
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(arcPtr->outline));
+
+ if (extent != 0) {
+ XDrawArc(display, drawable, arcPtr->outline.gc, 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. The same is done if
+ * the outline is dashed, because then polygons don't work.
+ */
+
+ if (lineWidth < 1.5 || dashnumber != 0) {
+ 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 == CHORD_STYLE) {
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ x1, y1, x2, y2);
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ 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->outline.gc,
+ cx, cy, x1, y1);
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ cx, cy, x2, y2);
+ }
+ } else {
+ if (arcPtr->style == CHORD_STYLE) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ display, drawable, arcPtr->outline.gc, None);
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ display, drawable, arcPtr->outline.gc, None);
+ TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, display, drawable, arcPtr->outline.gc,
+ None);
+ }
+ }
+
+ Tk_ResetOutlineGC(canvas, itemPtr, &(arcPtr->outline));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = (double) arcPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = (double) arcPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = (double) arcPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * 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 = arcPtr->bbox[3] - arcPtr->bbox[1];
+ if (t1 != 0.0) {
+ t1 = (pointPtr[1] - vertex[1]) / t1;
+ }
+ t2 = arcPtr->bbox[2] - arcPtr->bbox[0];
+ if (t2 != 0.0) {
+ t2 = (pointPtr[0] - vertex[0]) / t2;
+ }
+ 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 == ARC_STYLE) {
+ if (angleInRange) {
+ return TkOvalToPoint(arcPtr->bbox, 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->outline.gc == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outline.gc == None) {
+ width = 0.0;
+ }
+
+ if (arcPtr->style == PIESLICE_STYLE) {
+ 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;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = (double) arcPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = (double) arcPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = (double) arcPtr->outline.disabledWidth;
+ }
+ }
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outline.gc == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outline.gc == None) {
+ width = 0.0;
+ }
+
+ /*
+ * 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 == PIESLICE_STYLE) && (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 == PIESLICE_STYLE) {
+ 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 == CHORD_STYLE) {
+ 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(canvas,arcPtr)
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ ArcItem *arcPtr; /* Information about arc. */
+{
+ double sin1, cos1, sin2, cos2, angle, width, halfWidth;
+ double boxWidth, boxHeight;
+ double vertex[2], corner1[2], corner2[2];
+ double *outlinePtr;
+ Tk_State state = arcPtr->header.state;
+
+
+ /*
+ * 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;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ /*
+ * 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.
+ */
+
+ width = arcPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *) arcPtr) {
+ if (arcPtr->outline.activeWidth>arcPtr->outline.width) {
+ width = arcPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>arcPtr->outline.width) {
+ width = arcPtr->outline.disabledWidth;
+ }
+ }
+ halfWidth = 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 == CHORD_STYLE) {
+ outlinePtr[0] = outlinePtr[12] = corner1[0];
+ outlinePtr[1] = outlinePtr[13] = corner1[1];
+ TkGetButtPoints(arcPtr->center2, arcPtr->center1,
+ 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 == PIESLICE_STYLE) {
+ /*
+ * 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, 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, 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 the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+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;
+ XColor *color;
+ Pixmap stipple;
+ XColor *fillColor;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+
+ 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(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ color = arcPtr->outline.color;
+ stipple = arcPtr->outline.stipple;
+ fillColor = arcPtr->fillColor;
+ fillStipple = arcPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeColor!=NULL) {
+ color = arcPtr->outline.activeColor;
+ }
+ if (arcPtr->outline.activeStipple!=None) {
+ stipple = arcPtr->outline.activeStipple;
+ }
+ if (arcPtr->activeFillColor!=NULL) {
+ fillColor = arcPtr->activeFillColor;
+ }
+ if (arcPtr->activeFillStipple!=None) {
+ fillStipple = arcPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledColor!=NULL) {
+ color = arcPtr->outline.disabledColor;
+ }
+ if (arcPtr->outline.disabledStipple!=None) {
+ stipple = arcPtr->outline.disabledStipple;
+ }
+ if (arcPtr->disabledFillColor!=NULL) {
+ fillColor = arcPtr->disabledFillColor;
+ }
+ if (arcPtr->disabledFillStipple!=None) {
+ fillStipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ /*
+ * 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 == CHORD_STYLE) {
+ 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, fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ if (fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outline.gc != 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->outline.gc != 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", ang1, ang2);
+ Tcl_AppendResult(interp, buffer,
+ " arc\nsetmatrix\n0 setlinecap\n", (char *) NULL);
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &(arcPtr->outline)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->style != ARC_STYLE) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ if (arcPtr->style == CHORD_STYLE) {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ CHORD_OUTLINE_PTS);
+ } else {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ PIE_OUTLINE1_PTS);
+ if (Tk_CanvasPsColor(interp, canvas, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ stipple) != 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, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * StyleParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-style" option.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The state for a given item gets replaced by the state
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+StyleParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ int c;
+ size_t length;
+
+ register Style *stylePtr = (Style *) (widgRec + offset);
+
+ if(value == NULL || *value == 0) {
+ *stylePtr = PIESLICE_STYLE;
+ return TCL_OK;
+ }
+
+ c = value[0];
+ length = strlen(value);
+
+ if ((c == 'a') && (strncmp(value, "arc", length) == 0)) {
+ *stylePtr = ARC_STYLE;
+ return TCL_OK;
+ }
+ if ((c == 'c') && (strncmp(value, "chord", length) == 0)) {
+ *stylePtr = CHORD_STYLE;
+ return TCL_OK;
+ }
+ if ((c == 'p') && (strncmp(value, "pieslice", length) == 0)) {
+ *stylePtr = PIESLICE_STYLE;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad -style option \"",
+ value, "\": must be arc, chord, or pieslice",
+ (char *) NULL);
+ *stylePtr = PIESLICE_STYLE;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * StylePrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-style"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the state 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+StylePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Ignored. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Style *stylePtr = (Style *) (widgRec + offset);
+
+ if (*stylePtr==ARC_STYLE) {
+ return "arc";
+ } else if (*stylePtr==CHORD_STYLE) {
+ return "chord";
+ } else {
+ return "pieslice";
+ }
+}
diff --git a/tcl/generic/tkCanvBmap.c b/tcl/generic/tkCanvBmap.c
new file mode 100644
index 00000000000..d015689f47f
--- /dev/null
+++ b/tcl/generic/tkCanvBmap.c
@@ -0,0 +1,985 @@
+/*
+ * tkCanvBmap.c --
+ *
+ * This file implements bitmap items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+ Pixmap activeBitmap; /* Bitmap to display in window. */
+ Pixmap disabledBitmap; /* Bitmap to display in window. */
+ XColor *fgColor; /* Foreground color to use for bitmap. */
+ XColor *activeFgColor; /* Foreground color to use for bitmap. */
+ XColor *disabledFgColor; /* Foreground color to use for bitmap. */
+ XColor *bgColor; /* Background color to use for bitmap. */
+ XColor *activeBgColor; /* Background color to use for bitmap. */
+ XColor *disabledBgColor; /* 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 stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-activebackground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, activeBgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activebitmap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, activeBitmap), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, activeFgColor), TK_CONFIG_NULL_OK},
+ {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, "-disabledbackground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, disabledBgColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledbitmap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, disabledBitmap),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledforeground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, disabledFgColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(BitmapItem, fgColor), 0},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {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 objc,
+ Tcl_Obj *CONST objv[]));
+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 objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+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 */
+ CreateBitmap, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureBitmap, /* configureProc */
+ BitmapCoords, /* coordProc */
+ DeleteBitmap, /* deleteProc */
+ DisplayBitmap, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ 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 */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateBitmap --
+ *
+ * This procedure is invoked to create a new bitmap
+ * item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new bitmap item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateBitmap(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int i;
+
+ if (objc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj(objv[1], NULL);
+ if (((objc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z'))) {
+ i = 1;
+ } else {
+ i = 2;
+ }
+ }
+
+ if (objc < i) {
+ 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->activeBitmap = None;
+ bmapPtr->disabledBitmap = None;
+ bmapPtr->fgColor = NULL;
+ bmapPtr->activeFgColor = NULL;
+ bmapPtr->disabledFgColor = NULL;
+ bmapPtr->bgColor = NULL;
+ bmapPtr->activeBgColor = NULL;
+ bmapPtr->disabledBgColor = NULL;
+ bmapPtr->gc = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((BitmapCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureBitmap(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on bitmap items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapCoords(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(bmapPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(bmapPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (objc <3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &bmapPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &bmapPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeBitmapBbox(canvas, bmapPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureBitmap --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a bitmap item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureBitmap(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Bitmap item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* 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;
+ XColor *fgColor;
+ XColor *bgColor;
+ Pixmap bitmap;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) bmapPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as those
+ * that determine the graphics context.
+ */
+
+ state = itemPtr->state;
+
+ if (bmapPtr->activeFgColor!=NULL ||
+ bmapPtr->activeBgColor!=NULL ||
+ bmapPtr->activeBitmap!=None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputeBitmapBbox(canvas, bmapPtr);
+ return TCL_OK;
+ }
+ fgColor = bmapPtr->fgColor;
+ bgColor = bmapPtr->bgColor;
+ bitmap = bmapPtr->bitmap;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (bmapPtr->activeFgColor!=NULL) {
+ fgColor = bmapPtr->activeFgColor;
+ }
+ if (bmapPtr->activeBgColor!=NULL) {
+ bgColor = bmapPtr->activeBgColor;
+ }
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (bmapPtr->disabledFgColor!=NULL) {
+ fgColor = bmapPtr->disabledFgColor;
+ }
+ if (bmapPtr->disabledBgColor!=NULL) {
+ bgColor = bmapPtr->disabledBgColor;
+ }
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ if (state==TK_STATE_DISABLED || bitmap == None) {
+ ComputeBitmapBbox(canvas, bmapPtr);
+ return TCL_OK;
+ }
+
+ gcValues.foreground = fgColor->pixel;
+ mask = GCForeground;
+ if (bgColor != NULL) {
+ gcValues.background = bgColor->pixel;
+ mask |= GCBackground;
+ } else {
+ gcValues.clip_mask = bitmap;
+ mask |= GCClipMask;
+ }
+ if (bitmap == None) {
+ newGC = None;
+ } else {
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ 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->activeBitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->activeBitmap);
+ }
+ if (bmapPtr->disabledBitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->disabledBitmap);
+ }
+ if (bmapPtr->fgColor != NULL) {
+ Tk_FreeColor(bmapPtr->fgColor);
+ }
+ if (bmapPtr->activeFgColor != NULL) {
+ Tk_FreeColor(bmapPtr->activeFgColor);
+ }
+ if (bmapPtr->disabledFgColor != NULL) {
+ Tk_FreeColor(bmapPtr->disabledFgColor);
+ }
+ if (bmapPtr->bgColor != NULL) {
+ Tk_FreeColor(bmapPtr->bgColor);
+ }
+ if (bmapPtr->activeBgColor != NULL) {
+ Tk_FreeColor(bmapPtr->activeBgColor);
+ }
+ if (bmapPtr->disabledBgColor != NULL) {
+ Tk_FreeColor(bmapPtr->disabledBgColor);
+ }
+ 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;
+ Pixmap bitmap;
+ Tk_State state = bmapPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ bitmap = bmapPtr->bitmap;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)bmapPtr) {
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ x = (int) (bmapPtr->x + ((bmapPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (bmapPtr->y + ((bmapPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (state==TK_STATE_HIDDEN || 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;
+ XColor *fgColor;
+ XColor *bgColor;
+ Pixmap bitmap;
+ Tk_State state = itemPtr->state;
+
+ /*
+ * If the area being displayed doesn't cover the whole bitmap,
+ * then only redisplay the part of the bitmap that needs
+ * redisplay.
+ */
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ fgColor = bmapPtr->fgColor;
+ bgColor = bmapPtr->bgColor;
+ bitmap = bmapPtr->bitmap;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (bmapPtr->activeFgColor!=NULL) {
+ fgColor = bmapPtr->activeFgColor;
+ }
+ if (bmapPtr->activeBgColor!=NULL) {
+ bgColor = bmapPtr->activeBgColor;
+ }
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (bmapPtr->disabledFgColor!=NULL) {
+ fgColor = bmapPtr->disabledFgColor;
+ }
+ if (bmapPtr->disabledBgColor!=NULL) {
+ bgColor = bmapPtr->disabledBgColor;
+ }
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ if (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, bitmap, drawable,
+ bmapPtr->gc, bmapX, bmapY, (unsigned int) bmapWidth,
+ (unsigned int) bmapHeight, drawableX, drawableY, 1);
+ XSetClipOrigin(display, bmapPtr->gc, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 the interp's result, replacing whatever used to be there.
+ * If no error occurs, then Postscript for the item is appended
+ * to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+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[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4];
+
+ if (bmapPtr->bitmap == None) {
+ return TCL_OK;
+ }
+
+ /*
+ * Compute the coordinates of the lower-left corner of the bitmap,
+ * 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/tcl/generic/tkCanvImg.c b/tcl/generic/tkCanvImg.c
new file mode 100644
index 00000000000..7bd7b4e3f91
--- /dev/null
+++ b/tcl/generic/tkCanvImg.c
@@ -0,0 +1,899 @@
+/*
+ * tkCanvImg.c --
+ *
+ * This file implements image items for canvas widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+ char *activeImageString; /* String describing -activeimage option.
+ * NULL means no image right now. */
+ char *disabledImageString; /* String describing -disabledimage option.
+ * NULL means no image right now. */
+ Tk_Image image; /* Image to display in window, or NULL if
+ * no image at present. */
+ Tk_Image activeImage; /* Image to display in window, or NULL if
+ * no image at present. */
+ Tk_Image disabledImage; /* Image to display in window, or NULL if
+ * no image at present. */
+} ImageItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-activeimage", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, activeImageString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-disabledimage", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, disabledImageString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {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,
+ Tcl_Obj *CONST 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 int ImageToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+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,
+ Tcl_Obj *CONST argv[], int flags));
+static int CreateImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, Tcl_Obj *CONST 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 */
+ TK_CONFIG_OBJS, /* flags */
+ ImageToPoint, /* pointProc */
+ ImageToArea, /* areaProc */
+ ImageToPostscript, /* 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
+ * the interp's result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new image item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+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. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ int i;
+
+ if (argc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj((Tcl_Obj *) argv[1], NULL);
+ if (((argc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z'))) {
+ i = 1;
+ } else {
+ i = 2;
+ }
+ }
+
+ if (argc < i) {
+ 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->activeImageString = NULL;
+ imgPtr->disabledImageString = NULL;
+ imgPtr->image = NULL;
+ imgPtr->activeImage = NULL;
+ imgPtr->disabledImage = NULL;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((ImageCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureImage(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on image items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+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. */
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (argc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(imgPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(imgPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (argc < 3) {
+ if (argc==1) {
+ if (Tcl_ListObjGetElements(interp, argv[0], &argc,
+ (Tcl_Obj ***) &argv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (argc != 2) {
+ char buf[64];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1],
+ &imgPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeImageBbox(canvas, imgPtr);
+ } else {
+ char buf[64];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureImage --
+ *
+ * This procedure is invoked to configure various aspects
+ * of an image item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+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. */
+ Tcl_Obj *CONST 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 (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, argc,
+ (CONST char **) argv, (char *) imgPtr, flags|TK_CONFIG_OBJS)) {
+ 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->activeImageString != NULL) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+ 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;
+ if (imgPtr->activeImageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->activeImageString,
+ ImageChangedProc, (ClientData) imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->activeImage != NULL) {
+ Tk_FreeImage(imgPtr->activeImage);
+ }
+ imgPtr->activeImage = image;
+ if (imgPtr->disabledImageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->disabledImageString,
+ ImageChangedProc, (ClientData) imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->disabledImage != NULL) {
+ Tk_FreeImage(imgPtr->disabledImage);
+ }
+ imgPtr->disabledImage = 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->activeImageString != NULL) {
+ ckfree(imgPtr->activeImageString);
+ }
+ if (imgPtr->disabledImageString != NULL) {
+ ckfree(imgPtr->disabledImageString);
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+ if (imgPtr->activeImage != NULL) {
+ Tk_FreeImage(imgPtr->activeImage);
+ }
+ if (imgPtr->disabledImage != NULL) {
+ Tk_FreeImage(imgPtr->disabledImage);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ Tk_Image image;
+ Tk_State state = imgPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ image = imgPtr->image;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)imgPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+
+ x = (int) (imgPtr->x + ((imgPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (imgPtr->y + ((imgPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if ((state == TK_STATE_HIDDEN) || (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(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;
+ Tk_Image image;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ image = imgPtr->image;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+
+ if (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(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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * image 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
+ImageToPostscript(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.*/
+{
+ ImageItem *imgPtr = (ImageItem *)itemPtr;
+ Tk_Window canvasWin = Tk_CanvasTkwin(canvas);
+
+ char buffer[256];
+ double x, y;
+ int width, height;
+ Tk_Image image;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ image = imgPtr->image;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+ Tk_SizeOfImage(image, &width, &height);
+
+ /*
+ * Compute the coordinates of the lower-left corner of the image,
+ * taking into account the anchor position for the image.
+ */
+
+ x = imgPtr->x;
+ y = Tk_CanvasPsY(canvas, imgPtr->y);
+
+ switch (imgPtr->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;
+ }
+
+ if (image == NULL) {
+ return TCL_OK;
+ }
+
+ if (!prepass) {
+ sprintf(buffer, "%.15g %.15g", x, y);
+ Tcl_AppendResult(interp, buffer, " translate\n", (char *) NULL);
+ }
+
+ return Tk_PostscriptImage(image, interp, canvasWin,
+ ((TkCanvas *) canvas)->psInfo, 0, 0, width, height, prepass);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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/tcl/generic/tkCanvLine.c b/tcl/generic/tkCanvLine.c
new file mode 100644
index 00000000000..af1ab3504bd
--- /dev/null
+++ b/tcl/generic/tkCanvLine.c
@@ -0,0 +1,2467 @@
+/*
+ * tkCanvLine.c --
+ *
+ * This file implements line items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each line item.
+ */
+
+typedef enum {
+ ARROWS_NONE, ARROWS_FIRST, ARROWS_LAST, ARROWS_BOTH
+} Arrows;
+
+typedef struct LineItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ Tk_Canvas canvas; /* Canvas containing item. Needed for
+ * parsing arrow shapes. */
+ int numPoints; /* Number of points in line (always >= 0). */
+ 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 capStyle; /* Cap style for line. */
+ int joinStyle; /* Join style for line. */
+ GC arrowGC; /* Graphics context for drawing arrowheads. */
+ Arrows 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. */
+ Tk_SmoothMethod *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 objc,
+ Tcl_Obj *CONST objv[], 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 objc, Tcl_Obj *CONST objv[]));
+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 GetLineIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr));
+static int LineCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void LineDeleteCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+static void LineInsert _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj));
+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 ArrowParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST char *value, char *recordPtr, int offset));
+static char * ArrowPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static int ParseArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST 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 = {
+ (Tk_OptionParseProc *) ParseArrowShape,
+ PrintArrowShape, (ClientData) NULL
+};
+static Tk_CustomOption arrowOption = {
+ (Tk_OptionParseProc *) ArrowParseProc,
+ ArrowPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption smoothOption = {
+ (Tk_OptionParseProc *) TkSmoothParseProc,
+ TkSmoothPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption dashOption = {
+ (Tk_OptionParseProc *) TkCanvasDashParseProc,
+ TkCanvasDashPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc,
+ (ClientData) (TK_OFFSET_RELATIVE|TK_OFFSET_INDEX)
+};
+static Tk_CustomOption pixelOption = {
+ (Tk_OptionParseProc *) TkPixelParseProc,
+ TkPixelPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.activeColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(LineItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-arrow", (char *) NULL, (char *) NULL,
+ "none", Tk_Offset(LineItem, arrow), TK_CONFIG_DONT_SET_DEFAULT, &arrowOption},
+ {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, outline.color), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(LineItem, outline.offset),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(LineItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL,
+ "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(LineItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_CUSTOM, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(LineItem, smooth),
+ TK_CONFIG_DONT_SET_DEFAULT, &smoothOption},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, outline.stipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", (char *) NULL, (char *) NULL,
+ "1.0", Tk_Offset(LineItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {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 */
+ TK_CONFIG_OBJS, /* flags */
+ LineToPoint, /* pointProc */
+ LineToArea, /* areaProc */
+ LineToPostscript, /* postscriptProc */
+ ScaleLine, /* scaleProc */
+ TranslateLine, /* translateProc */
+ (Tk_ItemIndexProc *) GetLineIndex, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) LineInsert, /* insertProc */
+ LineDeleteCoords, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+
+/*
+ * The definition below determines how large are static arrays
+ * used to hold spline points (splines larger than this have to
+ * have their arrays malloc-ed).
+ */
+
+#define MAX_STATIC_POINTS 200
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateLine --
+ *
+ * This procedure is invoked to create a new line item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * the interp's result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new line item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateLine(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing line. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i;
+
+ /*
+ * Carry out initialization that is needed to set defaults and to
+ * allow proper cleanup after errors during the the remainder of
+ * this procedure.
+ */
+
+ Tk_CreateOutline(&(linePtr->outline));
+ linePtr->canvas = canvas;
+ linePtr->numPoints = 0;
+ linePtr->coordPtr = NULL;
+ linePtr->capStyle = CapButt;
+ linePtr->joinStyle = JoinRound;
+ linePtr->arrowGC = None;
+ linePtr->arrow = ARROWS_NONE;
+ linePtr->arrowShapeA = (float)8.0;
+ linePtr->arrowShapeB = (float)10.0;
+ linePtr->arrowShapeC = (float)3.0;
+ linePtr->firstArrowPtr = NULL;
+ linePtr->lastArrowPtr = NULL;
+ linePtr->smooth = (Tk_SmoothMethod *) NULL;
+ 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 = 0; i < objc; i++) {
+ char *arg = Tcl_GetString(objv[i]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if (i && (LineCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureLine(interp, canvas, itemPtr, objc-i, objv+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 the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineCoords(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i, numPoints;
+ double *coordPtr;
+
+ if (objc == 0) {
+ int numCoords;
+ Tcl_Obj *subobj, *obj = Tcl_NewObj();
+
+ 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;
+ }
+ subobj = Tcl_NewDoubleObj(*coordPtr);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ }
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (objc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for line",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (objc < 4) {
+ Tcl_AppendResult(interp,
+ "too few coordinates specified for line",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = objc/2;
+ if (linePtr->numPoints != numPoints) {
+ coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * objc));
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ linePtr->coordPtr = coordPtr;
+ linePtr->numPoints = numPoints;
+ }
+ coordPtr = linePtr->coordPtr;
+ for (i = 0; i <objc; i++) {
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i],
+ coordPtr++) != 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 != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureLine --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a line item such as its background color.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureLine(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Line item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* 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;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) linePtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (linePtr->outline.activeWidth > linePtr->outline.width ||
+ linePtr->outline.activeDash.number != 0 ||
+ linePtr->outline.activeColor != NULL ||
+ linePtr->outline.activeStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr,
+ &(linePtr->outline));
+ if (mask) {
+ if (linePtr->arrow == ARROWS_NONE) {
+ gcValues.cap_style = linePtr->capStyle;
+ mask |= GCCapStyle;
+ }
+ gcValues.join_style = linePtr->joinStyle;
+ mask |= GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ gcValues.line_width = 0;
+ arrowGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = arrowGC = None;
+ }
+ if (linePtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->outline.gc);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->arrowGC);
+ }
+ linePtr->outline.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;
+ }
+
+ if ((!linePtr->numPoints) || (state==TK_STATE_HIDDEN)) {
+ ComputeLineBbox(canvas, linePtr);
+ return TCL_OK;
+ }
+
+ /*
+ * 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 != ARROWS_FIRST)
+ && (linePtr->arrow != ARROWS_BOTH)) {
+ 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 != ARROWS_LAST)
+ && (linePtr->arrow != ARROWS_BOTH)) {
+ 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 != ARROWS_NONE) {
+ 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;
+
+ Tk_DeleteOutline(display, &(linePtr->outline));
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ 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, intWidth;
+ double width;
+ Tk_State state = linePtr->header.state;
+ Tk_TSOffset *tsoffset;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (!(linePtr->numPoints) || (state==TK_STATE_HIDDEN)) {
+ linePtr->header.x1 = -1;
+ linePtr->header.x2 = -1;
+ linePtr->header.y1 = -1;
+ linePtr->header.y2 = -1;
+ return;
+ }
+
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ 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->outline.width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ TkIncludePoint((Tk_Item *) linePtr, linePtr->firstArrowPtr);
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ TkIncludePoint((Tk_Item *) linePtr, linePtr->lastArrowPtr);
+ }
+ }
+
+ tsoffset = &linePtr->outline.tsoffset;
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ double *coordPtr = linePtr->coordPtr + (tsoffset->flags & ~TK_OFFSET_INDEX);
+ if (tsoffset->flags <= 0) {
+ coordPtr = linePtr->coordPtr;
+ if ((linePtr->arrow == ARROWS_FIRST) || (linePtr->arrow == ARROWS_BOTH)) {
+ coordPtr = linePtr->firstArrowPtr;
+ }
+ }
+ if (tsoffset->flags > (linePtr->numPoints * 2)) {
+ coordPtr = linePtr->coordPtr + (linePtr->numPoints * 2);
+ if ((linePtr->arrow == ARROWS_LAST) || (linePtr->arrow == ARROWS_BOTH)) {
+ coordPtr = linePtr->lastArrowPtr;
+ }
+ }
+ tsoffset->xoffset = (int) (coordPtr[0] + 0.5);
+ tsoffset->yoffset = (int) (coordPtr[1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = linePtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (linePtr->header.x1 + linePtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = linePtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = linePtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (linePtr->header.y1 + linePtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = linePtr->header.y2;
+ }
+ }
+
+ intWidth = (int) (width + 0.5);
+ linePtr->header.x1 -= intWidth;
+ linePtr->header.x2 += intWidth;
+ linePtr->header.y1 -= intWidth;
+ linePtr->header.y2 += intWidth;
+
+ if (linePtr->numPoints==1) {
+ linePtr->header.x1 -= 1;
+ linePtr->header.x2 += 1;
+ linePtr->header.y1 -= 1;
+ linePtr->header.y2 += 1;
+ return;
+ }
+
+ /*
+ * 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,
+ 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 != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ 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, linewidth;
+ int i, numPoints;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple = linePtr->outline.stipple;
+
+ if ((!linePtr->numPoints)||(linePtr->outline.gc==None)) {
+ return;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ linewidth = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeStipple != None) {
+ stipple = linePtr->outline.activeStipple;
+ }
+ if (linePtr->outline.activeWidth != linewidth) {
+ linewidth = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledStipple != None) {
+ stipple = linePtr->outline.disabledStipple;
+ }
+ if (linePtr->outline.disabledWidth != linewidth) {
+ linewidth = linePtr->outline.disabledWidth;
+ }
+ }
+ /*
+ * 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 = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ } 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 = linePtr->smooth->coordProc(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 (Tk_ChangeOutlineGC(canvas, itemPtr, &(linePtr->outline))) {
+ Tk_CanvasSetOffset(canvas, linePtr->arrowGC, &linePtr->outline.tsoffset);
+ }
+ if (numPoints>1) {
+ XDrawLines(display, drawable, linePtr->outline.gc, pointPtr, numPoints,
+ CoordModeOrigin);
+ } else {
+ int intwidth = (int) (linewidth + 0.5);
+ if (intwidth<1) {
+ intwidth=1;
+ }
+ XFillArc(display, drawable, linePtr->outline.gc,
+ pointPtr->x - intwidth/2, pointPtr->y - intwidth/2,
+ (unsigned int)intwidth+1, (unsigned int)intwidth+1, 0, 64*360);
+ }
+ 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->arrowGC, NULL);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->arrowGC, NULL);
+ }
+ if (Tk_ResetOutlineGC(canvas, itemPtr, &(linePtr->outline))) {
+ XSetTSOrigin(display, linePtr->arrowGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineInsert --
+ *
+ * Insert coords into a line item at a given index.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The coords in the given item is modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+LineInsert(canvas, itemPtr, beforeThis, obj)
+ Tk_Canvas canvas; /* Canvas containing text item. */
+ Tk_Item *itemPtr; /* Line item to be modified. */
+ int beforeThis; /* Index before which new coordinates
+ * are to be inserted. */
+ Tcl_Obj *obj; /* New coordinates to be inserted. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int length, objc, i;
+ double *new, *coordPtr;
+ Tk_State state = itemPtr->state;
+ Tcl_Obj **objv;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &objc, &objv) != TCL_OK)
+ || !objc || objc&1) {
+ return;
+ }
+ length = 2*linePtr->numPoints;
+ if (beforeThis < 0) {
+ beforeThis = 0;
+ }
+ if (beforeThis > length) {
+ beforeThis = length;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ linePtr->coordPtr[length-2] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[length-1] = linePtr->lastArrowPtr[1];
+ }
+ new = (double *) ckalloc((unsigned)(sizeof(double) * (length + objc)));
+ for(i=0; i<beforeThis; i++) {
+ new[i] = linePtr->coordPtr[i];
+ }
+ for(i=0; i<objc; i++) {
+ if (Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,objv[i],
+ new+(i+beforeThis))!=TCL_OK) {
+ Tcl_ResetResult(((TkCanvas *)canvas)->interp);
+ ckfree((char *) new);
+ return;
+ }
+ }
+
+ for(i=beforeThis; i<length; i++) {
+ new[i+objc] = linePtr->coordPtr[i];
+ }
+ if(linePtr->coordPtr) ckfree((char *)linePtr->coordPtr);
+ linePtr->coordPtr = new;
+ linePtr->numPoints = (length + objc)/2;
+
+ if ((length>3) && (state != TK_STATE_HIDDEN)) {
+ /*
+ * This is some optimizing code that will result that only the part
+ * of the polygon that changed (and the objects that are overlapping
+ * with that part) need to be redrawn. A special flag is set that
+ * instructs the general canvas code not to redraw the whole
+ * object. If this flag is not set, the canvas will do the redrawing,
+ * otherwise I have to do it here.
+ */
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+
+ if (beforeThis>0) {beforeThis -= 2; objc+=2; }
+ if ((beforeThis+objc)<length) objc+=2;
+ if (linePtr->smooth) {
+ if(beforeThis>0) {
+ beforeThis-=2; objc+=2;
+ }
+ if((beforeThis+objc+2)<length) {
+ objc+=2;
+ }
+ }
+ itemPtr->x1 = itemPtr->x2 = (int) linePtr->coordPtr[beforeThis];
+ itemPtr->y1 = itemPtr->y2 = (int) linePtr->coordPtr[beforeThis+1];
+ if ((linePtr->firstArrowPtr != NULL) && (beforeThis<1)) {
+ /* include old first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+objc)>=length)) {
+ /* include old last arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ coordPtr = linePtr->coordPtr+beforeThis+2;
+ for(i=2; i<objc; i+=2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ coordPtr+=2;
+ }
+ }
+ 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 != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+
+ if(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW) {
+ double width;
+ int intWidth;
+ if ((linePtr->firstArrowPtr != NULL) && (beforeThis>2)) {
+ /* include new first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+objc)<(length-2))) {
+ /* include new right arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+ intWidth = (int) (width + 0.5);
+ if (intWidth < 1) {
+ intWidth = 1;
+ }
+ itemPtr->x1 -= intWidth; itemPtr->y1 -= intWidth;
+ itemPtr->x2 += intWidth; itemPtr->y2 += intWidth;
+ Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ }
+
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineDeleteCoords --
+ *
+ * Delete one or more coordinates from a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get
+ * deleted from itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+LineDeleteCoords(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. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int count, i, first1, last1;
+ int length = 2*linePtr->numPoints;
+ double *coordPtr;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ first &= -2;
+ last &= -2;
+
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= length) {
+ last = length-2;
+ }
+ if (first > last) {
+ return;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ linePtr->coordPtr[length-2] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[length-1] = linePtr->lastArrowPtr[1];
+ }
+ first1 = first; last1 = last;
+ if(first1>0) first1 -= 2;
+ if(last1<length-2) last1 += 2;
+ if (linePtr->smooth) {
+ if(first1>0) first1 -= 2;
+ if(last1<length-2) last1 += 2;
+ }
+
+ if((first1<2) && (last1 >= length-2)) {
+ /*
+ * This is some optimizing code that will result that only the part
+ * of the line that changed (and the objects that are overlapping
+ * with that part) need to be redrawn. A special flag is set that
+ * instructs the general canvas code not to redraw the whole
+ * object. If this flag is set, the redrawing has to be done here,
+ * otherwise the general Canvas code will take care of it.
+ */
+
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+ itemPtr->x1 = itemPtr->x2 = (int) linePtr->coordPtr[first1];
+ itemPtr->y1 = itemPtr->y2 = (int) linePtr->coordPtr[first1+1];
+ if ((linePtr->firstArrowPtr != NULL) && (first1<2)) {
+ /* include old first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (last1>=length-2)) {
+ /* include old last arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ coordPtr = linePtr->coordPtr+first1+2;
+ for (i=first1+2; i<=last1; i+=2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ coordPtr+=2;
+ }
+ }
+
+ count = last + 2 - first;
+ for (i=last+2; i<length; i++) {
+ linePtr->coordPtr[i-count] = linePtr->coordPtr[i];
+ }
+ linePtr->numPoints -= count/2;
+ 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 != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ if(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW) {
+ double width;
+ int intWidth;
+ if ((linePtr->firstArrowPtr != NULL) && (first1<4)) {
+ /* include new first arrow */
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (last1>(length-4))) {
+ /* include new right arrow */
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+ intWidth = (int) (width + 0.5);
+ if (intWidth < 1) {
+ intWidth = 1;
+ }
+ itemPtr->x1 -= intWidth; itemPtr->y1 -= intWidth;
+ itemPtr->x2 += intWidth; itemPtr->y2 += intWidth;
+ Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ Tk_State state = itemPtr->state;
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr, *linePoints;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double poly[10];
+ double bestDist, dist, width;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner
+ * had to be treated as beveled after all
+ * because the angle was < 11 degrees. */
+
+ bestDist = 1.0e36;
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ if (width < 1.0) {
+ width = 1.0;
+ }
+
+ if (!numPoints || itemPtr->state==TK_STATE_HIDDEN) {
+ return bestDist;
+ } else if (numPoints == 1) {
+ bestDist = hypot(linePoints[0] - pointPtr[0], linePoints[1] - pointPtr[1])
+ - width/2.0;
+ if (bestDist < 0) bestDist = 0;
+ return bestDist;
+ }
+
+ /*
+ * 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])
+ - width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge,
+ * consisting of two points for the first point of the edge
+ * and two points for the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, width,
+ linePtr->capStyle == CapProjecting, poly, poly+2);
+ } else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0,
+ poly, poly+2);
+
+ /*
+ * If this line uses beveled joints, then check the distance
+ * to a polygon comprising the last two points of the previous
+ * polygon and the first two from this polygon; this checks
+ * the wedges that fill the mitered joint.
+ */
+
+ 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, width,
+ linePtr->capStyle == CapProjecting, poly+4, poly+6);
+ } else if (linePtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the distance to the cap around the
+ * final end point of the line.
+ */
+
+ if (linePtr->capStyle == CapRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If there are arrowheads, check the distance to the arrowheads.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ 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;
+ double radius, width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ radius = (width+1.0)/2.0;
+
+ if ((state==TK_STATE_HIDDEN) || !linePtr->numPoints) {
+ return -1;
+ } else if (linePtr->numPoints == 1) {
+ double oval[4];
+ oval[0] = linePtr->coordPtr[0]-radius;
+ oval[1] = linePtr->coordPtr[1]-radius;
+ oval[2] = linePtr->coordPtr[0]+radius;
+ oval[3] = linePtr->coordPtr[1]+radius;
+ return TkOvalToArea(oval, rectPtr);
+ }
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ /*
+ * Check the segments of the line.
+ */
+
+ if (width < 1.0) {
+ width = 1.0;
+ }
+
+ result = TkThickPolyLineToArea(linePoints, numPoints,
+ width, linePtr->capStyle, linePtr->joinStyle,
+ rectPtr);
+ if (result == 0) {
+ goto done;
+ }
+
+ /*
+ * Check arrowheads, if any.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ rectPtr) != result) {
+ result = 0;
+ goto done;
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ 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 != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetLineIndex --
+ *
+ * Parse an index into a line 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
+GetLineIndex(interp, canvas, itemPtr, obj, 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. */
+ Tcl_Obj *obj; /* Specification of a particular coord
+ * in itemPtr's line. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ size_t length;
+ char *string = Tcl_GetStringFromObj(obj, (int *) &length);
+
+ if (string[0] == 'e') {
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = 2*linePtr->numPoints;
+ } 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 index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (string[0] == '@') {
+ int i;
+ double x ,y, bestDist, dist, *coordPtr;
+ char *end, *p;
+
+ p = string+1;
+ x = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ p = end+1;
+ y = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ bestDist = 1.0e36;
+ coordPtr = linePtr->coordPtr;
+ *indexPtr = 0;
+ for(i=0; i<linePtr->numPoints; i++) {
+ dist = hypot(coordPtr[0] - x, coordPtr[1] - y);
+ if (dist<bestDist) {
+ bestDist = dist;
+ *indexPtr = 2*i;
+ }
+ coordPtr += 2;
+ }
+ } else {
+ if (Tcl_GetIntFromObj(interp, obj, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ *indexPtr &= -2; /* if index is odd, make it even */
+ if (*indexPtr < 0){
+ *indexPtr = 0;
+ } else if (*indexPtr > (2*linePtr->numPoints)) {
+ *indexPtr = (2*linePtr->numPoints);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+ CONST 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;
+ CONST char **argv = NULL;
+
+ if (offset != Tk_Offset(LineItem, arrowShapeA)) {
+ panic("ParseArrowShape received bogus offset");
+ }
+
+ if (Tcl_SplitList(interp, (char *) 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;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-arrow" option.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The arrow for a given item gets replaced by the arrow
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArrowParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ int c;
+ size_t length;
+
+ register Arrows *arrowPtr = (Arrows *) (widgRec + offset);
+
+ if(value == NULL || *value == 0) {
+ *arrowPtr = ARROWS_NONE;
+ return TCL_OK;
+ }
+
+ c = value[0];
+ length = strlen(value);
+
+ if ((c == 'n') && (strncmp(value, "none", length) == 0)) {
+ *arrowPtr = ARROWS_NONE;
+ return TCL_OK;
+ }
+ if ((c == 'f') && (strncmp(value, "first", length) == 0)) {
+ *arrowPtr = ARROWS_FIRST;
+ return TCL_OK;
+ }
+ if ((c == 'l') && (strncmp(value, "last", length) == 0)) {
+ *arrowPtr = ARROWS_LAST;
+ return TCL_OK;
+ }
+ if ((c == 'b') && (strncmp(value, "both", length) == 0)) {
+ *arrowPtr = ARROWS_BOTH;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad arrow spec \"", value,
+ "\": must be none, first, last, or both",
+ (char *) NULL);
+ *arrowPtr = ARROWS_NONE;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-arrow"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the arrows 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+ArrowPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Arrows *arrowPtr = (Arrows *) (widgRec + offset);
+
+ switch (*arrowPtr) {
+ case ARROWS_FIRST:
+ return "first";
+ case ARROWS_LAST:
+ return "last";
+ case ARROWS_BOTH:
+ return "both";
+ default:
+ return "none";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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). */
+ double width;
+ Tk_State state = linePtr->header.state;
+
+ if (linePtr->numPoints <2) {
+ return TCL_OK;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * 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 + 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 = (width/2.0)/shapeC;
+ backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0;
+ if (linePtr->arrow != ARROWS_LAST) {
+ poly = linePtr->firstArrowPtr;
+ if (poly == NULL) {
+ poly = (double *) ckalloc((unsigned)
+ (2*PTS_IN_ARROW*sizeof(double)));
+ poly[0] = poly[10] = linePtr->coordPtr[0];
+ poly[1] = poly[11] = linePtr->coordPtr[1];
+ linePtr->firstArrowPtr = poly;
+ }
+ 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 != ARROWS_FIRST) {
+ coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2);
+ poly = linePtr->lastArrowPtr;
+ if (poly == NULL) {
+ poly = (double *) ckalloc((unsigned)
+ (2*PTS_IN_ARROW*sizeof(double)));
+ poly[0] = poly[10] = coordPtr[2];
+ poly[1] = poly[11] = coordPtr[3];
+ 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 the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+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[64 + TCL_INTEGER_SPACE];
+ char *style;
+
+ double width;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ color = linePtr->outline.color;
+ stipple = linePtr->outline.stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth>width) {
+ width = linePtr->outline.activeWidth;
+ }
+ if (linePtr->outline.activeColor!=NULL) {
+ color = linePtr->outline.activeColor;
+ }
+ if (linePtr->outline.activeStipple!=None) {
+ stipple = linePtr->outline.activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth>0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ if (linePtr->outline.disabledColor!=NULL) {
+ color = linePtr->outline.disabledColor;
+ }
+ if (linePtr->outline.disabledStipple!=None) {
+ stipple = linePtr->outline.disabledStipple;
+ }
+ }
+
+ if (color == NULL || linePtr->numPoints<1 || linePtr->coordPtr==NULL) {
+ return TCL_OK;
+ }
+
+ if (linePtr->numPoints==1) {
+ sprintf(buffer, "%.15g %.15g translate %.15g %.15g",
+ linePtr->coordPtr[0], Tk_CanvasPsY(canvas, linePtr->coordPtr[1]),
+ width/2.0, width/2.0);
+ Tcl_AppendResult(interp, "matrix currentmatrix\n",buffer,
+ " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) 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 < 3)) {
+ Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints);
+ } else {
+ if ((stipple == None) && linePtr->smooth->postscriptProc) {
+ linePtr->smooth->postscriptProc(interp, canvas,
+ linePtr->coordPtr, linePtr->numPoints, linePtr->splineSteps);
+ } 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 = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ pointPtr = staticPoints;
+ if (numPoints > MAX_STATIC_POINTS) {
+ pointPtr = (double *) ckalloc((unsigned)
+ (numPoints * 2 * sizeof(double)));
+ }
+ numPoints = linePtr->smooth->coordProc(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.
+ */
+
+ 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_CanvasPsOutline(canvas, itemPtr,
+ &(linePtr->outline)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Output polygons for the arrowheads, if there are any.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ if (stipple != 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 (stipple != 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 the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * arrowhead is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+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. */
+{
+ Pixmap stipple;
+ Tk_State state = linePtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ stipple = linePtr->outline.stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) {
+ if (linePtr->outline.activeStipple!=None) {
+ stipple = linePtr->outline.activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (linePtr->outline.activeStipple!=None) {
+ stipple = linePtr->outline.disabledStipple;
+ }
+ }
+
+ Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW);
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkCanvPoly.c b/tcl/generic/tkCanvPoly.c
new file mode 100644
index 00000000000..58ffab55090
--- /dev/null
+++ b/tcl/generic/tkCanvPoly.c
@@ -0,0 +1,1928 @@
+/*
+ * 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.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ *
+ * 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 polygon item.
+ */
+
+typedef struct PolygonItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ int numPoints; /* Number of points in polygon.
+ * 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 joinStyle; /* Join style for outline */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Foreground color for polygon. */
+ XColor *activeFillColor; /* Foreground color for polygon if state is active. */
+ XColor *disabledFillColor; /* Foreground color for polygon if state is disabled. */
+ Pixmap fillStipple; /* Stipple bitmap for filling polygon. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling polygon if state is active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling polygon if state is disabled. */
+ GC fillGC; /* Graphics context for filling polygon. */
+ Tk_SmoothMethod *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 smoothOption = {
+ (Tk_OptionParseProc *) TkSmoothParseProc,
+ TkSmoothPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption dashOption = {
+ (Tk_OptionParseProc *) TkCanvasDashParseProc,
+ TkCanvasDashPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc,
+ (ClientData) (TK_OFFSET_RELATIVE|TK_OFFSET_INDEX)
+};
+static Tk_CustomOption pixelOption = {
+ (Tk_OptionParseProc *) TkPixelParseProc,
+ TkPixelPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, activeFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.activeColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, activeFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(PolygonItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(PolygonItem, outline.offset),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, disabledFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, disabledFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(PolygonItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL,
+ "round", Tk_Offset(PolygonItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(PolygonItem, tsoffset),
+ TK_CONFIG_NULL_OK, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.color),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(PolygonItem, outline.tsoffset),
+ TK_CONFIG_NULL_OK, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outline.stipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(PolygonItem, smooth),
+ TK_CONFIG_DONT_SET_DEFAULT, &smoothOption},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {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_CUSTOM, "-width", (char *) NULL, (char *) NULL,
+ "1.0", Tk_Offset(PolygonItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {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 objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreatePolygon _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+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 GetPolygonIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr));
+static int PolygonCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void PolygonDeleteCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+static void PolygonInsert _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj));
+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 */
+ TK_CONFIG_OBJS, /* flags */
+ PolygonToPoint, /* pointProc */
+ PolygonToArea, /* areaProc */
+ PolygonToPostscript, /* postscriptProc */
+ ScalePolygon, /* scaleProc */
+ TranslatePolygon, /* translateProc */
+ (Tk_ItemIndexProc *) GetPolygonIndex,/* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) PolygonInsert,/* insertProc */
+ PolygonDeleteCoords, /* 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
+ * the interp's result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new polygon item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreatePolygon(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing polygon. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i;
+
+ /*
+ * Carry out initialization that is needed in order to clean
+ * up after errors during the the remainder of this procedure.
+ */
+
+ Tk_CreateOutline(&(polyPtr->outline));
+ polyPtr->numPoints = 0;
+ polyPtr->pointsAllocated = 0;
+ polyPtr->coordPtr = NULL;
+ polyPtr->joinStyle = JoinRound;
+ polyPtr->tsoffset.flags = 0;
+ polyPtr->tsoffset.xoffset = 0;
+ polyPtr->tsoffset.yoffset = 0;
+ polyPtr->fillColor = NULL;
+ polyPtr->activeFillColor = NULL;
+ polyPtr->disabledFillColor = NULL;
+ polyPtr->fillStipple = None;
+ polyPtr->activeFillStipple = None;
+ polyPtr->disabledFillStipple = None;
+ polyPtr->fillGC = None;
+ polyPtr->smooth = (Tk_SmoothMethod *) NULL;
+ 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 = 0; i < objc; i++) {
+ char *arg = Tcl_GetString(objv[i]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if (i && PolygonCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) {
+ goto error;
+ }
+
+ if (ConfigurePolygon(interp, canvas, itemPtr, objc-i, objv+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 the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonCoords(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i, numPoints;
+
+ if (objc == 0) {
+ /*
+ * Print the coords used to create the polygon. If we auto
+ * closed the polygon then we don't report the last point.
+ */
+ Tcl_Obj *subobj, *obj = Tcl_NewObj();
+ for (i = 0; i < 2*(polyPtr->numPoints - polyPtr->autoClosed); i++) {
+ subobj = Tcl_NewDoubleObj(polyPtr->coordPtr[i]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ }
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (objc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for polygon",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = objc/2;
+ if (polyPtr->pointsAllocated <= numPoints) {
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+
+ /*
+ * One extra point gets allocated here, because we always
+ * add another point to close the polygon.
+ */
+
+ polyPtr->coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * (objc+2)));
+ polyPtr->pointsAllocated = numPoints+1;
+ }
+ for (i = objc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[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 (objc>2 && ((polyPtr->coordPtr[objc-2] != polyPtr->coordPtr[0])
+ || (polyPtr->coordPtr[objc-1] != polyPtr->coordPtr[1]))) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ polyPtr->coordPtr[objc] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[objc+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 the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigurePolygon(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Polygon item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* 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;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) polyPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ state = itemPtr->state;
+
+ if (polyPtr->outline.activeWidth > polyPtr->outline.width ||
+ polyPtr->outline.activeDash.number != 0 ||
+ polyPtr->outline.activeColor != NULL ||
+ polyPtr->outline.activeStipple != None ||
+ polyPtr->activeFillColor != NULL ||
+ polyPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+ }
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &(polyPtr->outline));
+ if (mask) {
+ gcValues.cap_style = CapRound;
+ gcValues.join_style = polyPtr->joinStyle;
+ mask |= GCCapStyle|GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (polyPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->outline.gc);
+ }
+ polyPtr->outline.gc = newGC;
+
+ color = polyPtr->fillColor;
+ stipple = polyPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->activeFillColor!=NULL) {
+ color = polyPtr->activeFillColor;
+ }
+ if (polyPtr->activeFillStipple!=None) {
+ stipple = polyPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->disabledFillColor!=NULL) {
+ color = polyPtr->disabledFillColor;
+ }
+ if (polyPtr->disabledFillStipple!=None) {
+ stipple = polyPtr->disabledFillStipple;
+ }
+ }
+
+ if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ mask = GCForeground;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ 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;
+
+ Tk_DeleteOutline(display,&(polyPtr->outline));
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+ if (polyPtr->fillColor != NULL) {
+ Tk_FreeColor(polyPtr->fillColor);
+ }
+ if (polyPtr->activeFillColor != NULL) {
+ Tk_FreeColor(polyPtr->activeFillColor);
+ }
+ if (polyPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(polyPtr->disabledFillColor);
+ }
+ if (polyPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->fillStipple);
+ }
+ if (polyPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->activeFillStipple);
+ }
+ if (polyPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->disabledFillStipple);
+ }
+ 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;
+ double width;
+ Tk_State state = polyPtr->header.state;
+ Tk_TSOffset *tsoffset;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ if (polyPtr->coordPtr == NULL || (polyPtr->numPoints < 1) || (state==TK_STATE_HIDDEN)) {
+ polyPtr->header.x1 = polyPtr->header.x2 =
+ polyPtr->header.y1 = polyPtr->header.y2 = -1;
+ return;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)polyPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+
+ coordPtr = polyPtr->coordPtr;
+ polyPtr->header.x1 = polyPtr->header.x2 = (int) *coordPtr;
+ polyPtr->header.y1 = polyPtr->header.y2 = (int) coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the polygon,
+ * then expand in all directions by the outline'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 = polyPtr->coordPtr+2; i < polyPtr->numPoints-1;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, coordPtr);
+ }
+
+ tsoffset = &polyPtr->tsoffset;
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ int index = tsoffset->flags & ~TK_OFFSET_INDEX;
+ if (tsoffset->flags == INT_MAX) {
+ index = (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ if (index < 0) {
+ index = 0;
+ }
+ }
+ index %= (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ if (index <0) {
+ index += (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ }
+ tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5);
+ tsoffset->yoffset = (int) (polyPtr->coordPtr[index+1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = polyPtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (polyPtr->header.x1 + polyPtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = polyPtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = polyPtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (polyPtr->header.y1 + polyPtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = polyPtr->header.y2;
+ }
+ }
+
+ if (polyPtr->outline.gc != None) {
+ tsoffset = &polyPtr->outline.tsoffset;
+ if (tsoffset) {
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ int index = tsoffset->flags & ~TK_OFFSET_INDEX;
+ if (tsoffset->flags == INT_MAX) {
+ index = (polyPtr->numPoints - 1) * 2;
+ }
+ index %= (polyPtr->numPoints - 1) * 2;
+ if (index <0) {
+ index += (polyPtr->numPoints - 1) * 2;
+ }
+ tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5);
+ tsoffset->yoffset = (int) (polyPtr->coordPtr[index+1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = polyPtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (polyPtr->header.x1 + polyPtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = polyPtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = polyPtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (polyPtr->header.y1 + polyPtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = polyPtr->header.y2;
+ }
+ }
+ }
+
+ i = (int) ((width+1.5)/2.0);
+ polyPtr->header.x1 -= i;
+ polyPtr->header.x2 += i;
+ polyPtr->header.y1 -= i;
+ polyPtr->header.y2 += i;
+
+ /*
+ * 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 (polyPtr->joinStyle == JoinMiter) {
+ double miter[4];
+ int j;
+ coordPtr = polyPtr->coordPtr;
+ if (polyPtr->numPoints>3) {
+ if (TkGetMiterPoints(coordPtr+2*(polyPtr->numPoints-2),
+ coordPtr, coordPtr+2, width,
+ miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, miter+j);
+ }
+ }
+ }
+ for (i = polyPtr->numPoints ; i >= 3;
+ i--, coordPtr += 2) {
+
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, miter+j);
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g.
+ * X may round differently than we do).
+ */
+
+ polyPtr->header.x1 -= 1;
+ polyPtr->header.x2 += 1;
+ polyPtr->header.y1 -= 1;
+ polyPtr->header.y2 += 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 && numPoints>3) {
+ 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;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple = polyPtr->fillStipple;
+ double linewidth = polyPtr->outline.width;
+
+ if (((polyPtr->fillGC == None) && (polyPtr->outline.gc == None)) ||
+ (polyPtr->numPoints < 1) ||
+ (polyPtr->numPoints < 3 && polyPtr->outline.gc == None)) {
+ return;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>linewidth) {
+ linewidth = polyPtr->outline.activeWidth;
+ }
+ if (polyPtr->activeFillStipple != None) {
+ stipple = polyPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ linewidth = polyPtr->outline.disabledWidth;
+ }
+ if (polyPtr->disabledFillStipple != None) {
+ stipple = polyPtr->disabledFillStipple;
+ }
+ }
+ /*
+ * 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 ((stipple != None) && (polyPtr->fillGC != None)) {
+ Tk_TSOffset *tsoffset = &polyPtr->tsoffset;
+ int w=0; int h=0;
+ int flags = tsoffset->flags;
+ if (!(flags & TK_OFFSET_INDEX) && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) {
+ Tk_SizeOfBitmap(display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, polyPtr->fillGC, tsoffset);
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(polyPtr->outline));
+
+ if(polyPtr->numPoints < 3) {
+ short x,y;
+ int intLineWidth = (int) (linewidth + 0.5);
+ if (intLineWidth < 1) {
+ intLineWidth = 1;
+ }
+ Tk_CanvasDrawableCoords(canvas, polyPtr->coordPtr[0],
+ polyPtr->coordPtr[1], &x,&y);
+ XFillArc(display, drawable, polyPtr->outline.gc,
+ x - intLineWidth/2, y - intLineWidth/2,
+ (unsigned int)intLineWidth+1, (unsigned int)intLineWidth+1,
+ 0, 64*360);
+ } else if (!polyPtr->smooth || polyPtr->numPoints < 4) {
+ TkFillPolygon(canvas, polyPtr->coordPtr, polyPtr->numPoints,
+ display, drawable, polyPtr->fillGC, polyPtr->outline.gc);
+ } 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 = polyPtr->smooth->coordProc(canvas, (double *) NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned)
+ (numPoints * sizeof(XPoint)));
+ }
+ numPoints = polyPtr->smooth->coordProc(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->outline.gc != None) {
+ XDrawLines(display, drawable, polyPtr->outline.gc, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ Tk_ResetOutlineGC(canvas, itemPtr, &(polyPtr->outline));
+ if ((stipple != None) && (polyPtr->fillGC != None)) {
+ XSetTSOrigin(display, polyPtr->fillGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonInsert --
+ *
+ * Insert coords into a polugon item at a given index.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The coords in the given item is modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PolygonInsert(canvas, itemPtr, beforeThis, obj)
+ Tk_Canvas canvas; /* Canvas containing text item. */
+ Tk_Item *itemPtr; /* Line item to be modified. */
+ int beforeThis; /* Index before which new coordinates
+ * are to be inserted. */
+ Tcl_Obj *obj; /* New coordinates to be inserted. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int length, objc, i;
+ Tcl_Obj **objv;
+ double *new;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &objc, &objv) != TCL_OK)
+ || !objc || objc&1) {
+ return;
+ }
+ length = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ while(beforeThis>length) beforeThis-=length;
+ while(beforeThis<0) beforeThis+=length;
+ new = (double *) ckalloc((unsigned)(sizeof(double) * (length + 2 + objc)));
+ for (i=0; i<beforeThis; i++) {
+ new[i] = polyPtr->coordPtr[i];
+ }
+ for (i=0; i<objc; i++) {
+ if (Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,objv[i],
+ new+(i+beforeThis))!=TCL_OK) {
+ ckfree((char *) new);
+ return;
+ }
+ }
+
+ for(i=beforeThis; i<length; i++) {
+ new[i+objc] = polyPtr->coordPtr[i];
+ }
+ if(polyPtr->coordPtr) ckfree((char *) polyPtr->coordPtr);
+ length+=objc;
+ polyPtr->coordPtr = new;
+ polyPtr->numPoints = (length/2) + polyPtr->autoClosed;
+
+ /*
+ * Close the polygon if it isn't already closed, or remove autoclosing
+ * if the user's coordinates are now closed.
+ */
+
+ if (polyPtr->autoClosed) {
+ if ((new[length-2] == new[0]) && (new[length-1] == new[1])) {
+ polyPtr->autoClosed = 0;
+ polyPtr->numPoints--;
+ }
+ }
+ else {
+ if ((new[length-2] != new[0]) || (new[length-1] != new[1])) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ }
+ }
+
+ new[length] = new[0];
+ new[length+1] = new[1];
+ if (((length-objc)>3) && (state != TK_STATE_HIDDEN)) {
+ /*
+ * This is some optimizing code that will result that only the part
+ * of the polygon that changed (and the objects that are overlapping
+ * with that part) need to be redrawn. A special flag is set that
+ * instructs the general canvas code not to redraw the whole
+ * object. If this flag is not set, the canvas will do the redrawing,
+ * otherwise I have to do it here.
+ */
+ double width;
+ int j;
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+
+ /*
+ * The header elements that normally are used for the
+ * bounding box, are now used to calculate the bounding
+ * box for only the part that has to be redrawn. That
+ * doesn't matter, because afterwards the bounding
+ * box has to be re-calculated anyway.
+ */
+
+ itemPtr->x1 = itemPtr->x2 = (int) polyPtr->coordPtr[beforeThis];
+ itemPtr->y1 = itemPtr->y2 = (int) polyPtr->coordPtr[beforeThis+1];
+ beforeThis-=2; objc+=4;
+ if(polyPtr->smooth) {
+ beforeThis-=2; objc+=4;
+ } /* be carefull; beforeThis could now be negative */
+ for(i=beforeThis; i<beforeThis+objc; i+=2) {
+ j=i;
+ if(j<0) j+=length;
+ if(j>=length) j-=length;
+ TkIncludePoint(itemPtr, polyPtr->coordPtr+j);
+ }
+ width = polyPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+ itemPtr->x1 -= (int) width; itemPtr->y1 -= (int) width;
+ itemPtr->x2 += (int) width; itemPtr->y2 += (int) width;
+ Tk_CanvasEventuallyRedraw(canvas,
+ itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ }
+
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonDeleteCoords --
+ *
+ * Delete one or more coordinates from a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get
+ * deleted from itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PolygonDeleteCoords(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. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int count, i;
+ int length = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+
+ while(first>=length) first-=length;
+ while(first<0) first+=length;
+ while(last>=length) last-=length;
+ while(last<0) last+=length;
+
+ first &= -2;
+ last &= -2;
+
+ count = last + 2 - first;
+ if(count<=0) count +=length;
+
+ if(count >= length) {
+ polyPtr->numPoints = 0;
+ if(polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+ return;
+ }
+
+ if(last>=first) {
+ for(i=last+2; i<length; i++) {
+ polyPtr->coordPtr[i-count] = polyPtr->coordPtr[i];
+ }
+ } else {
+ for(i=last; i<=first; i++) {
+ polyPtr->coordPtr[i-last] = polyPtr->coordPtr[i];
+ }
+ }
+ polyPtr->coordPtr[length-count] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[length-count+1] = polyPtr->coordPtr[1];
+ polyPtr->numPoints -= count/2;
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, *polyPoints;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double poly[10];
+ double radius;
+ 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. */
+ double width;
+ Tk_State state = itemPtr->state;
+
+ bestDist = 1.0e36;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+ radius = width/2.0;
+
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((polyPtr->smooth) && (polyPtr->numPoints>2)) {
+ numPoints = polyPtr->smooth->coordProc(canvas, (double *) NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ polyPoints = staticSpace;
+ } else {
+ polyPoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ polyPoints);
+ } else {
+ numPoints = polyPtr->numPoints;
+ polyPoints = polyPtr->coordPtr;
+ }
+
+ bestDist = TkPolygonToPoint(polyPoints, numPoints, pointPtr);
+ if (bestDist<=0.0) {
+ goto donepoint;
+ }
+ if ((polyPtr->outline.gc != None) && (polyPtr->joinStyle == JoinRound)) {
+ dist = bestDist - radius;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else {
+ bestDist = dist;
+ }
+ }
+
+ if ((polyPtr->outline.gc == None) || (width <= 1)) goto donepoint;
+
+ /*
+ * 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 = polyPoints; count >= 2;
+ count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point then compute
+ * the distance between the point and the point.
+ */
+
+ if (polyPtr->joinStyle == JoinRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - radius;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } 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) width,
+ 0, poly, poly+2);
+ } else if ((polyPtr->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) 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 ((polyPtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width,
+ 0, poly+4, poly+6);
+ } else if (polyPtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) 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 donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ donepoint:
+ if ((polyPoints != staticSpace) && polyPoints != polyPtr->coordPtr) {
+ ckfree((char *) polyPoints);
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double *polyPoints, 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. */
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = polyPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+
+ radius = width/2.0;
+ inside = -1;
+
+ if ((state==TK_STATE_HIDDEN) || polyPtr->numPoints<2) {
+ return -1;
+ } else if (polyPtr->numPoints <3) {
+ double oval[4];
+ oval[0] = polyPtr->coordPtr[0]-radius;
+ oval[1] = polyPtr->coordPtr[1]-radius;
+ oval[2] = polyPtr->coordPtr[0]+radius;
+ oval[3] = polyPtr->coordPtr[1]+radius;
+ return TkOvalToArea(oval, rectPtr);
+ }
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if (polyPtr->smooth) {
+ numPoints = polyPtr->smooth->coordProc(canvas, (double *) NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ polyPoints = staticSpace;
+ } else {
+ polyPoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ polyPoints);
+ } else {
+ numPoints = polyPtr->numPoints;
+ polyPoints = polyPtr->coordPtr;
+ }
+
+ /*
+ * Simple test to see if we are in the polygon. Polygons are
+ * different from othe canvas items in that they register points
+ * being inside even if it isn't filled.
+ */
+ inside = TkPolygonToArea(polyPoints, numPoints, rectPtr);
+ if (inside==0) goto donearea;
+
+ if (polyPtr->outline.gc == None) goto donearea ;
+
+ /*
+ * 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, coordPtr = polyPoints; 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 (polyPtr->joinStyle == JoinRound) {
+ 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 donearea;
+ }
+ }
+
+ /*
+ * 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,
+ 0, poly, poly+2);
+ } else if ((polyPtr->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 ((polyPtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ 0, poly+4, poly+6);
+ } else if (polyPtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ }
+
+ donearea:
+ if ((polyPoints != staticSpace) && (polyPoints != polyPtr->coordPtr)) {
+ ckfree((char *) polyPoints);
+ }
+ return inside;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPolygonIndex --
+ *
+ * Parse an index into a polygon 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
+GetPolygonIndex(interp, canvas, itemPtr, obj, 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. */
+ Tcl_Obj *obj; /* Specification of a particular coord
+ * in itemPtr's line. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ size_t length;
+ char *string = Tcl_GetStringFromObj(obj, (int *) &length);
+
+ if (string[0] == 'e') {
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ } 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 index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (string[0] == '@') {
+ int i;
+ double x ,y, bestDist, dist, *coordPtr;
+ char *end, *p;
+
+ p = string+1;
+ x = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ p = end+1;
+ y = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ bestDist = 1.0e36;
+ coordPtr = polyPtr->coordPtr;
+ *indexPtr = 0;
+ for(i=0; i<(polyPtr->numPoints-1); i++) {
+ dist = hypot(coordPtr[0] - x, coordPtr[1] - y);
+ if (dist<bestDist) {
+ bestDist = dist;
+ *indexPtr = 2*i;
+ }
+ coordPtr += 2;
+ }
+ } else {
+ int count = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ if (Tcl_GetIntFromObj(interp, obj, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ *indexPtr &= -2; /* if odd, make it even */
+ if (count) {
+ if (*indexPtr > 0) {
+ *indexPtr = ((*indexPtr - 2) % count) + 2;
+ } else {
+ *indexPtr = -((-(*indexPtr)) % count);
+ }
+ } else {
+ *indexPtr = 0;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ char *style;
+ XColor *color;
+ XColor *fillColor;
+ Pixmap stipple;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+ double width;
+
+ if (polyPtr->numPoints<2 || polyPtr->coordPtr==NULL) {
+ return TCL_OK;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ color = polyPtr->outline.color;
+ stipple = polyPtr->fillStipple;
+ fillColor = polyPtr->fillColor;
+ fillStipple = polyPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth>width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ if (polyPtr->outline.activeColor!=NULL) {
+ color = polyPtr->outline.activeColor;
+ }
+ if (polyPtr->outline.activeStipple!=None) {
+ stipple = polyPtr->outline.activeStipple;
+ }
+ if (polyPtr->activeFillColor!=NULL) {
+ fillColor = polyPtr->activeFillColor;
+ }
+ if (polyPtr->activeFillStipple!=None) {
+ fillStipple = polyPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth>0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ if (polyPtr->outline.disabledColor!=NULL) {
+ color = polyPtr->outline.disabledColor;
+ }
+ if (polyPtr->outline.disabledStipple!=None) {
+ stipple = polyPtr->outline.disabledStipple;
+ }
+ if (polyPtr->disabledFillColor!=NULL) {
+ fillColor = polyPtr->disabledFillColor;
+ }
+ if (polyPtr->disabledFillStipple!=None) {
+ fillStipple = polyPtr->disabledFillStipple;
+ }
+ }
+ if (polyPtr->numPoints==2) {
+ char string[128];
+ sprintf(string, "%.15g %.15g translate %.15g %.15g",
+ polyPtr->coordPtr[0], Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]),
+ width/2.0, width/2.0);
+ Tcl_AppendResult(interp, "matrix currentmatrix\n",string,
+ " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, color)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Fill the area of the polygon.
+ */
+
+ if (fillColor != NULL && polyPtr->numPoints>3) {
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (fillStipple != None) {
+ Tcl_AppendResult(interp, "eoclip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (color != 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 (color != NULL) {
+
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
+ }
+
+ if (polyPtr->joinStyle == JoinRound) {
+ style = "1";
+ } else if (polyPtr->joinStyle == JoinBevel) {
+ style = "2";
+ } else {
+ style = "0";
+ }
+ Tcl_AppendResult(interp, style," setlinejoin 1 setlinecap\n",
+ (char *) NULL);
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &(polyPtr->outline)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkCanvPs.c b/tcl/generic/tkCanvPs.c
new file mode 100644
index 00000000000..18ffd3ab6fb
--- /dev/null
+++ b/tcl/generic/tkCanvPs.c
@@ -0,0 +1,1834 @@
+/*
+ * tkCanvPs.c --
+ *
+ * This module provides Postscript output support for canvases,
+ * including the "postscript" widget command plus a few utility
+ * procedures used for generating Postscript.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+ int prolog; /* Non-zero means output should contain
+ the file prolog.ps in the header. */
+} 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, "-prolog", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, prolog), 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}
+};
+
+/*
+ * 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. */
+ CONST char **argv; /* Argument strings. Caller has
+ * already parsed this command enough
+ * to know that argv[1] is
+ * "postscript". */
+{
+ TkPostscriptInfo psInfo;
+ Tk_PostscriptInfo oldInfoPtr;
+ int result;
+ Tk_Item *itemPtr;
+#define STRING_LENGTH 400
+ char string[STRING_LENGTH+1];
+ CONST char *p;
+ time_t now;
+ size_t length;
+ Tk_Window tkwin = canvasPtr->tkwin;
+ 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;
+ char psenccmd[]="::tk::ensure_psenc_is_loaded";
+
+ /*
+ *----------------------------------------------------------------
+ * Initialize the data structure describing Postscript generation,
+ * then process all the arguments to fill the data structure in.
+ *----------------------------------------------------------------
+ */
+ result = Tcl_EvalEx(interp,psenccmd,-1,TCL_EVAL_GLOBAL);
+ if (result != TCL_OK) {
+ return result;
+ }
+ oldInfoPtr = canvasPtr->psInfo;
+ canvasPtr->psInfo = (Tk_PostscriptInfo) &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;
+ psInfo.prolog = 1;
+ Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
+ result = Tk_ConfigureWidget(interp, 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(tkwin);
+ }
+ if (psInfo.height == -1) {
+ psInfo.height = Tk_Height(tkwin);
+ }
+ psInfo.x2 = psInfo.x + psInfo.width;
+ psInfo.y2 = psInfo.y + psInfo.height;
+
+ if (psInfo.pageXString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageXString,
+ &psInfo.pageX) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageYString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageYString,
+ &psInfo.pageY) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageWidthString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageWidthString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.width;
+ } else if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageHeightString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.height;
+ } else {
+ psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tkwin));
+ psInfo.scale /= WidthOfScreen(Tk_Screen(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(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(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(interp)) {
+ Tcl_AppendResult(interp, "can't specify -file in a",
+ " safe interpreter", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
+ if (p == NULL) {
+ goto cleanup;
+ }
+ psInfo.chan = Tcl_OpenFileChannel(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(interp, psInfo.channelName,
+ &mode);
+ if (psInfo.chan == (Tcl_Channel) NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if ((mode & TCL_WRITABLE) == 0) {
+ Tcl_AppendResult(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)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 1);
+ Tcl_ResetResult(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.
+ *--------------------------------------------------------
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
+ "%%Creator: Tk Canvas Widget\n", (char *) NULL);
+#ifdef HAVE_PW_GECOS
+ if (!Tcl_IsSafe(interp)) {
+ struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */
+ Tcl_AppendResult(interp, "%%For: ",
+ (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
+ (char *) NULL);
+ endpwent();
+ }
+#endif /* HAVE_PW_GECOS */
+ Tcl_AppendResult(interp, "%%Title: Window ",
+ Tk_PathName(tkwin), "\n", (char *) NULL);
+ time(&now);
+ Tcl_AppendResult(interp, "%%CreationDate: ",
+ ctime(&now), (char *) NULL); /* INTL: Native. */
+ if (!psInfo.rotate) {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX + psInfo.scale*deltaX),
+ (int) (psInfo.pageY + psInfo.scale*deltaY),
+ (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
+ + 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(interp, "%%BoundingBox: ", string,
+ "\n", (char *) NULL);
+ Tcl_AppendResult(interp, "%%Pages: 1\n",
+ "%%DocumentData: Clean7Bit\n", (char *) NULL);
+ Tcl_AppendResult(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(interp, p,
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr),
+ "\n", (char *) NULL);
+ p = "%%+ font ";
+ }
+ Tcl_AppendResult(interp, "%%EndComments\n\n", (char *) NULL);
+
+ /*
+ * Insert the prolog
+ */
+ Tcl_AppendResult(interp, Tcl_GetVar(interp,"::tk::ps_preamable",TCL_GLOBAL_ONLY), (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+
+ /*
+ *-----------------------------------------------------------
+ * Document setup: set the color level and include fonts.
+ *-----------------------------------------------------------
+ */
+
+ sprintf(string, "/CL %d def\n", psInfo.colorLevel);
+ Tcl_AppendResult(interp, "%%BeginSetup\n", string,
+ (char *) NULL);
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(interp, "%%IncludeResource: font ",
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
+ }
+ Tcl_AppendResult(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(interp, "%%Page: 1 1\n", "save\n",
+ (char *) NULL);
+ sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ if (psInfo.rotate) {
+ Tcl_AppendResult(interp, "90 rotate\n", (char *) NULL);
+ }
+ sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
+ psInfo.x,
+ Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo),
+ psInfo.x2,
+ Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo),
+ psInfo.x2,
+ Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo),
+ psInfo.x,
+ Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo));
+ Tcl_AppendResult(interp, string,
+ " lineto closepath clip newpath\n", (char *) NULL);
+ }
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Iterate through all the items, having each relevant one draw itself.
+ * Quit if any of the items returns an error.
+ *---------------------------------------------------------------------
+ */
+
+ 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;
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN) {
+ continue;
+ }
+ Tcl_AppendResult(interp, "gsave\n", (char *) NULL);
+ result = (*itemPtr->typePtr->postscriptProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0);
+ if (result != TCL_OK) {
+ char msg[64 + TCL_INTEGER_SPACE];
+
+ sprintf(msg, "\n (generating Postscript for item %d)",
+ itemPtr->id);
+ Tcl_AddErrorInfo(interp, msg);
+ goto cleanup;
+ }
+ Tcl_AppendResult(interp, "grestore\n", (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(interp);
+ }
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Output page-end information, such as commands to print the page
+ * and document trailer stuff.
+ *---------------------------------------------------------------------
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendResult(interp, "restore showpage\n\n",
+ "%%Trailer\nend\n%%EOF\n", (char *) NULL);
+ }
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -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(interp, psInfo.chan);
+ }
+ if (psInfo.channelName != NULL) {
+ ckfree(psInfo.channelName);
+ }
+ Tcl_DeleteHashTable(&psInfo.fontTable);
+ canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr;
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptColor --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to set a color value for output. Given information
+ * about an X color, this procedure will generate Postscript
+ * commands to set up an appropriate color in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptColor(interp, psInfo, colorPtr)
+ Tcl_Interp *interp;
+ Tk_PostscriptInfo psInfo; /* Postscript info. */
+ XColor *colorPtr; /* Information about color. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ 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) {
+ CONST 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_PostscriptFont --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to output text. Given information about an X
+ * font, this procedure will generate Postscript commands
+ * to set up an appropriate font in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * The Postscript font name is entered into psInfoPtr->fontTable
+ * if it wasn't already there.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptFont(interp, psInfo, tkfont)
+ Tcl_Interp *interp;
+ Tk_PostscriptInfo psInfo; /* Postscript Info. */
+ Tk_Font tkfont; /* Information about font in which text
+ * is to be printed. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ char *end;
+ char pointString[TCL_INTEGER_SPACE];
+ Tcl_DString ds;
+ int i, points;
+
+ /*
+ * First, look up the font's name in the font map, if there is one.
+ * If there is an entry for this font, it consists of a list
+ * containing font name and size. Use this information.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ if (psInfoPtr->fontVar != NULL) {
+ CONST char *list;
+ int argc;
+ double size;
+ CONST char **argv;
+ CONST 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_PostscriptBitmap --
+ *
+ * This procedure is called to output the contents of a
+ * sub-region of a bitmap in proper image data format for
+ * Postscript (i.e. data between angle brackets, one bit
+ * per pixel).
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, startX, startY, width,
+ height)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* Postscript info. */
+ 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. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ 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(tkwin), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
+ (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
+ imagePtr = XGetImage(Tk_Display(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_PostscriptStipple --
+ *
+ * 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 the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptStipple(interp, tkwin, psInfo, bitmap)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* Interpreter for returning Postscript
+ * or error message. */
+ Pixmap bitmap; /* Bitmap to use for stippling. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int width, height;
+ char string[TCL_INTEGER_SPACE * 2];
+ 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(tkwin), 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_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0,
+ width, height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptY --
+ *
+ * Given a y-coordinate in local 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_PostscriptY(y, psInfo)
+ double y; /* Y-coordinate in canvas coords. */
+ Tk_PostscriptInfo psInfo; /* Postscript info */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+
+ return psInfoPtr->y2 - y;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptPath --
+ *
+ * Given an array of points for a path, generate Postscript
+ * commands to create the path.
+ *
+ * Results:
+ * Postscript commands get appended to what's in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_PostscriptPath(interp, psInfo, coordPtr, numPoints)
+ Tcl_Interp *interp;
+ Tk_PostscriptInfo psInfo; /* 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 = (TkPostscriptInfo *) psInfo;
+ char buffer[200];
+
+ if (psInfoPtr->prepass) {
+ return;
+ }
+ sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
+ Tk_PostscriptY(coordPtr[1], psInfo));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (numPoints--, coordPtr += 2; numPoints > 0;
+ numPoints--, coordPtr += 2) {
+ sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
+ Tk_PostscriptY(coordPtr[1], psInfo));
+ 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
+ * the interp's 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkImageGetColor --
+ *
+ * This procedure converts a pixel value to three floating
+ * point numbers, representing the amount of red, green, and
+ * blue in that pixel on the screen. It makes use of colormap
+ * data passed as an argument, and should work for all Visual
+ * types.
+ *
+ * Results:
+ * Returns red, green, and blue color values in the range
+ * 0 to 1. There are no error returns.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TkImageGetColor(cdata, pixel, red, green, blue)
+ TkColormapData *cdata; /* Colormap data */
+ unsigned long pixel; /* Pixel value to look up */
+ double *red, *green, *blue; /* Color data to return */
+{
+ if (cdata->separated) {
+ int r = (pixel & cdata->red_mask) >> cdata->red_shift;
+ int g = (pixel & cdata->green_mask) >> cdata->green_shift;
+ int b = (pixel & cdata->blue_mask) >> cdata->blue_shift;
+ *red = cdata->colors[r].red / 65535.0;
+ *green = cdata->colors[g].green / 65535.0;
+ *blue = cdata->colors[b].blue / 65535.0;
+ } else {
+ *red = cdata->colors[pixel].red / 65535.0;
+ *green = cdata->colors[pixel].green / 65535.0;
+ *blue = cdata->colors[pixel].blue / 65535.0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostscriptImage --
+ *
+ * This procedure is called to output the contents of an
+ * image in Postscript, using a format appropriate for the
+ * current color mode (i.e. one bit per pixel in monochrome,
+ * one byte per pixel in gray, and three bytes per pixel in
+ * color).
+ *
+ * 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
+TkPostscriptImage(interp, tkwin, psInfo, ximage, x, y, width, height)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* postscript info */
+ XImage *ximage; /* Image to draw */
+ int x, y; /* First pixel to output */
+ int width, height; /* Width and height of area */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ char buffer[256];
+ int xx, yy, band, maxRows;
+ double red, green, blue;
+ int bytesPerLine=0, maxWidth=0;
+ int level = psInfoPtr->colorLevel;
+ Colormap cmap;
+ int i, depth, ncolors;
+ Visual *visual;
+ TkColormapData cdata;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ cmap = Tk_Colormap(tkwin);
+ depth = Tk_Depth(tkwin);
+ visual = Tk_Visual(tkwin);
+
+ /*
+ * Obtain information about the colormap, ie the mapping between
+ * pixel values and RGB values. The code below should work
+ * for all Visual types.
+ */
+
+ ncolors = visual->map_entries;
+ cdata.colors = (XColor *) ckalloc(sizeof(XColor) * ncolors);
+ cdata.ncolors = ncolors;
+
+ if (visual->class == DirectColor || visual->class == TrueColor) {
+ cdata.separated = 1;
+ cdata.red_mask = visual->red_mask;
+ cdata.green_mask = visual->green_mask;
+ cdata.blue_mask = visual->blue_mask;
+ cdata.red_shift = 0;
+ cdata.green_shift = 0;
+ cdata.blue_shift = 0;
+ while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0)
+ cdata.red_shift ++;
+ while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0)
+ cdata.green_shift ++;
+ while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0)
+ cdata.blue_shift ++;
+ for (i = 0; i < ncolors; i ++)
+ cdata.colors[i].pixel =
+ ((i << cdata.red_shift) & cdata.red_mask) |
+ ((i << cdata.green_shift) & cdata.green_mask) |
+ ((i << cdata.blue_shift) & cdata.blue_mask);
+ } else {
+ cdata.separated=0;
+ for (i = 0; i < ncolors; i ++)
+ cdata.colors[i].pixel = i;
+ }
+ if (visual->class == StaticGray || visual->class == GrayScale)
+ cdata.color = 0;
+ else
+ cdata.color = 1;
+
+
+ XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);
+
+ /*
+ * Figure out which color level to use (possibly lower than the
+ * one specified by the user). For example, if the user specifies
+ * color with monochrome screen, use gray or monochrome mode instead.
+ */
+
+ if (!cdata.color && level == 2) {
+ level = 1;
+ }
+
+ if (!cdata.color && cdata.ncolors == 2) {
+ level = 0;
+ }
+
+ /*
+ * Check that at least one row of the image can be represented
+ * with a string less than 64 KB long (this is a limit in the
+ * Postscript interpreter).
+ */
+
+ switch (level)
+ {
+ case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break;
+ case 1: bytesPerLine = width; maxWidth = 60000; break;
+ case 2: bytesPerLine = 3 * width; maxWidth = 20000; break;
+ }
+
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ sprintf(buffer,
+ "Can't generate Postscript for images more than %d pixels wide",
+ maxWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ ckfree((char *) cdata.colors);
+ return TCL_ERROR;
+ }
+
+ maxRows = 60000 / bytesPerLine;
+
+ for (band = height-1; band >= 0; band -= maxRows) {
+ int rows = (band >= maxRows) ? maxRows : band + 1;
+ int lineLen = 0;
+ switch (level) {
+ case 0:
+ sprintf(buffer, "%d %d 1 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 1:
+ sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 2:
+ sprintf(buffer, "%d %d 8 matrix {\n<",
+ width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ }
+ for (yy = band; yy > band - rows; yy--) {
+ switch (level) {
+ case 0: {
+ /*
+ * Generate data for image in monochrome mode.
+ * No attempt at dithering is made--instead, just
+ * set a threshold.
+ */
+ unsigned char mask=0x80;
+ unsigned char data=0x00;
+ for (xx = x; xx< x+width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5)
+ data |= mask;
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ mask=0x80;
+ data=0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask=0x80;
+ data=0x00;
+ }
+ break;
+ }
+ case 1: {
+ /*
+ * Generate data in gray mode--in this case, take a
+ * weighted sum of the red, green, and blue values.
+ */
+ for (xx = x; xx < x+width; xx ++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 *
+ (0.30 * red +
+ 0.59 * green +
+ 0.11 * blue)));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ case 2: {
+ /*
+ * Finally, color mode. Here, just output the red, green,
+ * and blue values directly.
+ */
+ for (xx = x; xx < x+width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X%02X%02X",
+ (int) floor(0.5 + 255.0 * red),
+ (int) floor(0.5 + 255.0 * green),
+ (int) floor(0.5 + 255.0 * blue));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 6;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ }
+ }
+ switch (level) {
+ case 0: sprintf(buffer, ">\n} image\n"); break;
+ case 1: sprintf(buffer, ">\n} image\n"); break;
+ case 2: sprintf(buffer, ">\n} false 3 colorimage\n"); break;
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "0 %d translate\n", rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+ ckfree((char *) cdata.colors);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptPhoto --
+ *
+ * This procedure is called to output the contents of a
+ * photo image in Postscript, using a format appropriate for
+ * the requested postscript color mode (i.e. one byte per pixel
+ * in gray, and three bytes per pixel in color).
+ *
+ * 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 interpreter's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tk_PostscriptPhoto(interp, blockPtr, psInfo, width, height)
+ Tcl_Interp *interp;
+ Tk_PhotoImageBlock *blockPtr;
+ Tk_PostscriptInfo psInfo;
+ int width, height;
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int colorLevel = psInfoPtr->colorLevel;
+ static int codeIncluded = 0;
+
+ unsigned char *pixelPtr;
+ char buffer[256], cspace[40], decode[40];
+ int bpc;
+ int xx, yy, lineLen;
+ float red, green, blue;
+ int alpha;
+ int bytesPerLine=0, maxWidth=0;
+
+ unsigned char opaque = 255;
+ unsigned char *alphaPtr;
+ int alphaOffset, alphaPitch, alphaIncr;
+
+ if (psInfoPtr->prepass) {
+ codeIncluded = 0;
+ return TCL_OK;
+ }
+
+ /*
+ * Define the "TkPhoto" function, which is a modified version
+ * of the original "transparentimage" function posted
+ * by ian@five-d.com (Ian Kemmish) to comp.lang.postscript.
+ * For a monochrome colorLevel this is a slightly different
+ * version that uses the imagemask command instead of image.
+ */
+
+ if( !codeIncluded && (colorLevel != 0) ) {
+ /*
+ * Color and gray-scale code.
+ */
+
+ codeIncluded = !0;
+ Tcl_AppendResult( interp,
+ "/TkPhoto { \n",
+ " gsave \n",
+ " 32 dict begin \n",
+ " /tinteger exch def \n",
+ " /transparent 1 string def \n",
+ " transparent 0 tinteger put \n",
+ " /olddict exch def \n",
+ " olddict /DataSource get dup type /filetype ne { \n",
+ " olddict /DataSource 3 -1 roll \n",
+ " 0 () /SubFileDecode filter put \n",
+ " } { \n",
+ " pop \n",
+ " } ifelse \n",
+ " /newdict olddict maxlength dict def \n",
+ " olddict newdict copy pop \n",
+ " /w newdict /Width get def \n",
+ " /crpp newdict /Decode get length 2 idiv def \n",
+ " /str w string def \n",
+ " /pix w crpp mul string def \n",
+ " /substrlen 2 w log 2 log div floor exp cvi def \n",
+ " /substrs [ \n",
+ " { \n",
+ " substrlen string \n",
+ " 0 1 substrlen 1 sub { \n",
+ " 1 index exch tinteger put \n",
+ " } for \n",
+ " /substrlen substrlen 2 idiv def \n",
+ " substrlen 0 eq {exit} if \n",
+ " } loop \n",
+ " ] def \n",
+ " /h newdict /Height get def \n",
+ " 1 w div 1 h div matrix scale \n",
+ " olddict /ImageMatrix get exch matrix concatmatrix \n",
+ " matrix invertmatrix concat \n",
+ " newdict /Height 1 put \n",
+ " newdict /DataSource pix put \n",
+ " /mat [w 0 0 h 0 0] def \n",
+ " newdict /ImageMatrix mat put \n",
+ " 0 1 h 1 sub { \n",
+ " mat 5 3 -1 roll neg put \n",
+ " olddict /DataSource get str readstring pop pop \n",
+ " /tail str def \n",
+ " /x 0 def \n",
+ " olddict /DataSource get pix readstring pop pop \n",
+ " { \n",
+ " tail transparent search dup /done exch not def \n",
+ " {exch pop exch pop} if \n",
+ " /w1 exch length def \n",
+ " w1 0 ne { \n",
+ " newdict /DataSource ",
+ " pix x crpp mul w1 crpp mul getinterval put \n",
+ " newdict /Width w1 put \n",
+ " mat 4 x neg put \n",
+ " /x x w1 add def \n",
+ " newdict image \n",
+ " /tail tail w1 tail length w1 sub getinterval def \n",
+ " } if \n",
+ " done {exit} if \n",
+ " tail substrs { \n",
+ " anchorsearch {pop} if \n",
+ " } forall \n",
+ " /tail exch def \n",
+ " tail length 0 eq {exit} if \n",
+ " /x w tail length sub def \n",
+ " } loop \n",
+ " } for \n",
+ " end \n",
+ " grestore \n",
+ "} bind def \n\n\n", (char *) NULL);
+ } else if( !codeIncluded && (colorLevel == 0) ) {
+ /*
+ * Monochrome-only code
+ */
+
+ codeIncluded = !0;
+ Tcl_AppendResult( interp,
+ "/TkPhoto { \n",
+ " gsave \n",
+ " 32 dict begin \n",
+ " /dummyInteger exch def \n",
+ " /olddict exch def \n",
+ " olddict /DataSource get dup type /filetype ne { \n",
+ " olddict /DataSource 3 -1 roll \n",
+ " 0 () /SubFileDecode filter put \n",
+ " } { \n",
+ " pop \n",
+ " } ifelse \n",
+ " /newdict olddict maxlength dict def \n",
+ " olddict newdict copy pop \n",
+ " /w newdict /Width get def \n",
+ " /pix w 7 add 8 idiv string def \n",
+ " /h newdict /Height get def \n",
+ " 1 w div 1 h div matrix scale \n",
+ " olddict /ImageMatrix get exch matrix concatmatrix \n",
+ " matrix invertmatrix concat \n",
+ " newdict /Height 1 put \n",
+ " newdict /DataSource pix put \n",
+ " /mat [w 0 0 h 0 0] def \n",
+ " newdict /ImageMatrix mat put \n",
+ " 0 1 h 1 sub { \n",
+ " mat 5 3 -1 roll neg put \n",
+ " 0.000 0.000 0.000 setrgbcolor \n",
+ " olddict /DataSource get pix readstring pop pop \n",
+ " newdict /DataSource pix put \n",
+ " newdict imagemask \n",
+ " 1.000 1.000 1.000 setrgbcolor \n",
+ " olddict /DataSource get pix readstring pop pop \n",
+ " newdict /DataSource pix put \n",
+ " newdict imagemask \n",
+ " } for \n",
+ " end \n",
+ " grestore \n",
+ "} bind def \n\n\n", (char *) NULL);
+ }
+
+ /*
+ * Check that at least one row of the image can be represented
+ * with a string less than 64 KB long (this is a limit in the
+ * Postscript interpreter).
+ */
+
+ switch (colorLevel)
+ {
+ case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break;
+ case 1: bytesPerLine = width; maxWidth = 60000; break;
+ case 2: bytesPerLine = 3 * width; maxWidth = 20000; break;
+ }
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ sprintf(buffer,
+ "Can't generate Postscript for images more than %d pixels wide",
+ maxWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set up the postscript code except for the image-data stream.
+ */
+
+ switch (colorLevel) {
+ case 0:
+ strcpy( cspace, "/DeviceGray");
+ strcpy( decode, "[1 0]");
+ bpc = 1;
+ break;
+ case 1:
+ strcpy( cspace, "/DeviceGray");
+ strcpy( decode, "[0 1]");
+ bpc = 8;
+ break;
+ default:
+ strcpy( cspace, "/DeviceRGB");
+ strcpy( decode, "[0 1 0 1 0 1]");
+ bpc = 8;
+ break;
+ }
+
+
+ Tcl_AppendResult(interp,
+ cspace, " setcolorspace\n\n", (char *) NULL);
+
+ sprintf(buffer,
+ " /Width %d\n /Height %d\n /BitsPerComponent %d\n",
+ width, height, bpc);
+ Tcl_AppendResult(interp,
+ "<<\n /ImageType 1\n", buffer,
+ " /DataSource currentfile",
+ " /ASCIIHexDecode filter\n", (char *) NULL);
+
+
+ sprintf(buffer,
+ " /ImageMatrix [1 0 0 -1 0 %d]\n", height);
+ Tcl_AppendResult(interp, buffer,
+ " /Decode ", decode, "\n>>\n1 TkPhoto\n", (char *) NULL);
+
+
+ /*
+ * Check the PhotoImageBlock information.
+ * We assume that:
+ * if pixelSize is 1,2 or 4, the image is R,G,B,A;
+ * if pixelSize is 3, the image is R,G,B and offset[3] is bogus.
+ */
+
+ if (blockPtr->pixelSize == 3) {
+ /*
+ * No alpha information: the whole image is opaque.
+ */
+
+ alphaPtr = &opaque;
+ alphaPitch = alphaIncr = alphaOffset = 0;
+ } else {
+ /*
+ * Set up alpha handling.
+ */
+
+ alphaPtr = blockPtr->pixelPtr;
+ alphaPitch = blockPtr->pitch;
+ alphaIncr = blockPtr->pixelSize;
+ alphaOffset = blockPtr->offset[3];
+ }
+
+
+ for (yy = 0, lineLen=0; yy < height; yy++) {
+ switch (colorLevel) {
+ case 0: {
+ /*
+ * Generate data for image in monochrome mode.
+ * No attempt at dithering is made--instead, just
+ * set a threshold.
+ * To handle transparecies we need to output two lines:
+ * one for the black pixels, one for the white ones.
+ */
+
+ unsigned char mask=0x80;
+ unsigned char data=0x00;
+ for (xx = 0; xx< width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ red = pixelPtr[blockPtr->offset[0]];
+ green = pixelPtr[blockPtr->offset[1]];
+ blue = pixelPtr[blockPtr->offset[2]];
+
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+
+ /*
+ * If pixel is less than threshold, then it is black.
+ */
+
+ if ((alpha != 0) &&
+ ( 0.3086 * red
+ + 0.6094 * green
+ + 0.082 * blue < 128)) {
+ data |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ mask=0x80;
+ data=0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask=0x80;
+ data=0x00;
+ }
+
+ mask=0x80;
+ data=0x00;
+ for (xx = 0; xx< width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ red = pixelPtr[blockPtr->offset[0]];
+ green = pixelPtr[blockPtr->offset[1]];
+ blue = pixelPtr[blockPtr->offset[2]];
+
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+
+ /*
+ * If pixel is greater than threshold, then it is white.
+ */
+
+ if ((alpha != 0) &&
+ ( 0.3086 * red
+ + 0.6094 * green
+ + 0.082 * blue >= 128)) {
+ data |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ mask=0x80;
+ data=0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask=0x80;
+ data=0x00;
+ }
+ break;
+ }
+ case 1: {
+ /*
+ * Generate transparency data.
+ * We must prevent a transparent value of 0
+ * because of a bug in some HP printers.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+ sprintf(buffer, "%02X", alpha | 0x01);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+
+
+ /*
+ * Generate data in gray mode--in this case, take a
+ * weighted sum of the red, green, and blue values.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ red = pixelPtr[blockPtr->offset[0]];
+ green = pixelPtr[blockPtr->offset[1]];
+ blue = pixelPtr[blockPtr->offset[2]];
+
+ sprintf(buffer, "%02X", (int) floor(0.5 +
+ ( 0.3086 * red + 0.6094 * green + 0.0820 * blue)));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ default: {
+ /*
+ * Generate transparency data.
+ * We must prevent a transparent value of 0
+ * because of a bug in some HP printers.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ alpha = *(alphaPtr + (yy * alphaPitch)
+ + (xx * alphaIncr) + alphaOffset);
+ sprintf(buffer, "%02X", alpha | 0x01);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+
+
+ /*
+ * Finally, color mode. Here, just output the red, green,
+ * and blue values directly.
+ */
+
+ for (xx = 0; xx < width; xx ++) {
+ pixelPtr = blockPtr->pixelPtr
+ + (yy * blockPtr->pitch)
+ + (xx *blockPtr->pixelSize);
+
+ sprintf(buffer, "%02X%02X%02X",
+ pixelPtr[blockPtr->offset[0]],
+ pixelPtr[blockPtr->offset[1]],
+ pixelPtr[blockPtr->offset[2]]);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 6;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ }
+ }
+
+ Tcl_AppendResult(interp, ">\n", (char *) NULL);
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkCanvText.c b/tcl/generic/tkCanvText.c
new file mode 100644
index 00000000000..d2ef1b865f3
--- /dev/null
+++ b/tcl/generic/tkCanvText.c
@@ -0,0 +1,1515 @@
+/*
+ * tkCanvText.c --
+ *
+ * This file implements text items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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; /* Character index of character just before
+ * which the insertion cursor is displayed. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_Anchor anchor; /* Where to anchor text relative to (x,y). */
+ Tk_TSOffset tsoffset;
+ XColor *color; /* Color for text. */
+ XColor *activeColor; /* Color for text. */
+ XColor *disabledColor; /* 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. */
+ Pixmap activeStipple; /* Stipple bitmap for text, or None. */
+ Pixmap disabledStipple; /* Stipple bitmap for text, or None. */
+ char *text; /* Text for item (malloc-ed). */
+ int width; /* Width of lines for word-wrap, pixels.
+ * Zero means no word-wrap. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ int numChars; /* Length of text in characters. */
+ int numBytes; /* Length of text in bytes. */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int leftEdge; /* Pixel location of the left edge of the
+ * text item; where the left border of the
+ * text layout is drawn. */
+ int rightEdge; /* Pixel just to right of right edge of
+ * area of text item. Used for selecting up
+ * to end of line. */
+ 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 stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc, (ClientData) (TK_OFFSET_RELATIVE)
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, activeColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, activeStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(TextItem, anchor),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, disabledColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, disabledStipple), TK_CONFIG_NULL_OK},
+ {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_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(TextItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {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,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateText _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, Tcl_Obj *CONST objv[]));
+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,
+ Tcl_Obj *obj, 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, Tcl_Obj *CONST objv[]));
+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 */
+ TK_CONFIG_OBJS, /* flags */
+ TextToPoint, /* pointProc */
+ TextToArea, /* areaProc */
+ TextToPostscript, /* postscriptProc */
+ ScaleText, /* scaleProc */
+ TranslateText, /* translateProc */
+ (Tk_ItemIndexProc *) GetTextIndex,/* indexProc */
+ SetTextCursor, /* icursorProc */
+ GetSelText, /* selectionProc */
+ TextInsert, /* insertProc */
+ TextDeleteChars, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateText --
+ *
+ * This procedure is invoked to create a new text item
+ * in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item then an error message is left in
+ * the interp's result; in this case itemPtr is left uninitialized
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new text item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateText(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int i = 2;
+
+ if (objc == 1) {
+ i = 1;
+ } else if (objc > 1) {
+ char *arg = Tcl_GetString(objv[1]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+
+ if (objc < i) {
+ 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->tsoffset.flags = 0;
+ textPtr->tsoffset.xoffset = 0;
+ textPtr->tsoffset.yoffset = 0;
+ textPtr->color = NULL;
+ textPtr->activeColor = NULL;
+ textPtr->disabledColor = NULL;
+ textPtr->tkfont = NULL;
+ textPtr->justify = TK_JUSTIFY_LEFT;
+ textPtr->stipple = None;
+ textPtr->activeStipple = None;
+ textPtr->disabledStipple = None;
+ textPtr->text = NULL;
+ textPtr->width = 0;
+
+ textPtr->numChars = 0;
+ textPtr->numBytes = 0;
+ textPtr->textLayout = NULL;
+ textPtr->leftEdge = 0;
+ textPtr->rightEdge = 0;
+ textPtr->gc = None;
+ textPtr->selTextGC = None;
+ textPtr->cursorOffGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((TextCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureText(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on text items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextCoords(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of coordinates supplied in objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(textPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(textPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (objc < 3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &textPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &textPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeTextBbox(canvas, textPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureText --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a text item, such as its border and background colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureText(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* 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;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) textPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ state = itemPtr->state;
+
+ if (textPtr->activeColor != NULL ||
+ textPtr->activeStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ color = textPtr->color;
+ stipple = textPtr->stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeColor!=NULL) {
+ color = textPtr->activeColor;
+ }
+ if (textPtr->activeStipple!=None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (textPtr->disabledColor!=NULL) {
+ color = textPtr->disabledColor;
+ }
+ if (textPtr->disabledStipple!=None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ newGC = newSelGC = None;
+ if (textPtr->tkfont != NULL) {
+ gcValues.font = Tk_FontId(textPtr->tkfont);
+ mask = GCFont;
+ if (color != NULL) {
+ gcValues.foreground = color->pixel;
+ mask |= GCForeground;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ mask &= ~(GCTile|GCFillStyle|GCStipple);
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ gcValues.foreground = textInfoPtr->selFgColorPtr->pixel;
+ newSelGC = Tk_GetGC(tkwin, mask|GCForeground, &gcValues);
+ }
+ 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->numBytes = strlen(textPtr->text);
+ textPtr->numChars = Tcl_NumUtfChars(textPtr->text, textPtr->numBytes);
+ if (textInfoPtr->selItemPtr == itemPtr) {
+
+ if (textInfoPtr->selectFirst >= textPtr->numChars) {
+ textInfoPtr->selItemPtr = NULL;
+ } else {
+ if (textInfoPtr->selectLast >= textPtr->numChars) {
+ textInfoPtr->selectLast = textPtr->numChars - 1;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= textPtr->numChars)) {
+ textInfoPtr->selectAnchor = textPtr->numChars - 1;
+ }
+ }
+ }
+ if (textPtr->insertPos >= textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ }
+
+ 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);
+ }
+ if (textPtr->activeColor != NULL) {
+ Tk_FreeColor(textPtr->activeColor);
+ }
+ if (textPtr->disabledColor != NULL) {
+ Tk_FreeColor(textPtr->disabledColor);
+ }
+ Tk_FreeFont(textPtr->tkfont);
+ if (textPtr->stipple != None) {
+ Tk_FreeBitmap(display, textPtr->stipple);
+ }
+ if (textPtr->activeStipple != None) {
+ Tk_FreeBitmap(display, textPtr->activeStipple);
+ }
+ if (textPtr->disabledStipple != None) {
+ Tk_FreeBitmap(display, textPtr->disabledStipple);
+ }
+ 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 bbox is to be recomputed. */
+{
+ Tk_CanvasTextInfo *textInfoPtr;
+ int leftX, topY, width, height, fudge;
+ Tk_State state = textPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ textPtr->textLayout = Tk_ComputeTextLayout(textPtr->tkfont,
+ textPtr->text, textPtr->numChars, textPtr->width,
+ textPtr->justify, 0, &width, &height);
+
+ if (state == TK_STATE_HIDDEN || textPtr->color == NULL) {
+ width = height = 0;
+ }
+
+ /*
+ * Use overall geometry information to compute the top-left corner
+ * of the bounding box for the text item.
+ */
+
+ leftX = (int) floor(textPtr->x + 0.5);
+ topY = (int) floor(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 selFirstChar, selLastChar;
+ short drawableX, drawableY;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+
+ textPtr = (TextItem *) itemPtr;
+ textInfoPtr = textPtr->textInfoPtr;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ stipple = textPtr->stipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeStipple!=None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (textPtr->disabledStipple!=None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ 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 (stipple != None) {
+ Tk_CanvasSetOffset(canvas, textPtr->gc, &textPtr->tsoffset);
+ }
+
+ selFirstChar = -1;
+ selLastChar = 0; /* lint. */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ selFirstChar = textInfoPtr->selectFirst;
+ selLastChar = textInfoPtr->selectLast;
+ if (selLastChar > textPtr->numChars) {
+ selLastChar = textPtr->numChars - 1;
+ }
+ if ((selFirstChar >= 0) && (selFirstChar <= selLastChar)) {
+ int xFirst, yFirst, hFirst;
+ int xLast, yLast, wLast;
+
+ /*
+ * Draw a special background under the selection.
+ */
+
+ Tk_CharBbox(textPtr->textLayout, selFirstChar, &xFirst, &yFirst,
+ NULL, &hFirst);
+ Tk_CharBbox(textPtr->textLayout, selLastChar, &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);
+ Tk_SetCaretPos(Tk_CanvasTkwin(canvas), drawableX, drawableY,
+ height);
+ 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 ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) {
+ Tk_DrawTextLayout(display, drawable, textPtr->selTextGC,
+ textPtr->textLayout, drawableX, drawableY, selFirstChar,
+ selLastChar + 1);
+ }
+
+ if (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, index, string)
+ Tk_Canvas canvas; /* Canvas containing text item. */
+ Tk_Item *itemPtr; /* Text item to be modified. */
+ int index; /* Character index before which string is
+ * to be inserted. */
+ char *string; /* New characters to be inserted. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteIndex, byteCount, charsAdded;
+ char *new, *text;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ string = Tcl_GetStringFromObj((Tcl_Obj *) string, &byteCount);
+
+ text = textPtr->text;
+
+ if (index < 0) {
+ index = 0;
+ }
+ if (index > textPtr->numChars) {
+ index = textPtr->numChars;
+ }
+ byteIndex = Tcl_UtfAtIndex(text, index) - text;
+ byteCount = strlen(string);
+ if (byteCount == 0) {
+ return;
+ }
+
+ new = (char *) ckalloc((unsigned) textPtr->numBytes + byteCount + 1);
+ memcpy(new, text, (size_t) byteIndex);
+ strcpy(new + byteIndex, string);
+ strcpy(new + byteIndex + byteCount, text + byteIndex);
+
+ ckfree(text);
+ textPtr->text = new;
+ charsAdded = Tcl_NumUtfChars(string, byteCount);
+ textPtr->numChars += charsAdded;
+ textPtr->numBytes += byteCount;
+
+ /*
+ * Inserting characters invalidates indices such as those for the
+ * selection and cursor. Update the indices appropriately.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst >= index) {
+ textInfoPtr->selectFirst += charsAdded;
+ }
+ if (textInfoPtr->selectLast >= index) {
+ textInfoPtr->selectLast += charsAdded;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= index)) {
+ textInfoPtr->selectAnchor += charsAdded;
+ }
+ }
+ if (textPtr->insertPos >= index) {
+ textPtr->insertPos += charsAdded;
+ }
+ ComputeTextBbox(canvas, textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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; /* Character index of first character to
+ * delete. */
+ int last; /* Character index of last character to
+ * delete (inclusive). */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteIndex, byteCount, charsRemoved;
+ char *new, *text;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ text = textPtr->text;
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= textPtr->numChars) {
+ last = textPtr->numChars - 1;
+ }
+ if (first > last) {
+ return;
+ }
+ charsRemoved = last + 1 - first;
+
+ byteIndex = Tcl_UtfAtIndex(text, first) - text;
+ byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved)
+ - (text + byteIndex);
+
+ new = (char *) ckalloc((unsigned) (textPtr->numBytes + 1 - byteCount));
+ memcpy(new, text, (size_t) byteIndex);
+ strcpy(new + byteIndex, text + byteIndex + byteCount);
+
+ ckfree(text);
+ textPtr->text = new;
+ textPtr->numChars -= charsRemoved;
+ textPtr->numBytes -= byteCount;
+
+ /*
+ * Update indexes for the selection and cursor to reflect the
+ * renumbering of the remaining characters.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst > first) {
+ textInfoPtr->selectFirst -= charsRemoved;
+ if (textInfoPtr->selectFirst < first) {
+ textInfoPtr->selectFirst = first;
+ }
+ }
+ if (textInfoPtr->selectLast >= first) {
+ textInfoPtr->selectLast -= charsRemoved;
+ if (textInfoPtr->selectLast < first - 1) {
+ textInfoPtr->selectLast = first - 1;
+ }
+ }
+ if (textInfoPtr->selectFirst > textInfoPtr->selectLast) {
+ textInfoPtr->selItemPtr = NULL;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor > first)) {
+ textInfoPtr->selectAnchor -= charsRemoved;
+ if (textInfoPtr->selectAnchor < first) {
+ textInfoPtr->selectAnchor = first;
+ }
+ }
+ }
+ if (textPtr->insertPos > first) {
+ textPtr->insertPos -= charsRemoved;
+ if (textPtr->insertPos < first) {
+ textPtr->insertPos = first;
+ }
+ }
+ ComputeTextBbox(canvas, textPtr);
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ Tk_State state = itemPtr->state;
+ double value;
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ textPtr = (TextItem *) itemPtr;
+ value = (double) Tk_DistanceToTextLayout(textPtr->textLayout,
+ (int) pointPtr[0] - textPtr->leftEdge,
+ (int) pointPtr[1] - textPtr->header.y1);
+
+ if ((state == TK_STATE_HIDDEN) || (textPtr->color == NULL) ||
+ (textPtr->text == NULL) || (*textPtr->text == 0)) {
+ value = 1.0e36;
+ }
+ return value;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ 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
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetTextIndex(interp, canvas, itemPtr, obj, 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. */
+ Tcl_Obj *obj; /* Specification of a particular character
+ * in itemPtr's text. */
+ int *indexPtr; /* Where to store converted character
+ * index. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ size_t length;
+ int c;
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+ char *string = Tcl_GetStringFromObj(obj, (int *) &length);
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
+ *indexPtr = textPtr->numChars;
+ } else if ((c == 'i') && (strncmp(string, "insert", length) == 0)) {
+ *indexPtr = textPtr->insertPos;
+ } else if ((c == 's') && (strncmp(string, "sel.first", length) == 0)
+ && (length >= 5)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectFirst;
+ } else if ((c == 's') && (strncmp(string, "sel.last", length) == 0)
+ && (length >= 5)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectLast;
+ } else if (c == '@') {
+ int x, y;
+ double tmp;
+ char *end, *p;
+
+ 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_GetIntFromObj((Tcl_Interp *)NULL, obj, 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 the interp's result,
+ * so we have to clear it out before storing our own message.
+ */
+
+ badIndex:
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "bad index \"", string, "\"",
+ (char *) NULL);
+ 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; /* Character index of character just before
+ * which cursor is to be positioned. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (index < 0) {
+ textPtr->insertPos = 0;
+ } else if (index > textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ } 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; /* Byte offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place selection. */
+ int maxBytes; /* Maximum number of bytes to place at
+ * buffer, not including terminating NULL
+ * character. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteCount;
+ char *text;
+ CONST char *selStart, *selEnd;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ if ((textInfoPtr->selectFirst < 0) ||
+ (textInfoPtr->selectFirst > textInfoPtr->selectLast)) {
+ return 0;
+ }
+ text = textPtr->text;
+ selStart = Tcl_UtfAtIndex(text, textInfoPtr->selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > maxBytes) {
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * text items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is wanted. */
+ int prepass; /* 1 means this is a prepass to collect
+ * font information; 0 means final Postscript
+ * is being created. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int x, y;
+ Tk_FontMetrics fm;
+ char *justify;
+ char buffer[500];
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ color = textPtr->color;
+ stipple = textPtr->stipple;
+ if (state == TK_STATE_HIDDEN || textPtr->color == NULL ||
+ textPtr->text == NULL || *textPtr->text == 0) {
+ return TCL_OK;
+ } else if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeColor!=NULL) {
+ color = textPtr->activeColor;
+ }
+ if (textPtr->activeStipple!=None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (textPtr->disabledColor!=NULL) {
+ color = textPtr->disabledColor;
+ }
+ if (textPtr->disabledStipple!=None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (prepass != 0) {
+ return TCL_OK;
+ }
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "/StippleText {\n ",
+ (char *) NULL);
+ Tk_CanvasPsStipple(interp, canvas, 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,
+ ((stipple == None) ? "false" : "true"));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkCanvUtil.c b/tcl/generic/tkCanvUtil.c
new file mode 100644
index 00000000000..50594016940
--- /dev/null
+++ b/tcl/generic/tkCanvUtil.c
@@ -0,0 +1,1481 @@
+/*
+ * 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 "tkInt.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
+ * the interp's 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. */
+ CONST 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_CanvasGetCoordFromObj --
+ *
+ * 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_CanvasGetCoordFromObj(interp, canvas, obj, doublePtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to which coordinate applies. */
+ Tcl_Obj *obj; /* Describes coordinate (any screen
+ * coordinate form may be used here). */
+ double *doublePtr; /* Place to store converted coordinate. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if (Tk_GetMMFromObj(canvasPtr->interp, canvasPtr->tkwin, obj,
+ 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_CanvasSetOffset--
+ *
+ * This procedure sets the stipple offset in a graphics
+ * context so that stipples drawn with the GC will
+ * line up with other stipples with the same offset.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The graphics context is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasSetOffset(canvas, gc, offset)
+ 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. */
+ Tk_TSOffset *offset; /* offset (may be NULL pointer)*/
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ int flags = 0;
+ int x = - canvasPtr->drawableXOrigin;
+ int y = - canvasPtr->drawableYOrigin;
+
+ if (offset != NULL) {
+ flags = offset->flags;
+ x += offset->xoffset;
+ y += offset->yoffset;
+ }
+ if ((flags & TK_OFFSET_RELATIVE) && !(flags & TK_OFFSET_INDEX)) {
+ Tk_SetTSOrigin(canvasPtr->tkwin, gc, x - canvasPtr->xOrigin,
+ y - canvasPtr->yOrigin);
+ } else {
+ XSetTSOrigin(canvasPtr->display, gc, x, y);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ CONST 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;
+ CONST 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, (CONST char **) itemPtr->tagPtr);
+}
+
+
+static int DashConvert _ANSI_ARGS_((char *l, CONST char *p,
+ int n, double width));
+#define ABS(a) ((a>=0)?(a):(-(a)))
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvasDashParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * "-dash", "-activedash" and "-disableddash" options for canvas
+ * objects.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The dash list for a given canvas object gets replaced by
+ * those indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCanvasDashParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ return Tk_GetDash(interp, value, (Tk_Dash *)(widgRec+offset));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvasDashPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-dash", "-activedash"
+ * and "-disableddash" configuration options for canvas items.
+ *
+ * Results:
+ * The return value is a string describing all the dash list for
+ * the item referred to by "widgRec"and "offset". 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 *
+TkCanvasDashPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset in record for item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ Tk_Dash *dash = (Tk_Dash *) (widgRec+offset);
+ char *buffer;
+ char *p;
+ int i = dash->number;
+
+ if (i < 0) {
+ i = -i;
+ *freeProcPtr = TCL_DYNAMIC;
+ buffer = (char *) ckalloc((unsigned int) (i+1));
+ p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ memcpy(buffer, p, (unsigned int) i);
+ buffer[i] = 0;
+ return buffer;
+ } else if (!i) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return "";
+ }
+ buffer = (char *)ckalloc((unsigned int) (4*i));
+ *freeProcPtr = TCL_DYNAMIC;
+
+ p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ sprintf(buffer, "%d", *p++ & 0xff);
+ while(--i) {
+ sprintf(buffer+strlen(buffer), " %d", *p++ & 0xff);
+ }
+ return buffer;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateSmoothMethod --
+ *
+ * This procedure is invoked to add additional values
+ * for the "-smooth" option to the list.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * In the future "-smooth <name>" will be accepted as
+ * smooth method for the line and polygon.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_SmoothMethod tkBezierSmoothMethod = {
+ "bezier",
+ TkMakeBezierCurve,
+ (void (*) _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas,
+ double *coordPtr, int numPoints, int numSteps)))
+ TkMakeBezierPostscript,
+};
+
+static void SmoothMethodCleanupProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp));
+
+typedef struct SmoothAssocData {
+ struct SmoothAssocData *nextPtr; /* pointer to next SmoothAssocData */
+ Tk_SmoothMethod smooth; /* name and functions associated with this
+ * option */
+} SmoothAssocData;
+
+void
+Tk_CreateSmoothMethod(interp, smooth)
+ Tcl_Interp *interp;
+ Tk_SmoothMethod *smooth;
+{
+ SmoothAssocData *methods, *typePtr2, *prevPtr, *ptr;
+ methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod",
+ (Tcl_InterpDeleteProc **) NULL);
+
+ /*
+ * If there's already a smooth method with the given name, remove it.
+ */
+
+ for (typePtr2 = methods, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (!strcmp(typePtr2->smooth.name, smooth->name)) {
+ if (prevPtr == NULL) {
+ methods = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ ckfree((char *) typePtr2);
+ break;
+ }
+ }
+ ptr = (SmoothAssocData *) ckalloc(sizeof(SmoothAssocData));
+ ptr->smooth.name = smooth->name;
+ ptr->smooth.coordProc = smooth->coordProc;
+ ptr->smooth.postscriptProc = smooth->postscriptProc;
+ ptr->nextPtr = methods;
+ Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc,
+ (ClientData) ptr);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * SmoothMethodCleanupProc --
+ *
+ * This procedure is invoked whenever an interpreter is deleted
+ * to cleanup the smooth methods.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Smooth methods are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SmoothMethodCleanupProc(clientData, interp)
+ ClientData clientData; /* Points to "smoothMethod" AssocData
+ * for the interpreter. */
+ Tcl_Interp *interp; /* Interpreter that is being deleted. */
+{
+ SmoothAssocData *ptr, *methods = (SmoothAssocData *) clientData;
+
+ while (methods != NULL) {
+ methods = (ptr = methods)->nextPtr;
+ ckfree((char *) ptr);
+ }
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSmoothParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-smooth" option.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The smooth option for a given item gets replaced by the value
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkSmoothParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ register Tk_SmoothMethod **smoothPtr =
+ (Tk_SmoothMethod **) (widgRec + offset);
+ Tk_SmoothMethod *smooth = NULL;
+ int b;
+ size_t length;
+ SmoothAssocData *methods;
+
+ if (value == NULL || *value == 0) {
+ *smoothPtr = (Tk_SmoothMethod *) NULL;
+ return TCL_OK;
+ }
+ length = strlen(value);
+ methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod",
+ (Tcl_InterpDeleteProc **) NULL);
+ while (methods != (SmoothAssocData *) NULL) {
+ if (strncmp(value, methods->smooth.name, length) == 0) {
+ if (smooth != (Tk_SmoothMethod *) NULL) {
+ Tcl_AppendResult(interp, "ambigeous smooth method \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ smooth = &methods->smooth;
+ }
+ methods = methods->nextPtr;
+ }
+ if (smooth) {
+ *smoothPtr = smooth;
+ return TCL_OK;
+ } else if (strncmp(value, tkBezierSmoothMethod.name, length) == 0) {
+ /*
+ * We need to do handle the built-in bezier method.
+ */
+ *smoothPtr = &tkBezierSmoothMethod;
+ return TCL_OK;
+ }
+
+
+ if (Tcl_GetBoolean(interp, (char *) value, &b) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *smoothPtr = b ? &tkBezierSmoothMethod : (Tk_SmoothMethod*) NULL;
+ return TCL_OK;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSmoothPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-smooth"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the smooth option 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 *
+TkSmoothPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Tk_SmoothMethod **smoothPtr = (Tk_SmoothMethod **) (widgRec + offset);
+
+ return (*smoothPtr) ? (*smoothPtr)->name : "0";
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetDash
+ *
+ * This procedure is used to parse a string, assuming
+ * it is dash information.
+ *
+ * Results:
+ * The return value is a standard Tcl result: TCL_OK means
+ * that the dash information was parsed ok, and
+ * TCL_ERROR means it couldn't be parsed.
+ *
+ * Side effects:
+ * Dash information in the dash structure is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetDash(interp, value, dash)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ CONST char *value; /* Textual specification of dash list. */
+ Tk_Dash *dash; /* Pointer to record in which to
+ * store dash information. */
+{
+ int argc, i;
+ CONST char **largv, **argv = NULL;
+ char *pt;
+
+ if ((value==(char *) NULL) || (*value==0) ) {
+ dash->number = 0;
+ return TCL_OK;
+ }
+ if ((*value == '.') || (*value == ',') ||
+ (*value == '-') || (*value == '_')) {
+ i = DashConvert((char *) NULL, value, -1, 0.0);
+ if (i>0) {
+ i = strlen(value);
+ } else {
+ goto badDashList;
+ }
+ if (i > sizeof(char *)) {
+ dash->pattern.pt = pt = (char *) ckalloc(strlen(value));
+ } else {
+ pt = dash->pattern.array;
+ }
+ memcpy(pt,value, (unsigned int) i);
+ dash->number = -i;
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ badDashList:
+ Tcl_AppendResult(interp, "bad dash list \"", value,
+ "\": must be a list of integers or a format like \"-..\"",
+ (char *) NULL);
+ syntaxError:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ if (ABS(dash->number) > sizeof(char *))
+ ckfree((char *) dash->pattern.pt);
+ dash->number = 0;
+ return TCL_ERROR;
+ }
+
+ if (ABS(dash->number) > sizeof(char *)) {
+ ckfree((char *) dash->pattern.pt);
+ }
+ if (argc > sizeof(char *)) {
+ dash->pattern.pt = pt = (char *) ckalloc((unsigned int) argc);
+ } else {
+ pt = dash->pattern.array;
+ }
+ dash->number = argc;
+
+ largv = argv;
+ while(argc>0) {
+ if (Tcl_GetInt(interp, *largv, &i) != TCL_OK ||
+ i < 1 || i>255) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "expected integer in the range 1..255 but got \"",
+ *largv, "\"", (char *) NULL);
+ goto syntaxError;
+ }
+ *pt++ = i;
+ argc--; largv++;
+ }
+
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateOutline
+ *
+ * This procedure initializes the Tk_Outline structure
+ * with default values.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+void Tk_CreateOutline(outline)
+ Tk_Outline *outline;
+{
+ outline->gc = None;
+ outline->width = 1.0;
+ outline->activeWidth = 0.0;
+ outline->disabledWidth = 0.0;
+ outline->offset = 0;
+ outline->dash.number = 0;
+ outline->activeDash.number = 0;
+ outline->disabledDash.number = 0;
+ outline->tsoffset.flags = 0;
+ outline->tsoffset.xoffset = 0;
+ outline->tsoffset.yoffset = 0;
+ outline->color = NULL;
+ outline->activeColor = NULL;
+ outline->disabledColor = NULL;
+ outline->stipple = None;
+ outline->activeStipple = None;
+ outline->disabledStipple = None;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteOutline
+ *
+ * This procedure frees all memory that might be
+ * allocated and referenced in the Tk_Outline structure.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+void Tk_DeleteOutline(display, outline)
+ Display *display; /* Display containing window */
+ Tk_Outline *outline;
+{
+ if (outline->gc != None) {
+ Tk_FreeGC(display, outline->gc);
+ }
+ if (ABS(outline->dash.number) > sizeof(char *)) {
+ ckfree((char *) outline->dash.pattern.pt);
+ }
+ if (ABS(outline->activeDash.number) > sizeof(char *)) {
+ ckfree((char *) outline->activeDash.pattern.pt);
+ }
+ if (ABS(outline->disabledDash.number) > sizeof(char *)) {
+ ckfree((char *) outline->disabledDash.pattern.pt);
+ }
+ if (outline->color != NULL) {
+ Tk_FreeColor(outline->color);
+ }
+ if (outline->activeColor != NULL) {
+ Tk_FreeColor(outline->activeColor);
+ }
+ if (outline->disabledColor != NULL) {
+ Tk_FreeColor(outline->disabledColor);
+ }
+ if (outline->stipple != None) {
+ Tk_FreeBitmap(display, outline->stipple);
+ }
+ if (outline->activeStipple != None) {
+ Tk_FreeBitmap(display, outline->activeStipple);
+ }
+ if (outline->disabledStipple != None) {
+ Tk_FreeBitmap(display, outline->disabledStipple);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigOutlineGC
+ *
+ * This procedure should be called in the canvas object
+ * during the configure command. The graphics context
+ * description in gcValues is updated according to the
+ * information in the dash structure, as far as possible.
+ *
+ * Results:
+ * The return-value is a mask, indicating which
+ * elements of gcValues have been updated.
+ * 0 means there is no outline.
+ *
+ * Side effects:
+ * GC information in gcValues is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int Tk_ConfigOutlineGC(gcValues, canvas, item, outline)
+ XGCValues *gcValues;
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ int mask = 0;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ if (outline->width < 0.0) {
+ outline->width = 0.0;
+ }
+ if (outline->activeWidth < 0.0) {
+ outline->activeWidth = 0.0;
+ }
+ if (outline->disabledWidth < 0) {
+ outline->disabledWidth = 0.0;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ return 0;
+ }
+
+ width = outline->width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth>width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number != 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor!=NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple!=None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (outline->disabledWidth>0) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number != 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor!=NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple!=None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+
+ if (color==NULL) {
+ return 0;
+ }
+
+ gcValues->line_width = (int) (width + 0.5);
+ if (color != NULL) {
+ gcValues->foreground = color->pixel;
+ mask = GCForeground|GCLineWidth;
+ if (stipple != None) {
+ gcValues->stipple = stipple;
+ gcValues->fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ }
+ if (mask && (dash->number != 0)) {
+ gcValues->line_style = LineOnOffDash;
+ gcValues->dash_offset = outline->offset;
+ if (dash->number >= 2) {
+ gcValues->dashes = 4;
+ } else if (dash->number > 0) {
+ gcValues->dashes = dash->pattern.array[0];
+ } else {
+ gcValues->dashes = (char) (4 * width);
+ }
+ mask |= GCLineStyle|GCDashList|GCDashOffset;
+ }
+ return mask;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ChangeOutlineGC
+ *
+ * Updates the GC to represent the full information of
+ * the dash structure. Partly this is already done in
+ * Tk_ConfigOutlineGC().
+ * This function should be called just before drawing
+ * the dashed item.
+ *
+ * Results:
+ * 1 if there is a stipple pattern.
+ * 0 otherwise.
+ *
+ * Side effects:
+ * GC is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ChangeOutlineGC(canvas, item, outline)
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ CONST char *p;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ width = outline->width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth > width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number != 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor != NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple != None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (outline->disabledWidth > width) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number != 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor != NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple != None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+ if (color==NULL) {
+ return 0;
+ }
+
+ if ((dash->number<-1) || ((dash->number == -1) && (dash->pattern.array[1]!=','))) {
+ char *q;
+ int i = -dash->number;
+
+ p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ q = (char *) ckalloc(2*(unsigned int)i);
+ i = DashConvert(q, p, i, width);
+ XSetDashes(((TkCanvas *)canvas)->display, outline->gc, outline->offset, q, i);
+ ckfree(q);
+ } else if ( dash->number>2 || (dash->number==2 &&
+ (dash->pattern.array[0]!=dash->pattern.array[1]))) {
+ p = (char *) (dash->number > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ XSetDashes(((TkCanvas *)canvas)->display, outline->gc, outline->offset, p, dash->number);
+ }
+ if (stipple!=None) {
+ int w=0; int h=0;
+ Tk_TSOffset *tsoffset = &outline->tsoffset;
+ int flags = tsoffset->flags;
+ if (!(flags & TK_OFFSET_INDEX) && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) {
+ Tk_SizeOfBitmap(((TkCanvas *)canvas)->display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, outline->gc, tsoffset);
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ return 1;
+ }
+ return 0;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ResetOutlineGC
+ *
+ * Restores the GC to the situation before
+ * Tk_ChangeDashGC() was called.
+ * This function should be called just after the dashed
+ * item is drawn, because the GC is supposed to be
+ * read-only.
+ *
+ * Results:
+ * 1 if there is a stipple pattern.
+ * 0 otherwise.
+ *
+ * Side effects:
+ * GC is updated.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tk_ResetOutlineGC(canvas, item, outline)
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ char dashList;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ width = outline->width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth>width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number != 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor!=NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple!=None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (outline->disabledWidth>width) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number != 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor!=NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple!=None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+ if (color==NULL) {
+ return 0;
+ }
+
+ if ((dash->number > 2) || (dash->number < -1) || (dash->number==2 &&
+ (dash->pattern.array[0] != dash->pattern.array[1])) ||
+ ((dash->number == -1) && (dash->pattern.array[1] != ','))) {
+ if (dash->number < 0) {
+ dashList = (int) (4 * width + 0.5);
+ } else if (dash->number<3) {
+ dashList = dash->pattern.array[0];
+ } else {
+ dashList = 4;
+ }
+ XSetDashes(((TkCanvas *)canvas)->display, outline->gc,
+ outline->offset, &dashList , 1);
+ }
+ if (stipple != None) {
+ XSetTSOrigin(((TkCanvas *)canvas)->display, outline->gc, 0, 0);
+ return 1;
+ }
+ return 0;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsOutline
+ *
+ * Creates the postscript command for the correct
+ * Outline-information (width, dash, color and stipple).
+ *
+ * Results:
+ * TCL_OK if succeeded, otherwise TCL_ERROR.
+ *
+ * Side effects:
+ * canvas->interp->result contains the postscript string,
+ * or an error message if the result was TCL_ERROR.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tk_CanvasPsOutline(canvas, item, outline)
+ Tk_Canvas canvas;
+ Tk_Item *item;
+ Tk_Outline *outline;
+{
+ char string[41];
+ char pattern[11];
+ int i;
+ char *ptr;
+ char *str = string;
+ char *lptr = pattern;
+ Tcl_Interp *interp = ((TkCanvas *)canvas)->interp;
+ double width;
+ Tk_Dash *dash;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = item->state;
+
+ width = outline->width;
+ dash = &(outline->dash);
+ color = outline->color;
+ stipple = outline->stipple;
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == item) {
+ if (outline->activeWidth > width) {
+ width = outline->activeWidth;
+ }
+ if (outline->activeDash.number > 0) {
+ dash = &(outline->activeDash);
+ }
+ if (outline->activeColor != NULL) {
+ color = outline->activeColor;
+ }
+ if (outline->activeStipple != None) {
+ stipple = outline->activeStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (outline->disabledWidth > 0) {
+ width = outline->disabledWidth;
+ }
+ if (outline->disabledDash.number > 0) {
+ dash = &(outline->disabledDash);
+ }
+ if (outline->disabledColor != NULL) {
+ color = outline->disabledColor;
+ }
+ if (outline->disabledStipple != None) {
+ stipple = outline->disabledStipple;
+ }
+ }
+ sprintf(string, "%.15g setlinewidth\n", width);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+
+ if (dash->number > 10) {
+ str = (char *)ckalloc((unsigned int) (1 + 4*dash->number));
+ } else if (dash->number < -5) {
+ str = (char *)ckalloc((unsigned int) (1 - 8*dash->number));
+ lptr = (char *)ckalloc((unsigned int) (1 - 2*dash->number));
+ }
+ ptr = (char *) ((ABS(dash->number) > sizeof(char *)) ) ?
+ dash->pattern.pt : dash->pattern.array;
+ if (dash->number > 0) {
+ char *ptr0 = ptr;
+ sprintf(str, "[%d", *ptr++ & 0xff);
+ i = dash->number-1;
+ while (i--) {
+ sprintf(str+strlen(str), " %d", *ptr++ & 0xff);
+ }
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ if (dash->number&1) {
+ Tcl_AppendResult(interp, " ", str+1, (char *)NULL);
+ }
+ sprintf(str, "] %d setdash\n", outline->offset);
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ ptr = ptr0;
+ } else if (dash->number < 0) {
+ if ((i = DashConvert(lptr, ptr, -dash->number, width)) != 0) {
+ char *lptr0 = lptr;
+ sprintf(str, "[%d", *lptr++ & 0xff);
+ while (--i) {
+ sprintf(str+strlen(str), " %d", *lptr++ & 0xff);
+ }
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ sprintf(str, "] %d setdash\n", outline->offset);
+ Tcl_AppendResult(interp, str, (char *)NULL);
+ lptr = lptr0;
+ } else {
+ Tcl_AppendResult(interp, "[] 0 setdash\n", (char *)NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "[] 0 setdash\n", (char *)NULL);
+ }
+ if (str != string) {
+ ckfree(str);
+ }
+ if (lptr != pattern) {
+ ckfree(lptr);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DashConvert
+ *
+ * Converts a character-like dash-list (e.g. "-..")
+ * into an X11-style. l must point to a string that
+ * holds room to at least 2*n characters. if
+ * l == NULL, this function can be used for
+ * syntax checking only.
+ *
+ * Results:
+ * The length of the resulting X11 compatible
+ * dash-list. -1 if failed.
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DashConvert (l, p, n, width)
+ char *l;
+ CONST char *p;
+ int n;
+ double width;
+{
+ int result = 0;
+ int size, intWidth;
+
+ if (n<0) {
+ n = strlen(p);
+ }
+ intWidth = (int) (width + 0.5);
+ if (intWidth < 1) {
+ intWidth = 1;
+ }
+ while (n-- && *p) {
+ switch (*p++) {
+ case ' ':
+ if (result) {
+ if (l) {
+ l[-1] += intWidth + 1;
+ }
+ continue;
+ } else {
+ return 0;
+ }
+ break;
+ case '_':
+ size = 8;
+ break;
+ case '-':
+ size = 6;
+ break;
+ case ',':
+ size = 4;
+ break;
+ case '.':
+ size = 2;
+ break;
+ default:
+ return -1;
+ }
+ if (l) {
+ *l++ = size * intWidth;
+ *l++ = 4 * intWidth;
+ }
+ result += 2;
+ }
+ return result;
+}
diff --git a/tcl/generic/tkCanvWind.c b/tcl/generic/tkCanvWind.c
new file mode 100644
index 00000000000..af18628a888
--- /dev/null
+++ b/tcl/generic/tkCanvWind.c
@@ -0,0 +1,1100 @@
+/*
+ * 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 stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) 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, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {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 objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateWinItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+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 objc,
+ Tcl_Obj *CONST objv[]));
+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 int WinItemToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static double WinItemToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+#ifdef X_GetImage
+static int xerrorhandler _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *e));
+#endif
+static int CanvasPsWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Canvas canvas, double x,
+ double y, int width, int height));
+
+/*
+ * 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|TK_CONFIG_OBJS, /* flags */
+ WinItemToPoint, /* pointProc */
+ WinItemToArea, /* areaProc */
+ WinItemToPostscript, /* 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
+ * the interp's result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new window item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateWinItem(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing window. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int i = 2;
+
+ if (objc == 1) {
+ i = 1;
+ } else if (objc > 1) {
+ char *arg = Tcl_GetString(objv[1]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+
+ if (objc < i) {
+ 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 ((WinItemCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureWinItem(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on window items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemCoords(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(winItemPtr->x);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(winItemPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if (objc < 3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &winItemPtr->x)
+ != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &winItemPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureWinItem --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a window item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureWinItem(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Window item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* 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 (TCL_OK != Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) winItemPtr, flags|TK_CONFIG_OBJS)) {
+ 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-of-hierarchy 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_HIERARCHY) {
+ 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_HIERARCHY) {
+ 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;
+ Tk_State state = winItemPtr->header.state;
+
+ x = (int) (winItemPtr->x + ((winItemPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (winItemPtr->y + ((winItemPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if ((winItemPtr->tkwin == NULL) || (state == TK_STATE_HIDDEN)) {
+ /*
+ * 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);
+ Tk_State state = itemPtr->state;
+
+ if (winItemPtr->tkwin == NULL) {
+ return;
+ }
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state == TK_STATE_HIDDEN) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ 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
+ * window, 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 window.
+ */
+
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * xerrorhandler --
+ *
+ * This is a dummy function to catch X11 errors during an
+ * attempt to print a canvas window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+#ifdef X_GetImage
+static int
+xerrorhandler(clientData, e)
+ ClientData clientData;
+ XErrorEvent *e;
+{
+ return 0;
+}
+#endif
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * window 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
+WinItemToPostscript(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.*/
+{
+ WindowItem *winItemPtr = (WindowItem *)itemPtr;
+
+ double x, y;
+ int width, height;
+ Tk_Window tkwin = winItemPtr->tkwin;
+
+ if (prepass || winItemPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ width = Tk_Width(tkwin);
+ height = Tk_Height(tkwin);
+
+ /*
+ * Compute the coordinates of the lower-left corner of the window,
+ * taking into account the anchor position for the window.
+ */
+
+ x = winItemPtr->x;
+ y = Tk_CanvasPsY(canvas, winItemPtr->y);
+
+ switch (winItemPtr->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;
+ }
+
+ return CanvasPsWindow(interp, tkwin, canvas, x, y, width, height);
+}
+
+static int
+CanvasPsWindow(interp, tkwin, canvas, x, y, width, height)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Window tkwin; /* window to be printed */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ double x, y; /* origin of window. */
+ int width, height; /* width/height of window. */
+{
+ char buffer[256];
+ TkWindow *winPtr;
+ XImage *ximage;
+ int result;
+ Tcl_DString buffer1, buffer2;
+#ifdef X_GetImage
+ Tk_ErrorHandler handle;
+#endif
+
+ sprintf(buffer, "\n%%%% %s item (%s, %d x %d)\n%.15g %.15g translate\n",
+ Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ /* first try if the widget has its own "postscript" command. If it
+ * exists, this will produce much better postscript than
+ * when a pixmap is used.
+ */
+
+ Tcl_DStringInit(&buffer1);
+ Tcl_DStringInit(&buffer2);
+ Tcl_DStringGetResult(interp, &buffer2);
+ sprintf (buffer, "%s postscript -prolog 0\n", Tk_PathName(tkwin));
+ result = Tcl_Eval(interp, buffer);
+ Tcl_DStringGetResult(interp, &buffer1);
+ Tcl_DStringResult(interp, &buffer2);
+ Tcl_DStringFree(&buffer2);
+
+ if (result == TCL_OK) {
+ Tcl_AppendResult(interp,
+ "50 dict begin\nsave\ngsave\n",
+ (char *) NULL);
+ sprintf (buffer,
+ "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d",
+ height, width, height, width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ Tcl_AppendResult(interp, " 0 rlineto closepath\n",
+ "1.000 1.000 1.000 setrgbcolor AdjustColor\nfill\ngrestore\n",
+ Tcl_DStringValue(&buffer1), "\nrestore\nend\n\n\n",
+ (char *) NULL);
+ Tcl_DStringFree(&buffer1);
+
+ for (winPtr = ((TkWindow *) tkwin)->childList; winPtr != NULL;
+ winPtr = winPtr->nextPtr) {
+ if (Tk_IsMapped(winPtr)) {
+/* printf("child window: %s\n", winPtr->pathName);*/
+ }
+ }
+ return result;
+ }
+ Tcl_DStringFree(&buffer1);
+
+ /*
+ * If the window is off the screen it will generate an BadMatch/XError
+ * We catch any BadMatch errors here
+ */
+#ifdef X_GetImage
+ handle = Tk_CreateErrorHandler(Tk_Display(tkwin), BadMatch,
+ X_GetImage, -1, xerrorhandler, (ClientData) tkwin);
+#endif
+
+ /*
+ * Generate an XImage from the window. We can then read pixel
+ * values out of the XImage.
+ */
+
+ ximage = XGetImage(Tk_Display(tkwin), Tk_WindowId(tkwin), 0, 0,
+ (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap);
+
+#ifdef X_GetImage
+ Tk_DeleteErrorHandler(handle);
+#endif
+
+ if (ximage == (XImage*) NULL) {
+ return TCL_OK;
+ }
+
+ result = TkPostscriptImage(interp, tkwin,
+ ((TkCanvas *)canvas)->psInfo, ximage, 0, 0, width, height);
+
+ XDestroyImage(ximage);
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWinItem --
+ *
+ * This procedure is invoked to rescale a window item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window 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 window. */
+ Tk_Item *itemPtr; /* Window to be scaled. */
+ double originX, originY; /* Origin about which to scale window. */
+ 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 window by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the window 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/tcl/generic/tkCanvas.c b/tcl/generic/tkCanvas.c
new file mode 100644
index 00000000000..089ee3398a3
--- /dev/null
+++ b/tcl/generic/tkCanvas.c
@@ -0,0 +1,5704 @@
+/*
+ * tkCanvas.c --
+ *
+ * This module implements canvas widgets for the Tk toolkit.
+ * A canvas displays a background and a collection of graphical
+ * objects such as rectangles, lines, and texts.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/* #define USE_OLD_TAG_SEARCH 1 */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+#ifdef USE_OLD_TAG_SEARCH
+/*
+ * 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;
+
+#else /* USE_OLD_TAG_SEARCH */
+/*
+ * The structure defined below is used to keep track of a tag search
+ * in progress. No field should be accessed by anyone other than
+ * TagSearchScan, TagSearchFirst, TagSearchNext,
+ * TagSearchScanExpr, TagSearchEvalExpr,
+ * TagSearchExprInit, TagSearchExprDestroy,
+ * TagSearchDestroy.
+ * (
+ * Not quite accurate: the TagSearch structure is also accessed from:
+ * CanvasWidgetCmd, FindItems, RelinkItems
+ * The only instances of the structure are owned by:
+ * CanvasWidgetCmd
+ * CanvasWidgetCmd is the only function that calls:
+ * FindItems, RelinkItems
+ * CanvasWidgetCmd, FindItems, RelinkItems, are the only functions that call
+ * TagSearch*
+ * )
+ */
+
+typedef struct TagSearch {
+ TkCanvas *canvasPtr; /* Canvas widget being searched. */
+ 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. */
+ int type; /* search type */
+ int id; /* item id for searches by id */
+
+ char *string; /* tag expression string */
+ int stringIndex; /* current position in string scan */
+ int stringLength; /* length of tag expression string */
+
+ char *rewritebuffer; /* tag string (after removing escapes) */
+ unsigned int rewritebufferAllocated; /* available space for rewrites */
+
+ TagSearchExpr *expr; /* compiled tag expression */
+} TagSearch;
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * Custom option for handling "-state" and "-offset"
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc,
+ (ClientData) NULL /* only "normal" and "disabled" */
+};
+
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc,
+ (ClientData) TK_OFFSET_RELATIVE
+};
+
+/*
+ * 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_CUSTOM, "-offset", "offset", "Offset", "0,0",
+ Tk_Offset(TkCanvas, tsoffset),TK_CONFIG_DONT_SET_DEFAULT,
+ &offsetOption},
+ {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_CUSTOM, "-state", "state", "State",
+ "normal", Tk_Offset(TkCanvas, canvas_state), TK_CONFIG_DONT_SET_DEFAULT,
+ &stateOption},
+ {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. */
+
+#ifndef USE_OLD_TAG_SEARCH
+/*
+ * Uids for operands in compiled advanced tag search expressions
+ * Initialization is done by InitCanvas()
+ */
+static Tk_Uid allUid = NULL;
+static Tk_Uid currentUid = NULL;
+static Tk_Uid andUid = NULL;
+static Tk_Uid orUid = NULL;
+static Tk_Uid xorUid = NULL;
+static Tk_Uid parenUid = NULL;
+static Tk_Uid negparenUid = NULL;
+static Tk_Uid endparenUid = NULL;
+static Tk_Uid tagvalUid = NULL;
+static Tk_Uid negtagvalUid = NULL;
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * Standard item types provided by Tk:
+ */
+
+extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
+extern Tk_ItemType tkOvalType, tkPolygonType;
+extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType;
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void CanvasBindProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void CanvasBlinkProc _ANSI_ARGS_((ClientData clientData));
+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, Tcl_Obj *CONST *argv));
+static void CanvasWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int ConfigureCanvas _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *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 void EventuallyRedrawItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr));
+#ifdef USE_OLD_TAG_SEARCH
+static int FindItems _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
+ Tcl_Obj *newTagObj, int first));
+#else /* USE_OLD_TAG_SEARCH */
+static int FindItems _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, Tcl_Obj *CONST *argv,
+ Tcl_Obj *newTagObj, int first,
+ TagSearch **searchPtrPtr));
+#endif /* USE_OLD_TAG_SEARCH */
+static int FindArea _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, Tcl_Obj *CONST *argv, Tk_Uid uid,
+ int enclosed));
+static double GridAlign _ANSI_ARGS_((double coord, double spacing));
+static CONST char** GetStringsFromObjs _ANSI_ARGS_((int argc,
+ Tcl_Obj *CONST *objv));
+static void InitCanvas _ANSI_ARGS_((void));
+#ifdef USE_OLD_TAG_SEARCH
+static Tk_Item * NextItem _ANSI_ARGS_((TagSearch *searchPtr));
+#endif /* USE_OLD_TAG_SEARCH */
+static void PickCurrentItem _ANSI_ARGS_((TkCanvas *canvasPtr,
+ XEvent *eventPtr));
+static Tcl_Obj * ScrollFractions _ANSI_ARGS_((int screen1,
+ int screen2, int object1, int object2));
+#ifdef USE_OLD_TAG_SEARCH
+static void RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, Tk_Item *prevPtr));
+static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, TagSearch *searchPtr));
+#else /* USE_OLD_TAG_SEARCH */
+static int RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, Tk_Item *prevPtr,
+ TagSearch **searchPtrPtr));
+static void TagSearchExprInit _ANSI_ARGS_ ((
+ TagSearchExpr **exprPtrPtr));
+static void TagSearchExprDestroy _ANSI_ARGS_((TagSearchExpr *expr));
+static void TagSearchDestroy _ANSI_ARGS_((TagSearch *searchPtr));
+static int TagSearchScan _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tag, TagSearch **searchPtrPtr));
+static int TagSearchScanExpr _ANSI_ARGS_((Tcl_Interp *interp,
+ TagSearch *searchPtr, TagSearchExpr *expr));
+static int TagSearchEvalExpr _ANSI_ARGS_((TagSearchExpr *expr,
+ Tk_Item *itemPtr));
+static Tk_Item * TagSearchFirst _ANSI_ARGS_((TagSearch *searchPtr));
+static Tk_Item * TagSearchNext _ANSI_ARGS_((TagSearch *searchPtr));
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * The structure below defines canvas class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs canvasClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ CanvasWorldChanged, /* worldChangedProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasObjCmd --
+ *
+ * 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_CanvasObjCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkCanvas *canvasPtr;
+ Tk_Window new;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ if (argc < 2) {
+ Tcl_WrongNumArgs(interp, 1, argv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin,
+ Tcl_GetString(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_CreateObjCommand(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->psInfo = NULL;
+ canvasPtr->canvas_state = TK_STATE_NORMAL;
+ canvasPtr->tsoffset.flags = 0;
+ canvasPtr->tsoffset.xoffset = 0;
+ canvasPtr->tsoffset.yoffset = 0;
+#ifndef USE_OLD_TAG_SEARCH
+ canvasPtr->bindTagExprs = NULL;
+#endif
+ Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS);
+
+ Tk_SetClass(canvasPtr->tkwin, "Canvas");
+ Tk_SetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ CanvasEventProc, (ClientData) canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
+ |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
+ |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
+ CanvasBindProc, (ClientData) canvasPtr);
+ Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
+ CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING);
+ if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(canvasPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ unsigned int length;
+ int c, result;
+ Tk_Item *itemPtr = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#else /* USE_OLD_TAG_SEARCH */
+ TagSearch *searchPtr = NULL; /* Allocated by first TagSearchScan
+ * Freed by TagSearchDestroy */
+#endif /* USE_OLD_TAG_SEARCH */
+
+ int index;
+ static CONST char *optionStrings[] = {
+ "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", "yview",
+ NULL
+ };
+ enum options {
+ CANV_ADDTAG, CANV_BBOX, CANV_BIND, CANV_CANVASX,
+ CANV_CANVASY, CANV_CGET, CANV_CONFIGURE, CANV_COORDS,
+ CANV_CREATE, CANV_DCHARS, CANV_DELETE, CANV_DTAG,
+ CANV_FIND, CANV_FOCUS, CANV_GETTAGS, CANV_ICURSOR,
+ CANV_INDEX, CANV_INSERT, CANV_ITEMCGET, CANV_ITEMCONFIGURE,
+ CANV_LOWER, CANV_MOVE, CANV_POSTSCRIPT,CANV_RAISE,
+ CANV_SCALE, CANV_SCAN, CANV_SELECT, CANV_TYPE,
+ CANV_XVIEW, CANV_YVIEW
+ };
+
+ if (argc < 2) {
+ Tcl_WrongNumArgs(interp, 1, argv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, argv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) canvasPtr);
+
+ result = TCL_OK;
+ switch ((enum options) index) {
+ case CANV_ADDTAG: {
+ if (argc < 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tag searchCommand ?arg arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3);
+#else /* USE_OLD_TAG_SEARCH */
+ result = FindItems(interp, canvasPtr, argc, argv, argv[2], 3, &searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+
+ case CANV_BBOX: {
+ int i, gotAny;
+ int x1 = 0, y1 = 0, x2 = 0, y2 = 0; /* Initializations needed
+ * only to prevent compiler
+ * warnings. */
+
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagOrId ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ gotAny = 0;
+ for (i = 2; i < argc; i++) {
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_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) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", x1, y1, x2, y2);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ break;
+ }
+ case CANV_BIND: {
+ ClientData object;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?sequence? ?command?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Figure out what object to use for the binding (individual
+ * item vs. tag).
+ */
+
+ object = 0;
+#ifdef USE_OLD_TAG_SEARCH
+ if (isdigit(UCHAR(Tcl_GetString(argv[2])[0]))) {
+ int id;
+ char *end;
+ Tcl_HashEntry *entryPtr;
+
+ id = strtoul(Tcl_GetString(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 \"", Tcl_GetString(argv[2]),
+ "\" doesn't exist", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ bindByTag:
+ object = (ClientData) Tk_GetUid(Tcl_GetString(argv[2]));
+ }
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ if (searchPtr->type == 1) {
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) searchPtr->id);
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);
+ object = (ClientData) itemPtr;
+ }
+
+ if (object == 0) {
+ Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
+ "\" doesn't exist", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ object = (ClientData) searchPtr->expr->uid;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+
+ /*
+ * 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;
+ char* argv4 = Tcl_GetStringFromObj(argv[4],NULL);
+
+ if (argv4[0] == 0) {
+ result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3], NULL));
+ goto done;
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ if (searchPtr->type == 4) {
+ /*
+ * if new tag expression, then insert in linked list
+ */
+ TagSearchExpr *expr, **lastPtr;
+
+ lastPtr = &(canvasPtr->bindTagExprs);
+ while ((expr = *lastPtr) != NULL) {
+ if (expr->uid == searchPtr->expr->uid) {
+ break;
+ }
+ lastPtr = &(expr->next);
+ }
+ if (!expr) {
+ /*
+ * transfer ownership of expr to bindTagExprs list
+ */
+ *lastPtr = searchPtr->expr;
+ searchPtr->expr->next = NULL;
+
+ /*
+ * flag in TagSearch that expr has changed ownership
+ * so that TagSearchDestroy doesn't try to free it
+ */
+ searchPtr->expr = NULL;
+ }
+ }
+#endif /* not USE_OLD_TAG_SEARCH */
+ if (argv4[0] == '+') {
+ argv4++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3],NULL), argv4, append);
+ if (mask == 0) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3], NULL));
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "requested illegal events; ",
+ "only key, button, motion, enter, leave, and virtual ",
+ "events may be used", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if (argc == 4) {
+ CONST char *command;
+
+ command = Tk_GetBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetStringFromObj(argv[3], NULL));
+ if (command == NULL) {
+ CONST char *string;
+
+ string = Tcl_GetStringResult(interp);
+ /*
+ * Ignore missing binding errors. This is a special hack
+ * that relies on the error message returned by FindSequence
+ * in tkBind.c.
+ */
+
+ if (string[0] != '\0') {
+ result = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ } else {
+ Tcl_SetResult(interp, (char *) command, TCL_STATIC);
+ }
+ } else {
+ Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
+ }
+ break;
+ }
+ case CANV_CANVASX: {
+ int x;
+ double grid;
+ char buf[TCL_DOUBLE_SPACE];
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "screenx ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 4) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &grid) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ grid = 0.0;
+ }
+ x += canvasPtr->xOrigin;
+ Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_CANVASY: {
+ int y;
+ double grid;
+ char buf[TCL_DOUBLE_SPACE];
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "screeny ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 4) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ argv[3], &grid) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ grid = 0.0;
+ }
+ y += canvasPtr->yOrigin;
+ Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_CGET: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
+ break;
+ }
+ case CANV_CONFIGURE: {
+ 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, Tcl_GetString(argv[2]), 0);
+ } else {
+ result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ break;
+ }
+ case CANV_COORDS: {
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?x y x y ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ if (argc != 3) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ if (itemPtr->typePtr->coordProc != NULL) {
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = (*itemPtr->typePtr->coordProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3);
+ } else {
+ CONST char **args = GetStringsFromObjs(argc-3, argv+3);
+ result = (*itemPtr->typePtr->coordProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args);
+ if (args) ckfree((char *) args);
+ }
+ }
+ if (argc != 3) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ }
+ break;
+ }
+ case CANV_CREATE: {
+ Tk_ItemType *typePtr;
+ Tk_ItemType *matchPtr = NULL;
+ Tk_Item *itemPtr;
+ char buf[TCL_INTEGER_SPACE];
+ int isNew = 0;
+ Tcl_HashEntry *entryPtr;
+ char *arg;
+
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "type ?arg arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ arg = Tcl_GetStringFromObj(argv[2], (int *) &length);
+ c = arg[0];
+ for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) {
+ if ((c == typePtr->name[0])
+ && (strncmp(arg, typePtr->name, length) == 0)) {
+ if (matchPtr != NULL) {
+ badType:
+ Tcl_AppendResult(interp,
+ "unknown or ambiguous item type \"",
+ arg, "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ 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;
+ itemPtr->state = TK_STATE_NULL;
+ itemPtr->redraw_flags = 0;
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argc-3, argv+3);
+ } else {
+ CONST char **args = GetStringsFromObjs(argc-3, argv+3);
+ result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argc-3, (Tcl_Obj **) args);
+ if (args) ckfree((char *) args);
+ }
+ if (result != TCL_OK) {
+ ckfree((char *) itemPtr);
+ result = TCL_ERROR;
+ goto done;
+ }
+ 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;
+ itemPtr->redraw_flags |= FORCE_REDRAW;
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ sprintf(buf, "%d", itemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_DCHARS: {
+ int first, last;
+ int x1,x2,y1,y2;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId first ?last?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->dCharsProc == NULL)) {
+ continue;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &first);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &first);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (argc == 5) {
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[4], &last);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &last);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ } 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. Except if the insertProc sets the
+ * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr,
+ itemPtr, first, last);
+ if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+ break;
+ }
+ case CANV_DELETE: {
+ int i;
+ Tcl_HashEntry *entryPtr;
+
+ for (i = 2; i < argc; i++) {
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[i], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ 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;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_DTAG: {
+ Tk_Uid tag;
+ int i;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagToDelete?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 4) {
+ tag = Tk_GetUid(Tcl_GetStringFromObj(argv[3], NULL));
+ } else {
+ tag = Tk_GetUid(Tcl_GetStringFromObj(argv[2], NULL));
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ if (itemPtr->tagPtr[i] == tag) {
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_FIND: {
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "searchCommand ?arg arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ result = FindItems(interp, canvasPtr, argc, argv, (Tcl_Obj *) NULL, 2);
+#else /* USE_OLD_TAG_SEARCH */
+ result = FindItems(interp, canvasPtr, argc, argv,
+ (Tcl_Obj *) NULL, 2, &searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+ case CANV_FOCUS: {
+ if (argc > 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "?tagOrId?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ if (argc == 2) {
+ if (itemPtr != NULL) {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", itemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ goto done;
+ }
+ if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ if (Tcl_GetStringFromObj(argv[2], NULL)[0] == 0) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr->typePtr->icursorProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ goto done;
+ }
+ canvasPtr->textInfo.focusItemPtr = itemPtr;
+ if (canvasPtr->textInfo.gotFocus) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ break;
+ }
+ case CANV_GETTAGS: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ int i;
+ for (i = 0; i < itemPtr->numTags; i++) {
+ Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]);
+ }
+ }
+ break;
+ }
+ case CANV_ICURSOR: {
+ int index;
+
+ if (argc != 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->icursorProc == NULL)) {
+ goto done;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &index);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr,
+ index);
+ if ((itemPtr == canvasPtr->textInfo.focusItemPtr)
+ && (canvasPtr->textInfo.cursorOn)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ }
+ break;
+ }
+ case CANV_INDEX: {
+
+ int index;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (argc != 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId string");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr->typePtr->indexProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp, "can't find an indexable item \"",
+ Tcl_GetStringFromObj(argv[2], NULL), "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &index);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &index);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ sprintf(buf, "%d", index);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_INSERT: {
+ int beforeThis;
+ int x1,x2,y1,y2;
+
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId beforeThis string");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->insertProc == NULL)) {
+ continue;
+ }
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[3], &beforeThis);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[3], NULL), &beforeThis);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * 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. Except if the
+ * insertProc sets the TK_ITEM_DONT_REDRAW flag, nothing
+ * more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
+ itemPtr, beforeThis, (char *) argv[4]);
+ } else {
+ (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
+ itemPtr, beforeThis, Tcl_GetStringFromObj(argv[4], NULL));
+ }
+ if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+ break;
+ }
+ case CANV_ITEMCGET: {
+ if (argc != 4) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId option");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ Tcl_GetStringFromObj(argv[3], NULL), 0);
+ }
+ break;
+ }
+ case CANV_ITEMCONFIGURE: {
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?option value ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_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,
+ Tcl_GetString(argv[3]), 0);
+ } else {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = (*itemPtr->typePtr->configProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3,
+ TK_CONFIG_ARGV_ONLY);
+ } else {
+ CONST char **args = GetStringsFromObjs(argc-3, argv+3);
+ result = (*itemPtr->typePtr->configProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, (Tcl_Obj **) args,
+ TK_CONFIG_ARGV_ONLY);
+ if (args) ckfree((char *) args);
+ }
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if ((result != TCL_OK) || (argc < 5)) {
+ break;
+ }
+ }
+ break;
+ }
+ case CANV_LOWER: {
+ Tk_Item *itemPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?belowThis?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * First find the item just after which we'll insert the
+ * named items.
+ */
+
+ if (argc == 3) {
+ itemPtr = NULL;
+ } else {
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp, "tag \"", Tcl_GetString(argv[3]),
+ "\" doesn't match any items", (char *) NULL);
+ goto done;
+ }
+ itemPtr = itemPtr->prevPtr;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ RelinkItems(canvasPtr, argv[2], itemPtr);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = RelinkItems(canvasPtr, argv[2], itemPtr, &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+ case CANV_MOVE: {
+ double xAmount, yAmount;
+
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xAmount yAmount");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &xAmount) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
+ (Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr,
+ itemPtr, xAmount, yAmount);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ break;
+ }
+ case CANV_POSTSCRIPT: {
+ CONST char **args = GetStringsFromObjs(argc, argv);
+ result = TkCanvPostscriptCmd(canvasPtr, interp, argc, args);
+ if (args) ckfree((char *) args);
+ break;
+ }
+ case CANV_RAISE: {
+ Tk_Item *prevPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?aboveThis?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * First find the item just after which we'll insert the
+ * named items.
+ */
+
+ if (argc == 3) {
+ prevPtr = canvasPtr->lastItemPtr;
+ } else {
+ prevPtr = NULL;
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ prevPtr = itemPtr;
+ }
+ if (prevPtr == NULL) {
+ Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetStringFromObj(argv[3], NULL),
+ "\" doesn't match any items", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ RelinkItems(canvasPtr, argv[2], prevPtr);
+#else /* USE_OLD_TAG_SEARCH */
+ result = RelinkItems(canvasPtr, argv[2], prevPtr, &searchPtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+ break;
+ }
+ case CANV_SCALE: {
+ double xOrigin, yOrigin, xScale, yScale;
+
+ if (argc != 7) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xOrigin yOrigin xScale yScale");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ argv[3], &xOrigin) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ argv[4], &yOrigin) != TCL_OK)
+ || (Tcl_GetDoubleFromObj(interp, argv[5], &xScale) != TCL_OK)
+ || (Tcl_GetDoubleFromObj(interp, argv[6], &yScale) != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((xScale == 0.0) || (yScale == 0.0)) {
+ Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC);
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr,
+ itemPtr, xOrigin, yOrigin, xScale, yScale);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ break;
+ }
+ case CANV_SCAN: {
+ int x, y, gain=10;
+ static CONST char *optionStrings[] = {
+ "mark", "dragto", NULL
+ };
+
+ if (argc < 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "mark|dragto x y ?dragGain?");
+ result = TCL_ERROR;
+ } else if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings,
+ "scan option", 0, &index) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if ((argc != 5) && (argc != 5+index)) {
+ Tcl_WrongNumArgs(interp, 3, argv, index?"x y ?gain?":"x y");
+ result = TCL_ERROR;
+ } else if ((Tcl_GetIntFromObj(interp, argv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, argv[4], &y) != TCL_OK)){
+ result = TCL_ERROR;
+ } else if ((argc == 6) &&
+ (Tcl_GetIntFromObj(interp, argv[5], &gain) != TCL_OK)) {
+ result = TCL_ERROR;
+ } else if (!index) {
+ canvasPtr->scanX = x;
+ canvasPtr->scanXOrigin = canvasPtr->xOrigin;
+ canvasPtr->scanY = y;
+ canvasPtr->scanYOrigin = canvasPtr->yOrigin;
+ } else {
+ int newXOrigin, newYOrigin, tmp;
+
+ /*
+ * Compute a new view origin for the canvas, amplifying the
+ * mouse motion.
+ */
+
+ tmp = canvasPtr->scanXOrigin - gain*(x - canvasPtr->scanX)
+ - canvasPtr->scrollX1;
+ newXOrigin = canvasPtr->scrollX1 + tmp;
+ tmp = canvasPtr->scanYOrigin - gain*(y - canvasPtr->scanY)
+ - canvasPtr->scrollY1;
+ newYOrigin = canvasPtr->scrollY1 + tmp;
+ CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
+ }
+ break;
+ }
+ case CANV_SELECT: {
+ int index, optionindex;
+ static CONST char *optionStrings[] = {
+ "adjust", "clear", "from", "item", "to", NULL
+ };
+ enum options {
+ CANV_ADJUST, CANV_CLEAR, CANV_FROM, CANV_ITEM, CANV_TO
+ };
+
+ if (argc < 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "option ?tagOrId? ?arg?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc >= 4) {
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[3], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_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 \"",
+ Tcl_GetStringFromObj(argv[3], NULL), "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (argc == 5) {
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (char *) argv[4], &index);
+ } else {
+ result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, Tcl_GetStringFromObj(argv[4], NULL), &index);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ }
+ if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "select option", 0,
+ &optionindex) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ switch ((enum options) optionindex) {
+ case CANV_ADJUST: {
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ 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);
+ break;
+ }
+ case CANV_CLEAR: {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, 3, argv, (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ goto done;
+ break;
+ }
+ case CANV_FROM: {
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ break;
+ }
+ case CANV_ITEM: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 3, argv, (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ break;
+ }
+ case CANV_TO: {
+ if (argc != 5) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ break;
+ }
+ }
+ break;
+ }
+ case CANV_TYPE: {
+ if (argc != 3) {
+ Tcl_WrongNumArgs(interp, 2, argv, "tag");
+ result = TCL_ERROR;
+ goto done;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if ((result = TagSearchScan(canvasPtr, argv[2], &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+ itemPtr = TagSearchFirst(searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC);
+ }
+ break;
+ }
+ case CANV_XVIEW: {
+ int count, type;
+ int newX = 0; /* Initialization needed only to prevent
+ * gcc warnings. */
+ double fraction;
+
+ if (argc == 2) {
+ Tcl_SetObjResult(interp, ScrollFractions(
+ canvasPtr->xOrigin + canvasPtr->inset,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
+ - canvasPtr->inset, canvasPtr->scrollX1,
+ canvasPtr->scrollX2));
+ } else {
+ CONST char **args = GetStringsFromObjs(argc, argv);
+ type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
+ if (args) ckfree((char *) args);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ result = TCL_ERROR;
+ goto done;
+ 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);
+ }
+ break;
+ }
+ case CANV_YVIEW: {
+ int count, type;
+ int newY = 0; /* Initialization needed only to prevent
+ * gcc warnings. */
+ double fraction;
+
+ if (argc == 2) {
+ Tcl_SetObjResult(interp,ScrollFractions(\
+ canvasPtr->yOrigin + canvasPtr->inset,
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
+ - canvasPtr->inset, canvasPtr->scrollY1,
+ canvasPtr->scrollY2));
+ } else {
+ CONST char **args = GetStringsFromObjs(argc, argv);
+ type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
+ if (args) ckfree((char *) args);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ result = TCL_ERROR;
+ goto done;
+ 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);
+ }
+ break;
+ }
+ }
+ done:
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchDestroy(searchPtr);
+#endif /* not USE_OLD_TAG_SEARCH */
+ Tcl_Release((ClientData) canvasPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *expr, *next;
+#endif
+
+ /*
+ * 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);
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ next = expr->next;
+ TagSearchExprDestroy(expr);
+ expr = next;
+ }
+#endif
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (canvasPtr->bindingTable != NULL) {
+ Tk_DeleteBindingTable(canvasPtr->bindingTable);
+ }
+ Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0);
+ canvasPtr->tkwin = NULL;
+ 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 the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for canvasPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC new;
+
+ if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs,
+ argc, (CONST char **) argv, (char *) canvasPtr,
+ flags|TK_CONFIG_OBJS) != 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.graphics_exposures = False;
+ gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
+ new = Tk_GetGC(canvasPtr->tkwin,
+ GCFunction|GCGraphicsExposures|GCForeground, &gcValues);
+ 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;
+ CONST 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);
+ }
+
+ flags = canvasPtr->tsoffset.flags;
+ if (flags & TK_OFFSET_LEFT) {
+ canvasPtr->tsoffset.xoffset = 0;
+ } else if (flags & TK_OFFSET_CENTER) {
+ canvasPtr->tsoffset.xoffset = canvasPtr->width/2;
+ } else if (flags & TK_OFFSET_RIGHT) {
+ canvasPtr->tsoffset.xoffset = canvasPtr->width;
+ }
+ if (flags & TK_OFFSET_TOP) {
+ canvasPtr->tsoffset.yoffset = 0;
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ canvasPtr->tsoffset.yoffset = canvasPtr->height/2;
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ canvasPtr->tsoffset.yoffset = canvasPtr->height;
+ }
+
+ /*
+ * 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;
+ }
+ }
+
+ /*
+ * Scan through the item list, registering the bounding box
+ * for all items that didn't do that for the final coordinates
+ * yet. This can be determined by the FORCE_REDRAW flag.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->redraw_flags & FORCE_REDRAW) {
+ itemPtr->redraw_flags &= ~FORCE_REDRAW;
+ EventuallyRedrawItem((Tk_Canvas)canvasPtr, itemPtr);
+ itemPtr->redraw_flags &= ~FORCE_REDRAW;
+ }
+ }
+ /*
+ * 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 & 1)
+ || (itemPtr->x1 >= canvasPtr->redrawX2)
+ || (itemPtr->y1 >= canvasPtr->redrawY2)
+ || (itemPtr->x2 < canvasPtr->redrawX1)
+ || (itemPtr->y2 < canvasPtr->redrawY1)) {
+ continue;
+ }
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ 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 fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ if (canvasPtr->textInfo.gotFocus) {
+ fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
+ }
+ }
+ }
+
+ done:
+ canvasPtr->flags &= ~(REDRAW_PENDING|BBOX_NOT_EMPTY);
+ 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,
+ (Tcl_FreeProc *) 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 & 1) {
+ (*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 tkwin is NULL, the canvas has been destroyed, so we can't really
+ * redraw it.
+ */
+ if (canvasPtr->tkwin == NULL) {
+ return;
+ }
+
+ if ((x1 >= x2) || (y1 >= y2) ||
+ (x2 < canvasPtr->xOrigin) || (y2 < canvasPtr->yOrigin) ||
+ (x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) ||
+ (y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) {
+ return;
+ }
+ if (canvasPtr->flags & BBOX_NOT_EMPTY) {
+ 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;
+ canvasPtr->flags |= BBOX_NOT_EMPTY;
+ }
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EventuallyRedrawItem --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EventuallyRedrawItem(canvas, itemPtr)
+ Tk_Canvas canvas; /* Information about widget. */
+ Tk_Item *itemPtr; /* item to be redrawn. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if ((itemPtr->x1 >= itemPtr->x2) || (itemPtr->y1 >= itemPtr->y2) ||
+ (itemPtr->x2 < canvasPtr->xOrigin) ||
+ (itemPtr->y2 < canvasPtr->yOrigin) ||
+ (itemPtr->x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) ||
+ (itemPtr->y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) {
+ if (!(itemPtr->typePtr->alwaysRedraw & 1)) {
+ return;
+ }
+ }
+ if (!(itemPtr->redraw_flags & FORCE_REDRAW)) {
+ if (canvasPtr->flags & BBOX_NOT_EMPTY) {
+ if (itemPtr->x1 <= canvasPtr->redrawX1) {
+ canvasPtr->redrawX1 = itemPtr->x1;
+ }
+ if (itemPtr->y1 <= canvasPtr->redrawY1) {
+ canvasPtr->redrawY1 = itemPtr->y1;
+ }
+ if (itemPtr->x2 >= canvasPtr->redrawX2) {
+ canvasPtr->redrawX2 = itemPtr->x2;
+ }
+ if (itemPtr->y2 >= canvasPtr->redrawY2) {
+ canvasPtr->redrawY2 = itemPtr->y2;
+ }
+ } else {
+ canvasPtr->redrawX1 = itemPtr->x1;
+ canvasPtr->redrawY1 = itemPtr->y1;
+ canvasPtr->redrawX2 = itemPtr->x2;
+ canvasPtr->redrawY2 = itemPtr->y2;
+ canvasPtr->flags |= BBOX_NOT_EMPTY;
+ }
+ itemPtr->redraw_flags |= FORCE_REDRAW;
+ }
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ 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;
+#ifndef USE_OLD_TAG_SEARCH
+ allUid = Tk_GetUid("all");
+ currentUid = Tk_GetUid("current");
+ andUid = Tk_GetUid("&&");
+ orUid = Tk_GetUid("||");
+ xorUid = Tk_GetUid("^");
+ parenUid = Tk_GetUid("(");
+ endparenUid = Tk_GetUid(")");
+ negparenUid = Tk_GetUid("!(");
+ tagvalUid = Tk_GetUid("!!");
+ negtagvalUid = Tk_GetUid("!");
+#endif /* USE_OLD_TAG_SEARCH */
+}
+
+#ifdef USE_OLD_TAG_SEARCH
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, tagObj, searchPtr)
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ Tcl_Obj *tagObj; /* Object 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;
+ char *tag = Tcl_GetString(tagObj);
+ int count;
+ TkWindow *tkwin;
+ TkDisplay *dispPtr;
+
+ tkwin = (TkWindow *) canvasPtr->tkwin;
+ dispPtr = tkwin->dispPtr;
+
+ /*
+ * Initialize the search.
+ */
+
+ searchPtr->canvasPtr = canvasPtr;
+ searchPtr->searchOver = 0;
+
+ /*
+ * Find the first matching item in one of several ways. If the tag
+ * is a number then it selects the single item with the matching
+ * identifier. In this case see if the item being requested is the
+ * hot item, in which case the search can be skipped.
+ */
+
+ if (isdigit(UCHAR(*tag))) {
+ char *end;
+ Tcl_HashEntry *entryPtr;
+
+ dispPtr->numIdSearches++;
+ id = strtoul(tag, &end, 0);
+ if (*end == 0) {
+ itemPtr = canvasPtr->hotPtr;
+ lastPtr = canvasPtr->hotPrevPtr;
+ if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL)
+ || (lastPtr->nextPtr != itemPtr)) {
+ dispPtr->numSlowSearches++;
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
+ lastPtr = itemPtr->prevPtr;
+ } else {
+ lastPtr = itemPtr = NULL;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ canvasPtr->hotPtr = itemPtr;
+ canvasPtr->hotPrevPtr = lastPtr;
+ return itemPtr;
+ }
+ }
+
+ searchPtr->tag = uid = Tk_GetUid(tag);
+ if (uid == Tk_GetUid("all")) {
+ /*
+ * All items match.
+ */
+
+ searchPtr->tag = NULL;
+ searchPtr->lastPtr = NULL;
+ searchPtr->currentPtr = canvasPtr->firstItemPtr;
+ return canvasPtr->firstItemPtr;
+ }
+
+ /*
+ * None of the above. Search for an item with a matching tag.
+ */
+
+ for (lastPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+}
+
+#else /* USE_OLD_TAG_SEARCH */
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchExprInit --
+ *
+ * This procedure allocates and initializes one TagSearchExpr struct.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprInit(exprPtrPtr)
+TagSearchExpr **exprPtrPtr;
+{
+ TagSearchExpr* expr = *exprPtrPtr;
+
+ if (! expr) {
+ expr = (TagSearchExpr *) ckalloc(sizeof(TagSearchExpr));
+ expr->allocated = 0;
+ expr->uids = NULL;
+ expr->next = NULL;
+ }
+ expr->uid = NULL;
+ expr->index = 0;
+ expr->length = 0;
+ *exprPtrPtr = expr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchExprDestroy --
+ *
+ * This procedure destroys one TagSearchExpr structure.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprDestroy(expr)
+ TagSearchExpr *expr;
+{
+ if (expr) {
+ if (expr->uids) {
+ ckfree((char *)expr->uids);
+ }
+ ckfree((char *)expr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScan --
+ *
+ * This procedure is called to initiate an enumeration of
+ * all items in a given canvas that contain a tag that matches
+ * the tagOrId expression.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * was successfully scanned (syntax).
+ * The information at *searchPtr is initialized
+ * such that a call to TagSearchFirst, followed by
+ * successive calls to TagSearchNext will return 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchScan(canvasPtr, tagObj, searchPtrPtr)
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ Tcl_Obj *tagObj; /* Object giving tag value. */
+ TagSearch **searchPtrPtr; /* Record describing tag search;
+ * will be initialized here. */
+{
+ char *tag = Tcl_GetStringFromObj(tagObj,NULL);
+ int i;
+ TagSearch *searchPtr;
+
+ /*
+ * Initialize the search.
+ */
+
+ if (*searchPtrPtr) {
+ searchPtr = *searchPtrPtr;
+ } else {
+ /* Allocate primary search struct on first call */
+ *searchPtrPtr = searchPtr = (TagSearch *) ckalloc(sizeof(TagSearch));
+ searchPtr->expr = NULL;
+
+ /* Allocate buffer for rewritten tags (after de-escaping) */
+ searchPtr->rewritebufferAllocated = 100;
+ searchPtr->rewritebuffer =
+ ckalloc(searchPtr->rewritebufferAllocated);
+ }
+ TagSearchExprInit(&(searchPtr->expr));
+
+ /* How long is the tagOrId ? */
+ searchPtr->stringLength = strlen(tag);
+
+ /* Make sure there is enough buffer to hold rewritten tags */
+ if ((unsigned int)searchPtr->stringLength >=
+ searchPtr->rewritebufferAllocated) {
+ searchPtr->rewritebufferAllocated = searchPtr->stringLength + 100;
+ searchPtr->rewritebuffer =
+ ckrealloc(searchPtr->rewritebuffer,
+ searchPtr->rewritebufferAllocated);
+ }
+
+ /* Initialize search */
+ searchPtr->canvasPtr = canvasPtr;
+ searchPtr->searchOver = 0;
+ searchPtr->type = 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 (searchPtr->stringLength && isdigit(UCHAR(*tag))) {
+ char *end;
+
+ searchPtr->id = strtoul(tag, &end, 0);
+ if (*end == 0) {
+ searchPtr->type = 1;
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * For all other tags and tag expressions convert to a UID.
+ * This UID is kept forever, but this should be thought of
+ * as a cache rather than as a memory leak.
+ */
+ searchPtr->expr->uid = Tk_GetUid(tag);
+
+ /* short circuit impossible searches for null tags */
+ if (searchPtr->stringLength == 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Pre-scan tag for at least one unquoted "&&" "||" "^" "!"
+ * if not found then use string as simple tag
+ */
+ for (i = 0; i < searchPtr->stringLength ; i++) {
+ if (tag[i] == '"') {
+ i++;
+ for ( ; i < searchPtr->stringLength; i++) {
+ if (tag[i] == '\\') {
+ i++;
+ continue;
+ }
+ if (tag[i] == '"') {
+ break;
+ }
+ }
+ } else {
+ if ((tag[i] == '&' && tag[i+1] == '&')
+ || (tag[i] == '|' && tag[i+1] == '|')
+ || (tag[i] == '^')
+ || (tag[i] == '!')) {
+ searchPtr->type = 4;
+ break;
+ }
+ }
+ }
+
+ searchPtr->string = tag;
+ searchPtr->stringIndex = 0;
+ if (searchPtr->type == 4) {
+ /*
+ * an operator was found in the prescan, so
+ * now compile the tag expression into array of Tk_Uid
+ * flagging any syntax errors found
+ */
+ if (TagSearchScanExpr(canvasPtr->interp, searchPtr, searchPtr->expr) != TCL_OK) {
+ /* Syntax error in tag expression */
+ /* Result message set by TagSearchScanExpr */
+ return TCL_ERROR;
+ }
+ searchPtr->expr->length = searchPtr->expr->index;
+ } else {
+ if (searchPtr->expr->uid == allUid) {
+ /*
+ * All items match.
+ */
+ searchPtr->type = 2;
+ } else {
+ /*
+ * Optimized single-tag search
+ */
+ searchPtr->type = 3;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchDestroy --
+ *
+ * This procedure destroys any dynamic structures that
+ * may have been allocated by TagSearchScan.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchDestroy(searchPtr)
+ TagSearch *searchPtr; /* Record describing tag search */
+{
+ if (searchPtr) {
+ TagSearchExprDestroy(searchPtr->expr);
+ ckfree((char *)searchPtr->rewritebuffer);
+ ckfree((char *)searchPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScanExpr --
+ *
+ * This recursive procedure is called to scan a tag expression
+ * and compile it into an array of Tk_Uids.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * was successfully scanned (syntax).
+ * The information at *searchPtr is initialized
+ * such that a call to TagSearchFirst, followed by
+ * successive calls to TagSearchNext will return items
+ * that match tag.
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchScanExpr(interp, searchPtr, expr)
+ Tcl_Interp *interp; /* Current interpreter. */
+ TagSearch *searchPtr; /* Search data */
+ TagSearchExpr *expr; /* compiled expression result */
+{
+ int looking_for_tag; /* When true, scanner expects
+ * next char(s) to be a tag,
+ * else operand expected */
+ int found_tag; /* One or more tags found */
+ int found_endquote; /* For quoted tag string parsing */
+ int negate_result; /* Pending negation of next tag value */
+ char *tag; /* tag from tag expression string */
+ char c;
+
+ negate_result = 0;
+ found_tag = 0;
+ looking_for_tag = 1;
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex++];
+
+ if (expr->allocated == expr->index) {
+ expr->allocated += 15;
+ if (expr->uids) {
+ expr->uids =
+ (Tk_Uid *) ckrealloc((char *)(expr->uids),
+ (expr->allocated)*sizeof(Tk_Uid));
+ } else {
+ expr->uids =
+ (Tk_Uid *) ckalloc((expr->allocated)*sizeof(Tk_Uid));
+ }
+ }
+
+ if (looking_for_tag) {
+
+ switch (c) {
+ case ' ' : /* ignore unquoted whitespace */
+ case '\t' :
+ case '\n' :
+ case '\r' :
+ break;
+
+ case '!' : /* negate next tag or subexpr */
+ if (looking_for_tag > 1) {
+ Tcl_AppendResult(interp,
+ "Too many '!' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ looking_for_tag++;
+ negate_result = 1;
+ break;
+
+ case '(' : /* scan (negated) subexpr recursively */
+ if (negate_result) {
+ expr->uids[expr->index++] = negparenUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = parenUid;
+ }
+ if (TagSearchScanExpr(interp, searchPtr, expr) != TCL_OK) {
+ /* Result string should be already set
+ * by nested call to tag_expr_scan() */
+ return TCL_ERROR;
+ }
+ looking_for_tag = 0;
+ found_tag = 1;
+ break;
+
+ case '"' : /* quoted tag string */
+ if (negate_result) {
+ expr->uids[expr->index++] = negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = tagvalUid;
+ }
+ tag = searchPtr->rewritebuffer;
+ found_endquote = 0;
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c == '\\') {
+ c = searchPtr->string[searchPtr->stringIndex++];
+ }
+ if (c == '"') {
+ found_endquote = 1;
+ break;
+ }
+ *tag++ = c;
+ }
+ if (! found_endquote) {
+ Tcl_AppendResult(interp,
+ "Missing endquote in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (! (tag - searchPtr->rewritebuffer)) {
+ Tcl_AppendResult(interp,
+ "Null quoted tag string in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ *tag++ = '\0';
+ expr->uids[expr->index++] =
+ Tk_GetUid(searchPtr->rewritebuffer);
+ looking_for_tag = 0;
+ found_tag = 1;
+ break;
+
+ case '&' : /* illegal chars when looking for tag */
+ case '|' :
+ case '^' :
+ case ')' :
+ Tcl_AppendResult(interp,
+ "Unexpected operator in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+
+ default : /* unquoted tag string */
+ if (negate_result) {
+ expr->uids[expr->index++] = negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = tagvalUid;
+ }
+ tag = searchPtr->rewritebuffer;
+ *tag++ = c;
+ /* copy rest of tag, including any embedded whitespace */
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex];
+ if (c == '!' || c == '&' || c == '|' || c == '^'
+ || c == '(' || c == ')' || c == '"') {
+ break;
+ }
+ *tag++ = c;
+ searchPtr->stringIndex++;
+ }
+ /* remove trailing whitespace */
+ while (1) {
+ c = *--tag;
+ /* there must have been one non-whitespace char,
+ * so this will terminate */
+ if (c != ' ' && c != '\t' && c != '\n' && c != '\r') {
+ break;
+ }
+ }
+ *++tag = '\0';
+ expr->uids[expr->index++] =
+ Tk_GetUid(searchPtr->rewritebuffer);
+ looking_for_tag = 0;
+ found_tag = 1;
+ }
+
+ } else { /* ! looking_for_tag */
+
+ switch (c) {
+ case ' ' : /* ignore whitespace */
+ case '\t' :
+ case '\n' :
+ case '\r' :
+ break;
+
+ case '&' : /* AND operator */
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c != '&') {
+ Tcl_AppendResult(interp,
+ "Singleton '&' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = andUid;
+ looking_for_tag = 1;
+ break;
+
+ case '|' : /* OR operator */
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c != '|') {
+ Tcl_AppendResult(interp,
+ "Singleton '|' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = orUid;
+ looking_for_tag = 1;
+ break;
+
+ case '^' : /* XOR operator */
+ expr->uids[expr->index++] = xorUid;
+ looking_for_tag = 1;
+ break;
+
+ case ')' : /* end subexpression */
+ expr->uids[expr->index++] = endparenUid;
+ goto breakwhile;
+
+ default : /* syntax error */
+ Tcl_AppendResult(interp,
+ "Invalid boolean operator in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ breakwhile:
+ if (found_tag && ! looking_for_tag) {
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "Missing tag in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchEvalExpr --
+ *
+ * This recursive procedure is called to eval a tag expression.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * successfully matched the tags of the current item.
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchEvalExpr(expr, itemPtr)
+ TagSearchExpr *expr; /* Search expression */
+ Tk_Item *itemPtr; /* Item being test for match */
+{
+ int looking_for_tag; /* When true, scanner expects
+ * next char(s) to be a tag,
+ * else operand expected */
+ int negate_result; /* Pending negation of next tag value */
+ Tk_Uid uid;
+ Tk_Uid *tagPtr;
+ int count;
+ int result; /* Value of expr so far */
+ int parendepth;
+
+ result = 0; /* just to keep the compiler quiet */
+
+ negate_result = 0;
+ looking_for_tag = 1;
+ while (expr->index < expr->length) {
+ uid = expr->uids[expr->index++];
+ if (looking_for_tag) {
+ if (uid == tagvalUid) {
+/*
+ * assert(expr->index < expr->length);
+ */
+ uid = expr->uids[expr->index++];
+ result = 0;
+ /*
+ * set result 1 if tag is found in item's tags
+ */
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ result = 1;
+ break;
+ }
+ }
+
+ } else if (uid == negtagvalUid) {
+ negate_result = ! negate_result;
+/*
+ * assert(expr->index < expr->length);
+ */
+ uid = expr->uids[expr->index++];
+ result = 0;
+ /*
+ * set result 1 if tag is found in item's tags
+ */
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ result = 1;
+ break;
+ }
+ }
+
+ } else if (uid == parenUid) {
+ /*
+ * evaluate subexpressions with recursion
+ */
+ result = TagSearchEvalExpr(expr, itemPtr);
+
+ } else if (uid == negparenUid) {
+ negate_result = ! negate_result;
+ /*
+ * evaluate subexpressions with recursion
+ */
+ result = TagSearchEvalExpr(expr, itemPtr);
+/*
+ * } else {
+ * assert(0);
+ */
+ }
+ if (negate_result) {
+ result = ! result;
+ negate_result = 0;
+ }
+ looking_for_tag = 0;
+ } else { /* ! looking_for_tag */
+ if (((uid == andUid) && (!result)) || ((uid == orUid) && result)) {
+ /*
+ * short circuit expression evaluation
+ *
+ * if result before && is 0, or result before || is 1,
+ * then the expression is decided and no further
+ * evaluation is needed.
+ */
+
+ parendepth = 0;
+ while (expr->index < expr->length) {
+ uid = expr->uids[expr->index++];
+ if (uid == tagvalUid || uid == negtagvalUid) {
+ expr->index++;
+ continue;
+ }
+ if (uid == parenUid || uid == negparenUid) {
+ parendepth++;
+ continue;
+ }
+ if (uid == endparenUid) {
+ parendepth--;
+ if (parendepth < 0) {
+ break;
+ }
+ }
+ }
+ return result;
+
+ } else if (uid == xorUid) {
+ /*
+ * if the previous result was 1
+ * then negate the next result
+ */
+ negate_result = result;
+
+ } else if (uid == endparenUid) {
+ return result;
+/*
+ * } else {
+ * assert(0);
+ */
+ }
+ looking_for_tag = 1;
+ }
+ }
+/*
+ * assert(! looking_for_tag);
+ */
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchFirst --
+ *
+ * This procedure is called to get the first item
+ * item that matches a preestablished search predicate
+ * that was set by TagSearchScan.
+ *
+ * Results:
+ * The return value is a pointer to the first item, or NULL
+ * if there is no such item. The information at *searchPtr
+ * is updated such that successive calls to TagSearchNext
+ * will return successive items.
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+TagSearchFirst(searchPtr)
+ TagSearch *searchPtr; /* Record describing tag search */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid uid, *tagPtr;
+ int count;
+
+ /* short circuit impossible searches for null tags */
+ if (searchPtr->stringLength == 0) {
+ return NULL;
+ }
+
+ /*
+ * 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 (searchPtr->type == 1) {
+ Tcl_HashEntry *entryPtr;
+
+ itemPtr = searchPtr->canvasPtr->hotPtr;
+ lastPtr = searchPtr->canvasPtr->hotPrevPtr;
+ if ((itemPtr == NULL) || (itemPtr->id != searchPtr->id) || (lastPtr == NULL)
+ || (lastPtr->nextPtr != itemPtr)) {
+ entryPtr = Tcl_FindHashEntry(&searchPtr->canvasPtr->idTable,
+ (char *) searchPtr->id);
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
+ lastPtr = itemPtr->prevPtr;
+ } else {
+ lastPtr = itemPtr = NULL;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ searchPtr->canvasPtr->hotPtr = itemPtr;
+ searchPtr->canvasPtr->hotPrevPtr = lastPtr;
+ return itemPtr;
+ }
+
+ if (searchPtr->type == 2) {
+
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = NULL;
+ searchPtr->currentPtr = searchPtr->canvasPtr->firstItemPtr;
+ return searchPtr->canvasPtr->firstItemPtr;
+ }
+
+ if (searchPtr->type == 3) {
+
+ /*
+ * Optimized single-tag search
+ */
+
+ uid = searchPtr->expr->uid;
+ for (lastPtr = NULL, itemPtr = searchPtr->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;
+ }
+ }
+ }
+ } else {
+
+ /*
+ * None of the above. Search for an item matching the tag expression.
+ */
+
+ for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ searchPtr->expr->index = 0;
+ if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchNext --
+ *
+ * This procedure returns successive items that match a given
+ * tag; it should be called only after TagSearchFirst has been
+ * used to begin a search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches
+ * the tag expr specified to TagSearchScan, 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 *
+TagSearchNext(searchPtr)
+ TagSearch *searchPtr; /* Record describing search in
+ * progress. */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid uid, *tagPtr;
+ int count;
+
+ /*
+ * 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;
+ }
+
+ if (searchPtr->type == 2) {
+
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+
+ if (searchPtr->type == 3) {
+
+ /*
+ * Optimized single-tag search
+ */
+
+ uid = searchPtr->expr->uid;
+ 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;
+ }
+
+ /*
+ * Else.... evaluate tag expression
+ */
+
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ searchPtr->expr->index = 0;
+ if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoItem --
+ *
+ * This is a utility procedure called by FindItems. It
+ * either adds itemPtr's id to the result forming in interp,
+ * or it adds a new tag to itemPtr, depending on the value
+ * of tag.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tag is NULL then itemPtr's id is added as a list element
+ * to the interp's result; otherwise tag is added to itemPtr's
+ * list of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DoItem(interp, itemPtr, tag)
+ 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[TCL_INTEGER_SPACE];
+
+ 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 the interp's result. If newTag is NULL, then
+ * the normal the interp's result is an empty string. If an error
+ * occurs, then the interp's result will hold an error message.
+ *
+ * Side effects:
+ * If newTag is non-NULL, then all the items that match the
+ * information in argc/argv have that tag added to their
+ * lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+#ifdef USE_OLD_TAG_SEARCH
+FindItems(interp, canvasPtr, argc, argv, newTag, first)
+#else /* USE_OLD_TAG_SEARCH */
+FindItems(interp, canvasPtr, argc, argv, newTag, first, searchPtrPtr)
+#endif /* USE_OLD_TAG_SEARCH */
+ 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. */
+ Tcl_Obj *CONST *argv; /* Arguments that describe what items
+ * to search for (see user doc on
+ * "find" and "addtag" options). */
+ Tcl_Obj *newTag; /* If non-NULL, gives new tag to set
+ * on all found items; if NULL, then
+ * ids of found items are returned
+ * in the interp's result. */
+ int first; /* For error messages: gives number
+ * of elements of argv which are already
+ * handled. */
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearch **searchPtrPtr; /* From CanvasWidgetCmd local vars*/
+#endif /* not USE_OLD_TAG_SEARCH */
+{
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#endif /* USE_OLD_TAG_SEARCH */
+ Tk_Item *itemPtr;
+ Tk_Uid uid;
+ int index;
+ static CONST char *optionStrings[] = {
+ "above", "all", "below", "closest",
+ "enclosed", "overlapping", "withtag", NULL
+ };
+ enum options {
+ CANV_ABOVE, CANV_ALL, CANV_BELOW, CANV_CLOSEST,
+ CANV_ENCLOSED, CANV_OVERLAPPING, CANV_WITHTAG
+ };
+
+ if (newTag != NULL) {
+ uid = Tk_GetUid(Tcl_GetStringFromObj(newTag, NULL));
+ } else {
+ uid = NULL;
+ }
+ if (Tcl_GetIndexFromObj(interp, argv[first], optionStrings, "search command", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case CANV_ABOVE: {
+ Tk_Item *lastPtr = NULL;
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
+ return TCL_ERROR;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (itemPtr = TagSearchFirst(*searchPtrPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ lastPtr = itemPtr;
+ }
+ if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) {
+ DoItem(interp, lastPtr->nextPtr, uid);
+ }
+ break;
+ }
+ case CANV_ALL: {
+ if (argc != first+1) {
+ Tcl_WrongNumArgs(interp, first+1, argv, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ DoItem(interp, itemPtr, uid);
+ }
+ break;
+ }
+ case CANV_BELOW: {
+ Tk_Item *itemPtr;
+
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
+ return TCL_ERROR;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ itemPtr = TagSearchFirst(*searchPtrPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+ if (itemPtr != NULL) {
+ if (itemPtr->prevPtr != NULL) {
+ DoItem(interp, itemPtr->prevPtr, uid);
+ }
+ }
+ break;
+ }
+ case CANV_CLOSEST: {
+ double closestDist;
+ Tk_Item *startPtr, *closestPtr;
+ double coords[2], halo;
+ int x1, y1, x2, y2;
+
+ if ((argc < first+3) || (argc > first+5)) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "x y ?halo? ?start?");
+ return TCL_ERROR;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[first+1],
+ &coords[0]) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
+ (Tk_Canvas) canvasPtr, argv[first+2], &coords[1]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (argc > first+3) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[first+3],
+ &halo) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (halo < 0.0) {
+ Tcl_AppendResult(interp, "can't have negative halo value \"",
+ Tcl_GetString(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 == first+5) {
+#ifdef USE_OLD_TAG_SEARCH
+ itemPtr = StartTagSearch(canvasPtr, argv[first+4], &search);
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+4], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ itemPtr = TagSearchFirst(*searchPtrPtr);
+#endif /* USE_OLD_TAG_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;
+ while(itemPtr && (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL && canvasPtr->canvas_state == TK_STATE_HIDDEN))) {
+ itemPtr = itemPtr->nextPtr;
+ }
+ 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->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ 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;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_ENCLOSED: {
+ if (argc != first+5) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "x1 y1 x2 y2");
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+first+1, uid, 1);
+ }
+ case CANV_OVERLAPPING: {
+ if (argc != first+5) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "x1 y1 x2 y2");
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+first+1, uid, 0);
+ }
+ case CANV_WITHTAG: {
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
+ return TCL_ERROR;
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, argv[first+1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, argv[first+1], searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (itemPtr = TagSearchFirst(*searchPtrPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
+ DoItem(interp, itemPtr, uid);
+ }
+ }
+ }
+ 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 the interp's result.
+ * If newTag is NULL, then the normal the interp's result is an
+ * empty string. If an error occurs, then the interp's result will
+ * hold an error message.
+ *
+ * Side effects:
+ * If uid is non-NULL, then all the items overlapping
+ * or enclosed by the area in argv have that tag added to
+ * their lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+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. */
+ Tcl_Obj *CONST *argv; /* Array of four arguments that
+ * give the coordinates of the
+ * rectangular area to search. */
+ Tk_Uid uid; /* If non-NULL, gives new tag to set
+ * on all found items; if NULL, then
+ * ids of found items are returned
+ * in the interp's result. */
+ int enclosed; /* 0 means overlapping or enclosed
+ * items are OK, 1 means only enclosed
+ * items are OK. */
+{
+ double rect[4], tmp;
+ int x1, y1, x2, y2;
+ Tk_Item *itemPtr;
+
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[0],
+ &rect[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[1],
+ &rect[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[2],
+ &rect[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(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->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+#ifdef USE_OLD_TAG_SEARCH
+static void
+RelinkItems(canvasPtr, tag, prevPtr)
+#else /* USE_OLD_TAG_SEARCH */
+static int
+RelinkItems(canvasPtr, tag, prevPtr, searchPtrPtr)
+#endif /* USE_OLD_TAG_SEARCH */
+ TkCanvas *canvasPtr; /* Canvas to be modified. */
+ Tcl_Obj *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). */
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearch **searchPtrPtr; /* From CanvasWidgetCmd local vars */
+#endif /* not USE_OLD_TAG_SEARCH */
+{
+ Tk_Item *itemPtr;
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#endif /* USE_OLD_TAG_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;
+#ifdef USE_OLD_TAG_SEARCH
+ for (itemPtr = StartTagSearch(canvasPtr, tag, &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (TagSearchScan(canvasPtr, tag, searchPtrPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (itemPtr = TagSearchFirst(*searchPtrPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(*searchPtrPtr)) {
+#endif /* USE_OLD_TAG_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;
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+
+ /*
+ * Insert the list of to-be-moved items back into the canvas's
+ * at the desired position.
+ */
+
+ if (firstMovePtr == NULL) {
+#ifdef USE_OLD_TAG_SEARCH
+ return;
+#else /* USE_OLD_TAG_SEARCH */
+ return TCL_OK;
+#endif /* USE_OLD_TAG_SEARCH */
+ }
+ 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;
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ return TCL_OK;
+#endif /* not USE_OLD_TAG_SEARCH */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, a fake enter event on the new current item
+ * item and force a redraw of the two items. Canvas items
+ * that are hidden or disabled are ignored.
+ *
+ * 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;
+ Tk_Item *prevItemPtr;
+
+ /*
+ * 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--) {
+#ifdef USE_OLD_TAG_SEARCH
+ if (itemPtr->tagPtr[i] == Tk_GetUid("current")) {
+#else /* USE_OLD_TAG_SEARCH */
+ if (itemPtr->tagPtr[i] == currentUid) {
+#endif /* USE_OLD_TAG_SEARCH */
+ 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.
+ */
+
+ prevItemPtr = canvasPtr->currentItemPtr;
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr;
+ if (prevItemPtr != NULL && prevItemPtr != canvasPtr->currentItemPtr &&
+ (prevItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, prevItemPtr);
+ (*prevItemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, prevItemPtr, 0, (Tcl_Obj **) NULL,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ if (canvasPtr->currentItemPtr != NULL) {
+ XEvent event;
+
+#ifdef USE_OLD_TAG_SEARCH
+ DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr,
+ Tk_GetUid("current"));
+#else /* USE_OLD_TAG_SEARCH */
+ DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, currentUid);
+#endif /* USE_OLD_TAG_SEA */
+ if ((canvasPtr->currentItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT &&
+ prevItemPtr != canvasPtr->currentItemPtr)) {
+ (*canvasPtr->currentItemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, canvasPtr->currentItemPtr, 0, (Tcl_Obj **) NULL,
+ TK_CONFIG_ARGV_ONLY);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->currentItemPtr);
+ }
+ 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. Canvas items that are hidden
+ * or disabled are ignored.
+ *
+ * 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->state == TK_STATE_HIDDEN || itemPtr->state==TK_STATE_DISABLED ||
+ (itemPtr->state == TK_STATE_NULL && (canvasPtr->canvas_state == TK_STATE_HIDDEN ||
+ canvasPtr->canvas_state == TK_STATE_DISABLED))) {
+ continue;
+ }
+ 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;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *expr;
+ int numExprs;
+#endif /* not USE_OLD_TAG_SEARCH */
+
+ if (canvasPtr->bindingTable == NULL) {
+ return;
+ }
+
+ itemPtr = canvasPtr->currentItemPtr;
+ if ((eventPtr->type == KeyPress) || (eventPtr->type == KeyRelease)) {
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ }
+ if (itemPtr == NULL) {
+ return;
+ }
+
+#ifdef USE_OLD_TAG_SEARCH
+ /*
+ * 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;
+#else /* USE_OLD_TAG_SEARCH */
+ /*
+ * 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,
+ * (c) the expressions that are true for the event's item's tags, and
+ * (d) the tag "all".
+ *
+ * If there are a lot of tags then malloc an array to hold all of
+ * the objects.
+ */
+
+ /*
+ * flag and count all expressions that match item's tags
+ */
+ numExprs = 0;
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ expr->index = 0;
+ expr->match = TagSearchEvalExpr(expr, itemPtr);
+ if (expr->match) {
+ numExprs++;
+ }
+ expr = expr->next;
+ }
+
+ numObjects = itemPtr->numTags + numExprs + 2;
+#endif /* not USE_OLD_TAG_SEARCH */
+ if (numObjects <= NUM_STATIC) {
+ objectPtr = staticObjects;
+ } else {
+ objectPtr = (ClientData *) ckalloc((unsigned)
+ (numObjects * sizeof(ClientData)));
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ objectPtr[0] = (ClientData) Tk_GetUid("all");
+#else /* USE_OLD_TAG_SEARCH */
+ objectPtr[0] = (ClientData) allUid;
+#endif /* USE_OLD_TAG_SEARCH */
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i];
+ }
+ objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr;
+#ifndef USE_OLD_TAG_SEARCH
+ /*
+ * copy uids of matching expressions into object array
+ */
+ i = itemPtr->numTags+2;
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ if (expr->match) {
+ objectPtr[i++] = (int *) expr->uid;
+ }
+ expr = expr->next;
+ }
+#endif /* not USE_OLD_TAG_SEARCH */
+
+ /*
+ * 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) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr);
+ }
+ 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) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
+ }
+ 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)) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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) {
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
+ }
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollFractions --
+ *
+ * Given the range that's visible in the window and the "100%
+ * range" for what's in the canvas, return a list of two
+ * doubles representing 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 Tcl_Obj *
+ScrollFractions(screen1, screen2, object1, object2)
+ 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. */
+{
+ double range, f1, f2;
+ char buffer[2*TCL_DOUBLE_SPACE+2];
+
+ 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(buffer, "%g %g", f1, f2);
+ return Tcl_NewStringObj(buffer, -1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ 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) {
+ Tcl_Obj *fractions = ScrollFractions(xOrigin + inset,
+ xOrigin + width - inset, scrollX1, scrollX2);
+ result = Tcl_VarEval(interp, xScrollCmd, " ",
+ Tcl_GetString(fractions), (char *) NULL);
+ Tcl_DecrRefCount(fractions);
+ if (result != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release((ClientData) xScrollCmd);
+ }
+
+ if (yScrollCmd != NULL) {
+ Tcl_Obj *fractions = ScrollFractions(yOrigin + inset,
+ yOrigin + height - inset, scrollY1, scrollY2);
+ result = Tcl_VarEval(interp, yScrollCmd, " ",
+ Tcl_GetString(fractions), (char *) NULL);
+ Tcl_DecrRefCount(fractions);
+ 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));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStringsFromObjs
+ *
+ * Results:
+ * Converts object list into string list.
+ *
+ * Side effects:
+ * Memory is allocated for the argv array, which must
+ * be freed using ckfree() when no longer needed.
+ *
+ *----------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static CONST char **
+GetStringsFromObjs(argc, objv)
+ int argc;
+ Tcl_Obj *CONST objv[];
+{
+ register int i;
+ CONST char **argv;
+ if (argc <= 0) {
+ return NULL;
+ }
+ argv = (CONST char **) ckalloc((argc+1) * sizeof(char *));
+ for (i = 0; i < argc; i++) {
+ argv[i]=Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ }
+ argv[argc] = 0;
+ return argv;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ return Tk_PostscriptColor(interp, ((TkCanvas *) canvas)->psInfo,
+ colorPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ return Tk_PostscriptFont(interp, ((TkCanvas *) canvas)->psInfo, tkfont);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ return Tk_PostscriptBitmap(interp, ((TkCanvas *) canvas)->tkwin,
+ ((TkCanvas *) canvas)->psInfo, bitmap, startX, startY,
+ width, height);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ return Tk_PostscriptStipple(interp, ((TkCanvas *) canvas)->tkwin,
+ ((TkCanvas *) canvas)->psInfo, bitmap);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ return Tk_PostscriptY(y, ((TkCanvas *) canvas)->psInfo);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ Tk_PostscriptPath(interp, ((TkCanvas *) canvas)->psInfo,
+ coordPtr, numPoints);
+}
diff --git a/tcl/generic/tkCanvas.h b/tcl/generic/tkCanvas.h
new file mode 100644
index 00000000000..169f659294f
--- /dev/null
+++ b/tcl/generic/tkCanvas.h
@@ -0,0 +1,312 @@
+/*
+ * 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
+
+#ifndef USE_OLD_TAG_SEARCH
+typedef struct TagSearchExpr_s TagSearchExpr;
+
+struct TagSearchExpr_s {
+ TagSearchExpr *next; /* for linked lists of expressions - used in bindings */
+ Tk_Uid uid; /* the uid of the whole expression */
+ Tk_Uid *uids; /* expresion compiled to an array of uids */
+ int allocated; /* available space for array of uids */
+ int length; /* length of expression */
+ int index; /* current position in expression evaluation */
+ int match; /* this expression matches event's item's tags*/
+};
+#endif /* not USE_OLD_TAG_SEARCH */
+
+/*
+ * 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. */
+ Tk_PostscriptInfo psInfo;
+ /* 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. */
+ /*
+ * Additional information, added by the 'dash'-patch
+ */
+ VOID *reserved1;
+ Tk_State canvas_state; /* state of canvas */
+ VOID *reserved2;
+ VOID *reserved3;
+ Tk_TSOffset tsoffset;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *bindTagExprs; /* linked list of tag expressions used in bindings */
+#endif
+} 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.
+ * BBOX_NOT_EMPTY - 1 means that the bounding box of the area
+ * that should be redrawn is not empty.
+ */
+
+#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
+#define BBOX_NOT_EMPTY 0x200
+
+/*
+ * Flag bits for canvas items (redraw_flags):
+ *
+ * FORCE_REDRAW - 1 means that the new coordinates of some
+ * item are not yet registered using
+ * Tk_CanvasEventuallyRedraw(). It should still
+ * be done by the general canvas code.
+ */
+
+#define FORCE_REDRAW 8
+
+/*
+ * 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, CONST char **argv));
+
+/*
+ * The following definition is shared between tkCanvPs.c and tkCanvImg.c,
+ * and is used in generating postscript for images and windows.
+ */
+
+typedef struct TkColormapData { /* Hold color information for a window */
+ int separated; /* Whether to use separate color bands */
+ int color; /* Whether window is color or black/white */
+ int ncolors; /* Number of color values stored */
+ XColor *colors; /* Pixel value -> RGB mappings */
+ int red_mask, green_mask, blue_mask; /* Masks and shifts for each */
+ int red_shift, green_shift, blue_shift; /* color band */
+} TkColormapData;
+
+#endif /* _TKCANVAS */
diff --git a/tcl/generic/tkClipboard.c b/tcl/generic/tkClipboard.c
new file mode 100644
index 00000000000..110b6ee3ecc
--- /dev/null
+++ b/tcl/generic/tkClipboard.c
@@ -0,0 +1,760 @@
+/*
+ * tkClipboard.c --
+ *
+ * This file manages the clipboard for the Tk toolkit,
+ * maintaining a collection of data buffers that will be
+ * supplied on demand to requesting applications.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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));
+static int ClipboardGetProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *portion));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ CONST 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_ClipboardAppend.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs, an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * From now on, requests for the CLIPBOARD selection will be
+ * directed to the clipboard manager routines associated with
+ * clipWindow for the display of tkwin. In order to guarantee
+ * atomicity, no event handling should occur between
+ * Tk_ClipboardClear and the following Tk_ClipboardAppend
+ * 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_ClipboardAppend calls.
+ *
+ * Results:
+ * A standard Tcl result. If an error is returned, an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * The specified buffer will be copied onto the end of the clipboard.
+ * The clipboard maintains a list of buffers which will be used to
+ * supply the data for a selection get request. The first time a given
+ * type is appended, Tk_ClipboardAppend will register a selection
+ * handler of the appropriate type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_ClipboardObjCmd --
+ *
+ * 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_ClipboardObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ char *path = NULL;
+ Atom selection;
+ static CONST char *optionStrings[] = { "append", "clear", "get", NULL };
+ enum options { CLIPBOARD_APPEND, CLIPBOARD_CLEAR, CLIPBOARD_GET };
+ int index, i;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case CLIPBOARD_APPEND: {
+ Atom target, format;
+ char *targetName = NULL;
+ char *formatName = NULL;
+ char *string;
+ static CONST char *appendOptionStrings[] = {
+ "-displayof", "-format", "-type", NULL
+ };
+ enum appendOptions { APPEND_DISPLAYOF, APPEND_FORMAT,
+ APPEND_TYPE };
+ int subIndex, length;
+
+ for (i = 2; i < objc - 1; i++) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ if (string[0] != '-') {
+ break;
+ }
+
+ /*
+ * If the argument is "--", it signifies the end of arguments.
+ */
+ if (string[1] == '-' && length == 2) {
+ i++;
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], appendOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Increment i so that it points to the value for the flag
+ * instead of the flag itself.
+ */
+
+ i++;
+ if (i >= objc) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch ((enum appendOptions) subIndex) {
+ case APPEND_DISPLAYOF:
+ path = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_FORMAT:
+ formatName = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_TYPE:
+ targetName = Tcl_GetString(objv[i]);
+ break;
+ }
+ }
+ if (objc - i != 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options? data");
+ 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,
+ Tcl_GetString(objv[i]));
+ }
+ case CLIPBOARD_CLEAR: {
+ static CONST char *clearOptionStrings[] = { "-displayof", NULL };
+ enum clearOptions { CLEAR_DISPLAYOF };
+ int subIndex;
+ if (objc != 2 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ if (Tcl_GetIndexFromObj(interp, objv[2], clearOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((enum clearOptions) subIndex == CLEAR_DISPLAYOF) {
+ path = Tcl_GetString(objv[3]);
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_ClipboardClear(interp, tkwin);
+ }
+ case CLIPBOARD_GET: {
+ Atom target;
+ char *targetName = NULL;
+ Tcl_DString selBytes;
+ int result;
+ char *string;
+ static CONST char *getOptionStrings[] = {
+ "-displayof", "-type", NULL
+ };
+ enum getOptions { APPEND_DISPLAYOF, APPEND_TYPE };
+ int subIndex;
+
+ for (i = 2; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], getOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i++;
+ if (i >= objc) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch ((enum getOptions) subIndex) {
+ case APPEND_DISPLAYOF:
+ path = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_TYPE:
+ targetName = Tcl_GetString(objv[i]);
+ break;
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ selection = Tk_InternAtom(tkwin, "CLIPBOARD");
+
+ if (objc - i > 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options?");
+ return TCL_ERROR;
+ } else if (objc - i == 1) {
+ target = Tk_InternAtom(tkwin, Tcl_GetString(objv[i]));
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+
+ Tcl_DStringInit(&selBytes);
+ result = Tk_GetSelection(interp, tkwin, selection, target,
+ ClipboardGetProc, (ClientData) &selBytes);
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &selBytes);
+ } else {
+ Tcl_DStringFree(&selBytes);
+ }
+ return result;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipCleanup --
+ *
+ * This procedure is called to cleanup resources associated with
+ * claiming clipboard ownership and for receiving selection get
+ * results. This function is called in tkWindow.c. This has to be
+ * called by the display cleanup function because we still need the
+ * access display elements.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources are freed - the clipboard may no longer be used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkClipCleanup(dispPtr)
+ TkDisplay *dispPtr; /* display associated with clipboard */
+{
+ if (dispPtr->clipWindow != NULL) {
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->applicationAtom);
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->windowAtom);
+
+ Tk_DestroyWindow(dispPtr->clipWindow);
+ Tcl_Release((ClientData) dispPtr->clipWindow);
+ dispPtr->clipWindow = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipInit --
+ *
+ * This procedure is called to initialize the window for claiming
+ * clipboard ownership and for receiving selection get results. This
+ * function is called from tkSelect.c as well as tkClipboard.c.
+ *
+ * Results:
+ * The result is a standard Tcl return value, which is normally TCL_OK.
+ * If an error occurs then an error message is left in the interp's
+ * result and TCL_ERROR is returned.
+ *
+ * Side effects:
+ * Sets up the clipWindow and related data structures.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ Tcl_Preserve((ClientData) dispPtr->clipWindow);
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ClipboardGetProc --
+ *
+ * This procedure is invoked to process pieces of the selection
+ * as they arrive during "clipboard 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
+ClipboardGetProc(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;
+}
+
diff --git a/tcl/generic/tkCmds.c b/tcl/generic/tkCmds.c
new file mode 100644
index 00000000000..10843a10ceb
--- /dev/null
+++ b/tcl/generic/tkCmds.c
@@ -0,0 +1,2051 @@
+/*
+ * tkCmds.c --
+ *
+ * This file contains a collection of Tk-related Tcl commands
+ * that didn't fit in any particular file of the toolkit.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 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>
+
+#if defined(WIN32)
+#include "tkWinInt.h"
+#elif defined(MAC_TCL)
+#include "tkMacInt.h"
+#elif defined(MAC_OSX_TK)
+#include "tkMacOSXInt.h"
+#else
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static TkWindow * GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
+static char * WaitVariableProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static void WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void WaitWindowProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BellObjCmd --
+ *
+ * This procedure is invoked to process the "bell" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BellObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *bellOptions[] = {"-displayof", "-nice", (char *) NULL};
+ enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE };
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int i, index, nice = 0;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?-nice?");
+ return TCL_ERROR;
+ }
+
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], bellOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case TK_BELL_DISPLAYOF:
+ if (++i >= objc) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-displayof window? ?-nice?");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_BELL_NICE:
+ nice = 1;
+ break;
+ }
+ }
+ XBell(Tk_Display(tkwin), 0);
+ if (!nice) {
+ XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
+ }
+ XFlush(Tk_Display(tkwin));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindObjCmd --
+ *
+ * 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_BindObjCmd(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;
+ TkWindow *winPtr;
+ ClientData object;
+ char *string;
+
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[1]);
+
+ /*
+ * Bind tags either a window name or a tag name for the first argument.
+ * If the argument starts with ".", assume it is a window; otherwise, it
+ * is a tag.
+ */
+
+ if (string[0] == '.') {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ object = (ClientData) winPtr->pathName;
+ } else {
+ winPtr = (TkWindow *) clientData;
+ object = (ClientData) Tk_GetUid(string);
+ }
+
+ /*
+ * If there are four arguments, the command is modifying a binding. If
+ * there are three arguments, the command is querying a binding. If there
+ * are only two arguments, the command is querying all the bindings for
+ * the given tag/window.
+ */
+
+ if (objc == 4) {
+ int append = 0;
+ unsigned long mask;
+ char *sequence, *script;
+ sequence = Tcl_GetString(objv[2]);
+ script = Tcl_GetString(objv[3]);
+
+ /*
+ * If the script is null, just delete the binding.
+ */
+
+ if (script[0] == 0) {
+ return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
+ object, sequence);
+ }
+
+ /*
+ * If the script begins with "+", append this script to the existing
+ * binding.
+ */
+
+ if (script[0] == '+') {
+ script++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
+ object, sequence, script, append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ } else if (objc == 3) {
+ CONST char *command;
+
+ command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
+ object, Tcl_GetString(objv[2]));
+ if (command == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+ Tcl_SetResult(interp, (char *) command, TCL_STATIC);
+ } 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;
+ 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_HIERARCHY);
+ topLevPtr = topLevPtr->parentPtr) {
+ /* Empty loop body. */
+ }
+ if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
+ count = 4;
+ objPtr[2] = (ClientData) topLevPtr->pathName;
+ } else {
+ count = 3;
+ }
+ objPtr[count-1] = (ClientData) Tk_GetUid("all");
+ }
+ Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
+ count, objPtr);
+ if (objPtr != objects) {
+ ckfree((char *) objPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindtagsObjCmd --
+ *
+ * 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_BindtagsObjCmd(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;
+ TkWindow *winPtr, *winPtr2;
+ int i, length;
+ char *p;
+ Tcl_Obj *listPtr, **tags;
+
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?taglist?");
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]),
+ tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ listPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(listPtr);
+ if (winPtr->numTags == 0) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(winPtr->pathName, -1));
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(winPtr->classUid, -1));
+ winPtr2 = winPtr;
+ while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) {
+ winPtr2 = winPtr2->parentPtr;
+ }
+ if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(winPtr2->pathName, -1));
+ }
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj("all", -1));
+ } else {
+ for (i = 0; i < winPtr->numTags; i++) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1));
+ }
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ Tcl_DecrRefCount(listPtr);
+ return TCL_OK;
+ }
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ if (Tcl_ListObjGetElements(interp, objv[2], &length, &tags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (length == 0) {
+ return TCL_OK;
+ }
+
+ winPtr->numTags = length;
+ winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
+ (length * sizeof(ClientData)));
+ for (i = 0; i < length; i++) {
+ p = Tcl_GetString(tags[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);
+ }
+ }
+ 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_DestroyObjCmd --
+ *
+ * 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_DestroyObjCmd(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 window;
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int i;
+
+ for (i = 1; i < objc; i++) {
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[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_LowerObjCmd --
+ *
+ * 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_LowerObjCmd(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 mainwin = (Tk_Window) clientData;
+ Tk_Window tkwin, other;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
+ Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),
+ "\" below \"", (other ? Tcl_GetString(objv[2]) : ""),
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RaiseObjCmd --
+ *
+ * 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_RaiseObjCmd(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 mainwin = (Tk_Window) clientData;
+ Tk_Window tkwin, other;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
+ Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),
+ "\" above \"", (other ? Tcl_GetString(objv[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 CONST char *optionStrings[] = {
+ "appname", "caret", "scaling", "useinputmethods",
+ "windowingsystem", NULL
+ };
+ enum options {
+ TK_APPNAME, TK_CARET, TK_SCALING, TK_USE_IM,
+ TK_WINDOWINGSYSTEM
+ };
+
+ 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;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "appname not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ 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_AppendResult(interp, winPtr->nameUid, NULL);
+ break;
+ }
+ case TK_CARET: {
+ Tcl_Obj *objPtr;
+ TkCaret *caretPtr;
+ Tk_Window window;
+ static CONST char *caretStrings[]
+ = { "-x", "-y", "-height", NULL };
+ enum caretOptions
+ { TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT };
+
+ if ((objc < 3) || ((objc > 4) && !(objc & 1))) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-x x? ?-y y? ?-height height?");
+ return TCL_ERROR;
+ }
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ caretPtr = &(((TkWindow *) window)->dispPtr->caret);
+ if (objc == 3) {
+ /*
+ * Return all the current values
+ */
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-height", 7));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->height));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-x", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->x));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-y", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->y));
+ Tcl_SetObjResult(interp, objPtr);
+ } else if (objc == 4) {
+ int value;
+ /*
+ * Return the current value of the selected option
+ */
+ if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings,
+ "caret option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == TK_CARET_X) {
+ value = caretPtr->x;
+ } else if (index == TK_CARET_Y) {
+ value = caretPtr->y;
+ } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
+ value = caretPtr->height;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
+ } else {
+ int i, value, x = 0, y = 0, height = -1;
+
+ for (i = 3; i < objc; i += 2) {
+ if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
+ "caret option", 0, &index) != TCL_OK) ||
+ (Tcl_GetIntFromObj(interp, objv[i+1], &value)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (index == TK_CARET_X) {
+ x = value;
+ } else if (index == TK_CARET_Y) {
+ y = value;
+ } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
+ height = value;
+ }
+ }
+ if (height < 0) {
+ height = Tk_Height(window);
+ }
+ Tk_SetCaretPos(window, x, y, height);
+ }
+ break;
+ }
+ case TK_SCALING: {
+ Screen *screenPtr;
+ int skip, width, height;
+ double d;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "scaling not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ 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;
+ }
+ case TK_USE_IM: {
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ int skip;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "useinputmethods not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ } else if (skip) {
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ }
+ if ((objc - skip) == 3) {
+ /*
+ * In the case where TK_USE_INPUT_METHODS is not defined,
+ * this will be ignored and we will always return 0.
+ * That will indicate to the user that input methods
+ * are just not available.
+ */
+ int boolVal;
+ if (Tcl_GetBooleanFromObj(interp, objv[2+skip], &boolVal)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+#ifdef TK_USE_INPUT_METHODS
+ if (boolVal) {
+ dispPtr->flags |= TK_DISPLAY_USE_IM;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_USE_IM;
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ } else if ((objc - skip) != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? ?boolean?");
+ return TCL_ERROR;
+ }
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ (int) (dispPtr->flags & TK_DISPLAY_USE_IM));
+ break;
+ }
+ case TK_WINDOWINGSYSTEM: {
+ CONST char *windowingsystem;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+#if defined(WIN32)
+ windowingsystem = "win32";
+#elif defined(MAC_TCL)
+ windowingsystem = "classic";
+#elif defined(MAC_OSX_TK)
+ windowingsystem = "aqua";
+#else
+ windowingsystem = "x11";
+#endif
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkwaitObjCmd --
+ *
+ * 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_TkwaitObjCmd(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 done, index;
+ static CONST char *optionStrings[] = { "variable", "visibility", "window",
+ (char *) NULL };
+ enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case TKWAIT_VARIABLE: {
+ if (Tcl_TraceVar(interp, Tcl_GetString(objv[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, Tcl_GetString(objv[2]),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done);
+ break;
+ }
+
+ case TKWAIT_VISIBILITY: {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[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 \"", Tcl_GetString(objv[2]),
+ "\" was deleted before its visibility changed",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_DeleteEventHandler(window,
+ VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, (ClientData) &done);
+ break;
+ }
+
+ case TKWAIT_WINDOW: {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[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.
+ */
+ break;
+ }
+ }
+
+ /*
+ * 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. */
+ CONST char *name1; /* Name of variable. */
+ CONST 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_UpdateObjCmd --
+ *
+ * This procedure is invoked to process the "update" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_UpdateObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
+ int flags, index;
+ TkDisplay *dispPtr;
+
+ if (objc == 1) {
+ flags = TCL_DONT_WAIT;
+ } else if (objc == 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ flags = TCL_IDLE_EVENTS;
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Handle all pending events, sync all displays, and repeat over
+ * and over again until all pending events have been handled.
+ * Special note: it's possible that the entire application could
+ * be destroyed by an event handler that occurs during the update.
+ * Thus, don't use any information from tkwin after calling
+ * Tcl_DoOneEvent.
+ */
+
+ while (1) {
+ while (Tcl_DoOneEvent(flags) != 0) {
+ /* Empty loop body */
+ }
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XSync(dispPtr->display, False);
+ }
+ if (Tcl_DoOneEvent(flags) == 0) {
+ break;
+ }
+ }
+
+ /*
+ * 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 *string;
+ TkWindow *winPtr;
+ Tk_Window tkwin;
+ Tcl_Obj *resultPtr;
+
+ static TkStateMap visualMap[] = {
+ {PseudoColor, "pseudocolor"},
+ {GrayScale, "grayscale"},
+ {DirectColor, "directcolor"},
+ {TrueColor, "truecolor"},
+ {StaticColor, "staticcolor"},
+ {StaticGray, "staticgray"},
+ {-1, NULL}
+ };
+ static CONST 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;
+ resultPtr = Tcl_GetObjResult(interp);
+
+ switch ((enum options) index) {
+ case WIN_CELLS: {
+ Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
+ break;
+ }
+ case WIN_CHILDREN: {
+ Tcl_Obj *strPtr;
+
+ winPtr = winPtr->childList;
+ for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ if (!(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
+ strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ }
+ break;
+ }
+ case WIN_CLASS: {
+ Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
+ break;
+ }
+ case WIN_COLORMAPFULL: {
+ Tcl_SetBooleanObj(resultPtr,
+ TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
+ break;
+ }
+ case WIN_DEPTH: {
+ Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
+ break;
+ }
+ case WIN_GEOMETRY: {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
+ Tk_X(tkwin), Tk_Y(tkwin));
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_HEIGHT: {
+ Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
+ break;
+ }
+ case WIN_ID: {
+ char buf[TCL_INTEGER_SPACE];
+
+ Tk_MakeWindowExist(tkwin);
+ TkpPrintWindowId(buf, Tk_WindowId(tkwin));
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_ISMAPPED: {
+ Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
+ break;
+ }
+ case WIN_MANAGER: {
+ if (winPtr->geomMgrPtr != NULL) {
+ Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
+ }
+ break;
+ }
+ case WIN_NAME: {
+ Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
+ break;
+ }
+ case WIN_PARENT: {
+ if (winPtr->parentPtr != NULL) {
+ Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
+ }
+ break;
+ }
+ case WIN_POINTERX: {
+ useX = 1;
+ useY = 0;
+ goto pointerxy;
+ }
+ 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);
+ }
+ if (useX & useY) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", x, y);
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ } else if (useX) {
+ Tcl_SetIntObj(resultPtr, x);
+ } else {
+ Tcl_SetIntObj(resultPtr, y);
+ }
+ break;
+ }
+ case WIN_REQHEIGHT: {
+ Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
+ break;
+ }
+ case WIN_REQWIDTH: {
+ Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
+ break;
+ }
+ case WIN_ROOTX: {
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_SetIntObj(resultPtr, x);
+ break;
+ }
+ case WIN_ROOTY: {
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_SetIntObj(resultPtr, y);
+ break;
+ }
+ case WIN_SCREEN: {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
+ Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".",
+ buf, NULL);
+ break;
+ }
+ case WIN_SCREENCELLS: {
+ Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENDEPTH: {
+ Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENHEIGHT: {
+ Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENWIDTH: {
+ Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENMMHEIGHT: {
+ Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENMMWIDTH: {
+ Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENVISUAL: {
+ class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
+ goto visual;
+ }
+ case WIN_SERVER: {
+ TkGetServerInfo(interp, tkwin);
+ break;
+ }
+ case WIN_TOPLEVEL: {
+ winPtr = GetToplevel(tkwin);
+ if (winPtr != NULL) {
+ Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
+ }
+ break;
+ }
+ case WIN_VIEWABLE: {
+ int viewable = 0;
+ for ( ; ; winPtr = winPtr->parentPtr) {
+ if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
+ break;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ viewable = 1;
+ break;
+ }
+ }
+
+ Tcl_SetBooleanObj(resultPtr, viewable);
+ break;
+ }
+ case WIN_VISUAL: {
+ class = Tk_Visual(tkwin)->class;
+
+ visual:
+ string = TkFindStateString(visualMap, class);
+ if (string == NULL) {
+ string = "unknown";
+ }
+ Tcl_SetStringObj(resultPtr, string, -1);
+ break;
+ }
+ case WIN_VISUALID: {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "0x%x",
+ (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_VROOTHEIGHT: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, height);
+ break;
+ }
+ case WIN_VROOTWIDTH: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, width);
+ break;
+ }
+ case WIN_VROOTX: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, x);
+ break;
+ }
+ case WIN_VROOTY: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetIntObj(resultPtr, y);
+ break;
+ }
+ case WIN_WIDTH: {
+ Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
+ break;
+ }
+ case WIN_X: {
+ Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
+ break;
+ }
+ case WIN_Y: {
+ Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
+ break;
+ }
+
+ /*
+ * Uses -displayof.
+ */
+
+ case WIN_ATOM: {
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
+ break;
+ }
+ case WIN_ATOMNAME: {
+ CONST char *name;
+ long id;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ name = Tk_GetAtomName(tkwin, (Atom) id);
+ if (strcmp(name, "?bad atom?") == 0) {
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ Tcl_AppendStringsToObj(resultPtr,
+ "no atom exists with id \"", string, "\"", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetStringObj(resultPtr, name, -1);
+ break;
+ }
+ case WIN_CONTAINING: {
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ 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_SetStringObj(resultPtr, 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: {
+ Window 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), id);
+ if ((winPtr == NULL) ||
+ (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
+ "\" doesn't exist in this application", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the window is a utility window with no associated path
+ * (such as a wrapper window or send communication window), just
+ * return an empty string.
+ */
+
+ tkwin = (Tk_Window) winPtr;
+ if (Tk_PathName(tkwin) != NULL) {
+ Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+
+ /*
+ * objv[3] is window.
+ */
+
+ case WIN_EXISTS: {
+ int alive;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
+ Tcl_ResetResult(interp);
+ resultPtr = Tcl_GetObjResult(interp);
+
+ alive = 1;
+ if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
+ alive = 0;
+ }
+ Tcl_SetBooleanObj(resultPtr, alive);
+ break;
+ }
+ case WIN_FPIXELS: {
+ double mm, pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
+ / WidthMMOfScreen(Tk_Screen(tkwin));
+ Tcl_SetDoubleObj(resultPtr, pixels);
+ break;
+ }
+ case WIN_PIXELS: {
+ int pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetIntObj(resultPtr, pixels);
+ break;
+ }
+ case WIN_RGB: {
+ XColor *colorPtr;
+ char buf[TCL_INTEGER_SPACE * 3];
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ colorPtr = Tk_GetColor(interp, tkwin, string);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
+ colorPtr->blue);
+ Tk_FreeColor(colorPtr);
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ break;
+ }
+ case WIN_VISUALSAVAILABLE: {
+ XVisualInfo template, *visInfoPtr;
+ int count, i;
+ int includeVisualId;
+ Tcl_Obj *strPtr;
+ char buf[16 + TCL_INTEGER_SPACE];
+ char visualIdString[TCL_INTEGER_SPACE];
+
+ if (objc == 3) {
+ includeVisualId = 0;
+ } else if ((objc == 4)
+ && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
+ "includeids") == 0)) {
+ includeVisualId = 1;
+ } 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);
+ if (visInfoPtr == NULL) {
+ Tcl_SetStringObj(resultPtr,
+ "can't find any visuals for screen", -1);
+ return TCL_ERROR;
+ }
+ for (i = 0; i < count; i++) {
+ string = TkFindStateString(visualMap, visInfoPtr[i].class);
+ if (string == NULL) {
+ strcpy(buf, "unknown");
+ } else {
+ sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
+ }
+ if (includeVisualId) {
+ sprintf(visualIdString, " 0x%x",
+ (unsigned int) visInfoPtr[i].visualid);
+ strcat(buf, visualIdString);
+ }
+ strPtr = Tcl_NewStringObj(buf, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ XFree((char *) visInfoPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+#if 0
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WmObjCmd --
+ *
+ * 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_WmObjCmd(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;
+ TkWindow *winPtr;
+
+ static CONST char *optionStrings[] = {
+ "aspect", "client", "command", "deiconify",
+ "focusmodel", "frame", "geometry", "grid",
+ "group", "iconbitmap", "iconify", "iconmask",
+ "iconname", "iconposition", "iconwindow", "maxsize",
+ "minsize", "overrideredirect", "positionfrom", "protocol",
+ "resizable", "sizefrom", "state", "title",
+ "tracing", "transient", "withdraw", (char *) NULL
+ };
+ enum options {
+ TKWM_ASPECT, TKWM_CLIENT, TKWM_COMMAND, TKWM_DEICONIFY,
+ TKWM_FOCUSMOD, TKWM_FRAME, TKWM_GEOMETRY, TKWM_GRID,
+ TKWM_GROUP, TKWM_ICONBMP, TKWM_ICONIFY, TKWM_ICONMASK,
+ TKWM_ICONNAME, TKWM_ICONPOS, TKWM_ICONWIN, TKWM_MAXSIZE,
+ TKWM_MINSIZE, TKWM_OVERRIDE, TKWM_POSFROM, TKWM_PROTOCOL,
+ TKWM_RESIZABLE, TKWM_SIZEFROM, TKWM_STATE, TKWM_TITLE,
+ TKWM_TRACING, TKWM_TRANSIENT, TKWM_WITHDRAW
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == TKWM_TRACING) {
+ int wmTracing;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmTracing) {
+ dispPtr->flags |= TK_DISPLAY_WM_TRACING;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
+ }
+ return TCL_OK;
+ }
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) Tk_NameToWindow(interp,
+ Tcl_GetString(objv[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;
+ }
+
+ switch ((enum options) index) {
+ case TKWM_ASPECT: {
+ TkpWmAspectCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_CLIENT: {
+ TkpWmClientCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_COMMAND: {
+ TkpWmCommandCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_DEICONIFY: {
+ TkpWmDeiconifyCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_FOCUSMOD: {
+ TkpWmFocusmodCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_FRAME: {
+ TkpWmFrameCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_GEOMETRY: {
+ TkpWmGeometryCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_GRID: {
+ TkpWmGridCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_GROUP: {
+ TkpWmGroupCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONBMP: {
+ TkpWmIconbitmapCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONIFY: {
+ TkpWmIconifyCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONMASK: {
+ TkpWmIconmaskCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONNAME: {
+ /* slight Unix variation */
+ TkpWmIconnameCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONPOS: {
+ /* nearly same - 1 line more on Unix */
+ TkpWmIconpositionCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_ICONWIN: {
+ TkpWmIconwindowCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_MAXSIZE: {
+ /* nearly same, win diffs */
+ TkpWmMaxsizeCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_MINSIZE: {
+ /* nearly same, win diffs */
+ TkpWmMinsizeCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_OVERRIDE: {
+ /* almost same */
+ TkpWmOverrideCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_POSFROM: {
+ /* Equal across platforms */
+ TkpWmPositionfromCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_PROTOCOL: {
+ /* Equal across platforms */
+ TkpWmProtocolCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_RESIZABLE: {
+ /* almost same */
+ TkpWmResizableCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_SIZEFROM: {
+ /* Equal across platforms */
+ TkpWmSizefromCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_STATE: {
+ TkpWmStateCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_TITLE: {
+ TkpWmTitleCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_TRANSIENT: {
+ TkpWmTransientCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ case TKWM_WITHDRAW: {
+ TkpWmWithdrawCmd(interp, tkwin, winPtr, objc, objv);
+ break;
+ }
+ }
+
+ updateGeom:
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ CONST 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/tcl/generic/tkColor.c b/tcl/generic/tkColor.c
new file mode 100644
index 00000000000..94ea80c09be
--- /dev/null
+++ b/tcl/generic/tkColor.c
@@ -0,0 +1,813 @@
+/*
+ * tkColor.c --
+ *
+ * This file maintains a database of color values for the Tk
+ * toolkit, in order to avoid round-trips to the server to
+ * map color names to pixel values.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkColor.h"
+
+/*
+ * Structures of the following following type are used as keys for
+ * colorValueTable (in TkDisplay).
+ */
+
+typedef struct {
+ int red, green, blue; /* Values for desired color. */
+ Colormap colormap; /* Colormap from which color will be
+ * allocated. */
+ Display *display; /* Display for colormap. */
+} ValueKey;
+
+
+/*
+ * The structure below is used to allocate thread-local data.
+ */
+
+typedef struct ThreadSpecificData {
+ char rgbString[20]; /* */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void ColorInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupColorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeColorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void InitColorObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "color" Tcl
+ * object, which maps a string color name to a TkColor object. The
+ * ptr1 field of the Tcl_Obj points to a TkColor object.
+ */
+
+Tcl_ObjType tkColorObjType = {
+ "color", /* name */
+ FreeColorObjProc, /* freeIntRepProc */
+ DupColorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocColorFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * XColor structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the red, blue, and green intensities for the color
+ * given by the string in objPtr, and also specifies a pixel value
+ * to use to draw in that color. If an error occurs, NULL is
+ * returned and an error message will be left in interp's result
+ * (unless interp is NULL).
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColorFromObj so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_AllocColorFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Used only for error reporting. If NULL,
+ * then no messages are provided. */
+ Tk_Window tkwin; /* Window in which the color will be used.*/
+ Tcl_Obj *objPtr; /* Object that describes the color; string
+ * value is a color name such as "red" or
+ * "#ff0000".*/
+{
+ TkColor *tkColPtr;
+
+ if (objPtr->typePtr != &tkColorObjType) {
+ InitColorObj(objPtr);
+ }
+ tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkColor, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (tkColPtr != NULL) {
+ if (tkColPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkColor that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeColorObjProc(objPtr);
+ tkColPtr = NULL;
+ } else if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ return (XColor *) tkColPtr;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkColor that we wanted. Search
+ * the list of TkColors with the same name to see if one of the
+ * other TkColors is the right one.
+ */
+
+ if (tkColPtr != NULL) {
+ TkColor *firstColorPtr =
+ (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
+ FreeColorObjProc(objPtr);
+ for (tkColPtr = firstColorPtr; tkColPtr != NULL;
+ tkColPtr = tkColPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ tkColPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ return (XColor *) tkColPtr;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call Tk_GetColor to allocate a new TkColor object.
+ */
+
+ tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
+ }
+ return (XColor *) tkColPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColor --
+ *
+ * Given a string name for a color, map the name to a corresponding
+ * XColor structure.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the red, blue, and green intensities for the color
+ * given by "name", and also specifies a pixel value to use to
+ * draw in that color. If an error occurs, NULL is returned and
+ * an error message will be left in the interp's result.
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColor so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColor(interp, tkwin, name)
+ Tcl_Interp *interp; /* Place to leave error message if
+ * color can't be found. */
+ Tk_Window tkwin; /* Window in which color will be used. */
+ Tk_Uid name; /* Name of color to be allocated (in form
+ * suitable for passing to XParseColor). */
+{
+ Tcl_HashEntry *nameHashPtr;
+ int new;
+ TkColor *tkColPtr;
+ TkColor *existingColPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color
+ * name.
+ */
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &new);
+ if (!new) {
+ existingColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
+ for (tkColPtr = existingColPtr; tkColPtr != NULL;
+ tkColPtr = tkColPtr->nextPtr) {
+ if ((tkColPtr->screen == Tk_Screen(tkwin))
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ return &tkColPtr->color;
+ }
+ }
+ } else {
+ existingColPtr = NULL;
+ }
+
+ /*
+ * The name isn't currently known. Map from the name to a pixel
+ * value.
+ */
+
+ tkColPtr = TkpGetColor(tkwin, name);
+ if (tkColPtr == NULL) {
+ if (interp != NULL) {
+ if (*name == '#') {
+ Tcl_AppendResult(interp, "invalid color name \"", name,
+ "\"", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "unknown color name \"", name,
+ "\"", (char *) NULL);
+ }
+ }
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return (XColor *) NULL;
+ }
+
+ /*
+ * Now create a new TkColor structure and add it to colorNameTable
+ * (in TkDisplay).
+ */
+
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = Tk_Colormap(tkwin);
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_NAME;
+ tkColPtr->hashPtr = nameHashPtr;
+ tkColPtr->nextPtr = existingColPtr;
+ 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);
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color
+ * name.
+ */
+
+ valueKey.red = colorPtr->red;
+ valueKey.green = colorPtr->green;
+ valueKey.blue = colorPtr->blue;
+ valueKey.colormap = Tk_Colormap(tkwin);
+ valueKey.display = display;
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable,
+ (char *) &valueKey, &new);
+ if (!new) {
+ tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr);
+ tkColPtr->resourceRefCount++;
+ return &tkColPtr->color;
+ }
+
+ /*
+ * The name isn't currently known. Find a pixel value for this
+ * color and add a new structure to colorValueTable (in TkDisplay).
+ */
+
+ tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = valueKey.colormap;
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_VALUE;
+ tkColPtr->hashPtr = valueHashPtr;
+ tkColPtr->nextPtr = 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfColor(colorPtr)
+ XColor *colorPtr; /* Color whose name is desired. */
+{
+ register TkColor *tkColPtr = (TkColor *) colorPtr;
+
+ if ((tkColPtr->magic == COLOR_MAGIC) &&
+ (tkColPtr->type == TK_COLOR_BY_NAME)) {
+ return tkColPtr->hashPtr->key.string;
+ } else {
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red,
+ colorPtr->green, colorPtr->blue);
+ return tsdPtr->rgbString;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ 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. */
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ Screen *screen = tkColPtr->screen;
+ TkColor *prevPtr;
+
+ /*
+ * Do a quick sanity check to make sure this color was really
+ * allocated by Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ panic("Tk_FreeColor called with bogus color");
+ }
+
+ tkColPtr->resourceRefCount--;
+ if (tkColPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ /*
+ * This color is no longer being actively used, so free the color
+ * resources associated with it and remove it from the hash table.
+ * no longer any objects referencing it.
+ */
+
+ if (tkColPtr->gc != None) {
+ XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
+ tkColPtr->gc = None;
+ }
+ TkpFreeColor(tkColPtr);
+
+ prevPtr = (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
+ if (prevPtr == tkColPtr) {
+ if (tkColPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(tkColPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != tkColPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = tkColPtr->nextPtr;
+ }
+
+ /*
+ * Free the TkColor structure if there are no objects referencing
+ * it. However, if there are objects referencing it then keep the
+ * structure around; it will get freed when the last reference is
+ * cleared
+ */
+
+ if (tkColPtr->objRefCount == 0) {
+ ckfree((char *) tkColPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColorFromObj --
+ *
+ * This procedure is called to release a color allocated by
+ * Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this color
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the color represented by
+ * objPtr is decremented, and the color is released to X if there are
+ * no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this color lives in. Needed
+ * for the screen and colormap values. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr));
+ FreeColorObjProc(objPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeColorObjProc --
+ *
+ * This proc is called to release an object reference to a color.
+ * Called when the object's internal rep is released or when
+ * the cached tkColPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the color's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeColorObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount--;
+ if ((tkColPtr->objRefCount == 0)
+ && (tkColPtr->resourceRefCount == 0)) {
+ ckfree((char *) tkColPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupColorObjProc --
+ *
+ * When a cached color object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The color's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupColorObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColorFromObj --
+ *
+ * Returns the color referred to by a Tcl object. The color must
+ * already have been allocated via a call to Tk_AllocColorFromObj
+ * or Tk_GetColor.
+ *
+ * Results:
+ * Returns the XColor * that matches the tkwin and the string rep
+ * of objPtr.
+ *
+ * Side effects:
+ * If the object is not already a color, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window in which the color will be
+ * used. */
+ Tcl_Obj *objPtr; /* String value contains the name of the
+ * desired color. */
+{
+ TkColor *tkColPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkColorObjType) {
+ InitColorObj(objPtr);
+ }
+
+ /*
+ * First check to see if the internal representation of the object
+ * is defined and is a color that is valid for the current screen
+ * and color map. If it is, we are done.
+ */
+ tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+ if ((tkColPtr != NULL)
+ && (tkColPtr->resourceRefCount > 0)
+ && (Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ /*
+ * The object already points to the right TkColor structure.
+ * Just return it.
+ */
+
+ return (XColor *) tkColPtr;
+ }
+
+ /*
+ * If we reach this point, it means that the TkColor structure
+ * that we have cached in the internal representation is not valid
+ * for the current screen and colormap. But there is a list of
+ * other TkColor structures attached to the TkDisplay. Walk this
+ * list looking for the right TkColor structure.
+ */
+
+ hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ for (tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
+ (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ FreeColorObjProc(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ tkColPtr->objRefCount++;
+ return (XColor *) tkColPtr;
+ }
+ }
+
+ error:
+ panic(" Tk_GetColorFromObj called with non-existent color!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitColorObj --
+ *
+ * Bookeeping procedure to change an objPtr to a color type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old internal rep of the object is freed. The object's
+ * type is set to color with a NULL TkColor pointer (the pointer
+ * will be set later by either Tk_AllocColorFromObj or
+ * Tk_GetColorFromObj).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitColorObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkColorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ColorInit --
+ *
+ * Initialize the structure used for color management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ColorInit(dispPtr)
+ TkDisplay *dispPtr;
+{
+ if (!dispPtr->colorInit) {
+ dispPtr->colorInit = 1;
+ Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->colorValueTable,
+ sizeof(ValueKey)/sizeof(int));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugColor --
+ *
+ * This procedure returns debugging information about a color.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkColor
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkColor structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugColor(tkwin, name)
+ Tk_Window tkwin; /* The window in which the color will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkColor *tkColPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name);
+ if (hashPtr != NULL) {
+ tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
+ if (tkColPtr == NULL) {
+ panic("TkDebugColor found empty hash table entry");
+ }
+ for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(tkColPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(tkColPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
diff --git a/tcl/generic/tkColor.h b/tcl/generic/tkColor.h
new file mode 100644
index 00000000000..c82a87f7454
--- /dev/null
+++ b/tcl/generic/tkColor.h
@@ -0,0 +1,89 @@
+/*
+ * tkColor.h --
+ *
+ * Declarations of data types and functions used by the
+ * Tk color module.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKCOLOR
+#define _TKCOLOR
+
+#include <tkInt.h>
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * One of the following data structures is used to keep track of
+ * each color that is being used by the application; typically there
+ * is a colormap entry allocated for each of these colors.
+ */
+
+#define TK_COLOR_BY_NAME 1
+#define TK_COLOR_BY_VALUE 2
+
+#define COLOR_MAGIC ((unsigned int) 0x46140277)
+
+typedef struct TkColor {
+ XColor color; /* Information about this color. */
+ unsigned int magic; /* Used for quick integrity check on this
+ * structure. Must always have the
+ * value COLOR_MAGIC. */
+ GC gc; /* Simple gc with this color as foreground
+ * color and all other fields defaulted.
+ * May be None. */
+ Screen *screen; /* Screen where this color is valid. Used
+ * to delete it, and to find its display. */
+ Colormap colormap; /* Colormap from which this entry was
+ * allocated. */
+ Visual *visual; /* Visual associated with colormap. */
+ int resourceRefCount; /* Number of active uses of this color (each
+ * active use corresponds to a call to
+ * Tk_AllocColorFromObj or Tk_GetColor).
+ * If this count is 0, then this TkColor
+ * structure is no longer valid and it isn't
+ * present in a hash table: it is being
+ * kept around only because there are objects
+ * referring to it. The structure is freed
+ * when resourceRefCount and objRefCount
+ * are both 0. */
+ int objRefCount; /* The number of Tcl objects that reference
+ * this structure. */
+ int type; /* TK_COLOR_BY_NAME or TK_COLOR_BY_VALUE */
+ Tcl_HashEntry *hashPtr; /* Pointer to hash table entry for this
+ * structure. (for use in deleting entry). */
+ struct TkColor *nextPtr; /* Points to the next TkColor structure with
+ * the same color name. Colors with the
+ * same name but different screens or
+ * colormaps are chained together off a
+ * single entry in nameTable. For colors in
+ * valueTable (those allocated by
+ * Tk_GetColorByValue) this field is always
+ * NULL. */
+} TkColor;
+
+/*
+ * Common APIs exported from all platform-specific implementations.
+ */
+
+#ifndef TkpFreeColor
+EXTERN void TkpFreeColor _ANSI_ARGS_((TkColor *tkColPtr));
+#endif
+EXTERN TkColor * TkpGetColor _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_Uid name));
+EXTERN TkColor * TkpGetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
+ XColor *colorPtr));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKCOLOR */
diff --git a/tcl/generic/tkConfig.c b/tcl/generic/tkConfig.c
new file mode 100644
index 00000000000..c3ded1cda43
--- /dev/null
+++ b/tcl/generic/tkConfig.c
@@ -0,0 +1,2217 @@
+/*
+ * tkConfig.c --
+ *
+ * This file contains procedures that manage configuration options
+ * for widgets and other things.
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * Temporary flag for working on new config package.
+ */
+
+#if 0
+
+/*
+ * used only for removing the old config code
+ */
+
+#define __NO_OLD_CONFIG
+#endif
+
+#include "tk.h"
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkFont.h"
+
+/*
+ * The following definition is an AssocData key used to keep track of
+ * all of the option tables that have been created for an interpreter.
+ */
+
+#define OPTION_HASH_KEY "TkOptionTable"
+
+/*
+ * The following two structures are used along with Tk_OptionSpec
+ * structures to manage configuration options. Tk_OptionSpec is
+ * static templates that are compiled into the code of a widget
+ * or other object manager. However, to look up options efficiently
+ * we need to supplement the static information with additional
+ * dynamic information, and this dynamic information may be different
+ * for each application. Thus we create structures of the following
+ * two types to hold all of the dynamic information; this is done
+ * by Tk_CreateOptionTable.
+ *
+ * One of the following structures corresponds to each Tk_OptionSpec.
+ * These structures exist as arrays inside TkOptionTable structures.
+ */
+
+typedef struct TkOption {
+ CONST Tk_OptionSpec *specPtr; /* The original spec from the template
+ * passed to Tk_CreateOptionTable.*/
+ Tk_Uid dbNameUID; /* The Uid form of the option database
+ * name. */
+ Tk_Uid dbClassUID; /* The Uid form of the option database
+ * class name. */
+ Tcl_Obj *defaultPtr; /* Default value for this option. */
+ union {
+ Tcl_Obj *monoColorPtr; /* For color and border options, this
+ * is an alternate default value to
+ * use on monochrome displays. */
+ struct TkOption *synonymPtr; /* For synonym options, this points to
+ * the master entry. */
+ struct Tk_ObjCustomOption *custom; /* For TK_OPTION_CUSTOM. */
+ } extra;
+ int flags; /* Miscellaneous flag values; see
+ * below for definitions. */
+} Option;
+
+/*
+ * Flag bits defined for Option structures:
+ *
+ * OPTION_NEEDS_FREEING - 1 means that FreeResources must be
+ * invoke to free resources associated with
+ * the option when it is no longer needed.
+ */
+
+#define OPTION_NEEDS_FREEING 1
+
+/*
+ * One of the following exists for each Tk_OptionSpec array that has
+ * been passed to Tk_CreateOptionTable.
+ */
+
+typedef struct OptionTable {
+ int refCount; /* Counts the number of uses of this
+ * table (the number of times
+ * Tk_CreateOptionTable has returned
+ * it). This can be greater than 1 if
+ * it is shared along several option
+ * table chains, or if the same table
+ * is used for multiple purposes. */
+ Tcl_HashEntry *hashEntryPtr; /* Hash table entry that refers to this
+ * table; used to delete the entry. */
+ struct OptionTable *nextPtr; /* If templatePtr was part of a chain
+ * of templates, this points to the
+ * table corresponding to the next
+ * template in the chain. */
+ int numOptions; /* The number of items in the options
+ * array below. */
+ Option options[1]; /* Information about the individual
+ * options in the table. This must be
+ * the last field in the structure:
+ * the actual size of the array will
+ * be numOptions, not 1. */
+} OptionTable;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int DoObjConfig _ANSI_ARGS_((Tcl_Interp *interp,
+ char *recordPtr, Option *optionPtr,
+ Tcl_Obj *valuePtr, Tk_Window tkwin,
+ Tk_SavedOption *savePtr));
+static void DestroyOptionHashTable _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+static void FreeResources _ANSI_ARGS_((Option *optionPtr,
+ Tcl_Obj *objPtr, char *internalPtr,
+ Tk_Window tkwin));
+static Tcl_Obj * GetConfigList _ANSI_ARGS_((char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin));
+static Tcl_Obj * GetObjectForOption _ANSI_ARGS_((char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin));
+static Option * GetOption _ANSI_ARGS_((CONST char *name,
+ OptionTable *tablePtr));
+static Option * GetOptionFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, OptionTable *tablePtr));
+static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetOptionFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines an object type that is used to cache the
+ * result of looking up an option name. If an object has this type, then
+ * its internalPtr1 field points to the OptionTable in which it was looked up,
+ * and the internalPtr2 field points to the entry that matched.
+ */
+
+Tcl_ObjType tkOptionObjType = {
+ "option", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ SetOptionFromAny /* setFromAnyProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateOptionTable --
+ *
+ * Given a template for configuration options, this procedure
+ * creates a table that may be used to look up options efficiently.
+ *
+ * Results:
+ * Returns a token to a structure that can be passed to procedures
+ * such as Tk_InitOptions, Tk_SetOptions, and Tk_FreeConfigOptions.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_OptionTable
+Tk_CreateOptionTable(interp, templatePtr)
+ Tcl_Interp *interp; /* Interpreter associated with the
+ * application in which this table
+ * will be used. */
+ CONST Tk_OptionSpec *templatePtr; /* Static information about the
+ * configuration options. */
+{
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hashEntryPtr;
+ int newEntry;
+ OptionTable *tablePtr;
+ CONST Tk_OptionSpec *specPtr, *specPtr2;
+ Option *optionPtr;
+ int numOptions, i;
+
+ /*
+ * We use an AssocData value in the interpreter to keep a hash
+ * table of all the option tables we've created for this application.
+ * This is used for two purposes. First, it allows us to share the
+ * tables (e.g. in several chains) and second, we use the deletion
+ * callback for the AssocData to delete all the option tables when
+ * the interpreter is deleted. The code below finds the hash table
+ * or creates a new one if it doesn't already exist.
+ */
+
+ hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
+ NULL);
+ if (hashTablePtr == NULL) {
+ hashTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(hashTablePtr, TCL_ONE_WORD_KEYS);
+ Tcl_SetAssocData(interp, OPTION_HASH_KEY, DestroyOptionHashTable,
+ (ClientData) hashTablePtr);
+ }
+
+ /*
+ * See if a table has already been created for this template. If
+ * so, just reuse the existing table.
+ */
+
+ hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr,
+ &newEntry);
+ if (!newEntry) {
+ tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);
+ tablePtr->refCount++;
+ return (Tk_OptionTable) tablePtr;
+ }
+
+ /*
+ * Count the number of options in the template, then create the
+ * table structure.
+ */
+
+ numOptions = 0;
+ for (specPtr = templatePtr; specPtr->type != TK_OPTION_END; specPtr++) {
+ numOptions++;
+ }
+ tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable)
+ + ((numOptions - 1) * sizeof(Option))));
+ tablePtr->refCount = 1;
+ tablePtr->hashEntryPtr = hashEntryPtr;
+ tablePtr->nextPtr = NULL;
+ tablePtr->numOptions = numOptions;
+
+ /*
+ * Initialize all of the Option structures in the table.
+ */
+
+ for (specPtr = templatePtr, optionPtr = tablePtr->options;
+ specPtr->type != TK_OPTION_END; specPtr++, optionPtr++) {
+ optionPtr->specPtr = specPtr;
+ optionPtr->dbNameUID = NULL;
+ optionPtr->dbClassUID = NULL;
+ optionPtr->defaultPtr = NULL;
+ optionPtr->extra.monoColorPtr = NULL;
+ optionPtr->flags = 0;
+
+ if (specPtr->type == TK_OPTION_SYNONYM) {
+ /*
+ * This is a synonym option; find the master option that it
+ * refers to and create a pointer from the synonym to the
+ * master.
+ */
+
+ for (specPtr2 = templatePtr, i = 0; ; specPtr2++, i++) {
+ if (specPtr2->type == TK_OPTION_END) {
+ panic("Tk_CreateOptionTable couldn't find synonym");
+ }
+ if (strcmp(specPtr2->optionName,
+ (char *) specPtr->clientData) == 0) {
+ optionPtr->extra.synonymPtr = tablePtr->options + i;
+ break;
+ }
+ }
+ } else {
+ if (specPtr->dbName != NULL) {
+ optionPtr->dbNameUID = Tk_GetUid(specPtr->dbName);
+ }
+ if (specPtr->dbClass != NULL) {
+ optionPtr->dbClassUID =
+ Tk_GetUid(specPtr->dbClass);
+ }
+ if (specPtr->defValue != NULL) {
+ optionPtr->defaultPtr =
+ Tcl_NewStringObj(specPtr->defValue, -1);
+ Tcl_IncrRefCount(optionPtr->defaultPtr);
+ }
+ if (((specPtr->type == TK_OPTION_COLOR)
+ || (specPtr->type == TK_OPTION_BORDER))
+ && (specPtr->clientData != NULL)) {
+ optionPtr->extra.monoColorPtr =
+ Tcl_NewStringObj((char *) specPtr->clientData, -1);
+ Tcl_IncrRefCount(optionPtr->extra.monoColorPtr);
+ }
+
+ if (specPtr->type == TK_OPTION_CUSTOM) {
+ /*
+ * Get the custom parsing, etc., functions.
+ */
+ optionPtr->extra.custom =
+ (Tk_ObjCustomOption *)specPtr->clientData;
+ }
+ }
+ if (((specPtr->type == TK_OPTION_STRING)
+ && (specPtr->internalOffset >= 0))
+ || (specPtr->type == TK_OPTION_COLOR)
+ || (specPtr->type == TK_OPTION_FONT)
+ || (specPtr->type == TK_OPTION_BITMAP)
+ || (specPtr->type == TK_OPTION_BORDER)
+ || (specPtr->type == TK_OPTION_CURSOR)
+ || (specPtr->type == TK_OPTION_CUSTOM)) {
+ optionPtr->flags |= OPTION_NEEDS_FREEING;
+ }
+ }
+ tablePtr->hashEntryPtr = hashEntryPtr;
+ Tcl_SetHashValue(hashEntryPtr, tablePtr);
+
+ /*
+ * Finally, check to see if this template chains to another template
+ * with additional options. If so, call ourselves recursively to
+ * create the next table(s).
+ */
+
+ if (specPtr->clientData != NULL) {
+ tablePtr->nextPtr = (OptionTable *) Tk_CreateOptionTable(interp,
+ (Tk_OptionSpec *) specPtr->clientData);
+ }
+
+ return (Tk_OptionTable) tablePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteOptionTable --
+ *
+ * Called to release resources used by an option table when
+ * the table is no longer needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option table and associated resources (such as additional
+ * option tables chained off it) are destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteOptionTable(optionTable)
+ Tk_OptionTable optionTable; /* The option table to delete. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+
+ tablePtr->refCount--;
+ if (tablePtr->refCount > 0) {
+ return;
+ }
+
+ if (tablePtr->nextPtr != NULL) {
+ Tk_DeleteOptionTable((Tk_OptionTable) tablePtr->nextPtr);
+ }
+
+ for (count = tablePtr->numOptions - 1, optionPtr = tablePtr->options;
+ count > 0; count--, optionPtr++) {
+ if (optionPtr->defaultPtr != NULL) {
+ Tcl_DecrRefCount(optionPtr->defaultPtr);
+ }
+ if (((optionPtr->specPtr->type == TK_OPTION_COLOR)
+ || (optionPtr->specPtr->type == TK_OPTION_BORDER))
+ && (optionPtr->extra.monoColorPtr != NULL)) {
+ Tcl_DecrRefCount(optionPtr->extra.monoColorPtr);
+ }
+ }
+ Tcl_DeleteHashEntry(tablePtr->hashEntryPtr);
+ ckfree((char *) tablePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyOptionHashTable --
+ *
+ * This procedure is the deletion callback associated with the
+ * AssocData entry created by Tk_CreateOptionTable. It is
+ * invoked when an interpreter is deleted, and deletes all of
+ * the option tables associated with that interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option hash table is destroyed along with all of the
+ * OptionTable structures that it refers to.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyOptionHashTable(clientData, interp)
+ ClientData clientData; /* The hash table we are destroying */
+ Tcl_Interp *interp; /* The interpreter we are destroying */
+{
+ Tcl_HashTable *hashTablePtr = (Tcl_HashTable *) clientData;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hashEntryPtr;
+ OptionTable *tablePtr;
+
+ for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
+ hashEntryPtr != NULL;
+ hashEntryPtr = Tcl_NextHashEntry(&search)) {
+ tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);
+
+ /*
+ * The following statements do two tricky things:
+ * 1. They ensure that the option table is deleted, even if
+ * there are outstanding references to it.
+ * 2. They ensure that Tk_DeleteOptionTable doesn't delete
+ * other tables chained from this one; we'll do it when
+ * we come across the hash table entry for the chained
+ * table (in fact, the chained table may already have
+ * been deleted).
+ */
+
+ tablePtr->refCount = 1;
+ tablePtr->nextPtr = NULL;
+ Tk_DeleteOptionTable((Tk_OptionTable) tablePtr);
+ }
+ Tcl_DeleteHashTable(hashTablePtr);
+ ckfree((char *) hashTablePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_InitOptions --
+ *
+ * This procedure is invoked when an object such as a widget
+ * is created. It supplies an initial value for each configuration
+ * option (the value may come from the option database, a system
+ * default, or the default in the option table).
+ *
+ * Results:
+ * The return value is TCL_OK if the procedure completed
+ * successfully, and TCL_ERROR if one of the initial values was
+ * bogus. If an error occurs and interp isn't NULL, then an
+ * error message will be left in its result.
+ *
+ * Side effects:
+ * Fields of recordPtr are filled in with initial values.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_InitOptions(interp, recordPtr, optionTable, tkwin)
+ Tcl_Interp *interp; /* Interpreter for error reporting. NULL
+ * means don't leave an error message. */
+ char *recordPtr; /* Pointer to the record to configure.
+ * Note: the caller should have properly
+ * initialized the record with NULL
+ * pointers for each option value. */
+ Tk_OptionTable optionTable; /* The token which matches the config
+ * specs for the widget in question. */
+ Tk_Window tkwin; /* Certain options types (such as
+ * TK_OPTION_COLOR) need fields out
+ * of the window they are used in to
+ * be able to calculate their values.
+ * Not needed unless one of these
+ * options is in the configSpecs record. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+ Tk_Uid value;
+ Tcl_Obj *valuePtr;
+ enum {
+ OPTION_DATABASE, SYSTEM_DEFAULT, TABLE_DEFAULT
+ } source;
+
+ /*
+ * If this table chains to other tables, handle their initialization
+ * first. That way, if both tables refer to the same field of the
+ * record, the value in the first table will win.
+ */
+
+ if (tablePtr->nextPtr != NULL) {
+ if (Tk_InitOptions(interp, recordPtr,
+ (Tk_OptionTable) tablePtr->nextPtr, tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Iterate over all of the options in the table, initializing each in
+ * turn.
+ */
+
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+
+ /*
+ * If we specify TK_OPTION_DONT_SET_DEFAULT, then the user has
+ * processed and set a default for this already.
+ */
+ if ((optionPtr->specPtr->type == TK_OPTION_SYNONYM) ||
+ (optionPtr->specPtr->flags & TK_OPTION_DONT_SET_DEFAULT)) {
+ continue;
+ }
+ source = TABLE_DEFAULT;
+
+ /*
+ * We look in three places for the initial value, using the first
+ * non-NULL value that we find. First, check the option database.
+ */
+
+ valuePtr = NULL;
+ if (optionPtr->dbNameUID != NULL) {
+ value = Tk_GetOption(tkwin, optionPtr->dbNameUID,
+ optionPtr->dbClassUID);
+ if (value != NULL) {
+ valuePtr = Tcl_NewStringObj(value, -1);
+ source = OPTION_DATABASE;
+ }
+ }
+
+ /*
+ * Second, check for a system-specific default value.
+ */
+ if ((valuePtr == NULL)
+ && (optionPtr->dbNameUID != NULL)) {
+ valuePtr = TkpGetSystemDefault(tkwin, optionPtr->dbNameUID,
+ optionPtr->dbClassUID);
+ if (valuePtr != NULL) {
+ source = SYSTEM_DEFAULT;
+ }
+ }
+
+ /*
+ * Third and last, use the default value supplied by the option
+ * table. In the case of color objects, we pick one of two
+ * values depending on whether the screen is mono or color.
+ */
+
+ if (valuePtr == NULL) {
+ if ((tkwin != NULL)
+ && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
+ || (optionPtr->specPtr->type == TK_OPTION_BORDER))
+ && (Tk_Depth(tkwin) <= 1)
+ && (optionPtr->extra.monoColorPtr != NULL)) {
+ valuePtr = optionPtr->extra.monoColorPtr;
+ } else {
+ valuePtr = optionPtr->defaultPtr;
+ }
+ }
+
+ if (valuePtr == NULL) {
+ continue;
+ }
+
+ /*
+ * Bump the reference count on valuePtr, so that it is strongly
+ * referenced here, and will be properly free'd when finished,
+ * regardless of what DoObjConfig does.
+ */
+ Tcl_IncrRefCount(valuePtr);
+
+ if (DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin,
+ (Tk_SavedOption *) NULL) != TCL_OK) {
+ if (interp != NULL) {
+ char msg[200];
+
+ switch (source) {
+ case OPTION_DATABASE:
+ sprintf(msg, "\n (database entry for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ break;
+ case SYSTEM_DEFAULT:
+ sprintf(msg, "\n (system default for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ break;
+ case TABLE_DEFAULT:
+ sprintf(msg, "\n (default value for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ }
+ if (tkwin != NULL) {
+ sprintf(msg + strlen(msg) - 1, " in widget \"%.50s\")",
+ Tk_PathName(tkwin));
+ }
+ Tcl_AddErrorInfo(interp, msg);
+ }
+ Tcl_DecrRefCount(valuePtr);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoObjConfig --
+ *
+ * This procedure applies a new value for a configuration option
+ * to the record being configured.
+ *
+ * Results:
+ * The return value is TCL_OK if the procedure completed
+ * successfully. If an error occurred then TCL_ERROR is
+ * returned and an error message is left in interp's result, if
+ * interp isn't NULL. In addition, if oldValuePtrPtr isn't
+ * NULL then it *oldValuePtrPtr is filled in with a pointer
+ * to the option's old value.
+ *
+ * Side effects:
+ * RecordPtr gets modified to hold the new value in the form of
+ * a Tcl_Obj, an internal representation, or both. The old
+ * value is freed if oldValuePtrPtr is NULL.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, savedOptionPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. If
+ * NULL, then no message is left if an error
+ * occurs. */
+ char *recordPtr; /* The record to modify to hold the new
+ * option value. */
+ Option *optionPtr; /* Pointer to information about the
+ * option. */
+ Tcl_Obj *valuePtr; /* New value for option. */
+ Tk_Window tkwin; /* Window in which option will be used (needed
+ * to allocate resources for some options).
+ * May be NULL if the option doesn't
+ * require window-related resources. */
+ Tk_SavedOption *savedOptionPtr;
+ /* If NULL, the old value for the option will
+ * be freed. If non-NULL, the old value will
+ * be stored here, and it becomes the property
+ * of the caller (the caller must eventually
+ * free the old value). */
+{
+ Tcl_Obj **slotPtrPtr, *oldPtr;
+ char *internalPtr; /* Points to location in record where
+ * internal representation of value should
+ * be stored, or NULL. */
+ char *oldInternalPtr; /* Points to location in which to save old
+ * internal representation of value. */
+ Tk_SavedOption internal; /* Used to save the old internal representation
+ * of the value if savedOptionPtr is NULL. */
+ CONST Tk_OptionSpec *specPtr;
+ int nullOK;
+
+ /*
+ * Save the old object form for the value, if there is one.
+ */
+
+ specPtr = optionPtr->specPtr;
+ if (specPtr->objOffset >= 0) {
+ slotPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
+ oldPtr = *slotPtrPtr;
+ } else {
+ slotPtrPtr = NULL;
+ oldPtr = NULL;
+ }
+
+ /*
+ * Apply the new value in a type-specific way. Also remember the
+ * old object and internal forms, if they exist.
+ */
+
+ if (specPtr->internalOffset >= 0) {
+ internalPtr = recordPtr + specPtr->internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+ if (savedOptionPtr != NULL) {
+ savedOptionPtr->optionPtr = optionPtr;
+ savedOptionPtr->valuePtr = oldPtr;
+ oldInternalPtr = (char *) &savedOptionPtr->internalForm;
+ } else {
+ oldInternalPtr = (char *) &internal.internalForm;
+ }
+ nullOK = (optionPtr->specPtr->flags & TK_OPTION_NULL_OK);
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_BOOLEAN: {
+ int new;
+
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &new)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_INT: {
+ int new;
+
+ if (Tcl_GetIntFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_DOUBLE: {
+ double new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = 0;
+ } else {
+ if (Tcl_GetDoubleFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (internalPtr != NULL) {
+ *((double *) oldInternalPtr) = *((double *) internalPtr);
+ *((double *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_STRING: {
+ char *new, *value;
+ int length;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ }
+ if (internalPtr != NULL) {
+ if (valuePtr != NULL) {
+ value = Tcl_GetStringFromObj(valuePtr, &length);
+ new = ckalloc((unsigned) (length + 1));
+ strcpy(new, value);
+ } else {
+ new = NULL;
+ }
+ *((char **) oldInternalPtr) = *((char **) internalPtr);
+ *((char **) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_STRING_TABLE: {
+ int new;
+
+ if (Tcl_GetIndexFromObj(interp, valuePtr,
+ (CONST char **) optionPtr->specPtr->clientData,
+ optionPtr->specPtr->optionName+1, 0, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_COLOR: {
+ XColor *newPtr;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newPtr = NULL;
+ } else {
+ newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((XColor **) oldInternalPtr) = *((XColor **) internalPtr);
+ *((XColor **) internalPtr) = newPtr;
+ }
+ break;
+ }
+ case TK_OPTION_FONT: {
+ Tk_Font new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_AllocFontFromObj(interp, tkwin, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Font *) oldInternalPtr) = *((Tk_Font *) internalPtr);
+ *((Tk_Font *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ Tk_Style new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_AllocStyleFromObj(interp, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Style *) oldInternalPtr) = *((Tk_Style *) internalPtr);
+ *((Tk_Style *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ Pixmap new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = None;
+ } else {
+ new = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Pixmap *) oldInternalPtr) = *((Pixmap *) internalPtr);
+ *((Pixmap *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_3DBorder *) oldInternalPtr) =
+ *((Tk_3DBorder *) internalPtr);
+ *((Tk_3DBorder *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ int new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = TK_RELIEF_NULL;
+ } else {
+ if (Tk_GetReliefFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ new = None;
+ valuePtr = NULL;
+ } else {
+ new = Tk_AllocCursorFromObj(interp, tkwin, valuePtr);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr);
+ *((Tk_Cursor *) internalPtr) = new;
+ }
+ Tk_DefineCursor(tkwin, new);
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ Tk_Justify new;
+
+ if (Tk_GetJustifyFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Justify *) oldInternalPtr)
+ = *((Tk_Justify *) internalPtr);
+ *((Tk_Justify *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ Tk_Anchor new;
+
+ if (Tk_GetAnchorFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Anchor *) oldInternalPtr)
+ = *((Tk_Anchor *) internalPtr);
+ *((Tk_Anchor *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ int new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = 0;
+ } else {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
+ &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ Tk_Window new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = None;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, valuePtr, &new)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Window *) oldInternalPtr) = *((Tk_Window *) internalPtr);
+ *((Tk_Window *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ if (custom->setProc(custom->clientData, interp, tkwin,
+ &valuePtr, recordPtr, optionPtr->specPtr->internalOffset,
+ (char *)oldInternalPtr,
+ optionPtr->specPtr->flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+
+ default: {
+ char buf[40+TCL_INTEGER_SPACE];
+ sprintf(buf, "bad config table: unknown type %d",
+ optionPtr->specPtr->type);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Release resources associated with the old value, if we're not
+ * returning it to the caller, then install the new object value into
+ * the record.
+ */
+
+ if (savedOptionPtr == NULL) {
+ if (optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
+ }
+ if (oldPtr != NULL) {
+ Tcl_DecrRefCount(oldPtr);
+ }
+ }
+ if (slotPtrPtr != NULL) {
+ *slotPtrPtr = valuePtr;
+ if (valuePtr != NULL) {
+ Tcl_IncrRefCount(valuePtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ObjectIsEmpty --
+ *
+ * This procedure tests whether the string value of an object is
+ * empty.
+ *
+ * Results:
+ * The return value is 1 if the string value of objPtr has length
+ * zero, and 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ObjectIsEmpty(objPtr)
+ Tcl_Obj *objPtr; /* Object to test. May be NULL. */
+{
+ int length;
+
+ if (objPtr == NULL) {
+ return 1;
+ }
+ if (objPtr->bytes != NULL) {
+ return (objPtr->length == 0);
+ }
+ Tcl_GetStringFromObj(objPtr, &length);
+ return (length == 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOption --
+ *
+ * This procedure searches through a chained option table to find
+ * the entry for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL
+ * if no matching entry could be found.
+ * Note: if the matching entry is a synonym then this procedure
+ * returns a pointer to the synonym entry, *not* the "real" entry
+ * that the synonym refers to.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Option *
+GetOption(name, tablePtr)
+ CONST char *name; /* String balue to be looked up in the
+ * option table. */
+ OptionTable *tablePtr; /* Table in which to look up name. */
+{
+ Option *bestPtr, *optionPtr;
+ OptionTable *tablePtr2;
+ CONST char *p1, *p2;
+ int count;
+
+ /*
+ * Search through all of the option tables in the chain to find the
+ * best match. Some tricky aspects:
+ *
+ * 1. We have to accept unique abbreviations.
+ * 2. The same name could appear in different tables in the chain.
+ * If this happens, we use the entry from the first table. We
+ * have to be careful to distinguish this case from an ambiguous
+ * abbreviation.
+ */
+
+ bestPtr = NULL;
+ for (tablePtr2 = tablePtr; tablePtr2 != NULL;
+ tablePtr2 = tablePtr2->nextPtr) {
+ for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions;
+ count > 0; optionPtr++, count--) {
+ for (p1 = name, p2 = optionPtr->specPtr->optionName;
+ *p1 == *p2; p1++, p2++) {
+ if (*p1 == 0) {
+ /*
+ * This is an exact match. We're done.
+ */
+
+ bestPtr = optionPtr;
+ goto done;
+ }
+ }
+ if (*p1 == 0) {
+ /*
+ * The name is an abbreviation for this option. Keep
+ * to make sure that the abbreviation only matches one
+ * option name. If we've already found a match in the
+ * past, then it is an error unless the full names for
+ * the two options are identical; in this case, the first
+ * option overrides the second.
+ */
+
+ if (bestPtr == NULL) {
+ bestPtr = optionPtr;
+ } else {
+ if (strcmp(bestPtr->specPtr->optionName,
+ optionPtr->specPtr->optionName) != 0) {
+ goto error;
+ }
+ }
+ }
+ }
+ }
+
+ done:
+ return bestPtr;
+
+ error:
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOptionFromObj --
+ *
+ * This procedure searches through a chained option table to find
+ * the entry for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL
+ * if no matching entry could be found. If NULL is returned and
+ * interp is not NULL than an error message is left in its result.
+ * Note: if the matching entry is a synonym then this procedure
+ * returns a pointer to the synonym entry, *not* the "real" entry
+ * that the synonym refers to.
+ *
+ * Side effects:
+ * Information about the matching entry is cached in the object
+ * containing the name, so that future lookups can proceed more
+ * quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Option *
+GetOptionFromObj(interp, objPtr, tablePtr)
+ Tcl_Interp *interp; /* Used only for error reporting; if NULL
+ * no message is left after an error. */
+ Tcl_Obj *objPtr; /* Object whose string value is to be
+ * looked up in the option table. */
+ OptionTable *tablePtr; /* Table in which to look up objPtr. */
+{
+ Option *bestPtr;
+ char *name;
+
+ /*
+ * First, check to see if the object already has the answer cached.
+ */
+
+ if (objPtr->typePtr == &tkOptionObjType) {
+ if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) {
+ return (Option *) objPtr->internalRep.twoPtrValue.ptr2;
+ }
+ }
+
+ /*
+ * The answer isn't cached.
+ */
+
+ name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ bestPtr = GetOption(name, tablePtr);
+ if (bestPtr == NULL) {
+ goto error;
+ }
+
+ if ((objPtr->typePtr != NULL)
+ && (objPtr->typePtr->freeIntRepProc != NULL)) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr;
+ objPtr->typePtr = &tkOptionObjType;
+ return bestPtr;
+
+ error:
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "unknown option \"", name,
+ "\"", (char *) NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetOptionSpec --
+ *
+ * This procedure searches through a chained option table to find
+ * the option spec for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the option spec of the matching
+ * entry, or NULL if no matching entry could be found.
+ * Note: if the matching entry is a synonym then this procedure
+ * returns a pointer to the option spec of the synonym entry, *not*
+ * the "real" entry that the synonym refers to.
+ * Note: this call is primarily used by the style management code
+ * (tkStyle.c) to look up an element's option spec into a widget's
+ * option table.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST Tk_OptionSpec *
+TkGetOptionSpec(name, optionTable)
+ CONST char *name; /* String value to be looked up. */
+ Tk_OptionTable optionTable; /* Table in which to look up name. */
+{
+ Option *optionPtr;
+
+ optionPtr = GetOption(name, (OptionTable *) optionTable);
+ if (optionPtr == NULL) {
+ return NULL;
+ }
+ return optionPtr->specPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOptionFromAny --
+ *
+ * This procedure is called to convert a Tcl object to option
+ * internal form. However, this doesn't make sense (need to have a
+ * table of options in order to do the conversion) so the
+ * procedure always generates an error.
+ *
+ * Results:
+ * The return value is always TCL_ERROR, and an error message is
+ * left in interp's result if interp isn't NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOptionFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "can't convert value to option except via GetOptionFromObj API",
+ -1);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetOptions --
+ *
+ * Process one or more name-value pairs for configuration options
+ * and fill in fields of a record with new values.
+ *
+ * Results:
+ * If all goes well then TCL_OK is returned and the old values of
+ * any modified objects are saved in *savePtr, if it isn't NULL (the
+ * caller must eventually call Tk_RestoreSavedOptions or
+ * Tk_FreeSavedOptions to free the contents of *savePtr). In
+ * addition, if maskPtr isn't NULL then *maskPtr is filled in with
+ * the OR of the typeMask bits from all modified options. If an
+ * error occurs then TCL_ERROR is returned and a message
+ * is left in interp's result unless interp is NULL; nothing is
+ * saved in *savePtr or *maskPtr in this case.
+ *
+ * Side effects:
+ * The fields of recordPtr get filled in with object pointers
+ * from objc/objv. Old information in widgRec's fields gets
+ * recycled. Information may be left at *savePtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SetOptions(interp, recordPtr, optionTable, objc, objv, tkwin, savePtr,
+ maskPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting.
+ * If NULL, then no error message is
+ * returned.*/
+ char *recordPtr; /* The record to configure. */
+ Tk_OptionTable optionTable; /* Describes valid options. */
+ int objc; /* The number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Contains one or more name-value
+ * pairs. */
+ Tk_Window tkwin; /* Window associated with the thing
+ * being configured; needed for some
+ * options (such as colors). */
+ Tk_SavedOptions *savePtr; /* If non-NULL, the old values of
+ * modified options are saved here
+ * so that they can be restored
+ * after an error. */
+ int *maskPtr; /* It non-NULL, this word is modified
+ * on a successful return to hold the
+ * bit-wise OR of the typeMask fields
+ * of all options that were modified
+ * by this call. Used by the caller
+ * to figure out which options
+ * actually changed. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ Tk_SavedOptions *lastSavePtr, *newSavePtr;
+ int mask;
+
+ if (savePtr != NULL) {
+ savePtr->recordPtr = recordPtr;
+ savePtr->tkwin = tkwin;
+ savePtr->numItems = 0;
+ savePtr->nextPtr = NULL;
+ }
+ lastSavePtr = savePtr;
+
+ /*
+ * Scan through all of the arguments, processing those
+ * that match entries in the option table.
+ */
+
+ mask = 0;
+ for ( ; objc > 0; objc -= 2, objv += 2) {
+ optionPtr = GetOptionFromObj(interp, objv[0], tablePtr);
+ if (optionPtr == NULL) {
+ goto error;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+
+ if (objc < 2) {
+ if (interp != NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "value for \"", Tcl_GetStringFromObj(*objv, NULL),
+ "\" missing", (char *) NULL);
+ goto error;
+ }
+ }
+ if ((savePtr != NULL)
+ && (lastSavePtr->numItems >= TK_NUM_SAVED_OPTIONS)) {
+ /*
+ * We've run out of space for saving old option values. Allocate
+ * more space.
+ */
+
+ newSavePtr = (Tk_SavedOptions *) ckalloc(sizeof(
+ Tk_SavedOptions));
+ newSavePtr->recordPtr = recordPtr;
+ newSavePtr->tkwin = tkwin;
+ newSavePtr->numItems = 0;
+ newSavePtr->nextPtr = NULL;
+ lastSavePtr->nextPtr = newSavePtr;
+ lastSavePtr = newSavePtr;
+ }
+ if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin,
+ (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems]
+ : (Tk_SavedOption *) NULL) != TCL_OK) {
+ char msg[100];
+
+ sprintf(msg, "\n (processing \"%.40s\" option)",
+ Tcl_GetStringFromObj(*objv, NULL));
+ Tcl_AddErrorInfo(interp, msg);
+ goto error;
+ }
+ if (savePtr != NULL) {
+ lastSavePtr->numItems++;
+ }
+ mask |= optionPtr->specPtr->typeMask;
+ }
+ if (maskPtr != NULL) {
+ *maskPtr = mask;
+ }
+ return TCL_OK;
+
+ error:
+ if (savePtr != NULL) {
+ Tk_RestoreSavedOptions(savePtr);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestoreSavedOptions --
+ *
+ * This procedure undoes the effect of a previous call to
+ * Tk_SetOptions by restoring all of the options to their value
+ * before the call to Tk_SetOptions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The configutation record is restored and all the information
+ * stored in savePtr is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_RestoreSavedOptions(savePtr)
+ Tk_SavedOptions *savePtr; /* Holds saved option information; must
+ * have been passed to Tk_SetOptions. */
+{
+ int i;
+ Option *optionPtr;
+ Tcl_Obj *newPtr; /* New object value of option, which we
+ * replace with old value and free. Taken
+ * from record. */
+ char *internalPtr; /* Points to internal value of option in
+ * record. */
+ CONST Tk_OptionSpec *specPtr;
+
+ /*
+ * Be sure to restore the options in the opposite order they were
+ * set. This is important because it's possible that the same
+ * option name was used twice in a single call to Tk_SetOptions.
+ */
+
+ if (savePtr->nextPtr != NULL) {
+ Tk_RestoreSavedOptions(savePtr->nextPtr);
+ ckfree((char *) savePtr->nextPtr);
+ savePtr->nextPtr = NULL;
+ }
+ for (i = savePtr->numItems - 1; i >= 0; i--) {
+ optionPtr = savePtr->items[i].optionPtr;
+ specPtr = optionPtr->specPtr;
+
+ /*
+ * First free the new value of the option, which is currently
+ * in the record.
+ */
+
+ if (specPtr->objOffset >= 0) {
+ newPtr = *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset));
+ } else {
+ newPtr = NULL;
+ }
+ if (specPtr->internalOffset >= 0) {
+ internalPtr = savePtr->recordPtr + specPtr->internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+ if (optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(optionPtr, newPtr, internalPtr, savePtr->tkwin);
+ }
+ if (newPtr != NULL) {
+ Tcl_DecrRefCount(newPtr);
+ }
+
+ /*
+ * Now restore the old value of the option.
+ */
+
+ if (specPtr->objOffset >= 0) {
+ *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset))
+ = savePtr->items[i].valuePtr;
+ }
+ if (specPtr->internalOffset >= 0) {
+ switch (specPtr->type) {
+ case TK_OPTION_BOOLEAN: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_INT: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_DOUBLE: {
+ *((double *) internalPtr)
+ = *((double *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_STRING: {
+ *((char **) internalPtr)
+ = *((char **) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_STRING_TABLE: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_COLOR: {
+ *((XColor **) internalPtr)
+ = *((XColor **) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_FONT: {
+ *((Tk_Font *) internalPtr)
+ = *((Tk_Font *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ *((Tk_Style *) internalPtr)
+ = *((Tk_Style *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ *((Pixmap *) internalPtr)
+ = *((Pixmap *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ *((Tk_3DBorder *) internalPtr)
+ = *((Tk_3DBorder *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ *((Tk_Cursor *) internalPtr)
+ = *((Tk_Cursor *) &savePtr->items[i].internalForm);
+ Tk_DefineCursor(savePtr->tkwin,
+ *((Tk_Cursor *) internalPtr));
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ *((Tk_Justify *) internalPtr)
+ = *((Tk_Justify *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ *((Tk_Anchor *) internalPtr)
+ = *((Tk_Anchor *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ *((Tk_Window *) internalPtr)
+ = *((Tk_Window *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ if (custom->restoreProc != NULL) {
+ custom->restoreProc(custom->clientData, savePtr->tkwin,
+ internalPtr,
+ (char *)&savePtr->items[i].internalForm);
+ }
+ break;
+ }
+ default: {
+ panic("bad option type in Tk_RestoreSavedOptions");
+ }
+ }
+ }
+ }
+ savePtr->numItems = 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FreeSavedOptions --
+ *
+ * Free all of the saved configuration option values from a
+ * previous call to Tk_SetOptions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage and system resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_FreeSavedOptions(savePtr)
+ Tk_SavedOptions *savePtr; /* Contains options saved in a previous
+ * call to Tk_SetOptions. */
+{
+ int count;
+ Tk_SavedOption *savedOptionPtr;
+
+ if (savePtr->nextPtr != NULL) {
+ Tk_FreeSavedOptions(savePtr->nextPtr);
+ ckfree((char *) savePtr->nextPtr);
+ }
+ for (count = savePtr->numItems,
+ savedOptionPtr = &savePtr->items[savePtr->numItems-1];
+ count > 0; count--, savedOptionPtr--) {
+ if (savedOptionPtr->optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(savedOptionPtr->optionPtr, savedOptionPtr->valuePtr,
+ (char *) &savedOptionPtr->internalForm, savePtr->tkwin);
+ }
+ if (savedOptionPtr->valuePtr != NULL) {
+ Tcl_DecrRefCount(savedOptionPtr->valuePtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeConfigOptions --
+ *
+ * Free all resources associated with configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All of the Tcl_Obj's in recordPtr that are controlled by
+ * configuration options in optionTable are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+Tk_FreeConfigOptions(recordPtr, optionTable, tkwin)
+ char *recordPtr; /* Record whose fields contain current
+ * values for options. */
+ Tk_OptionTable optionTable; /* Describes legal options. */
+ Tk_Window tkwin; /* Window associated with recordPtr; needed
+ * for freeing some options. */
+{
+ OptionTable *tablePtr;
+ Option *optionPtr;
+ int count;
+ Tcl_Obj **oldPtrPtr, *oldPtr;
+ char *oldInternalPtr;
+ CONST Tk_OptionSpec *specPtr;
+
+ for (tablePtr = (OptionTable *) optionTable; tablePtr != NULL;
+ tablePtr = tablePtr->nextPtr) {
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+ specPtr = optionPtr->specPtr;
+ if (specPtr->type == TK_OPTION_SYNONYM) {
+ continue;
+ }
+ if (specPtr->objOffset >= 0) {
+ oldPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
+ oldPtr = *oldPtrPtr;
+ *oldPtrPtr = NULL;
+ } else {
+ oldPtr = NULL;
+ }
+ if (specPtr->internalOffset >= 0) {
+ oldInternalPtr = recordPtr + specPtr->internalOffset;
+ } else {
+ oldInternalPtr = NULL;
+ }
+ if (optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
+ }
+ if (oldPtr != NULL) {
+ Tcl_DecrRefCount(oldPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeResources --
+ *
+ * Free system resources associated with a configuration option,
+ * such as colors or fonts.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any system resources associated with objPtr are released. However,
+ * objPtr itself is not freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeResources(optionPtr, objPtr, internalPtr, tkwin)
+ Option *optionPtr; /* Description of the configuration option. */
+ Tcl_Obj *objPtr; /* The current value of the option, specified
+ * as an object. */
+ char *internalPtr; /* A pointer to an internal representation for
+ * the option's value, such as an int or
+ * (XColor *). Only valid if
+ * optionPtr->specPtr->internalOffset >= 0. */
+ Tk_Window tkwin; /* The window in which this option is used. */
+{
+ int internalFormExists;
+
+ /*
+ * If there exists an internal form for the value, use it to free
+ * resources (also zero out the internal form). If there is no
+ * internal form, then use the object form.
+ */
+
+ internalFormExists = optionPtr->specPtr->internalOffset >= 0;
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_STRING:
+ if (internalFormExists) {
+ if (*((char **) internalPtr) != NULL) {
+ ckfree(*((char **) internalPtr));
+ *((char **) internalPtr) = NULL;
+ }
+ }
+ break;
+ case TK_OPTION_COLOR:
+ if (internalFormExists) {
+ if (*((XColor **) internalPtr) != NULL) {
+ Tk_FreeColor(*((XColor **) internalPtr));
+ *((XColor **) internalPtr) = NULL;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeColorFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_FONT:
+ if (internalFormExists) {
+ Tk_FreeFont(*((Tk_Font *) internalPtr));
+ *((Tk_Font *) internalPtr) = NULL;
+ } else if (objPtr != NULL) {
+ Tk_FreeFontFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_STYLE:
+ if (internalFormExists) {
+ Tk_FreeStyle(*((Tk_Style *) internalPtr));
+ *((Tk_Style *) internalPtr) = NULL;
+ } else if (objPtr != NULL) {
+ Tk_FreeStyleFromObj(objPtr);
+ }
+ break;
+ case TK_OPTION_BITMAP:
+ if (internalFormExists) {
+ if (*((Pixmap *) internalPtr) != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), *((Pixmap *) internalPtr));
+ *((Pixmap *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeBitmapFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_BORDER:
+ if (internalFormExists) {
+ if (*((Tk_3DBorder *) internalPtr) != NULL) {
+ Tk_Free3DBorder(*((Tk_3DBorder *) internalPtr));
+ *((Tk_3DBorder *) internalPtr) = NULL;
+ }
+ } else if (objPtr != NULL) {
+ Tk_Free3DBorderFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_CURSOR:
+ if (internalFormExists) {
+ if (*((Tk_Cursor *) internalPtr) != None) {
+ Tk_FreeCursor(Tk_Display(tkwin),
+ *((Tk_Cursor *) internalPtr));
+ *((Tk_Cursor *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeCursorFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ if (internalFormExists && custom->freeProc != NULL) {
+ custom->freeProc(custom->clientData, tkwin, internalPtr);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetOptionInfo --
+ *
+ * Returns a list object containing complete information about
+ * either a single option or all the configuration options in a
+ * table.
+ *
+ * Results:
+ * This procedure normally returns a pointer to an object.
+ * If namePtr isn't NULL, then the result object is a list with
+ * five elements: the option's name, its database name, database
+ * class, default value, and current value. If the option is a
+ * synonym then the list will contain only two values: the option
+ * name and the name of the option it refers to. If namePtr is
+ * NULL, then information is returned for every option in the
+ * option table: the result will have one sub-list (in the form
+ * described above) for each option in the table. If an error
+ * occurs (e.g. because namePtr isn't valid) then NULL is returned
+ * and an error message will be left in interp's result unless
+ * interp is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tk_GetOptionInfo(interp, recordPtr, optionTable, namePtr, tkwin)
+ Tcl_Interp *interp; /* Interpreter for error reporting. If
+ * NULL, then no error message is created. */
+ char *recordPtr; /* Record whose fields contain current
+ * values for options. */
+ Tk_OptionTable optionTable; /* Describes all the legal options. */
+ Tcl_Obj *namePtr; /* If non-NULL, the string value selects
+ * a single option whose info is to be
+ * returned. Otherwise info is returned for
+ * all options in optionTable. */
+ Tk_Window tkwin; /* Window associated with recordPtr; needed
+ * to compute correct default value for some
+ * options. */
+{
+ Tcl_Obj *resultPtr;
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+
+ /*
+ * If information is only wanted for a single configuration
+ * spec, then handle that one spec specially.
+ */
+
+ if (namePtr != NULL) {
+ optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
+ if (optionPtr == NULL) {
+ return (Tcl_Obj *) NULL;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+ return GetConfigList(recordPtr, optionPtr, tkwin);
+ }
+
+ /*
+ * Loop through all the specs, creating a big list with all
+ * their information.
+ */
+
+ resultPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ for (; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ GetConfigList(recordPtr, optionPtr, tkwin));
+ }
+ }
+ return resultPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetConfigList --
+ *
+ * Create a valid Tcl list holding the configuration information
+ * for a single configuration option.
+ *
+ * Results:
+ * A Tcl list, dynamically allocated. The caller is expected to
+ * arrange for this list to be freed eventually.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetConfigList(recordPtr, optionPtr, tkwin)
+ char *recordPtr; /* Pointer to record holding current
+ * values of configuration options. */
+ Option *optionPtr; /* Pointer to information describing a
+ * particular option. */
+ Tk_Window tkwin; /* Window corresponding to recordPtr. */
+{
+ Tcl_Obj *listPtr, *elementPtr;
+
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr,
+ Tcl_NewStringObj(optionPtr->specPtr->optionName, -1));
+
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ elementPtr = Tcl_NewStringObj(
+ optionPtr->extra.synonymPtr->specPtr->optionName, -1);
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+ } else {
+ if (optionPtr->dbNameUID == NULL) {
+ elementPtr = Tcl_NewObj();
+ } else {
+ elementPtr = Tcl_NewStringObj(optionPtr->dbNameUID, -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+
+ if (optionPtr->dbClassUID == NULL) {
+ elementPtr = Tcl_NewObj();
+ } else {
+ elementPtr = Tcl_NewStringObj(optionPtr->dbClassUID, -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+
+ if ((tkwin != NULL) && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
+ || (optionPtr->specPtr->type == TK_OPTION_BORDER))
+ && (Tk_Depth(tkwin) <= 1)
+ && (optionPtr->extra.monoColorPtr != NULL)) {
+ elementPtr = optionPtr->extra.monoColorPtr;
+ } else if (optionPtr->defaultPtr != NULL) {
+ elementPtr = optionPtr->defaultPtr;
+ } else {
+ elementPtr = Tcl_NewObj();
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+
+ if (optionPtr->specPtr->objOffset >= 0) {
+ elementPtr = *((Tcl_Obj **) (recordPtr
+ + optionPtr->specPtr->objOffset));
+ if (elementPtr == NULL) {
+ elementPtr = Tcl_NewObj();
+ }
+ } else {
+ elementPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
+ }
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetObjectForOption --
+ *
+ * This procedure is called to create an object that contains the
+ * value for an option. It is invoked by GetConfigList and
+ * Tk_GetOptionValue when only the internal form of an option is
+ * stored in the record.
+ *
+ * Results:
+ * The return value is a pointer to a Tcl object. The caller
+ * must call Tcl_IncrRefCount on this object to preserve it.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetObjectForOption(recordPtr, optionPtr, tkwin)
+ char *recordPtr; /* Pointer to record holding current
+ * values of configuration options. */
+ Option *optionPtr; /* Pointer to information describing an
+ * option whose internal value is stored
+ * in *recordPtr. */
+ Tk_Window tkwin; /* Window corresponding to recordPtr. */
+{
+ Tcl_Obj *objPtr;
+ char *internalPtr; /* Points to internal value of option in
+ * record. */
+
+ internalPtr = recordPtr + optionPtr->specPtr->internalOffset;
+ objPtr = NULL;
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_BOOLEAN: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ }
+ case TK_OPTION_INT: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ }
+ case TK_OPTION_DOUBLE: {
+ objPtr = Tcl_NewDoubleObj(*((double *) internalPtr));
+ break;
+ }
+ case TK_OPTION_STRING: {
+ objPtr = Tcl_NewStringObj(*((char **) internalPtr), -1);
+ break;
+ }
+ case TK_OPTION_STRING_TABLE: {
+ objPtr = Tcl_NewStringObj(
+ ((char **) optionPtr->specPtr->clientData)[
+ *((int *) internalPtr)], -1);
+ break;
+ }
+ case TK_OPTION_COLOR: {
+ XColor *colorPtr = *((XColor **) internalPtr);
+ if (colorPtr != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfColor(colorPtr), -1);
+ }
+ break;
+ }
+ case TK_OPTION_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) internalPtr);
+ if (tkfont != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfFont(tkfont), -1);
+ }
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ Tk_Style style = *((Tk_Style *) internalPtr);
+ if (style != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfStyle(style), -1);
+ }
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) internalPtr);
+ if (pixmap != None) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfBitmap(Tk_Display(tkwin),
+ pixmap), -1);
+ }
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) internalPtr);
+ if (border != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOf3DBorder(border), -1);
+ }
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfRelief(
+ *((int *) internalPtr)), -1);
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) internalPtr);
+ if (cursor != None) {
+ objPtr = Tcl_NewStringObj(
+ Tk_NameOfCursor(Tk_Display(tkwin), cursor), -1);
+ }
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfJustify(
+ *((Tk_Justify *) internalPtr)), -1);
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfAnchor(
+ *((Tk_Anchor *) internalPtr)), -1);
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ Tk_Window tkwin = *((Tk_Window *) internalPtr);
+ if (tkwin != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ objPtr = custom->getProc(custom->clientData, tkwin, recordPtr,
+ optionPtr->specPtr->internalOffset);
+ break;
+ }
+ default: {
+ panic("bad option type in GetObjectForOption");
+ }
+ }
+ if (objPtr == NULL) {
+ objPtr = Tcl_NewObj();
+ }
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOptionValue --
+ *
+ * This procedure returns the current value of a configuration
+ * option.
+ *
+ * Results:
+ * The return value is the object holding the current value of
+ * the option given by namePtr. If no such option exists, then
+ * the return value is NULL and an error message is left in
+ * interp's result (if interp isn't NULL).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tk_GetOptionValue(interp, recordPtr, optionTable, namePtr, tkwin)
+ Tcl_Interp *interp; /* Interpreter for error reporting. If
+ * NULL then no messages are provided for
+ * errors. */
+ char *recordPtr; /* Record whose fields contain current
+ * values for options. */
+ Tk_OptionTable optionTable; /* Describes legal options. */
+ Tcl_Obj *namePtr; /* Gives the command-line name for the
+ * option whose value is to be returned. */
+ Tk_Window tkwin; /* Window corresponding to recordPtr. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ Tcl_Obj *resultPtr;
+
+ optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
+ if (optionPtr == NULL) {
+ return NULL;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+ if (optionPtr->specPtr->objOffset >= 0) {
+ resultPtr = *((Tcl_Obj **) (recordPtr + optionPtr->specPtr->objOffset));
+ if (resultPtr == NULL) {
+ /*
+ * This option has a null value and is represented by a null
+ * object pointer. We can't return the null pointer, since that
+ * would indicate an error. Instead, return a new empty object.
+ */
+
+ resultPtr = Tcl_NewObj();
+ }
+ } else {
+ resultPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
+ }
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugConfig --
+ *
+ * This is a debugging procedure that returns information about
+ * one of the configuration tables that currently exists for an
+ * interpreter.
+ *
+ * Results:
+ * If the specified table exists in the given interpreter, then a
+ * list is returned describing the table and any other tables that
+ * it chains to: for each table there will be three list elements
+ * giving the reference count for the table, the number of elements
+ * in the table, and the command-line name for the first option
+ * in the table. If the table doesn't exist in the interpreter
+ * then an empty object is returned. The reference count for the
+ * returned object is 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugConfig(interp, table)
+ Tcl_Interp *interp; /* Interpreter in which the table is
+ * defined. */
+ Tk_OptionTable table; /* Table about which information is to
+ * be returned. May not necessarily
+ * exist in the interpreter anymore. */
+{
+ OptionTable *tablePtr = (OptionTable *) table;
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hashEntryPtr;
+ Tcl_HashSearch search;
+ Tcl_Obj *objPtr;
+
+ objPtr = Tcl_NewObj();
+ hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
+ NULL);
+ if (hashTablePtr == NULL) {
+ return objPtr;
+ }
+
+ /*
+ * Scan all the tables for this interpreter to make sure that the
+ * one we want still is valid.
+ */
+
+ for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
+ hashEntryPtr != NULL;
+ hashEntryPtr = Tcl_NextHashEntry(&search)) {
+ if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) {
+ for ( ; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewIntObj(tablePtr->refCount));
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewIntObj(tablePtr->numOptions));
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj(
+ tablePtr->options[0].specPtr->optionName,
+ -1));
+ }
+ break;
+ }
+ }
+ return objPtr;
+}
diff --git a/tcl/generic/tkConsole.c b/tcl/generic/tkConsole.c
new file mode 100644
index 00000000000..62f5237ca21
--- /dev/null
+++ b/tcl/generic/tkConsole.c
@@ -0,0 +1,818 @@
+/*
+ * 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>
+
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type holds information for each console
+ * which a handler (i.e. a Tcl command) has been defined for a particular
+ * top-level window.
+ */
+
+typedef struct ConsoleInfo {
+ Tcl_Interp *consoleInterp; /* Interpreter for the console. */
+ Tcl_Interp *interp; /* Interpreter to send console commands. */
+} ConsoleInfo;
+
+typedef struct ThreadSpecificData {
+ Tcl_Interp *gStdoutInterp;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+static int consoleInitialized = 0;
+
+/*
+ * The Mutex below is used to lock access to the consoleIntialized flag
+ */
+
+TCL_DECLARE_MUTEX(consoleMutex)
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ *
+ * The first three will be used in the tk app shells...
+ */
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST 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, CONST char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ CONST 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. */
+};
+
+
+#ifdef __WIN32__
+
+#include <windows.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShouldUseConsoleChannel
+ *
+ * Check to see if console window should be used for a given
+ * standard channel
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates the console channel and installs it as the standard
+ * channels.
+ *
+ *----------------------------------------------------------------------
+ */
+static int ShouldUseConsoleChannel(type)
+ int type;
+{
+ DWORD handleId; /* Standard handle to retrieve. */
+ DCB dcb;
+ DWORD consoleParams;
+ DWORD fileType;
+ int mode;
+ char *bufMode;
+ HANDLE handle;
+
+ switch (type) {
+ case TCL_STDIN:
+ handleId = STD_INPUT_HANDLE;
+ mode = TCL_READABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDOUT:
+ handleId = STD_OUTPUT_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDERR:
+ handleId = STD_ERROR_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "none";
+ break;
+ default:
+ return 0;
+ break;
+ }
+
+ handle = GetStdHandle(handleId);
+
+ /*
+ * Note that we need to check for 0 because Windows will return 0 if this
+ * is not a console mode application, even though this is not a valid
+ * handle.
+ */
+
+ if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
+ return 1;
+ }
+
+ /*
+ * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears
+ * to be a valid handle. See TclpGetDefaultStdChannel() for this change
+ * implemented. We didn't change it here because GetFileType() [below]
+ * will catch this with FILE_TYPE_UNKNOWN and appropriately return a
+ * value of 1, anyways.
+ *
+ * char dummyBuff[1];
+ * DWORD dummyWritten;
+ *
+ * if ((type == TCL_STDOUT)
+ * && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
+ * return 1;
+ * }
+ */
+
+ fileType = GetFileType(handle);
+
+ /*
+ * If the file is a character device, we need to try to figure out
+ * whether it is a serial port, a console, or something else. We
+ * test for the console case first because this is more common.
+ */
+
+ if (fileType == FILE_TYPE_CHAR) {
+ dcb.DCBlength = sizeof( DCB ) ;
+ if (!GetConsoleMode(handle, &consoleParams) &&
+ !GetCommState(handle, &dcb)) {
+ /*
+ * Don't use a CHAR type channel for stdio, otherwise Tk
+ * runs into trouble with the MS DevStudio debugger.
+ */
+
+ return 1;
+ }
+ } else if (fileType == FILE_TYPE_UNKNOWN) {
+ return 1;
+ } else if (Tcl_GetStdChannel(type) == NULL) {
+ return 1;
+ }
+
+ return 0;
+}
+#else
+/*
+ * Mac should always use a console channel, Unix should if it's trying to
+ */
+
+#define ShouldUseConsoleChannel(chan) (1)
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_InitConsoleChannels --
+ *
+ * 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
+Tk_InitConsoleChannels(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_Channel consoleChannel;
+
+ /*
+ * Ensure that we are getting the matching version of Tcl. This is
+ * really only an issue when Tk is loaded dynamically.
+ */
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return;
+ }
+
+ Tcl_MutexLock(&consoleMutex);
+ if (!consoleInitialized) {
+
+ consoleInitialized = 1;
+
+ /*
+ * check for STDIN, otherwise create it
+ *
+ * Don't do this check on the Mac, because it is hard to prevent
+ * callbacks from the SIOUX layer from opening stdout & stdin, but
+ * we don't want to use the SIOUX console. Since the console is not
+ * actually created till something is written to the channel, it is
+ * okay to just ignore it here.
+ *
+ * This is still a bit of a hack, however, and should be cleaned up
+ * when we have a better abstraction for the console.
+ */
+
+ if (ShouldUseConsoleChannel(TCL_STDIN)) {
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
+ (ClientData) TCL_STDIN, TCL_READABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-buffering", "none");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
+ }
+
+ /*
+ * check for STDOUT, otherwise create it
+ */
+
+ if (ShouldUseConsoleChannel(TCL_STDOUT)) {
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
+ (ClientData) TCL_STDOUT, TCL_WRITABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-buffering", "none");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
+ }
+
+ /*
+ * check for STDERR, otherwise create it
+ */
+
+ if (ShouldUseConsoleChannel(TCL_STDERR)) {
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
+ (ClientData) TCL_STDERR, TCL_WRITABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-buffering", "none");
+ Tcl_SetChannelOption(NULL, consoleChannel,
+ "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
+ }
+ }
+ Tcl_MutexUnlock(&consoleMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateConsoleWindow --
+ *
+ * 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
+Tk_CreateConsoleWindow(interp)
+ Tcl_Interp *interp; /* Interpreter to use for prompting. */
+{
+ Tcl_Interp *consoleInterp;
+ ConsoleInfo *info;
+ Tk_Window mainWindow = Tk_MainWindow(interp);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+#ifdef MAC_TCL
+ static char initCmd[] = "if {[catch {source $tk_library:console.tcl}]} {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;
+ }
+ tsdPtr->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. */
+ CONST char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCode; /* Where to store error code. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ *errorCode = 0;
+ Tcl_SetErrno(0);
+
+ if (tsdPtr->gStdoutInterp != NULL) {
+ TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf,
+ toWrite);
+ }
+
+ return toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ tsdPtr->gStdoutInterp = NULL;
+ 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. */
+ CONST char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ size_t length;
+ int result;
+ Tcl_Interp *consoleInterp;
+ Tcl_DString dString;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ result = TCL_OK;
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_DStringInit(&dString);
+
+ if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
+ Tcl_DStringAppend(&dString, "wm title . ", -1);
+ if (argc == 3) {
+ Tcl_DStringAppendElement(&dString, argv[2]);
+ }
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
+ Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
+ Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
+ if (argc == 3) {
+ result = Tcl_Eval(consoleInterp, argv[2]);
+ Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
+ (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " eval command\"", (char *) NULL);
+ result = TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be hide, show, or title",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_DStringFree(&dString);
+ Tcl_Release((ClientData) consoleInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ CONST char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ size_t 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_ResetResult(interp);
+ Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be eval or record",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static 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 "::tk::ConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "::tk::ConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ Tcl_Interp *consoleInterp;
+ Tcl_DString dString;
+
+ if (eventPtr->type == DestroyNotify) {
+
+ Tcl_DStringInit(&dString);
+
+ consoleInterp = info->consoleInterp;
+
+ /*
+ * It is possible that the console interpreter itself has
+ * already been deleted. In that case the consoleInterp
+ * field will be set to NULL. If the interpreter is already
+ * gone, we do not have to do any work here.
+ */
+
+ if (consoleInterp == (Tcl_Interp *) NULL) {
+ return;
+ }
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_DStringAppend(&dString, "::tk::ConsoleExit", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ Tcl_DStringFree(&dString);
+ 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. */
+ CONST 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 = "::tk::ConsoleOutput stderr ";
+ } else {
+ cmd = "::tk::ConsoleOutput 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, (int) 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/tcl/generic/tkCursor.c b/tcl/generic/tkCursor.c
new file mode 100644
index 00000000000..e389d267150
--- /dev/null
+++ b/tcl/generic/tkCursor.c
@@ -0,0 +1,868 @@
+/*
+ * tkCursor.c --
+ *
+ * This file maintains a database of read-only cursors for the Tk
+ * toolkit. This allows cursors to be shared between widgets and
+ * also avoids round-trips to the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * A TkCursor structure exists for each cursor that is currently
+ * active. Each structure is indexed with two hash tables defined
+ * below. One of the tables is cursorIdTable, and the other is either
+ * cursorNameTable or cursorDataTable, each of which are stored in the
+ * TkDisplay structure for the current thread.
+ */
+
+typedef struct {
+ CONST char *source; /* Cursor bits. */
+ CONST char *mask; /* Mask bits. */
+ int width, height; /* Dimensions of cursor (and data
+ * and mask). */
+ int xHot, yHot; /* Location of cursor hot-spot. */
+ Tk_Uid fg, bg; /* Colors for cursor. */
+ Display *display; /* Display on which cursor will be used. */
+} DataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void CursorInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
+static void FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static TkCursor * GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *name));
+static TkCursor * GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj *objPtr));
+static void InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "cursor" Tcl
+ * object, used for drawing. The color object remembers the hash table
+ * entry associated with a color. The actual allocation and deallocation
+ * of the color should be done by the configuration package when the cursor
+ * option is set.
+ */
+
+Tcl_ObjType tkCursorObjType = {
+ "cursor", /* name */
+ FreeCursorObjProc, /* freeIntRepProc */
+ DupCursorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocCursorFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * Tk_Cursor structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless objPtr couldn't be parsed correctly. In this case,
+ * None is returned and an error message is left in the interp's result.
+ * The caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursorFromObj when the cursor is no
+ * longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursorFromObj, so that the database can be cleaned up
+ * when cursors aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_AllocCursorFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for error results. */
+ Tk_Window tkwin; /* Window in which the cursor will be used.*/
+ Tcl_Obj *objPtr; /* Object describing cursor; see manual
+ * entry for description of legal
+ * syntax of this obj's string rep. */
+{
+ TkCursor *cursorPtr;
+
+ if (objPtr->typePtr != &tkCursorObjType) {
+ InitCursorObj(objPtr);
+ }
+ cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkCursor, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (cursorPtr != NULL) {
+ if (cursorPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkCursor that's
+ * no longer in use. Clear the reference.
+ */
+ FreeCursorObjProc(objPtr);
+ cursorPtr = NULL;
+ } else if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ return cursorPtr->cursor;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkCursor that we wanted. Search
+ * the list of TkCursors with the same name to see if one of the
+ * other TkCursors is the right one.
+ */
+
+ if (cursorPtr != NULL) {
+ TkCursor *firstCursorPtr =
+ (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
+ FreeCursorObjProc(objPtr);
+ for (cursorPtr = firstCursorPtr; cursorPtr != NULL;
+ cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ cursorPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ return cursorPtr->cursor;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call GetCursor to allocate a new TkCursor object.
+ */
+
+ cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ if (cursorPtr == NULL) {
+ return None;
+ } else {
+ cursorPtr->objRefCount++;
+ return cursorPtr->cursor;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursor --
+ *
+ * Given a string describing a cursor, locate (or create if necessary)
+ * a cursor that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless string couldn't be parsed correctly. In this case,
+ * None is returned and an error message is left in the interp's result.
+ * The caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursor when the cursor is no longer
+ * needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursor(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ Tk_Uid string; /* Description of cursor. See manual entry
+ * for details on legal syntax. */
+{
+ TkCursor *cursorPtr = GetCursor(interp, tkwin, string);
+ if (cursorPtr == NULL) {
+ return None;
+ }
+ return cursorPtr->cursor;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCursor --
+ *
+ * Given a string describing a cursor, locate (or create if necessary)
+ * a cursor that fits the description. This routine returns the
+ * internal data structure for the cursor, which avoids extra
+ * hash table lookups in Tk_AllocCursorFromObj.
+ *
+ * Results:
+ * The return value is a pointer to the TkCursor for the desired
+ * cursor, unless string couldn't be parsed correctly. In this
+ * case, NULL is returned and an error message is left in the
+ * interp's result. The caller should never modify the cursor that
+ * is returned, and should eventually call Tk_FreeCursor when the
+ * cursor is no longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkCursor *
+GetCursor(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ CONST char *string; /* Description of cursor. See manual entry
+ * for details on legal syntax. */
+{
+ Tcl_HashEntry *nameHashPtr;
+ register TkCursor *cursorPtr;
+ TkCursor *existingCursorPtr = NULL;
+ int new;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
+ }
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable,
+ string, &new);
+ if (!new) {
+ existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
+ for (cursorPtr = existingCursorPtr; cursorPtr != NULL;
+ cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ return cursorPtr;
+ }
+ }
+ } else {
+ existingCursorPtr = NULL;
+ }
+
+ cursorPtr = TkGetCursorByName(interp, tkwin, string);
+
+ if (cursorPtr == NULL) {
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
+ }
+
+ /*
+ * Add information about this cursor to our database.
+ */
+
+ cursorPtr->display = Tk_Display(tkwin);
+ cursorPtr->resourceRefCount = 1;
+ cursorPtr->objRefCount = 0;
+ cursorPtr->otherTable = &dispPtr->cursorNameTable;
+ cursorPtr->hashPtr = nameHashPtr;
+ cursorPtr->nextPtr = existingCursorPtr;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &new);
+ if (!new) {
+ panic("cursor already registered in Tk_GetCursor");
+ }
+ Tcl_SetHashValue(nameHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
+
+ return cursorPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursorFromData --
+ *
+ * Given a description of the bits and colors for a cursor,
+ * make a cursor that has the given properties.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless it couldn't be created properly. In this case, None is
+ * returned and an error message is left in the interp's result. The
+ * caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursor when the cursor is no
+ * longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * 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. */
+ CONST char *source; /* Bitmap data for cursor shape. */
+ CONST char *mask; /* Bitmap data for cursor mask. */
+ int width, height; /* Dimensions of cursor. */
+ int xHot, yHot; /* Location of hot-spot in cursor. */
+ Tk_Uid fg; /* Foreground color for cursor. */
+ Tk_Uid bg; /* Background color for cursor. */
+{
+ DataKey dataKey;
+ Tcl_HashEntry *dataHashPtr;
+ register TkCursor *cursorPtr;
+ int new;
+ XColor fgColor, bgColor;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
+ }
+
+ dataKey.source = source;
+ dataKey.mask = mask;
+ dataKey.width = width;
+ dataKey.height = height;
+ dataKey.xHot = xHot;
+ dataKey.yHot = yHot;
+ dataKey.fg = fg;
+ dataKey.bg = bg;
+ dataKey.display = Tk_Display(tkwin);
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable,
+ (char *) &dataKey, &new);
+ if (!new) {
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
+ cursorPtr->resourceRefCount++;
+ return cursorPtr->cursor;
+ }
+
+ /*
+ * No suitable cursor exists yet. Make one using the data
+ * available and add it to the database.
+ */
+
+ 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->resourceRefCount = 1;
+ cursorPtr->otherTable = &dispPtr->cursorDataTable;
+ cursorPtr->hashPtr = dataHashPtr;
+ cursorPtr->objRefCount = 0;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &new);
+ cursorPtr->nextPtr = NULL;
+
+ if (!new) {
+ panic("cursor already registered in Tk_GetCursorFromData");
+ }
+ Tcl_SetHashValue(dataHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
+ return cursorPtr->cursor;
+
+ error:
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return None;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfCursor(display, cursor)
+ Display *display; /* Display for which cursor was allocated. */
+ Tk_Cursor cursor; /* Identifier for cursor whose name is
+ * wanted. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkCursor *cursorPtr;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->cursorInit) {
+ printid:
+ sprintf(dispPtr->cursorString, "cursor id 0x%x",
+ (unsigned int) cursor);
+ return dispPtr->cursorString;
+ }
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
+ if (idHashPtr == NULL) {
+ goto printid;
+ }
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
+ if (cursorPtr->otherTable != &dispPtr->cursorNameTable) {
+ goto printid;
+ }
+ return cursorPtr->hashPtr->key.string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCursor --
+ *
+ * This procedure is invoked by both Tk_FreeCursor and
+ * Tk_FreeCursorFromObj; it does all the real work of deallocating
+ * a cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with cursor is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeCursor(cursorPtr)
+ TkCursor *cursorPtr; /* Cursor to be released. */
+{
+ TkCursor *prevPtr;
+
+ cursorPtr->resourceRefCount--;
+ if (cursorPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ Tcl_DeleteHashEntry(cursorPtr->idHashPtr);
+ prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
+ if (prevPtr == cursorPtr) {
+ if (cursorPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(cursorPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(cursorPtr->hashPtr, cursorPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != cursorPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = cursorPtr->nextPtr;
+ }
+ TkpFreeCursor(cursorPtr);
+ if (cursorPtr->objRefCount == 0) {
+ ckfree((char *) cursorPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeCursor --
+ *
+ * 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. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->cursorInit) {
+ panic("Tk_FreeCursor called before Tk_GetCursor");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeCursor received unknown cursor argument");
+ }
+ FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeCursorFromObj --
+ *
+ * This procedure is called to release a cursor allocated by
+ * Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *;
+ * it only gets rid of the hash table entry for this cursor
+ * and clears the cached value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the cursor represented by
+ * objPtr is decremented, and the cursor is released to X if there are
+ * no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeCursorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this cursor lives in. Needed
+ * for the display value. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ FreeCursor(GetCursorFromObj(tkwin, objPtr));
+ FreeCursorObjProc(objPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeCursorFromObjProc --
+ *
+ * This proc is called to release an object reference to a cursor.
+ * Called when the object's internal rep is released or when
+ * the cached tkColPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the color's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeCursorObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (cursorPtr != NULL) {
+ cursorPtr->objRefCount--;
+ if ((cursorPtr->objRefCount == 0)
+ && (cursorPtr->resourceRefCount == 0)) {
+ ckfree((char *) cursorPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupCursorObjProc --
+ *
+ * When a cached cursor object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The color's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupCursorObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkCursor *cursorPtr = (TkCursor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+
+ if (cursorPtr != NULL) {
+ cursorPtr->objRefCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursorFromObj --
+ *
+ * Returns the cursor referred to buy a Tcl object. The cursor must
+ * already have been allocated via a call to Tk_AllocCursorFromObj or
+ * Tk_GetCursor.
+ *
+ * Results:
+ * Returns the Tk_Cursor that matches the tkwin and the string rep
+ * of the name of the cursor given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a cursor, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursorFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+{
+ TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr);
+ /* GetCursorFromObj should never return NULL */
+ return cursorPtr->cursor;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCursorFromObj --
+ *
+ * Returns the cursor referred to by a Tcl object. The cursor must
+ * already have been allocated via a call to Tk_AllocCursorFromObj
+ * or Tk_GetCursor.
+ *
+ * Results:
+ * Returns the TkCursor * that matches the tkwin and the string rep
+ * of the name of the cursor given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a cursor, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkCursor *
+GetCursorFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* Window in which the cursor will be used. */
+ Tcl_Obj *objPtr; /* The object that describes the desired
+ * cursor. */
+{
+ TkCursor *cursorPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkCursorObjType) {
+ InitCursorObj(objPtr);
+ }
+
+ /*
+ * The internal representation is a cache of the last cursor used
+ * with the given name. But there can be lots different cursors
+ * for each cursor name; one cursor for each display. Check to
+ * see if the cursor we have cached is the one that is needed.
+ */
+ cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
+ if ((cursorPtr != NULL) && (Tk_Display(tkwin) == cursorPtr->display)) {
+ return cursorPtr;
+ }
+
+ /*
+ * If we get to here, it means the cursor we need is not in the cache.
+ * Try to look up the cursor in the TkDisplay structure of the window.
+ */
+
+ hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
+ cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ FreeCursorObjProc(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ cursorPtr->objRefCount++;
+ return cursorPtr;
+ }
+ }
+
+ error:
+ panic("GetCursorFromObj called with non-existent cursor!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitCursorObj --
+ *
+ * Bookeeping procedure to change an objPtr to a cursor type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old internal rep of the object is freed. The internal
+ * rep is cleared. The final form of the object is set
+ * by either Tk_AllocCursorFromObj or GetCursorFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitCursorObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkCursorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CursorInit --
+ *
+ * Initialize the structures used for cursor management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CursorInit(dispPtr)
+ TkDisplay *dispPtr; /* Display used to store thread-specific data. */
+{
+ Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int));
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it
+ * gets padded with extra unpredictable bytes on some 64-bit
+ * machines.
+ */
+
+ /*
+ * Old code....
+ * Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *)
+ * /sizeof(int));
+ *
+ * The comment above doesn't make sense.
+ * However, XIDs should only be 32 bits, by the definition of X,
+ * so the code above causes Tk to crash. Here is the real code:
+ */
+
+ Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS);
+
+ dispPtr->cursorInit = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugCursor --
+ *
+ * This procedure returns debugging information about a cursor.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkCursor
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkCursor structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugCursor(tkwin, name)
+ Tk_Window tkwin; /* The window in which the cursor will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkCursor *cursorPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name);
+ if (hashPtr != NULL) {
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
+ if (cursorPtr == NULL) {
+ panic("TkDebugCursor found empty hash table entry");
+ }
+ for ( ; (cursorPtr != NULL); cursorPtr = cursorPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(cursorPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(cursorPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
diff --git a/tcl/generic/tkDecls.h b/tcl/generic/tkDecls.h
new file mode 100644
index 00000000000..b80e12be9ad
--- /dev/null
+++ b/tcl/generic/tkDecls.h
@@ -0,0 +1,2275 @@
+/*
+ * tkDecls.h --
+ *
+ * Declarations of functions in the platform independent public Tcl API.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKDECLS
+#define _TKDECLS
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tk.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+EXTERN void Tk_MainLoop _ANSI_ARGS_((void));
+/* 1 */
+EXTERN XColor * Tk_3DBorderColor _ANSI_ARGS_((Tk_3DBorder border));
+/* 2 */
+EXTERN GC Tk_3DBorderGC _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_3DBorder border, int which));
+/* 3 */
+EXTERN void Tk_3DHorizontalBevel _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int leftIn,
+ int rightIn, int topBevel, int relief));
+/* 4 */
+EXTERN void Tk_3DVerticalBevel _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int leftBevel,
+ int relief));
+/* 5 */
+EXTERN void Tk_AddOption _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char * name, CONST char * value,
+ int priority));
+/* 6 */
+EXTERN void Tk_BindEvent _ANSI_ARGS_((
+ Tk_BindingTable bindingTable,
+ XEvent * eventPtr, Tk_Window tkwin,
+ int numObjects, ClientData * objectPtr));
+/* 7 */
+EXTERN void Tk_CanvasDrawableCoords _ANSI_ARGS_((
+ Tk_Canvas canvas, double x, double y,
+ short * drawableXPtr, short * drawableYPtr));
+/* 8 */
+EXTERN void Tk_CanvasEventuallyRedraw _ANSI_ARGS_((
+ Tk_Canvas canvas, int x1, int y1, int x2,
+ int y2));
+/* 9 */
+EXTERN int Tk_CanvasGetCoord _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, CONST char * str,
+ double * doublePtr));
+/* 10 */
+EXTERN Tk_CanvasTextInfo * Tk_CanvasGetTextInfo _ANSI_ARGS_((
+ Tk_Canvas canvas));
+/* 11 */
+EXTERN int Tk_CanvasPsBitmap _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, Pixmap bitmap, int x,
+ int y, int width, int height));
+/* 12 */
+EXTERN int Tk_CanvasPsColor _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, XColor * colorPtr));
+/* 13 */
+EXTERN int Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, Tk_Font font));
+/* 14 */
+EXTERN void Tk_CanvasPsPath _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, double * coordPtr,
+ int numPoints));
+/* 15 */
+EXTERN int Tk_CanvasPsStipple _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, Pixmap bitmap));
+/* 16 */
+EXTERN double Tk_CanvasPsY _ANSI_ARGS_((Tk_Canvas canvas, double y));
+/* 17 */
+EXTERN void Tk_CanvasSetStippleOrigin _ANSI_ARGS_((
+ Tk_Canvas canvas, GC gc));
+/* 18 */
+EXTERN int Tk_CanvasTagsParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * value,
+ char * widgRec, int offset));
+/* 19 */
+EXTERN char * Tk_CanvasTagsPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char * widgRec, int offset,
+ Tcl_FreeProc ** freeProcPtr));
+/* 20 */
+EXTERN Tk_Window Tk_CanvasTkwin _ANSI_ARGS_((Tk_Canvas canvas));
+/* 21 */
+EXTERN void Tk_CanvasWindowCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ double x, double y, short * screenXPtr,
+ short * screenYPtr));
+/* 22 */
+EXTERN void Tk_ChangeWindowAttributes _ANSI_ARGS_((
+ Tk_Window tkwin, unsigned long valueMask,
+ XSetWindowAttributes * attsPtr));
+/* 23 */
+EXTERN int Tk_CharBbox _ANSI_ARGS_((Tk_TextLayout layout,
+ int index, int * xPtr, int * yPtr,
+ int * widthPtr, int * heightPtr));
+/* 24 */
+EXTERN void Tk_ClearSelection _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection));
+/* 25 */
+EXTERN int Tk_ClipboardAppend _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Atom target, Atom format,
+ char* buffer));
+/* 26 */
+EXTERN int Tk_ClipboardClear _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin));
+/* 27 */
+EXTERN int Tk_ConfigureInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec * specs,
+ char * widgRec, CONST char * argvName,
+ int flags));
+/* 28 */
+EXTERN int Tk_ConfigureValue _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec * specs,
+ char * widgRec, CONST char * argvName,
+ int flags));
+/* 29 */
+EXTERN int Tk_ConfigureWidget _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec * specs,
+ int argc, CONST84 char ** argv,
+ char * widgRec, int flags));
+/* 30 */
+EXTERN void Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned int valueMask,
+ XWindowChanges * valuePtr));
+/* 31 */
+EXTERN Tk_TextLayout Tk_ComputeTextLayout _ANSI_ARGS_((Tk_Font font,
+ CONST char * str, int numChars,
+ int wrapLength, Tk_Justify justify,
+ int flags, int * widthPtr, int * heightPtr));
+/* 32 */
+EXTERN Tk_Window Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY,
+ Tk_Window tkwin));
+/* 33 */
+EXTERN unsigned long Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, CONST char * eventStr,
+ CONST char * command, int append));
+/* 34 */
+EXTERN Tk_BindingTable Tk_CreateBindingTable _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 35 */
+EXTERN Tk_ErrorHandler Tk_CreateErrorHandler _ANSI_ARGS_((Display * display,
+ int errNum, int request, int minorCode,
+ Tk_ErrorProc * errorProc,
+ ClientData clientData));
+/* 36 */
+EXTERN void Tk_CreateEventHandler _ANSI_ARGS_((Tk_Window token,
+ unsigned long mask, Tk_EventProc * proc,
+ ClientData clientData));
+/* 37 */
+EXTERN void Tk_CreateGenericHandler _ANSI_ARGS_((
+ Tk_GenericProc * proc, ClientData clientData));
+/* 38 */
+EXTERN void Tk_CreateImageType _ANSI_ARGS_((
+ Tk_ImageType * typePtr));
+/* 39 */
+EXTERN void Tk_CreateItemType _ANSI_ARGS_((Tk_ItemType * typePtr));
+/* 40 */
+EXTERN void Tk_CreatePhotoImageFormat _ANSI_ARGS_((
+ Tk_PhotoImageFormat * formatPtr));
+/* 41 */
+EXTERN void Tk_CreateSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Atom target,
+ Tk_SelectionProc * proc,
+ ClientData clientData, Atom format));
+/* 42 */
+EXTERN Tk_Window Tk_CreateWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window parent, CONST char * name,
+ CONST char * screenName));
+/* 43 */
+EXTERN Tk_Window Tk_CreateWindowFromPath _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ CONST char * pathName,
+ CONST char * screenName));
+/* 44 */
+EXTERN int Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name, CONST char * source,
+ int width, int height));
+/* 45 */
+EXTERN void Tk_DefineCursor _ANSI_ARGS_((Tk_Window window,
+ Tk_Cursor cursor));
+/* 46 */
+EXTERN void Tk_DeleteAllBindings _ANSI_ARGS_((
+ Tk_BindingTable bindingTable,
+ ClientData object));
+/* 47 */
+EXTERN int Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, CONST char * eventStr));
+/* 48 */
+EXTERN void Tk_DeleteBindingTable _ANSI_ARGS_((
+ Tk_BindingTable bindingTable));
+/* 49 */
+EXTERN void Tk_DeleteErrorHandler _ANSI_ARGS_((
+ Tk_ErrorHandler handler));
+/* 50 */
+EXTERN void Tk_DeleteEventHandler _ANSI_ARGS_((Tk_Window token,
+ unsigned long mask, Tk_EventProc * proc,
+ ClientData clientData));
+/* 51 */
+EXTERN void Tk_DeleteGenericHandler _ANSI_ARGS_((
+ Tk_GenericProc * proc, ClientData clientData));
+/* 52 */
+EXTERN void Tk_DeleteImage _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name));
+/* 53 */
+EXTERN void Tk_DeleteSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Atom target));
+/* 54 */
+EXTERN void Tk_DestroyWindow _ANSI_ARGS_((Tk_Window tkwin));
+/* 55 */
+EXTERN CONST84_RETURN char * Tk_DisplayName _ANSI_ARGS_((Tk_Window tkwin));
+/* 56 */
+EXTERN int Tk_DistanceToTextLayout _ANSI_ARGS_((
+ Tk_TextLayout layout, int x, int y));
+/* 57 */
+EXTERN void Tk_Draw3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint * pointPtr, int numPoints,
+ int borderWidth, int leftRelief));
+/* 58 */
+EXTERN void Tk_Draw3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height,
+ int borderWidth, int relief));
+/* 59 */
+EXTERN void Tk_DrawChars _ANSI_ARGS_((Display * display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ CONST char * source, int numBytes, int x,
+ int y));
+/* 60 */
+EXTERN void Tk_DrawFocusHighlight _ANSI_ARGS_((Tk_Window tkwin,
+ GC gc, int width, Drawable drawable));
+/* 61 */
+EXTERN void Tk_DrawTextLayout _ANSI_ARGS_((Display * display,
+ Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int firstChar, int lastChar));
+/* 62 */
+EXTERN void Tk_Fill3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint * pointPtr, int numPoints,
+ int borderWidth, int leftRelief));
+/* 63 */
+EXTERN void Tk_Fill3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height,
+ int borderWidth, int relief));
+/* 64 */
+EXTERN Tk_PhotoHandle Tk_FindPhoto _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * imageName));
+/* 65 */
+EXTERN Font Tk_FontId _ANSI_ARGS_((Tk_Font font));
+/* 66 */
+EXTERN void Tk_Free3DBorder _ANSI_ARGS_((Tk_3DBorder border));
+/* 67 */
+EXTERN void Tk_FreeBitmap _ANSI_ARGS_((Display * display,
+ Pixmap bitmap));
+/* 68 */
+EXTERN void Tk_FreeColor _ANSI_ARGS_((XColor * colorPtr));
+/* 69 */
+EXTERN void Tk_FreeColormap _ANSI_ARGS_((Display * display,
+ Colormap colormap));
+/* 70 */
+EXTERN void Tk_FreeCursor _ANSI_ARGS_((Display * display,
+ Tk_Cursor cursor));
+/* 71 */
+EXTERN void Tk_FreeFont _ANSI_ARGS_((Tk_Font f));
+/* 72 */
+EXTERN void Tk_FreeGC _ANSI_ARGS_((Display * display, GC gc));
+/* 73 */
+EXTERN void Tk_FreeImage _ANSI_ARGS_((Tk_Image image));
+/* 74 */
+EXTERN void Tk_FreeOptions _ANSI_ARGS_((Tk_ConfigSpec * specs,
+ char * widgRec, Display * display,
+ int needFlags));
+/* 75 */
+EXTERN void Tk_FreePixmap _ANSI_ARGS_((Display * display,
+ Pixmap pixmap));
+/* 76 */
+EXTERN void Tk_FreeTextLayout _ANSI_ARGS_((
+ Tk_TextLayout textLayout));
+/* 77 */
+EXTERN void Tk_FreeXId _ANSI_ARGS_((Display * display, XID xid));
+/* 78 */
+EXTERN GC Tk_GCForColor _ANSI_ARGS_((XColor * colorPtr,
+ Drawable drawable));
+/* 79 */
+EXTERN void Tk_GeometryRequest _ANSI_ARGS_((Tk_Window tkwin,
+ int reqWidth, int reqHeight));
+/* 80 */
+EXTERN Tk_3DBorder Tk_Get3DBorder _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid colorName));
+/* 81 */
+EXTERN void Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object));
+/* 82 */
+EXTERN int Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * str, Tk_Anchor * anchorPtr));
+/* 83 */
+EXTERN CONST84_RETURN char * Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin,
+ Atom atom));
+/* 84 */
+EXTERN CONST84_RETURN char * Tk_GetBinding _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, CONST char * eventStr));
+/* 85 */
+EXTERN Pixmap Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str));
+/* 86 */
+EXTERN Pixmap Tk_GetBitmapFromData _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ CONST char * source, int width, int height));
+/* 87 */
+EXTERN int Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * str, int * capPtr));
+/* 88 */
+EXTERN XColor * Tk_GetColor _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid name));
+/* 89 */
+EXTERN XColor * Tk_GetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
+ XColor * colorPtr));
+/* 90 */
+EXTERN Colormap Tk_GetColormap _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str));
+/* 91 */
+EXTERN Tk_Cursor Tk_GetCursor _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid str));
+/* 92 */
+EXTERN Tk_Cursor Tk_GetCursorFromData _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ CONST char * source, CONST char * mask,
+ int width, int height, int xHot, int yHot,
+ Tk_Uid fg, Tk_Uid bg));
+/* 93 */
+EXTERN Tk_Font Tk_GetFont _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str));
+/* 94 */
+EXTERN Tk_Font Tk_GetFontFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 95 */
+EXTERN void Tk_GetFontMetrics _ANSI_ARGS_((Tk_Font font,
+ Tk_FontMetrics * fmPtr));
+/* 96 */
+EXTERN GC Tk_GetGC _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long valueMask,
+ XGCValues * valuePtr));
+/* 97 */
+EXTERN Tk_Image Tk_GetImage _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * name,
+ Tk_ImageChangedProc * changeProc,
+ ClientData clientData));
+/* 98 */
+EXTERN ClientData Tk_GetImageMasterData _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * name,
+ Tk_ImageType ** typePtrPtr));
+/* 99 */
+EXTERN Tk_ItemType * Tk_GetItemTypes _ANSI_ARGS_((void));
+/* 100 */
+EXTERN int Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * str, int * joinPtr));
+/* 101 */
+EXTERN int Tk_GetJustify _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * str, Tk_Justify * justifyPtr));
+/* 102 */
+EXTERN int Tk_GetNumMainWindows _ANSI_ARGS_((void));
+/* 103 */
+EXTERN Tk_Uid Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char * name, CONST char * className));
+/* 104 */
+EXTERN int Tk_GetPixels _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str,
+ int * intPtr));
+/* 105 */
+EXTERN Pixmap Tk_GetPixmap _ANSI_ARGS_((Display * display,
+ Drawable d, int width, int height, int depth));
+/* 106 */
+EXTERN int Tk_GetRelief _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name, int * reliefPtr));
+/* 107 */
+EXTERN void Tk_GetRootCoords _ANSI_ARGS_((Tk_Window tkwin,
+ int * xPtr, int * yPtr));
+/* 108 */
+EXTERN int Tk_GetScrollInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, CONST84 char ** argv,
+ double * dblPtr, int * intPtr));
+/* 109 */
+EXTERN int Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str,
+ double * doublePtr));
+/* 110 */
+EXTERN int Tk_GetSelection _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc * proc, ClientData clientData));
+/* 111 */
+EXTERN Tk_Uid Tk_GetUid _ANSI_ARGS_((CONST char * str));
+/* 112 */
+EXTERN Visual * Tk_GetVisual _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str,
+ int * depthPtr, Colormap * colormapPtr));
+/* 113 */
+EXTERN void Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin,
+ int * xPtr, int * yPtr, int * widthPtr,
+ int * heightPtr));
+/* 114 */
+EXTERN int Tk_Grab _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, int grabGlobal));
+/* 115 */
+EXTERN void Tk_HandleEvent _ANSI_ARGS_((XEvent * eventPtr));
+/* 116 */
+EXTERN Tk_Window Tk_IdToWindow _ANSI_ARGS_((Display * display,
+ Window window));
+/* 117 */
+EXTERN void Tk_ImageChanged _ANSI_ARGS_((Tk_ImageMaster master,
+ int x, int y, int width, int height,
+ int imageWidth, int imageHeight));
+/* 118 */
+EXTERN int Tk_Init _ANSI_ARGS_((Tcl_Interp * interp));
+/* 119 */
+EXTERN Atom Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char * name));
+/* 120 */
+EXTERN int Tk_IntersectTextLayout _ANSI_ARGS_((
+ Tk_TextLayout layout, int x, int y,
+ int width, int height));
+/* 121 */
+EXTERN void Tk_MaintainGeometry _ANSI_ARGS_((Tk_Window slave,
+ Tk_Window master, int x, int y, int width,
+ int height));
+/* 122 */
+EXTERN Tk_Window Tk_MainWindow _ANSI_ARGS_((Tcl_Interp * interp));
+/* 123 */
+EXTERN void Tk_MakeWindowExist _ANSI_ARGS_((Tk_Window tkwin));
+/* 124 */
+EXTERN void Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_GeomMgr * mgrPtr, ClientData clientData));
+/* 125 */
+EXTERN void Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin));
+/* 126 */
+EXTERN int Tk_MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
+ CONST char * source, int numBytes,
+ int maxPixels, int flags, int * lengthPtr));
+/* 127 */
+EXTERN void Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height));
+/* 128 */
+EXTERN void Tk_MoveWindow _ANSI_ARGS_((Tk_Window tkwin, int x,
+ int y));
+/* 129 */
+EXTERN void Tk_MoveToplevelWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y));
+/* 130 */
+EXTERN CONST84_RETURN char * Tk_NameOf3DBorder _ANSI_ARGS_((
+ Tk_3DBorder border));
+/* 131 */
+EXTERN CONST84_RETURN char * Tk_NameOfAnchor _ANSI_ARGS_((Tk_Anchor anchor));
+/* 132 */
+EXTERN CONST84_RETURN char * Tk_NameOfBitmap _ANSI_ARGS_((Display * display,
+ Pixmap bitmap));
+/* 133 */
+EXTERN CONST84_RETURN char * Tk_NameOfCapStyle _ANSI_ARGS_((int cap));
+/* 134 */
+EXTERN CONST84_RETURN char * Tk_NameOfColor _ANSI_ARGS_((XColor * colorPtr));
+/* 135 */
+EXTERN CONST84_RETURN char * Tk_NameOfCursor _ANSI_ARGS_((Display * display,
+ Tk_Cursor cursor));
+/* 136 */
+EXTERN CONST84_RETURN char * Tk_NameOfFont _ANSI_ARGS_((Tk_Font font));
+/* 137 */
+EXTERN CONST84_RETURN char * Tk_NameOfImage _ANSI_ARGS_((
+ Tk_ImageMaster imageMaster));
+/* 138 */
+EXTERN CONST84_RETURN char * Tk_NameOfJoinStyle _ANSI_ARGS_((int join));
+/* 139 */
+EXTERN CONST84_RETURN char * Tk_NameOfJustify _ANSI_ARGS_((
+ Tk_Justify justify));
+/* 140 */
+EXTERN CONST84_RETURN char * Tk_NameOfRelief _ANSI_ARGS_((int relief));
+/* 141 */
+EXTERN Tk_Window Tk_NameToWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * pathName, Tk_Window tkwin));
+/* 142 */
+EXTERN void Tk_OwnSelection _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Tk_LostSelProc * proc,
+ ClientData clientData));
+/* 143 */
+EXTERN int Tk_ParseArgv _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, int * argcPtr,
+ CONST84 char ** argv, Tk_ArgvInfo * argTable,
+ int flags));
+/* 144 */
+EXTERN void Tk_PhotoPutBlock_NoComposite _ANSI_ARGS_((
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock * blockPtr, int x, int y,
+ int width, int height));
+/* 145 */
+EXTERN void Tk_PhotoPutZoomedBlock_NoComposite _ANSI_ARGS_((
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock * blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY));
+/* 146 */
+EXTERN int Tk_PhotoGetImage _ANSI_ARGS_((Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock * blockPtr));
+/* 147 */
+EXTERN void Tk_PhotoBlank _ANSI_ARGS_((Tk_PhotoHandle handle));
+/* 148 */
+EXTERN void Tk_PhotoExpand _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int width, int height));
+/* 149 */
+EXTERN void Tk_PhotoGetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int * widthPtr, int * heightPtr));
+/* 150 */
+EXTERN void Tk_PhotoSetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int width, int height));
+/* 151 */
+EXTERN int Tk_PointToChar _ANSI_ARGS_((Tk_TextLayout layout,
+ int x, int y));
+/* 152 */
+EXTERN int Tk_PostscriptFontName _ANSI_ARGS_((Tk_Font tkfont,
+ Tcl_DString * dsPtr));
+/* 153 */
+EXTERN void Tk_PreserveColormap _ANSI_ARGS_((Display * display,
+ Colormap colormap));
+/* 154 */
+EXTERN void Tk_QueueWindowEvent _ANSI_ARGS_((XEvent * eventPtr,
+ Tcl_QueuePosition position));
+/* 155 */
+EXTERN void Tk_RedrawImage _ANSI_ARGS_((Tk_Image image,
+ int imageX, int imageY, int width,
+ int height, Drawable drawable, int drawableX,
+ int drawableY));
+/* 156 */
+EXTERN void Tk_ResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int width, int height));
+/* 157 */
+EXTERN int Tk_RestackWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int aboveBelow, Tk_Window other));
+/* 158 */
+EXTERN Tk_RestrictProc * Tk_RestrictEvents _ANSI_ARGS_((
+ Tk_RestrictProc * proc, ClientData arg,
+ ClientData * prevArgPtr));
+/* 159 */
+EXTERN int Tk_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
+/* 160 */
+EXTERN CONST char * Tk_SetAppName _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char * name));
+/* 161 */
+EXTERN void Tk_SetBackgroundFromBorder _ANSI_ARGS_((
+ Tk_Window tkwin, Tk_3DBorder border));
+/* 162 */
+EXTERN void Tk_SetClass _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char * className));
+/* 163 */
+EXTERN void Tk_SetGrid _ANSI_ARGS_((Tk_Window tkwin,
+ int reqWidth, int reqHeight, int gridWidth,
+ int gridHeight));
+/* 164 */
+EXTERN void Tk_SetInternalBorder _ANSI_ARGS_((Tk_Window tkwin,
+ int width));
+/* 165 */
+EXTERN void Tk_SetWindowBackground _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long pixel));
+/* 166 */
+EXTERN void Tk_SetWindowBackgroundPixmap _ANSI_ARGS_((
+ Tk_Window tkwin, Pixmap pixmap));
+/* 167 */
+EXTERN void Tk_SetWindowBorder _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long pixel));
+/* 168 */
+EXTERN void Tk_SetWindowBorderWidth _ANSI_ARGS_((Tk_Window tkwin,
+ int width));
+/* 169 */
+EXTERN void Tk_SetWindowBorderPixmap _ANSI_ARGS_((
+ Tk_Window tkwin, Pixmap pixmap));
+/* 170 */
+EXTERN void Tk_SetWindowColormap _ANSI_ARGS_((Tk_Window tkwin,
+ Colormap colormap));
+/* 171 */
+EXTERN int Tk_SetWindowVisual _ANSI_ARGS_((Tk_Window tkwin,
+ Visual * visual, int depth,
+ Colormap colormap));
+/* 172 */
+EXTERN void Tk_SizeOfBitmap _ANSI_ARGS_((Display * display,
+ Pixmap bitmap, int * widthPtr,
+ int * heightPtr));
+/* 173 */
+EXTERN void Tk_SizeOfImage _ANSI_ARGS_((Tk_Image image,
+ int * widthPtr, int * heightPtr));
+/* 174 */
+EXTERN int Tk_StrictMotif _ANSI_ARGS_((Tk_Window tkwin));
+/* 175 */
+EXTERN void Tk_TextLayoutToPostscript _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_TextLayout layout));
+/* 176 */
+EXTERN int Tk_TextWidth _ANSI_ARGS_((Tk_Font font,
+ CONST char * str, int numBytes));
+/* 177 */
+EXTERN void Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window));
+/* 178 */
+EXTERN void Tk_UnderlineChars _ANSI_ARGS_((Display * display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ CONST char * source, int x, int y,
+ int firstByte, int lastByte));
+/* 179 */
+EXTERN void Tk_UnderlineTextLayout _ANSI_ARGS_((
+ Display * display, Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int underline));
+/* 180 */
+EXTERN void Tk_Ungrab _ANSI_ARGS_((Tk_Window tkwin));
+/* 181 */
+EXTERN void Tk_UnmaintainGeometry _ANSI_ARGS_((Tk_Window slave,
+ Tk_Window master));
+/* 182 */
+EXTERN void Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin));
+/* 183 */
+EXTERN void Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin));
+/* 184 */
+EXTERN void Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin, int x,
+ int y, int state));
+/* 185 */
+EXTERN Pixmap Tk_AllocBitmapFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 186 */
+EXTERN Tk_3DBorder Tk_Alloc3DBorderFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 187 */
+EXTERN XColor * Tk_AllocColorFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 188 */
+EXTERN Tk_Cursor Tk_AllocCursorFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 189 */
+EXTERN Tk_Font Tk_AllocFontFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr));
+/* 190 */
+EXTERN Tk_OptionTable Tk_CreateOptionTable _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ CONST Tk_OptionSpec * templatePtr));
+/* 191 */
+EXTERN void Tk_DeleteOptionTable _ANSI_ARGS_((
+ Tk_OptionTable optionTable));
+/* 192 */
+EXTERN void Tk_Free3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 193 */
+EXTERN void Tk_FreeBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 194 */
+EXTERN void Tk_FreeColorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 195 */
+EXTERN void Tk_FreeConfigOptions _ANSI_ARGS_((char * recordPtr,
+ Tk_OptionTable optionToken, Tk_Window tkwin));
+/* 196 */
+EXTERN void Tk_FreeSavedOptions _ANSI_ARGS_((
+ Tk_SavedOptions * savePtr));
+/* 197 */
+EXTERN void Tk_FreeCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 198 */
+EXTERN void Tk_FreeFontFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 199 */
+EXTERN Tk_3DBorder Tk_Get3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 200 */
+EXTERN int Tk_GetAnchorFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, Tk_Anchor * anchorPtr));
+/* 201 */
+EXTERN Pixmap Tk_GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 202 */
+EXTERN XColor * Tk_GetColorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 203 */
+EXTERN Tk_Cursor Tk_GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 204 */
+EXTERN Tcl_Obj * Tk_GetOptionInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionTable,
+ Tcl_Obj * namePtr, Tk_Window tkwin));
+/* 205 */
+EXTERN Tcl_Obj * Tk_GetOptionValue _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionTable,
+ Tcl_Obj * namePtr, Tk_Window tkwin));
+/* 206 */
+EXTERN int Tk_GetJustifyFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ Tk_Justify * justifyPtr));
+/* 207 */
+EXTERN int Tk_GetMMFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr,
+ double * doublePtr));
+/* 208 */
+EXTERN int Tk_GetPixelsFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr,
+ int * intPtr));
+/* 209 */
+EXTERN int Tk_GetReliefFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, int * resultPtr));
+/* 210 */
+EXTERN int Tk_GetScrollInfoObj _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[],
+ double * dblPtr, int * intPtr));
+/* 211 */
+EXTERN int Tk_InitOptions _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionToken,
+ Tk_Window tkwin));
+/* 212 */
+EXTERN void Tk_MainEx _ANSI_ARGS_((int argc, char ** argv,
+ Tcl_AppInitProc * appInitProc,
+ Tcl_Interp * interp));
+/* 213 */
+EXTERN void Tk_RestoreSavedOptions _ANSI_ARGS_((
+ Tk_SavedOptions * savePtr));
+/* 214 */
+EXTERN int Tk_SetOptions _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionTable,
+ int objc, Tcl_Obj *CONST objv[],
+ Tk_Window tkwin, Tk_SavedOptions * savePtr,
+ int * maskPtr));
+/* 215 */
+EXTERN void Tk_InitConsoleChannels _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 216 */
+EXTERN int Tk_CreateConsoleWindow _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 217 */
+EXTERN void Tk_CreateSmoothMethod _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ Tk_SmoothMethod * method));
+/* Slot 218 is reserved */
+/* Slot 219 is reserved */
+/* 220 */
+EXTERN int Tk_GetDash _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * value, Tk_Dash * dash));
+/* 221 */
+EXTERN void Tk_CreateOutline _ANSI_ARGS_((Tk_Outline * outline));
+/* 222 */
+EXTERN void Tk_DeleteOutline _ANSI_ARGS_((Display * display,
+ Tk_Outline * outline));
+/* 223 */
+EXTERN int Tk_ConfigOutlineGC _ANSI_ARGS_((XGCValues * gcValues,
+ Tk_Canvas canvas, Tk_Item * item,
+ Tk_Outline * outline));
+/* 224 */
+EXTERN int Tk_ChangeOutlineGC _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item * item, Tk_Outline * outline));
+/* 225 */
+EXTERN int Tk_ResetOutlineGC _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item * item, Tk_Outline * outline));
+/* 226 */
+EXTERN int Tk_CanvasPsOutline _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item * item, Tk_Outline * outline));
+/* 227 */
+EXTERN void Tk_SetTSOrigin _ANSI_ARGS_((Tk_Window tkwin, GC gc,
+ int x, int y));
+/* 228 */
+EXTERN int Tk_CanvasGetCoordFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Canvas canvas,
+ Tcl_Obj * obj, double * doublePtr));
+/* 229 */
+EXTERN void Tk_CanvasSetOffset _ANSI_ARGS_((Tk_Canvas canvas,
+ GC gc, Tk_TSOffset * offset));
+/* 230 */
+EXTERN void Tk_DitherPhoto _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int x, int y, int width, int height));
+/* 231 */
+EXTERN int Tk_PostscriptBitmap _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_PostscriptInfo psInfo,
+ Pixmap bitmap, int startX, int startY,
+ int width, int height));
+/* 232 */
+EXTERN int Tk_PostscriptColor _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_PostscriptInfo psInfo, XColor * colorPtr));
+/* 233 */
+EXTERN int Tk_PostscriptFont _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_PostscriptInfo psInfo, Tk_Font font));
+/* 234 */
+EXTERN int Tk_PostscriptImage _ANSI_ARGS_((Tk_Image image,
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psinfo, int x, int y,
+ int width, int height, int prepass));
+/* 235 */
+EXTERN void Tk_PostscriptPath _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_PostscriptInfo psInfo, double * coordPtr,
+ int numPoints));
+/* 236 */
+EXTERN int Tk_PostscriptStipple _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, Pixmap bitmap));
+/* 237 */
+EXTERN double Tk_PostscriptY _ANSI_ARGS_((double y,
+ Tk_PostscriptInfo psInfo));
+/* 238 */
+EXTERN int Tk_PostscriptPhoto _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_PhotoImageBlock * blockPtr,
+ Tk_PostscriptInfo psInfo, int width,
+ int height));
+/* 239 */
+EXTERN void Tk_CreateClientMessageHandler _ANSI_ARGS_((
+ Tk_ClientMessageProc * proc));
+/* 240 */
+EXTERN void Tk_DeleteClientMessageHandler _ANSI_ARGS_((
+ Tk_ClientMessageProc * proc));
+/* 241 */
+EXTERN Tk_Window Tk_CreateAnonymousWindow _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window parent,
+ CONST char * screenName));
+/* 242 */
+EXTERN void Tk_SetClassProcs _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_ClassProcs * procs,
+ ClientData instanceData));
+/* 243 */
+EXTERN void Tk_SetInternalBorderEx _ANSI_ARGS_((Tk_Window tkwin,
+ int left, int right, int top, int bottom));
+/* 244 */
+EXTERN void Tk_SetMinimumRequestSize _ANSI_ARGS_((
+ Tk_Window tkwin, int minWidth, int minHeight));
+/* 245 */
+EXTERN void Tk_SetCaretPos _ANSI_ARGS_((Tk_Window tkwin, int x,
+ int y, int height));
+/* 246 */
+EXTERN void Tk_PhotoPutBlock _ANSI_ARGS_((Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock * blockPtr, int x, int y,
+ int width, int height, int compRule));
+/* 247 */
+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, int compRule));
+/* 248 */
+EXTERN int Tk_CollapseMotionEvents _ANSI_ARGS_((
+ Display * display, int collapse));
+/* 249 */
+EXTERN Tk_StyleEngine Tk_RegisterStyleEngine _ANSI_ARGS_((
+ CONST char * name, Tk_StyleEngine parent));
+/* 250 */
+EXTERN Tk_StyleEngine Tk_GetStyleEngine _ANSI_ARGS_((CONST char * name));
+/* 251 */
+EXTERN int Tk_RegisterStyledElement _ANSI_ARGS_((
+ Tk_StyleEngine engine,
+ Tk_ElementSpec * templatePtr));
+/* 252 */
+EXTERN int Tk_GetElementId _ANSI_ARGS_((CONST char * name));
+/* 253 */
+EXTERN Tk_Style Tk_CreateStyle _ANSI_ARGS_((CONST char * name,
+ Tk_StyleEngine engine, ClientData clientData));
+/* 254 */
+EXTERN Tk_Style Tk_GetStyle _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name));
+/* 255 */
+EXTERN void Tk_FreeStyle _ANSI_ARGS_((Tk_Style style));
+/* 256 */
+EXTERN CONST char * Tk_NameOfStyle _ANSI_ARGS_((Tk_Style style));
+/* 257 */
+EXTERN Tk_Style Tk_AllocStyleFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr));
+/* 258 */
+EXTERN Tk_Style Tk_GetStyleFromObj _ANSI_ARGS_((Tcl_Obj * objPtr));
+/* 259 */
+EXTERN void Tk_FreeStyleFromObj _ANSI_ARGS_((Tcl_Obj * objPtr));
+/* 260 */
+EXTERN Tk_StyledElement Tk_GetStyledElement _ANSI_ARGS_((Tk_Style style,
+ int elementId, Tk_OptionTable optionTable));
+/* 261 */
+EXTERN void Tk_GetElementSize _ANSI_ARGS_((Tk_Style style,
+ Tk_StyledElement element, char * recordPtr,
+ Tk_Window tkwin, int width, int height,
+ int inner, int * widthPtr, int * heightPtr));
+/* 262 */
+EXTERN void Tk_GetElementBox _ANSI_ARGS_((Tk_Style style,
+ Tk_StyledElement element, char * recordPtr,
+ Tk_Window tkwin, int x, int y, int width,
+ int height, int inner, int * xPtr,
+ int * yPtr, int * widthPtr, int * heightPtr));
+/* 263 */
+EXTERN int Tk_GetElementBorderWidth _ANSI_ARGS_((Tk_Style style,
+ Tk_StyledElement element, char * recordPtr,
+ Tk_Window tkwin));
+/* 264 */
+EXTERN void Tk_DrawElement _ANSI_ARGS_((Tk_Style style,
+ Tk_StyledElement element, char * recordPtr,
+ Tk_Window tkwin, Drawable d, int x, int y,
+ int width, int height, int state));
+
+typedef struct TkStubHooks {
+ struct TkPlatStubs *tkPlatStubs;
+ struct TkIntStubs *tkIntStubs;
+ struct TkIntPlatStubs *tkIntPlatStubs;
+ struct TkIntXlibStubs *tkIntXlibStubs;
+} TkStubHooks;
+
+typedef struct TkStubs {
+ int magic;
+ struct TkStubHooks *hooks;
+
+ void (*tk_MainLoop) _ANSI_ARGS_((void)); /* 0 */
+ XColor * (*tk_3DBorderColor) _ANSI_ARGS_((Tk_3DBorder border)); /* 1 */
+ GC (*tk_3DBorderGC) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border, int which)); /* 2 */
+ void (*tk_3DHorizontalBevel) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftIn, int rightIn, int topBevel, int relief)); /* 3 */
+ void (*tk_3DVerticalBevel) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftBevel, int relief)); /* 4 */
+ void (*tk_AddOption) _ANSI_ARGS_((Tk_Window tkwin, CONST char * name, CONST char * value, int priority)); /* 5 */
+ void (*tk_BindEvent) _ANSI_ARGS_((Tk_BindingTable bindingTable, XEvent * eventPtr, Tk_Window tkwin, int numObjects, ClientData * objectPtr)); /* 6 */
+ void (*tk_CanvasDrawableCoords) _ANSI_ARGS_((Tk_Canvas canvas, double x, double y, short * drawableXPtr, short * drawableYPtr)); /* 7 */
+ void (*tk_CanvasEventuallyRedraw) _ANSI_ARGS_((Tk_Canvas canvas, int x1, int y1, int x2, int y2)); /* 8 */
+ int (*tk_CanvasGetCoord) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, CONST char * str, double * doublePtr)); /* 9 */
+ Tk_CanvasTextInfo * (*tk_CanvasGetTextInfo) _ANSI_ARGS_((Tk_Canvas canvas)); /* 10 */
+ int (*tk_CanvasPsBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Pixmap bitmap, int x, int y, int width, int height)); /* 11 */
+ int (*tk_CanvasPsColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, XColor * colorPtr)); /* 12 */
+ int (*tk_CanvasPsFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Tk_Font font)); /* 13 */
+ void (*tk_CanvasPsPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * coordPtr, int numPoints)); /* 14 */
+ int (*tk_CanvasPsStipple) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Pixmap bitmap)); /* 15 */
+ double (*tk_CanvasPsY) _ANSI_ARGS_((Tk_Canvas canvas, double y)); /* 16 */
+ void (*tk_CanvasSetStippleOrigin) _ANSI_ARGS_((Tk_Canvas canvas, GC gc)); /* 17 */
+ int (*tk_CanvasTagsParseProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, Tk_Window tkwin, CONST char * value, char * widgRec, int offset)); /* 18 */
+ char * (*tk_CanvasTagsPrintProc) _ANSI_ARGS_((ClientData clientData, Tk_Window tkwin, char * widgRec, int offset, Tcl_FreeProc ** freeProcPtr)); /* 19 */
+ Tk_Window (*tk_CanvasTkwin) _ANSI_ARGS_((Tk_Canvas canvas)); /* 20 */
+ void (*tk_CanvasWindowCoords) _ANSI_ARGS_((Tk_Canvas canvas, double x, double y, short * screenXPtr, short * screenYPtr)); /* 21 */
+ void (*tk_ChangeWindowAttributes) _ANSI_ARGS_((Tk_Window tkwin, unsigned long valueMask, XSetWindowAttributes * attsPtr)); /* 22 */
+ int (*tk_CharBbox) _ANSI_ARGS_((Tk_TextLayout layout, int index, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 23 */
+ void (*tk_ClearSelection) _ANSI_ARGS_((Tk_Window tkwin, Atom selection)); /* 24 */
+ int (*tk_ClipboardAppend) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom target, Atom format, char* buffer)); /* 25 */
+ int (*tk_ClipboardClear) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 26 */
+ int (*tk_ConfigureInfo) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, char * widgRec, CONST char * argvName, int flags)); /* 27 */
+ int (*tk_ConfigureValue) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, char * widgRec, CONST char * argvName, int flags)); /* 28 */
+ int (*tk_ConfigureWidget) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, int argc, CONST84 char ** argv, char * widgRec, int flags)); /* 29 */
+ void (*tk_ConfigureWindow) _ANSI_ARGS_((Tk_Window tkwin, unsigned int valueMask, XWindowChanges * valuePtr)); /* 30 */
+ Tk_TextLayout (*tk_ComputeTextLayout) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numChars, int wrapLength, Tk_Justify justify, int flags, int * widthPtr, int * heightPtr)); /* 31 */
+ Tk_Window (*tk_CoordsToWindow) _ANSI_ARGS_((int rootX, int rootY, Tk_Window tkwin)); /* 32 */
+ unsigned long (*tk_CreateBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, CONST char * eventStr, CONST char * command, int append)); /* 33 */
+ Tk_BindingTable (*tk_CreateBindingTable) _ANSI_ARGS_((Tcl_Interp * interp)); /* 34 */
+ Tk_ErrorHandler (*tk_CreateErrorHandler) _ANSI_ARGS_((Display * display, int errNum, int request, int minorCode, Tk_ErrorProc * errorProc, ClientData clientData)); /* 35 */
+ void (*tk_CreateEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 36 */
+ void (*tk_CreateGenericHandler) _ANSI_ARGS_((Tk_GenericProc * proc, ClientData clientData)); /* 37 */
+ void (*tk_CreateImageType) _ANSI_ARGS_((Tk_ImageType * typePtr)); /* 38 */
+ void (*tk_CreateItemType) _ANSI_ARGS_((Tk_ItemType * typePtr)); /* 39 */
+ void (*tk_CreatePhotoImageFormat) _ANSI_ARGS_((Tk_PhotoImageFormat * formatPtr)); /* 40 */
+ void (*tk_CreateSelHandler) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Atom target, Tk_SelectionProc * proc, ClientData clientData, Atom format)); /* 41 */
+ Tk_Window (*tk_CreateWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window parent, CONST char * name, CONST char * screenName)); /* 42 */
+ Tk_Window (*tk_CreateWindowFromPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * pathName, CONST char * screenName)); /* 43 */
+ int (*tk_DefineBitmap) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * source, int width, int height)); /* 44 */
+ void (*tk_DefineCursor) _ANSI_ARGS_((Tk_Window window, Tk_Cursor cursor)); /* 45 */
+ void (*tk_DeleteAllBindings) _ANSI_ARGS_((Tk_BindingTable bindingTable, ClientData object)); /* 46 */
+ int (*tk_DeleteBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, CONST char * eventStr)); /* 47 */
+ void (*tk_DeleteBindingTable) _ANSI_ARGS_((Tk_BindingTable bindingTable)); /* 48 */
+ void (*tk_DeleteErrorHandler) _ANSI_ARGS_((Tk_ErrorHandler handler)); /* 49 */
+ void (*tk_DeleteEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 50 */
+ void (*tk_DeleteGenericHandler) _ANSI_ARGS_((Tk_GenericProc * proc, ClientData clientData)); /* 51 */
+ void (*tk_DeleteImage) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 52 */
+ void (*tk_DeleteSelHandler) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Atom target)); /* 53 */
+ void (*tk_DestroyWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 54 */
+ CONST84_RETURN char * (*tk_DisplayName) _ANSI_ARGS_((Tk_Window tkwin)); /* 55 */
+ int (*tk_DistanceToTextLayout) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y)); /* 56 */
+ void (*tk_Draw3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 57 */
+ void (*tk_Draw3DRectangle) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief)); /* 58 */
+ void (*tk_DrawChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int numBytes, int x, int y)); /* 59 */
+ void (*tk_DrawFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable)); /* 60 */
+ void (*tk_DrawTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int firstChar, int lastChar)); /* 61 */
+ void (*tk_Fill3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 62 */
+ void (*tk_Fill3DRectangle) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief)); /* 63 */
+ Tk_PhotoHandle (*tk_FindPhoto) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * imageName)); /* 64 */
+ Font (*tk_FontId) _ANSI_ARGS_((Tk_Font font)); /* 65 */
+ void (*tk_Free3DBorder) _ANSI_ARGS_((Tk_3DBorder border)); /* 66 */
+ void (*tk_FreeBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap)); /* 67 */
+ void (*tk_FreeColor) _ANSI_ARGS_((XColor * colorPtr)); /* 68 */
+ void (*tk_FreeColormap) _ANSI_ARGS_((Display * display, Colormap colormap)); /* 69 */
+ void (*tk_FreeCursor) _ANSI_ARGS_((Display * display, Tk_Cursor cursor)); /* 70 */
+ void (*tk_FreeFont) _ANSI_ARGS_((Tk_Font f)); /* 71 */
+ void (*tk_FreeGC) _ANSI_ARGS_((Display * display, GC gc)); /* 72 */
+ void (*tk_FreeImage) _ANSI_ARGS_((Tk_Image image)); /* 73 */
+ void (*tk_FreeOptions) _ANSI_ARGS_((Tk_ConfigSpec * specs, char * widgRec, Display * display, int needFlags)); /* 74 */
+ void (*tk_FreePixmap) _ANSI_ARGS_((Display * display, Pixmap pixmap)); /* 75 */
+ void (*tk_FreeTextLayout) _ANSI_ARGS_((Tk_TextLayout textLayout)); /* 76 */
+ void (*tk_FreeXId) _ANSI_ARGS_((Display * display, XID xid)); /* 77 */
+ GC (*tk_GCForColor) _ANSI_ARGS_((XColor * colorPtr, Drawable drawable)); /* 78 */
+ void (*tk_GeometryRequest) _ANSI_ARGS_((Tk_Window tkwin, int reqWidth, int reqHeight)); /* 79 */
+ Tk_3DBorder (*tk_Get3DBorder) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid colorName)); /* 80 */
+ void (*tk_GetAllBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object)); /* 81 */
+ int (*tk_GetAnchor) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, Tk_Anchor * anchorPtr)); /* 82 */
+ CONST84_RETURN char * (*tk_GetAtomName) _ANSI_ARGS_((Tk_Window tkwin, Atom atom)); /* 83 */
+ CONST84_RETURN char * (*tk_GetBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, CONST char * eventStr)); /* 84 */
+ Pixmap (*tk_GetBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 85 */
+ Pixmap (*tk_GetBitmapFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * source, int width, int height)); /* 86 */
+ int (*tk_GetCapStyle) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * capPtr)); /* 87 */
+ XColor * (*tk_GetColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid name)); /* 88 */
+ XColor * (*tk_GetColorByValue) _ANSI_ARGS_((Tk_Window tkwin, XColor * colorPtr)); /* 89 */
+ Colormap (*tk_GetColormap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 90 */
+ Tk_Cursor (*tk_GetCursor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid str)); /* 91 */
+ Tk_Cursor (*tk_GetCursorFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * source, CONST char * mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg)); /* 92 */
+ Tk_Font (*tk_GetFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 93 */
+ Tk_Font (*tk_GetFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 94 */
+ void (*tk_GetFontMetrics) _ANSI_ARGS_((Tk_Font font, Tk_FontMetrics * fmPtr)); /* 95 */
+ GC (*tk_GetGC) _ANSI_ARGS_((Tk_Window tkwin, unsigned long valueMask, XGCValues * valuePtr)); /* 96 */
+ Tk_Image (*tk_GetImage) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * name, Tk_ImageChangedProc * changeProc, ClientData clientData)); /* 97 */
+ ClientData (*tk_GetImageMasterData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tk_ImageType ** typePtrPtr)); /* 98 */
+ Tk_ItemType * (*tk_GetItemTypes) _ANSI_ARGS_((void)); /* 99 */
+ int (*tk_GetJoinStyle) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * joinPtr)); /* 100 */
+ int (*tk_GetJustify) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, Tk_Justify * justifyPtr)); /* 101 */
+ int (*tk_GetNumMainWindows) _ANSI_ARGS_((void)); /* 102 */
+ Tk_Uid (*tk_GetOption) _ANSI_ARGS_((Tk_Window tkwin, CONST char * name, CONST char * className)); /* 103 */
+ int (*tk_GetPixels) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str, int * intPtr)); /* 104 */
+ Pixmap (*tk_GetPixmap) _ANSI_ARGS_((Display * display, Drawable d, int width, int height, int depth)); /* 105 */
+ int (*tk_GetRelief) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int * reliefPtr)); /* 106 */
+ void (*tk_GetRootCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 107 */
+ int (*tk_GetScrollInfo) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, double * dblPtr, int * intPtr)); /* 108 */
+ int (*tk_GetScreenMM) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str, double * doublePtr)); /* 109 */
+ int (*tk_GetSelection) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc * proc, ClientData clientData)); /* 110 */
+ Tk_Uid (*tk_GetUid) _ANSI_ARGS_((CONST char * str)); /* 111 */
+ Visual * (*tk_GetVisual) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str, int * depthPtr, Colormap * colormapPtr)); /* 112 */
+ void (*tk_GetVRootGeometry) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 113 */
+ int (*tk_Grab) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, int grabGlobal)); /* 114 */
+ void (*tk_HandleEvent) _ANSI_ARGS_((XEvent * eventPtr)); /* 115 */
+ Tk_Window (*tk_IdToWindow) _ANSI_ARGS_((Display * display, Window window)); /* 116 */
+ void (*tk_ImageChanged) _ANSI_ARGS_((Tk_ImageMaster master, int x, int y, int width, int height, int imageWidth, int imageHeight)); /* 117 */
+ int (*tk_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 118 */
+ Atom (*tk_InternAtom) _ANSI_ARGS_((Tk_Window tkwin, CONST char * name)); /* 119 */
+ int (*tk_IntersectTextLayout) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y, int width, int height)); /* 120 */
+ void (*tk_MaintainGeometry) _ANSI_ARGS_((Tk_Window slave, Tk_Window master, int x, int y, int width, int height)); /* 121 */
+ Tk_Window (*tk_MainWindow) _ANSI_ARGS_((Tcl_Interp * interp)); /* 122 */
+ void (*tk_MakeWindowExist) _ANSI_ARGS_((Tk_Window tkwin)); /* 123 */
+ void (*tk_ManageGeometry) _ANSI_ARGS_((Tk_Window tkwin, Tk_GeomMgr * mgrPtr, ClientData clientData)); /* 124 */
+ void (*tk_MapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 125 */
+ int (*tk_MeasureChars) _ANSI_ARGS_((Tk_Font tkfont, CONST char * source, int numBytes, int maxPixels, int flags, int * lengthPtr)); /* 126 */
+ void (*tk_MoveResizeWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height)); /* 127 */
+ void (*tk_MoveWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 128 */
+ void (*tk_MoveToplevelWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 129 */
+ CONST84_RETURN char * (*tk_NameOf3DBorder) _ANSI_ARGS_((Tk_3DBorder border)); /* 130 */
+ CONST84_RETURN char * (*tk_NameOfAnchor) _ANSI_ARGS_((Tk_Anchor anchor)); /* 131 */
+ CONST84_RETURN char * (*tk_NameOfBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap)); /* 132 */
+ CONST84_RETURN char * (*tk_NameOfCapStyle) _ANSI_ARGS_((int cap)); /* 133 */
+ CONST84_RETURN char * (*tk_NameOfColor) _ANSI_ARGS_((XColor * colorPtr)); /* 134 */
+ CONST84_RETURN char * (*tk_NameOfCursor) _ANSI_ARGS_((Display * display, Tk_Cursor cursor)); /* 135 */
+ CONST84_RETURN char * (*tk_NameOfFont) _ANSI_ARGS_((Tk_Font font)); /* 136 */
+ CONST84_RETURN char * (*tk_NameOfImage) _ANSI_ARGS_((Tk_ImageMaster imageMaster)); /* 137 */
+ CONST84_RETURN char * (*tk_NameOfJoinStyle) _ANSI_ARGS_((int join)); /* 138 */
+ CONST84_RETURN char * (*tk_NameOfJustify) _ANSI_ARGS_((Tk_Justify justify)); /* 139 */
+ CONST84_RETURN char * (*tk_NameOfRelief) _ANSI_ARGS_((int relief)); /* 140 */
+ Tk_Window (*tk_NameToWindow) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pathName, Tk_Window tkwin)); /* 141 */
+ void (*tk_OwnSelection) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Tk_LostSelProc * proc, ClientData clientData)); /* 142 */
+ int (*tk_ParseArgv) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, int * argcPtr, CONST84 char ** argv, Tk_ArgvInfo * argTable, int flags)); /* 143 */
+ void (*tk_PhotoPutBlock_NoComposite) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height)); /* 144 */
+ void (*tk_PhotoPutZoomedBlock_NoComposite) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY)); /* 145 */
+ int (*tk_PhotoGetImage) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr)); /* 146 */
+ void (*tk_PhotoBlank) _ANSI_ARGS_((Tk_PhotoHandle handle)); /* 147 */
+ void (*tk_PhotoExpand) _ANSI_ARGS_((Tk_PhotoHandle handle, int width, int height)); /* 148 */
+ void (*tk_PhotoGetSize) _ANSI_ARGS_((Tk_PhotoHandle handle, int * widthPtr, int * heightPtr)); /* 149 */
+ void (*tk_PhotoSetSize) _ANSI_ARGS_((Tk_PhotoHandle handle, int width, int height)); /* 150 */
+ int (*tk_PointToChar) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y)); /* 151 */
+ int (*tk_PostscriptFontName) _ANSI_ARGS_((Tk_Font tkfont, Tcl_DString * dsPtr)); /* 152 */
+ void (*tk_PreserveColormap) _ANSI_ARGS_((Display * display, Colormap colormap)); /* 153 */
+ void (*tk_QueueWindowEvent) _ANSI_ARGS_((XEvent * eventPtr, Tcl_QueuePosition position)); /* 154 */
+ void (*tk_RedrawImage) _ANSI_ARGS_((Tk_Image image, int imageX, int imageY, int width, int height, Drawable drawable, int drawableX, int drawableY)); /* 155 */
+ void (*tk_ResizeWindow) _ANSI_ARGS_((Tk_Window tkwin, int width, int height)); /* 156 */
+ int (*tk_RestackWindow) _ANSI_ARGS_((Tk_Window tkwin, int aboveBelow, Tk_Window other)); /* 157 */
+ Tk_RestrictProc * (*tk_RestrictEvents) _ANSI_ARGS_((Tk_RestrictProc * proc, ClientData arg, ClientData * prevArgPtr)); /* 158 */
+ int (*tk_SafeInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 159 */
+ CONST char * (*tk_SetAppName) _ANSI_ARGS_((Tk_Window tkwin, CONST char * name)); /* 160 */
+ void (*tk_SetBackgroundFromBorder) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border)); /* 161 */
+ void (*tk_SetClass) _ANSI_ARGS_((Tk_Window tkwin, CONST char * className)); /* 162 */
+ void (*tk_SetGrid) _ANSI_ARGS_((Tk_Window tkwin, int reqWidth, int reqHeight, int gridWidth, int gridHeight)); /* 163 */
+ void (*tk_SetInternalBorder) _ANSI_ARGS_((Tk_Window tkwin, int width)); /* 164 */
+ void (*tk_SetWindowBackground) _ANSI_ARGS_((Tk_Window tkwin, unsigned long pixel)); /* 165 */
+ void (*tk_SetWindowBackgroundPixmap) _ANSI_ARGS_((Tk_Window tkwin, Pixmap pixmap)); /* 166 */
+ void (*tk_SetWindowBorder) _ANSI_ARGS_((Tk_Window tkwin, unsigned long pixel)); /* 167 */
+ void (*tk_SetWindowBorderWidth) _ANSI_ARGS_((Tk_Window tkwin, int width)); /* 168 */
+ void (*tk_SetWindowBorderPixmap) _ANSI_ARGS_((Tk_Window tkwin, Pixmap pixmap)); /* 169 */
+ void (*tk_SetWindowColormap) _ANSI_ARGS_((Tk_Window tkwin, Colormap colormap)); /* 170 */
+ int (*tk_SetWindowVisual) _ANSI_ARGS_((Tk_Window tkwin, Visual * visual, int depth, Colormap colormap)); /* 171 */
+ void (*tk_SizeOfBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap, int * widthPtr, int * heightPtr)); /* 172 */
+ void (*tk_SizeOfImage) _ANSI_ARGS_((Tk_Image image, int * widthPtr, int * heightPtr)); /* 173 */
+ int (*tk_StrictMotif) _ANSI_ARGS_((Tk_Window tkwin)); /* 174 */
+ void (*tk_TextLayoutToPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_TextLayout layout)); /* 175 */
+ int (*tk_TextWidth) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numBytes)); /* 176 */
+ void (*tk_UndefineCursor) _ANSI_ARGS_((Tk_Window window)); /* 177 */
+ void (*tk_UnderlineChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int x, int y, int firstByte, int lastByte)); /* 178 */
+ void (*tk_UnderlineTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int underline)); /* 179 */
+ void (*tk_Ungrab) _ANSI_ARGS_((Tk_Window tkwin)); /* 180 */
+ void (*tk_UnmaintainGeometry) _ANSI_ARGS_((Tk_Window slave, Tk_Window master)); /* 181 */
+ void (*tk_UnmapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 182 */
+ void (*tk_UnsetGrid) _ANSI_ARGS_((Tk_Window tkwin)); /* 183 */
+ void (*tk_UpdatePointer) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int state)); /* 184 */
+ Pixmap (*tk_AllocBitmapFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 185 */
+ Tk_3DBorder (*tk_Alloc3DBorderFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 186 */
+ XColor * (*tk_AllocColorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 187 */
+ Tk_Cursor (*tk_AllocCursorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 188 */
+ Tk_Font (*tk_AllocFontFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 189 */
+ Tk_OptionTable (*tk_CreateOptionTable) _ANSI_ARGS_((Tcl_Interp * interp, CONST Tk_OptionSpec * templatePtr)); /* 190 */
+ void (*tk_DeleteOptionTable) _ANSI_ARGS_((Tk_OptionTable optionTable)); /* 191 */
+ void (*tk_Free3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 192 */
+ void (*tk_FreeBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 193 */
+ void (*tk_FreeColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 194 */
+ void (*tk_FreeConfigOptions) _ANSI_ARGS_((char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 195 */
+ void (*tk_FreeSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 196 */
+ void (*tk_FreeCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 197 */
+ void (*tk_FreeFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 198 */
+ Tk_3DBorder (*tk_Get3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 199 */
+ int (*tk_GetAnchorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Anchor * anchorPtr)); /* 200 */
+ Pixmap (*tk_GetBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 201 */
+ XColor * (*tk_GetColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 202 */
+ Tk_Cursor (*tk_GetCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 203 */
+ Tcl_Obj * (*tk_GetOptionInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 204 */
+ Tcl_Obj * (*tk_GetOptionValue) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 205 */
+ int (*tk_GetJustifyFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Justify * justifyPtr)); /* 206 */
+ int (*tk_GetMMFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, double * doublePtr)); /* 207 */
+ int (*tk_GetPixelsFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, int * intPtr)); /* 208 */
+ int (*tk_GetReliefFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * resultPtr)); /* 209 */
+ int (*tk_GetScrollInfoObj) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], double * dblPtr, int * intPtr)); /* 210 */
+ int (*tk_InitOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 211 */
+ void (*tk_MainEx) _ANSI_ARGS_((int argc, char ** argv, Tcl_AppInitProc * appInitProc, Tcl_Interp * interp)); /* 212 */
+ void (*tk_RestoreSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 213 */
+ int (*tk_SetOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, int objc, Tcl_Obj *CONST objv[], Tk_Window tkwin, Tk_SavedOptions * savePtr, int * maskPtr)); /* 214 */
+ void (*tk_InitConsoleChannels) _ANSI_ARGS_((Tcl_Interp * interp)); /* 215 */
+ int (*tk_CreateConsoleWindow) _ANSI_ARGS_((Tcl_Interp * interp)); /* 216 */
+ void (*tk_CreateSmoothMethod) _ANSI_ARGS_((Tcl_Interp * interp, Tk_SmoothMethod * method)); /* 217 */
+ void *reserved218;
+ void *reserved219;
+ int (*tk_GetDash) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * value, Tk_Dash * dash)); /* 220 */
+ void (*tk_CreateOutline) _ANSI_ARGS_((Tk_Outline * outline)); /* 221 */
+ void (*tk_DeleteOutline) _ANSI_ARGS_((Display * display, Tk_Outline * outline)); /* 222 */
+ int (*tk_ConfigOutlineGC) _ANSI_ARGS_((XGCValues * gcValues, Tk_Canvas canvas, Tk_Item * item, Tk_Outline * outline)); /* 223 */
+ int (*tk_ChangeOutlineGC) _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item * item, Tk_Outline * outline)); /* 224 */
+ int (*tk_ResetOutlineGC) _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item * item, Tk_Outline * outline)); /* 225 */
+ int (*tk_CanvasPsOutline) _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item * item, Tk_Outline * outline)); /* 226 */
+ void (*tk_SetTSOrigin) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int x, int y)); /* 227 */
+ int (*tk_CanvasGetCoordFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Tcl_Obj * obj, double * doublePtr)); /* 228 */
+ void (*tk_CanvasSetOffset) _ANSI_ARGS_((Tk_Canvas canvas, GC gc, Tk_TSOffset * offset)); /* 229 */
+ void (*tk_DitherPhoto) _ANSI_ARGS_((Tk_PhotoHandle handle, int x, int y, int width, int height)); /* 230 */
+ int (*tk_PostscriptBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, Pixmap bitmap, int startX, int startY, int width, int height)); /* 231 */
+ int (*tk_PostscriptColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_PostscriptInfo psInfo, XColor * colorPtr)); /* 232 */
+ int (*tk_PostscriptFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_PostscriptInfo psInfo, Tk_Font font)); /* 233 */
+ int (*tk_PostscriptImage) _ANSI_ARGS_((Tk_Image image, Tcl_Interp * interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo, int x, int y, int width, int height, int prepass)); /* 234 */
+ void (*tk_PostscriptPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_PostscriptInfo psInfo, double * coordPtr, int numPoints)); /* 235 */
+ int (*tk_PostscriptStipple) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, Pixmap bitmap)); /* 236 */
+ double (*tk_PostscriptY) _ANSI_ARGS_((double y, Tk_PostscriptInfo psInfo)); /* 237 */
+ int (*tk_PostscriptPhoto) _ANSI_ARGS_((Tcl_Interp * interp, Tk_PhotoImageBlock * blockPtr, Tk_PostscriptInfo psInfo, int width, int height)); /* 238 */
+ void (*tk_CreateClientMessageHandler) _ANSI_ARGS_((Tk_ClientMessageProc * proc)); /* 239 */
+ void (*tk_DeleteClientMessageHandler) _ANSI_ARGS_((Tk_ClientMessageProc * proc)); /* 240 */
+ Tk_Window (*tk_CreateAnonymousWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window parent, CONST char * screenName)); /* 241 */
+ void (*tk_SetClassProcs) _ANSI_ARGS_((Tk_Window tkwin, Tk_ClassProcs * procs, ClientData instanceData)); /* 242 */
+ void (*tk_SetInternalBorderEx) _ANSI_ARGS_((Tk_Window tkwin, int left, int right, int top, int bottom)); /* 243 */
+ void (*tk_SetMinimumRequestSize) _ANSI_ARGS_((Tk_Window tkwin, int minWidth, int minHeight)); /* 244 */
+ void (*tk_SetCaretPos) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int height)); /* 245 */
+ void (*tk_PhotoPutBlock) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height, int compRule)); /* 246 */
+ 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, int compRule)); /* 247 */
+ int (*tk_CollapseMotionEvents) _ANSI_ARGS_((Display * display, int collapse)); /* 248 */
+ Tk_StyleEngine (*tk_RegisterStyleEngine) _ANSI_ARGS_((CONST char * name, Tk_StyleEngine parent)); /* 249 */
+ Tk_StyleEngine (*tk_GetStyleEngine) _ANSI_ARGS_((CONST char * name)); /* 250 */
+ int (*tk_RegisterStyledElement) _ANSI_ARGS_((Tk_StyleEngine engine, Tk_ElementSpec * templatePtr)); /* 251 */
+ int (*tk_GetElementId) _ANSI_ARGS_((CONST char * name)); /* 252 */
+ Tk_Style (*tk_CreateStyle) _ANSI_ARGS_((CONST char * name, Tk_StyleEngine engine, ClientData clientData)); /* 253 */
+ Tk_Style (*tk_GetStyle) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 254 */
+ void (*tk_FreeStyle) _ANSI_ARGS_((Tk_Style style)); /* 255 */
+ CONST char * (*tk_NameOfStyle) _ANSI_ARGS_((Tk_Style style)); /* 256 */
+ Tk_Style (*tk_AllocStyleFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 257 */
+ Tk_Style (*tk_GetStyleFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 258 */
+ void (*tk_FreeStyleFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 259 */
+ Tk_StyledElement (*tk_GetStyledElement) _ANSI_ARGS_((Tk_Style style, int elementId, Tk_OptionTable optionTable)); /* 260 */
+ void (*tk_GetElementSize) _ANSI_ARGS_((Tk_Style style, Tk_StyledElement element, char * recordPtr, Tk_Window tkwin, int width, int height, int inner, int * widthPtr, int * heightPtr)); /* 261 */
+ void (*tk_GetElementBox) _ANSI_ARGS_((Tk_Style style, Tk_StyledElement element, char * recordPtr, Tk_Window tkwin, int x, int y, int width, int height, int inner, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 262 */
+ int (*tk_GetElementBorderWidth) _ANSI_ARGS_((Tk_Style style, Tk_StyledElement element, char * recordPtr, Tk_Window tkwin)); /* 263 */
+ void (*tk_DrawElement) _ANSI_ARGS_((Tk_Style style, Tk_StyledElement element, char * recordPtr, Tk_Window tkwin, Drawable d, int x, int y, int width, int height, int state)); /* 264 */
+} TkStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TkStubs *tkStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef Tk_MainLoop
+#define Tk_MainLoop \
+ (tkStubsPtr->tk_MainLoop) /* 0 */
+#endif
+#ifndef Tk_3DBorderColor
+#define Tk_3DBorderColor \
+ (tkStubsPtr->tk_3DBorderColor) /* 1 */
+#endif
+#ifndef Tk_3DBorderGC
+#define Tk_3DBorderGC \
+ (tkStubsPtr->tk_3DBorderGC) /* 2 */
+#endif
+#ifndef Tk_3DHorizontalBevel
+#define Tk_3DHorizontalBevel \
+ (tkStubsPtr->tk_3DHorizontalBevel) /* 3 */
+#endif
+#ifndef Tk_3DVerticalBevel
+#define Tk_3DVerticalBevel \
+ (tkStubsPtr->tk_3DVerticalBevel) /* 4 */
+#endif
+#ifndef Tk_AddOption
+#define Tk_AddOption \
+ (tkStubsPtr->tk_AddOption) /* 5 */
+#endif
+#ifndef Tk_BindEvent
+#define Tk_BindEvent \
+ (tkStubsPtr->tk_BindEvent) /* 6 */
+#endif
+#ifndef Tk_CanvasDrawableCoords
+#define Tk_CanvasDrawableCoords \
+ (tkStubsPtr->tk_CanvasDrawableCoords) /* 7 */
+#endif
+#ifndef Tk_CanvasEventuallyRedraw
+#define Tk_CanvasEventuallyRedraw \
+ (tkStubsPtr->tk_CanvasEventuallyRedraw) /* 8 */
+#endif
+#ifndef Tk_CanvasGetCoord
+#define Tk_CanvasGetCoord \
+ (tkStubsPtr->tk_CanvasGetCoord) /* 9 */
+#endif
+#ifndef Tk_CanvasGetTextInfo
+#define Tk_CanvasGetTextInfo \
+ (tkStubsPtr->tk_CanvasGetTextInfo) /* 10 */
+#endif
+#ifndef Tk_CanvasPsBitmap
+#define Tk_CanvasPsBitmap \
+ (tkStubsPtr->tk_CanvasPsBitmap) /* 11 */
+#endif
+#ifndef Tk_CanvasPsColor
+#define Tk_CanvasPsColor \
+ (tkStubsPtr->tk_CanvasPsColor) /* 12 */
+#endif
+#ifndef Tk_CanvasPsFont
+#define Tk_CanvasPsFont \
+ (tkStubsPtr->tk_CanvasPsFont) /* 13 */
+#endif
+#ifndef Tk_CanvasPsPath
+#define Tk_CanvasPsPath \
+ (tkStubsPtr->tk_CanvasPsPath) /* 14 */
+#endif
+#ifndef Tk_CanvasPsStipple
+#define Tk_CanvasPsStipple \
+ (tkStubsPtr->tk_CanvasPsStipple) /* 15 */
+#endif
+#ifndef Tk_CanvasPsY
+#define Tk_CanvasPsY \
+ (tkStubsPtr->tk_CanvasPsY) /* 16 */
+#endif
+#ifndef Tk_CanvasSetStippleOrigin
+#define Tk_CanvasSetStippleOrigin \
+ (tkStubsPtr->tk_CanvasSetStippleOrigin) /* 17 */
+#endif
+#ifndef Tk_CanvasTagsParseProc
+#define Tk_CanvasTagsParseProc \
+ (tkStubsPtr->tk_CanvasTagsParseProc) /* 18 */
+#endif
+#ifndef Tk_CanvasTagsPrintProc
+#define Tk_CanvasTagsPrintProc \
+ (tkStubsPtr->tk_CanvasTagsPrintProc) /* 19 */
+#endif
+#ifndef Tk_CanvasTkwin
+#define Tk_CanvasTkwin \
+ (tkStubsPtr->tk_CanvasTkwin) /* 20 */
+#endif
+#ifndef Tk_CanvasWindowCoords
+#define Tk_CanvasWindowCoords \
+ (tkStubsPtr->tk_CanvasWindowCoords) /* 21 */
+#endif
+#ifndef Tk_ChangeWindowAttributes
+#define Tk_ChangeWindowAttributes \
+ (tkStubsPtr->tk_ChangeWindowAttributes) /* 22 */
+#endif
+#ifndef Tk_CharBbox
+#define Tk_CharBbox \
+ (tkStubsPtr->tk_CharBbox) /* 23 */
+#endif
+#ifndef Tk_ClearSelection
+#define Tk_ClearSelection \
+ (tkStubsPtr->tk_ClearSelection) /* 24 */
+#endif
+#ifndef Tk_ClipboardAppend
+#define Tk_ClipboardAppend \
+ (tkStubsPtr->tk_ClipboardAppend) /* 25 */
+#endif
+#ifndef Tk_ClipboardClear
+#define Tk_ClipboardClear \
+ (tkStubsPtr->tk_ClipboardClear) /* 26 */
+#endif
+#ifndef Tk_ConfigureInfo
+#define Tk_ConfigureInfo \
+ (tkStubsPtr->tk_ConfigureInfo) /* 27 */
+#endif
+#ifndef Tk_ConfigureValue
+#define Tk_ConfigureValue \
+ (tkStubsPtr->tk_ConfigureValue) /* 28 */
+#endif
+#ifndef Tk_ConfigureWidget
+#define Tk_ConfigureWidget \
+ (tkStubsPtr->tk_ConfigureWidget) /* 29 */
+#endif
+#ifndef Tk_ConfigureWindow
+#define Tk_ConfigureWindow \
+ (tkStubsPtr->tk_ConfigureWindow) /* 30 */
+#endif
+#ifndef Tk_ComputeTextLayout
+#define Tk_ComputeTextLayout \
+ (tkStubsPtr->tk_ComputeTextLayout) /* 31 */
+#endif
+#ifndef Tk_CoordsToWindow
+#define Tk_CoordsToWindow \
+ (tkStubsPtr->tk_CoordsToWindow) /* 32 */
+#endif
+#ifndef Tk_CreateBinding
+#define Tk_CreateBinding \
+ (tkStubsPtr->tk_CreateBinding) /* 33 */
+#endif
+#ifndef Tk_CreateBindingTable
+#define Tk_CreateBindingTable \
+ (tkStubsPtr->tk_CreateBindingTable) /* 34 */
+#endif
+#ifndef Tk_CreateErrorHandler
+#define Tk_CreateErrorHandler \
+ (tkStubsPtr->tk_CreateErrorHandler) /* 35 */
+#endif
+#ifndef Tk_CreateEventHandler
+#define Tk_CreateEventHandler \
+ (tkStubsPtr->tk_CreateEventHandler) /* 36 */
+#endif
+#ifndef Tk_CreateGenericHandler
+#define Tk_CreateGenericHandler \
+ (tkStubsPtr->tk_CreateGenericHandler) /* 37 */
+#endif
+#ifndef Tk_CreateImageType
+#define Tk_CreateImageType \
+ (tkStubsPtr->tk_CreateImageType) /* 38 */
+#endif
+#ifndef Tk_CreateItemType
+#define Tk_CreateItemType \
+ (tkStubsPtr->tk_CreateItemType) /* 39 */
+#endif
+#ifndef Tk_CreatePhotoImageFormat
+#define Tk_CreatePhotoImageFormat \
+ (tkStubsPtr->tk_CreatePhotoImageFormat) /* 40 */
+#endif
+#ifndef Tk_CreateSelHandler
+#define Tk_CreateSelHandler \
+ (tkStubsPtr->tk_CreateSelHandler) /* 41 */
+#endif
+#ifndef Tk_CreateWindow
+#define Tk_CreateWindow \
+ (tkStubsPtr->tk_CreateWindow) /* 42 */
+#endif
+#ifndef Tk_CreateWindowFromPath
+#define Tk_CreateWindowFromPath \
+ (tkStubsPtr->tk_CreateWindowFromPath) /* 43 */
+#endif
+#ifndef Tk_DefineBitmap
+#define Tk_DefineBitmap \
+ (tkStubsPtr->tk_DefineBitmap) /* 44 */
+#endif
+#ifndef Tk_DefineCursor
+#define Tk_DefineCursor \
+ (tkStubsPtr->tk_DefineCursor) /* 45 */
+#endif
+#ifndef Tk_DeleteAllBindings
+#define Tk_DeleteAllBindings \
+ (tkStubsPtr->tk_DeleteAllBindings) /* 46 */
+#endif
+#ifndef Tk_DeleteBinding
+#define Tk_DeleteBinding \
+ (tkStubsPtr->tk_DeleteBinding) /* 47 */
+#endif
+#ifndef Tk_DeleteBindingTable
+#define Tk_DeleteBindingTable \
+ (tkStubsPtr->tk_DeleteBindingTable) /* 48 */
+#endif
+#ifndef Tk_DeleteErrorHandler
+#define Tk_DeleteErrorHandler \
+ (tkStubsPtr->tk_DeleteErrorHandler) /* 49 */
+#endif
+#ifndef Tk_DeleteEventHandler
+#define Tk_DeleteEventHandler \
+ (tkStubsPtr->tk_DeleteEventHandler) /* 50 */
+#endif
+#ifndef Tk_DeleteGenericHandler
+#define Tk_DeleteGenericHandler \
+ (tkStubsPtr->tk_DeleteGenericHandler) /* 51 */
+#endif
+#ifndef Tk_DeleteImage
+#define Tk_DeleteImage \
+ (tkStubsPtr->tk_DeleteImage) /* 52 */
+#endif
+#ifndef Tk_DeleteSelHandler
+#define Tk_DeleteSelHandler \
+ (tkStubsPtr->tk_DeleteSelHandler) /* 53 */
+#endif
+#ifndef Tk_DestroyWindow
+#define Tk_DestroyWindow \
+ (tkStubsPtr->tk_DestroyWindow) /* 54 */
+#endif
+#ifndef Tk_DisplayName
+#define Tk_DisplayName \
+ (tkStubsPtr->tk_DisplayName) /* 55 */
+#endif
+#ifndef Tk_DistanceToTextLayout
+#define Tk_DistanceToTextLayout \
+ (tkStubsPtr->tk_DistanceToTextLayout) /* 56 */
+#endif
+#ifndef Tk_Draw3DPolygon
+#define Tk_Draw3DPolygon \
+ (tkStubsPtr->tk_Draw3DPolygon) /* 57 */
+#endif
+#ifndef Tk_Draw3DRectangle
+#define Tk_Draw3DRectangle \
+ (tkStubsPtr->tk_Draw3DRectangle) /* 58 */
+#endif
+#ifndef Tk_DrawChars
+#define Tk_DrawChars \
+ (tkStubsPtr->tk_DrawChars) /* 59 */
+#endif
+#ifndef Tk_DrawFocusHighlight
+#define Tk_DrawFocusHighlight \
+ (tkStubsPtr->tk_DrawFocusHighlight) /* 60 */
+#endif
+#ifndef Tk_DrawTextLayout
+#define Tk_DrawTextLayout \
+ (tkStubsPtr->tk_DrawTextLayout) /* 61 */
+#endif
+#ifndef Tk_Fill3DPolygon
+#define Tk_Fill3DPolygon \
+ (tkStubsPtr->tk_Fill3DPolygon) /* 62 */
+#endif
+#ifndef Tk_Fill3DRectangle
+#define Tk_Fill3DRectangle \
+ (tkStubsPtr->tk_Fill3DRectangle) /* 63 */
+#endif
+#ifndef Tk_FindPhoto
+#define Tk_FindPhoto \
+ (tkStubsPtr->tk_FindPhoto) /* 64 */
+#endif
+#ifndef Tk_FontId
+#define Tk_FontId \
+ (tkStubsPtr->tk_FontId) /* 65 */
+#endif
+#ifndef Tk_Free3DBorder
+#define Tk_Free3DBorder \
+ (tkStubsPtr->tk_Free3DBorder) /* 66 */
+#endif
+#ifndef Tk_FreeBitmap
+#define Tk_FreeBitmap \
+ (tkStubsPtr->tk_FreeBitmap) /* 67 */
+#endif
+#ifndef Tk_FreeColor
+#define Tk_FreeColor \
+ (tkStubsPtr->tk_FreeColor) /* 68 */
+#endif
+#ifndef Tk_FreeColormap
+#define Tk_FreeColormap \
+ (tkStubsPtr->tk_FreeColormap) /* 69 */
+#endif
+#ifndef Tk_FreeCursor
+#define Tk_FreeCursor \
+ (tkStubsPtr->tk_FreeCursor) /* 70 */
+#endif
+#ifndef Tk_FreeFont
+#define Tk_FreeFont \
+ (tkStubsPtr->tk_FreeFont) /* 71 */
+#endif
+#ifndef Tk_FreeGC
+#define Tk_FreeGC \
+ (tkStubsPtr->tk_FreeGC) /* 72 */
+#endif
+#ifndef Tk_FreeImage
+#define Tk_FreeImage \
+ (tkStubsPtr->tk_FreeImage) /* 73 */
+#endif
+#ifndef Tk_FreeOptions
+#define Tk_FreeOptions \
+ (tkStubsPtr->tk_FreeOptions) /* 74 */
+#endif
+#ifndef Tk_FreePixmap
+#define Tk_FreePixmap \
+ (tkStubsPtr->tk_FreePixmap) /* 75 */
+#endif
+#ifndef Tk_FreeTextLayout
+#define Tk_FreeTextLayout \
+ (tkStubsPtr->tk_FreeTextLayout) /* 76 */
+#endif
+#ifndef Tk_FreeXId
+#define Tk_FreeXId \
+ (tkStubsPtr->tk_FreeXId) /* 77 */
+#endif
+#ifndef Tk_GCForColor
+#define Tk_GCForColor \
+ (tkStubsPtr->tk_GCForColor) /* 78 */
+#endif
+#ifndef Tk_GeometryRequest
+#define Tk_GeometryRequest \
+ (tkStubsPtr->tk_GeometryRequest) /* 79 */
+#endif
+#ifndef Tk_Get3DBorder
+#define Tk_Get3DBorder \
+ (tkStubsPtr->tk_Get3DBorder) /* 80 */
+#endif
+#ifndef Tk_GetAllBindings
+#define Tk_GetAllBindings \
+ (tkStubsPtr->tk_GetAllBindings) /* 81 */
+#endif
+#ifndef Tk_GetAnchor
+#define Tk_GetAnchor \
+ (tkStubsPtr->tk_GetAnchor) /* 82 */
+#endif
+#ifndef Tk_GetAtomName
+#define Tk_GetAtomName \
+ (tkStubsPtr->tk_GetAtomName) /* 83 */
+#endif
+#ifndef Tk_GetBinding
+#define Tk_GetBinding \
+ (tkStubsPtr->tk_GetBinding) /* 84 */
+#endif
+#ifndef Tk_GetBitmap
+#define Tk_GetBitmap \
+ (tkStubsPtr->tk_GetBitmap) /* 85 */
+#endif
+#ifndef Tk_GetBitmapFromData
+#define Tk_GetBitmapFromData \
+ (tkStubsPtr->tk_GetBitmapFromData) /* 86 */
+#endif
+#ifndef Tk_GetCapStyle
+#define Tk_GetCapStyle \
+ (tkStubsPtr->tk_GetCapStyle) /* 87 */
+#endif
+#ifndef Tk_GetColor
+#define Tk_GetColor \
+ (tkStubsPtr->tk_GetColor) /* 88 */
+#endif
+#ifndef Tk_GetColorByValue
+#define Tk_GetColorByValue \
+ (tkStubsPtr->tk_GetColorByValue) /* 89 */
+#endif
+#ifndef Tk_GetColormap
+#define Tk_GetColormap \
+ (tkStubsPtr->tk_GetColormap) /* 90 */
+#endif
+#ifndef Tk_GetCursor
+#define Tk_GetCursor \
+ (tkStubsPtr->tk_GetCursor) /* 91 */
+#endif
+#ifndef Tk_GetCursorFromData
+#define Tk_GetCursorFromData \
+ (tkStubsPtr->tk_GetCursorFromData) /* 92 */
+#endif
+#ifndef Tk_GetFont
+#define Tk_GetFont \
+ (tkStubsPtr->tk_GetFont) /* 93 */
+#endif
+#ifndef Tk_GetFontFromObj
+#define Tk_GetFontFromObj \
+ (tkStubsPtr->tk_GetFontFromObj) /* 94 */
+#endif
+#ifndef Tk_GetFontMetrics
+#define Tk_GetFontMetrics \
+ (tkStubsPtr->tk_GetFontMetrics) /* 95 */
+#endif
+#ifndef Tk_GetGC
+#define Tk_GetGC \
+ (tkStubsPtr->tk_GetGC) /* 96 */
+#endif
+#ifndef Tk_GetImage
+#define Tk_GetImage \
+ (tkStubsPtr->tk_GetImage) /* 97 */
+#endif
+#ifndef Tk_GetImageMasterData
+#define Tk_GetImageMasterData \
+ (tkStubsPtr->tk_GetImageMasterData) /* 98 */
+#endif
+#ifndef Tk_GetItemTypes
+#define Tk_GetItemTypes \
+ (tkStubsPtr->tk_GetItemTypes) /* 99 */
+#endif
+#ifndef Tk_GetJoinStyle
+#define Tk_GetJoinStyle \
+ (tkStubsPtr->tk_GetJoinStyle) /* 100 */
+#endif
+#ifndef Tk_GetJustify
+#define Tk_GetJustify \
+ (tkStubsPtr->tk_GetJustify) /* 101 */
+#endif
+#ifndef Tk_GetNumMainWindows
+#define Tk_GetNumMainWindows \
+ (tkStubsPtr->tk_GetNumMainWindows) /* 102 */
+#endif
+#ifndef Tk_GetOption
+#define Tk_GetOption \
+ (tkStubsPtr->tk_GetOption) /* 103 */
+#endif
+#ifndef Tk_GetPixels
+#define Tk_GetPixels \
+ (tkStubsPtr->tk_GetPixels) /* 104 */
+#endif
+#ifndef Tk_GetPixmap
+#define Tk_GetPixmap \
+ (tkStubsPtr->tk_GetPixmap) /* 105 */
+#endif
+#ifndef Tk_GetRelief
+#define Tk_GetRelief \
+ (tkStubsPtr->tk_GetRelief) /* 106 */
+#endif
+#ifndef Tk_GetRootCoords
+#define Tk_GetRootCoords \
+ (tkStubsPtr->tk_GetRootCoords) /* 107 */
+#endif
+#ifndef Tk_GetScrollInfo
+#define Tk_GetScrollInfo \
+ (tkStubsPtr->tk_GetScrollInfo) /* 108 */
+#endif
+#ifndef Tk_GetScreenMM
+#define Tk_GetScreenMM \
+ (tkStubsPtr->tk_GetScreenMM) /* 109 */
+#endif
+#ifndef Tk_GetSelection
+#define Tk_GetSelection \
+ (tkStubsPtr->tk_GetSelection) /* 110 */
+#endif
+#ifndef Tk_GetUid
+#define Tk_GetUid \
+ (tkStubsPtr->tk_GetUid) /* 111 */
+#endif
+#ifndef Tk_GetVisual
+#define Tk_GetVisual \
+ (tkStubsPtr->tk_GetVisual) /* 112 */
+#endif
+#ifndef Tk_GetVRootGeometry
+#define Tk_GetVRootGeometry \
+ (tkStubsPtr->tk_GetVRootGeometry) /* 113 */
+#endif
+#ifndef Tk_Grab
+#define Tk_Grab \
+ (tkStubsPtr->tk_Grab) /* 114 */
+#endif
+#ifndef Tk_HandleEvent
+#define Tk_HandleEvent \
+ (tkStubsPtr->tk_HandleEvent) /* 115 */
+#endif
+#ifndef Tk_IdToWindow
+#define Tk_IdToWindow \
+ (tkStubsPtr->tk_IdToWindow) /* 116 */
+#endif
+#ifndef Tk_ImageChanged
+#define Tk_ImageChanged \
+ (tkStubsPtr->tk_ImageChanged) /* 117 */
+#endif
+#ifndef Tk_Init
+#define Tk_Init \
+ (tkStubsPtr->tk_Init) /* 118 */
+#endif
+#ifndef Tk_InternAtom
+#define Tk_InternAtom \
+ (tkStubsPtr->tk_InternAtom) /* 119 */
+#endif
+#ifndef Tk_IntersectTextLayout
+#define Tk_IntersectTextLayout \
+ (tkStubsPtr->tk_IntersectTextLayout) /* 120 */
+#endif
+#ifndef Tk_MaintainGeometry
+#define Tk_MaintainGeometry \
+ (tkStubsPtr->tk_MaintainGeometry) /* 121 */
+#endif
+#ifndef Tk_MainWindow
+#define Tk_MainWindow \
+ (tkStubsPtr->tk_MainWindow) /* 122 */
+#endif
+#ifndef Tk_MakeWindowExist
+#define Tk_MakeWindowExist \
+ (tkStubsPtr->tk_MakeWindowExist) /* 123 */
+#endif
+#ifndef Tk_ManageGeometry
+#define Tk_ManageGeometry \
+ (tkStubsPtr->tk_ManageGeometry) /* 124 */
+#endif
+#ifndef Tk_MapWindow
+#define Tk_MapWindow \
+ (tkStubsPtr->tk_MapWindow) /* 125 */
+#endif
+#ifndef Tk_MeasureChars
+#define Tk_MeasureChars \
+ (tkStubsPtr->tk_MeasureChars) /* 126 */
+#endif
+#ifndef Tk_MoveResizeWindow
+#define Tk_MoveResizeWindow \
+ (tkStubsPtr->tk_MoveResizeWindow) /* 127 */
+#endif
+#ifndef Tk_MoveWindow
+#define Tk_MoveWindow \
+ (tkStubsPtr->tk_MoveWindow) /* 128 */
+#endif
+#ifndef Tk_MoveToplevelWindow
+#define Tk_MoveToplevelWindow \
+ (tkStubsPtr->tk_MoveToplevelWindow) /* 129 */
+#endif
+#ifndef Tk_NameOf3DBorder
+#define Tk_NameOf3DBorder \
+ (tkStubsPtr->tk_NameOf3DBorder) /* 130 */
+#endif
+#ifndef Tk_NameOfAnchor
+#define Tk_NameOfAnchor \
+ (tkStubsPtr->tk_NameOfAnchor) /* 131 */
+#endif
+#ifndef Tk_NameOfBitmap
+#define Tk_NameOfBitmap \
+ (tkStubsPtr->tk_NameOfBitmap) /* 132 */
+#endif
+#ifndef Tk_NameOfCapStyle
+#define Tk_NameOfCapStyle \
+ (tkStubsPtr->tk_NameOfCapStyle) /* 133 */
+#endif
+#ifndef Tk_NameOfColor
+#define Tk_NameOfColor \
+ (tkStubsPtr->tk_NameOfColor) /* 134 */
+#endif
+#ifndef Tk_NameOfCursor
+#define Tk_NameOfCursor \
+ (tkStubsPtr->tk_NameOfCursor) /* 135 */
+#endif
+#ifndef Tk_NameOfFont
+#define Tk_NameOfFont \
+ (tkStubsPtr->tk_NameOfFont) /* 136 */
+#endif
+#ifndef Tk_NameOfImage
+#define Tk_NameOfImage \
+ (tkStubsPtr->tk_NameOfImage) /* 137 */
+#endif
+#ifndef Tk_NameOfJoinStyle
+#define Tk_NameOfJoinStyle \
+ (tkStubsPtr->tk_NameOfJoinStyle) /* 138 */
+#endif
+#ifndef Tk_NameOfJustify
+#define Tk_NameOfJustify \
+ (tkStubsPtr->tk_NameOfJustify) /* 139 */
+#endif
+#ifndef Tk_NameOfRelief
+#define Tk_NameOfRelief \
+ (tkStubsPtr->tk_NameOfRelief) /* 140 */
+#endif
+#ifndef Tk_NameToWindow
+#define Tk_NameToWindow \
+ (tkStubsPtr->tk_NameToWindow) /* 141 */
+#endif
+#ifndef Tk_OwnSelection
+#define Tk_OwnSelection \
+ (tkStubsPtr->tk_OwnSelection) /* 142 */
+#endif
+#ifndef Tk_ParseArgv
+#define Tk_ParseArgv \
+ (tkStubsPtr->tk_ParseArgv) /* 143 */
+#endif
+#ifndef Tk_PhotoPutBlock_NoComposite
+#define Tk_PhotoPutBlock_NoComposite \
+ (tkStubsPtr->tk_PhotoPutBlock_NoComposite) /* 144 */
+#endif
+#ifndef Tk_PhotoPutZoomedBlock_NoComposite
+#define Tk_PhotoPutZoomedBlock_NoComposite \
+ (tkStubsPtr->tk_PhotoPutZoomedBlock_NoComposite) /* 145 */
+#endif
+#ifndef Tk_PhotoGetImage
+#define Tk_PhotoGetImage \
+ (tkStubsPtr->tk_PhotoGetImage) /* 146 */
+#endif
+#ifndef Tk_PhotoBlank
+#define Tk_PhotoBlank \
+ (tkStubsPtr->tk_PhotoBlank) /* 147 */
+#endif
+#ifndef Tk_PhotoExpand
+#define Tk_PhotoExpand \
+ (tkStubsPtr->tk_PhotoExpand) /* 148 */
+#endif
+#ifndef Tk_PhotoGetSize
+#define Tk_PhotoGetSize \
+ (tkStubsPtr->tk_PhotoGetSize) /* 149 */
+#endif
+#ifndef Tk_PhotoSetSize
+#define Tk_PhotoSetSize \
+ (tkStubsPtr->tk_PhotoSetSize) /* 150 */
+#endif
+#ifndef Tk_PointToChar
+#define Tk_PointToChar \
+ (tkStubsPtr->tk_PointToChar) /* 151 */
+#endif
+#ifndef Tk_PostscriptFontName
+#define Tk_PostscriptFontName \
+ (tkStubsPtr->tk_PostscriptFontName) /* 152 */
+#endif
+#ifndef Tk_PreserveColormap
+#define Tk_PreserveColormap \
+ (tkStubsPtr->tk_PreserveColormap) /* 153 */
+#endif
+#ifndef Tk_QueueWindowEvent
+#define Tk_QueueWindowEvent \
+ (tkStubsPtr->tk_QueueWindowEvent) /* 154 */
+#endif
+#ifndef Tk_RedrawImage
+#define Tk_RedrawImage \
+ (tkStubsPtr->tk_RedrawImage) /* 155 */
+#endif
+#ifndef Tk_ResizeWindow
+#define Tk_ResizeWindow \
+ (tkStubsPtr->tk_ResizeWindow) /* 156 */
+#endif
+#ifndef Tk_RestackWindow
+#define Tk_RestackWindow \
+ (tkStubsPtr->tk_RestackWindow) /* 157 */
+#endif
+#ifndef Tk_RestrictEvents
+#define Tk_RestrictEvents \
+ (tkStubsPtr->tk_RestrictEvents) /* 158 */
+#endif
+#ifndef Tk_SafeInit
+#define Tk_SafeInit \
+ (tkStubsPtr->tk_SafeInit) /* 159 */
+#endif
+#ifndef Tk_SetAppName
+#define Tk_SetAppName \
+ (tkStubsPtr->tk_SetAppName) /* 160 */
+#endif
+#ifndef Tk_SetBackgroundFromBorder
+#define Tk_SetBackgroundFromBorder \
+ (tkStubsPtr->tk_SetBackgroundFromBorder) /* 161 */
+#endif
+#ifndef Tk_SetClass
+#define Tk_SetClass \
+ (tkStubsPtr->tk_SetClass) /* 162 */
+#endif
+#ifndef Tk_SetGrid
+#define Tk_SetGrid \
+ (tkStubsPtr->tk_SetGrid) /* 163 */
+#endif
+#ifndef Tk_SetInternalBorder
+#define Tk_SetInternalBorder \
+ (tkStubsPtr->tk_SetInternalBorder) /* 164 */
+#endif
+#ifndef Tk_SetWindowBackground
+#define Tk_SetWindowBackground \
+ (tkStubsPtr->tk_SetWindowBackground) /* 165 */
+#endif
+#ifndef Tk_SetWindowBackgroundPixmap
+#define Tk_SetWindowBackgroundPixmap \
+ (tkStubsPtr->tk_SetWindowBackgroundPixmap) /* 166 */
+#endif
+#ifndef Tk_SetWindowBorder
+#define Tk_SetWindowBorder \
+ (tkStubsPtr->tk_SetWindowBorder) /* 167 */
+#endif
+#ifndef Tk_SetWindowBorderWidth
+#define Tk_SetWindowBorderWidth \
+ (tkStubsPtr->tk_SetWindowBorderWidth) /* 168 */
+#endif
+#ifndef Tk_SetWindowBorderPixmap
+#define Tk_SetWindowBorderPixmap \
+ (tkStubsPtr->tk_SetWindowBorderPixmap) /* 169 */
+#endif
+#ifndef Tk_SetWindowColormap
+#define Tk_SetWindowColormap \
+ (tkStubsPtr->tk_SetWindowColormap) /* 170 */
+#endif
+#ifndef Tk_SetWindowVisual
+#define Tk_SetWindowVisual \
+ (tkStubsPtr->tk_SetWindowVisual) /* 171 */
+#endif
+#ifndef Tk_SizeOfBitmap
+#define Tk_SizeOfBitmap \
+ (tkStubsPtr->tk_SizeOfBitmap) /* 172 */
+#endif
+#ifndef Tk_SizeOfImage
+#define Tk_SizeOfImage \
+ (tkStubsPtr->tk_SizeOfImage) /* 173 */
+#endif
+#ifndef Tk_StrictMotif
+#define Tk_StrictMotif \
+ (tkStubsPtr->tk_StrictMotif) /* 174 */
+#endif
+#ifndef Tk_TextLayoutToPostscript
+#define Tk_TextLayoutToPostscript \
+ (tkStubsPtr->tk_TextLayoutToPostscript) /* 175 */
+#endif
+#ifndef Tk_TextWidth
+#define Tk_TextWidth \
+ (tkStubsPtr->tk_TextWidth) /* 176 */
+#endif
+#ifndef Tk_UndefineCursor
+#define Tk_UndefineCursor \
+ (tkStubsPtr->tk_UndefineCursor) /* 177 */
+#endif
+#ifndef Tk_UnderlineChars
+#define Tk_UnderlineChars \
+ (tkStubsPtr->tk_UnderlineChars) /* 178 */
+#endif
+#ifndef Tk_UnderlineTextLayout
+#define Tk_UnderlineTextLayout \
+ (tkStubsPtr->tk_UnderlineTextLayout) /* 179 */
+#endif
+#ifndef Tk_Ungrab
+#define Tk_Ungrab \
+ (tkStubsPtr->tk_Ungrab) /* 180 */
+#endif
+#ifndef Tk_UnmaintainGeometry
+#define Tk_UnmaintainGeometry \
+ (tkStubsPtr->tk_UnmaintainGeometry) /* 181 */
+#endif
+#ifndef Tk_UnmapWindow
+#define Tk_UnmapWindow \
+ (tkStubsPtr->tk_UnmapWindow) /* 182 */
+#endif
+#ifndef Tk_UnsetGrid
+#define Tk_UnsetGrid \
+ (tkStubsPtr->tk_UnsetGrid) /* 183 */
+#endif
+#ifndef Tk_UpdatePointer
+#define Tk_UpdatePointer \
+ (tkStubsPtr->tk_UpdatePointer) /* 184 */
+#endif
+#ifndef Tk_AllocBitmapFromObj
+#define Tk_AllocBitmapFromObj \
+ (tkStubsPtr->tk_AllocBitmapFromObj) /* 185 */
+#endif
+#ifndef Tk_Alloc3DBorderFromObj
+#define Tk_Alloc3DBorderFromObj \
+ (tkStubsPtr->tk_Alloc3DBorderFromObj) /* 186 */
+#endif
+#ifndef Tk_AllocColorFromObj
+#define Tk_AllocColorFromObj \
+ (tkStubsPtr->tk_AllocColorFromObj) /* 187 */
+#endif
+#ifndef Tk_AllocCursorFromObj
+#define Tk_AllocCursorFromObj \
+ (tkStubsPtr->tk_AllocCursorFromObj) /* 188 */
+#endif
+#ifndef Tk_AllocFontFromObj
+#define Tk_AllocFontFromObj \
+ (tkStubsPtr->tk_AllocFontFromObj) /* 189 */
+#endif
+#ifndef Tk_CreateOptionTable
+#define Tk_CreateOptionTable \
+ (tkStubsPtr->tk_CreateOptionTable) /* 190 */
+#endif
+#ifndef Tk_DeleteOptionTable
+#define Tk_DeleteOptionTable \
+ (tkStubsPtr->tk_DeleteOptionTable) /* 191 */
+#endif
+#ifndef Tk_Free3DBorderFromObj
+#define Tk_Free3DBorderFromObj \
+ (tkStubsPtr->tk_Free3DBorderFromObj) /* 192 */
+#endif
+#ifndef Tk_FreeBitmapFromObj
+#define Tk_FreeBitmapFromObj \
+ (tkStubsPtr->tk_FreeBitmapFromObj) /* 193 */
+#endif
+#ifndef Tk_FreeColorFromObj
+#define Tk_FreeColorFromObj \
+ (tkStubsPtr->tk_FreeColorFromObj) /* 194 */
+#endif
+#ifndef Tk_FreeConfigOptions
+#define Tk_FreeConfigOptions \
+ (tkStubsPtr->tk_FreeConfigOptions) /* 195 */
+#endif
+#ifndef Tk_FreeSavedOptions
+#define Tk_FreeSavedOptions \
+ (tkStubsPtr->tk_FreeSavedOptions) /* 196 */
+#endif
+#ifndef Tk_FreeCursorFromObj
+#define Tk_FreeCursorFromObj \
+ (tkStubsPtr->tk_FreeCursorFromObj) /* 197 */
+#endif
+#ifndef Tk_FreeFontFromObj
+#define Tk_FreeFontFromObj \
+ (tkStubsPtr->tk_FreeFontFromObj) /* 198 */
+#endif
+#ifndef Tk_Get3DBorderFromObj
+#define Tk_Get3DBorderFromObj \
+ (tkStubsPtr->tk_Get3DBorderFromObj) /* 199 */
+#endif
+#ifndef Tk_GetAnchorFromObj
+#define Tk_GetAnchorFromObj \
+ (tkStubsPtr->tk_GetAnchorFromObj) /* 200 */
+#endif
+#ifndef Tk_GetBitmapFromObj
+#define Tk_GetBitmapFromObj \
+ (tkStubsPtr->tk_GetBitmapFromObj) /* 201 */
+#endif
+#ifndef Tk_GetColorFromObj
+#define Tk_GetColorFromObj \
+ (tkStubsPtr->tk_GetColorFromObj) /* 202 */
+#endif
+#ifndef Tk_GetCursorFromObj
+#define Tk_GetCursorFromObj \
+ (tkStubsPtr->tk_GetCursorFromObj) /* 203 */
+#endif
+#ifndef Tk_GetOptionInfo
+#define Tk_GetOptionInfo \
+ (tkStubsPtr->tk_GetOptionInfo) /* 204 */
+#endif
+#ifndef Tk_GetOptionValue
+#define Tk_GetOptionValue \
+ (tkStubsPtr->tk_GetOptionValue) /* 205 */
+#endif
+#ifndef Tk_GetJustifyFromObj
+#define Tk_GetJustifyFromObj \
+ (tkStubsPtr->tk_GetJustifyFromObj) /* 206 */
+#endif
+#ifndef Tk_GetMMFromObj
+#define Tk_GetMMFromObj \
+ (tkStubsPtr->tk_GetMMFromObj) /* 207 */
+#endif
+#ifndef Tk_GetPixelsFromObj
+#define Tk_GetPixelsFromObj \
+ (tkStubsPtr->tk_GetPixelsFromObj) /* 208 */
+#endif
+#ifndef Tk_GetReliefFromObj
+#define Tk_GetReliefFromObj \
+ (tkStubsPtr->tk_GetReliefFromObj) /* 209 */
+#endif
+#ifndef Tk_GetScrollInfoObj
+#define Tk_GetScrollInfoObj \
+ (tkStubsPtr->tk_GetScrollInfoObj) /* 210 */
+#endif
+#ifndef Tk_InitOptions
+#define Tk_InitOptions \
+ (tkStubsPtr->tk_InitOptions) /* 211 */
+#endif
+#ifndef Tk_MainEx
+#define Tk_MainEx \
+ (tkStubsPtr->tk_MainEx) /* 212 */
+#endif
+#ifndef Tk_RestoreSavedOptions
+#define Tk_RestoreSavedOptions \
+ (tkStubsPtr->tk_RestoreSavedOptions) /* 213 */
+#endif
+#ifndef Tk_SetOptions
+#define Tk_SetOptions \
+ (tkStubsPtr->tk_SetOptions) /* 214 */
+#endif
+#ifndef Tk_InitConsoleChannels
+#define Tk_InitConsoleChannels \
+ (tkStubsPtr->tk_InitConsoleChannels) /* 215 */
+#endif
+#ifndef Tk_CreateConsoleWindow
+#define Tk_CreateConsoleWindow \
+ (tkStubsPtr->tk_CreateConsoleWindow) /* 216 */
+#endif
+#ifndef Tk_CreateSmoothMethod
+#define Tk_CreateSmoothMethod \
+ (tkStubsPtr->tk_CreateSmoothMethod) /* 217 */
+#endif
+/* Slot 218 is reserved */
+/* Slot 219 is reserved */
+#ifndef Tk_GetDash
+#define Tk_GetDash \
+ (tkStubsPtr->tk_GetDash) /* 220 */
+#endif
+#ifndef Tk_CreateOutline
+#define Tk_CreateOutline \
+ (tkStubsPtr->tk_CreateOutline) /* 221 */
+#endif
+#ifndef Tk_DeleteOutline
+#define Tk_DeleteOutline \
+ (tkStubsPtr->tk_DeleteOutline) /* 222 */
+#endif
+#ifndef Tk_ConfigOutlineGC
+#define Tk_ConfigOutlineGC \
+ (tkStubsPtr->tk_ConfigOutlineGC) /* 223 */
+#endif
+#ifndef Tk_ChangeOutlineGC
+#define Tk_ChangeOutlineGC \
+ (tkStubsPtr->tk_ChangeOutlineGC) /* 224 */
+#endif
+#ifndef Tk_ResetOutlineGC
+#define Tk_ResetOutlineGC \
+ (tkStubsPtr->tk_ResetOutlineGC) /* 225 */
+#endif
+#ifndef Tk_CanvasPsOutline
+#define Tk_CanvasPsOutline \
+ (tkStubsPtr->tk_CanvasPsOutline) /* 226 */
+#endif
+#ifndef Tk_SetTSOrigin
+#define Tk_SetTSOrigin \
+ (tkStubsPtr->tk_SetTSOrigin) /* 227 */
+#endif
+#ifndef Tk_CanvasGetCoordFromObj
+#define Tk_CanvasGetCoordFromObj \
+ (tkStubsPtr->tk_CanvasGetCoordFromObj) /* 228 */
+#endif
+#ifndef Tk_CanvasSetOffset
+#define Tk_CanvasSetOffset \
+ (tkStubsPtr->tk_CanvasSetOffset) /* 229 */
+#endif
+#ifndef Tk_DitherPhoto
+#define Tk_DitherPhoto \
+ (tkStubsPtr->tk_DitherPhoto) /* 230 */
+#endif
+#ifndef Tk_PostscriptBitmap
+#define Tk_PostscriptBitmap \
+ (tkStubsPtr->tk_PostscriptBitmap) /* 231 */
+#endif
+#ifndef Tk_PostscriptColor
+#define Tk_PostscriptColor \
+ (tkStubsPtr->tk_PostscriptColor) /* 232 */
+#endif
+#ifndef Tk_PostscriptFont
+#define Tk_PostscriptFont \
+ (tkStubsPtr->tk_PostscriptFont) /* 233 */
+#endif
+#ifndef Tk_PostscriptImage
+#define Tk_PostscriptImage \
+ (tkStubsPtr->tk_PostscriptImage) /* 234 */
+#endif
+#ifndef Tk_PostscriptPath
+#define Tk_PostscriptPath \
+ (tkStubsPtr->tk_PostscriptPath) /* 235 */
+#endif
+#ifndef Tk_PostscriptStipple
+#define Tk_PostscriptStipple \
+ (tkStubsPtr->tk_PostscriptStipple) /* 236 */
+#endif
+#ifndef Tk_PostscriptY
+#define Tk_PostscriptY \
+ (tkStubsPtr->tk_PostscriptY) /* 237 */
+#endif
+#ifndef Tk_PostscriptPhoto
+#define Tk_PostscriptPhoto \
+ (tkStubsPtr->tk_PostscriptPhoto) /* 238 */
+#endif
+#ifndef Tk_CreateClientMessageHandler
+#define Tk_CreateClientMessageHandler \
+ (tkStubsPtr->tk_CreateClientMessageHandler) /* 239 */
+#endif
+#ifndef Tk_DeleteClientMessageHandler
+#define Tk_DeleteClientMessageHandler \
+ (tkStubsPtr->tk_DeleteClientMessageHandler) /* 240 */
+#endif
+#ifndef Tk_CreateAnonymousWindow
+#define Tk_CreateAnonymousWindow \
+ (tkStubsPtr->tk_CreateAnonymousWindow) /* 241 */
+#endif
+#ifndef Tk_SetClassProcs
+#define Tk_SetClassProcs \
+ (tkStubsPtr->tk_SetClassProcs) /* 242 */
+#endif
+#ifndef Tk_SetInternalBorderEx
+#define Tk_SetInternalBorderEx \
+ (tkStubsPtr->tk_SetInternalBorderEx) /* 243 */
+#endif
+#ifndef Tk_SetMinimumRequestSize
+#define Tk_SetMinimumRequestSize \
+ (tkStubsPtr->tk_SetMinimumRequestSize) /* 244 */
+#endif
+#ifndef Tk_SetCaretPos
+#define Tk_SetCaretPos \
+ (tkStubsPtr->tk_SetCaretPos) /* 245 */
+#endif
+#ifndef Tk_PhotoPutBlock
+#define Tk_PhotoPutBlock \
+ (tkStubsPtr->tk_PhotoPutBlock) /* 246 */
+#endif
+#ifndef Tk_PhotoPutZoomedBlock
+#define Tk_PhotoPutZoomedBlock \
+ (tkStubsPtr->tk_PhotoPutZoomedBlock) /* 247 */
+#endif
+#ifndef Tk_CollapseMotionEvents
+#define Tk_CollapseMotionEvents \
+ (tkStubsPtr->tk_CollapseMotionEvents) /* 248 */
+#endif
+#ifndef Tk_RegisterStyleEngine
+#define Tk_RegisterStyleEngine \
+ (tkStubsPtr->tk_RegisterStyleEngine) /* 249 */
+#endif
+#ifndef Tk_GetStyleEngine
+#define Tk_GetStyleEngine \
+ (tkStubsPtr->tk_GetStyleEngine) /* 250 */
+#endif
+#ifndef Tk_RegisterStyledElement
+#define Tk_RegisterStyledElement \
+ (tkStubsPtr->tk_RegisterStyledElement) /* 251 */
+#endif
+#ifndef Tk_GetElementId
+#define Tk_GetElementId \
+ (tkStubsPtr->tk_GetElementId) /* 252 */
+#endif
+#ifndef Tk_CreateStyle
+#define Tk_CreateStyle \
+ (tkStubsPtr->tk_CreateStyle) /* 253 */
+#endif
+#ifndef Tk_GetStyle
+#define Tk_GetStyle \
+ (tkStubsPtr->tk_GetStyle) /* 254 */
+#endif
+#ifndef Tk_FreeStyle
+#define Tk_FreeStyle \
+ (tkStubsPtr->tk_FreeStyle) /* 255 */
+#endif
+#ifndef Tk_NameOfStyle
+#define Tk_NameOfStyle \
+ (tkStubsPtr->tk_NameOfStyle) /* 256 */
+#endif
+#ifndef Tk_AllocStyleFromObj
+#define Tk_AllocStyleFromObj \
+ (tkStubsPtr->tk_AllocStyleFromObj) /* 257 */
+#endif
+#ifndef Tk_GetStyleFromObj
+#define Tk_GetStyleFromObj \
+ (tkStubsPtr->tk_GetStyleFromObj) /* 258 */
+#endif
+#ifndef Tk_FreeStyleFromObj
+#define Tk_FreeStyleFromObj \
+ (tkStubsPtr->tk_FreeStyleFromObj) /* 259 */
+#endif
+#ifndef Tk_GetStyledElement
+#define Tk_GetStyledElement \
+ (tkStubsPtr->tk_GetStyledElement) /* 260 */
+#endif
+#ifndef Tk_GetElementSize
+#define Tk_GetElementSize \
+ (tkStubsPtr->tk_GetElementSize) /* 261 */
+#endif
+#ifndef Tk_GetElementBox
+#define Tk_GetElementBox \
+ (tkStubsPtr->tk_GetElementBox) /* 262 */
+#endif
+#ifndef Tk_GetElementBorderWidth
+#define Tk_GetElementBorderWidth \
+ (tkStubsPtr->tk_GetElementBorderWidth) /* 263 */
+#endif
+#ifndef Tk_DrawElement
+#define Tk_DrawElement \
+ (tkStubsPtr->tk_DrawElement) /* 264 */
+#endif
+
+#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKDECLS */
+
diff --git a/tcl/generic/tkEntry.c b/tcl/generic/tkEntry.c
new file mode 100644
index 00000000000..5ab3846d292
--- /dev/null
+++ b/tcl/generic/tkEntry.c
@@ -0,0 +1,4620 @@
+/*
+ * Entry.c --
+ *
+ * This module implements entry and spinbox widgets for the Tk toolkit.
+ * An entry displays a string and allows the string to be edited.
+ * A spinbox expands on the entry by adding up/down buttons that control
+ * the value of the entry widget.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
+ * Copyright (c) 2002 ActiveState 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 "default.h"
+
+enum EntryType {
+ TK_ENTRY, TK_SPINBOX
+};
+
+/*
+ * A data structure of the following type is kept for each Entry
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the entry. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with entry. */
+ Tcl_Command widgetCmd; /* Token for entry's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ enum EntryType type; /* Specialized type of Entry widget */
+
+ /*
+ * Fields that are set by widget commands other than "configure".
+ */
+
+ CONST char *string; /* Pointer to storage for string;
+ * NULL-terminated; malloc-ed. */
+ int insertPos; /* Character index before which next typed
+ * character will be inserted. */
+
+ /*
+ * Information about what's selected, if any.
+ */
+
+ int selectFirst; /* Character index of first selected
+ * character (-1 means nothing selected. */
+ int selectLast; /* Character index just after last selected
+ * character (-1 means nothing selected. */
+ int selectAnchor; /* Fixed end of selection (i.e. "select to"
+ * operation will use this as one end of the
+ * selection). */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkIndex; /* Character index of character that was at
+ * left of window when scan started. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around whole
+ * window, plus used for background. */
+ Tk_3DBorder disabledBorder; /* Used for drawing border around whole
+ * window in disabled state, plus used for
+ * background. */
+ Tk_3DBorder readonlyBorder; /* Used for drawing border around whole
+ * window in readonly state, 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 *dfgColorPtr; /* Text color in disabled 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. */
+ int state; /* Normal or disabled. Entry is read-only
+ * when disabled. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, entry's string tracks the
+ * contents of this variable and vice versa. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int prefWidth; /* Desired width of window, measured in
+ * average characters. */
+ char *scrollCmd; /* Command prefix for communicating with
+ * scrollbar(s). Malloc'ed. NULL means
+ * no command to issue. */
+ char *showChar; /* Value of -show option. If non-NULL, first
+ * character is used for displaying all
+ * characters in entry. Malloc'ed.
+ * This is only used by the Entry widget. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ CONST char *displayString; /* String to use when displaying. This may
+ * be a pointer to string, or a pointer to
+ * malloced memory with the same character
+ * length as string but whose characters
+ * are all equal to showChar. */
+ int numBytes; /* Length of string in bytes. */
+ int numChars; /* Length of string in characters. Both
+ * string and displayString have the same
+ * character length, but may have different
+ * byte lengths due to being made from
+ * different UTF-8 characters. */
+ int numDisplayBytes; /* Length of displayString in bytes. */
+ int inset; /* Number of pixels on the left and right
+ * sides that are taken up by XPAD, borderWidth
+ * (if any), and highlightWidth (if any). */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int layoutX, layoutY; /* Origin for layout. */
+ int leftX; /* X position at which character at leftIndex
+ * is drawn (varies depending on justify). */
+ int leftIndex; /* Character index of left-most character
+ * visible in window. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+ GC textGC; /* For drawing normal text. */
+ GC selTextGC; /* For drawing selected text. */
+ GC highlightGC; /* For drawing traversal highlight. */
+ int avgWidth; /* Width of average character. */
+ int xWidth; /* Extra width to reserve for widget.
+ * Used by spinboxes for button space. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+
+ int validate; /* Non-zero means try to validate */
+ char *validateCmd; /* Command prefix to use when invoking
+ * validate command. NULL means don't
+ * invoke commands. Malloc'ed. */
+ char *invalidCmd; /* Command called when a validation returns 0
+ * (successfully fails), defaults to {}. */
+
+} Entry;
+
+/*
+ * A data structure of the following type is kept for each spinbox
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Entry entry; /* A pointer to the generic entry structure.
+ * This must be the first element of the
+ * Spinbox. */
+
+ /*
+ * Spinbox specific configuration settings.
+ */
+
+ Tk_3DBorder activeBorder; /* Used for drawing border around active
+ * buttons. */
+ Tk_3DBorder buttonBorder; /* Used for drawing border around buttons. */
+ Tk_Cursor bCursor; /* cursor for buttons, or None. */
+ int bdRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ int buRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ char *command; /* Command to invoke for spin buttons.
+ * NULL means no command to issue. */
+
+ /*
+ * Spinbox specific fields for use with configuration settings above.
+ */
+
+ int wrap; /* whether to wrap around when spinning */
+
+ int selElement; /* currently selected control */
+ int curElement; /* currently mouseover control */
+
+ int repeatDelay; /* repeat delay */
+ int repeatInterval; /* repeat interval */
+
+ double fromValue; /* Value corresponding to left/top of dial */
+ double toValue; /* Value corresponding to right/bottom
+ * of dial */
+ double increment; /* If > 0, all values are rounded to an
+ * even multiple of this value. */
+ char *formatBuf; /* string into which to format value.
+ * Malloc'ed. */
+ char *reqFormat; /* Sprintf conversion specifier used for the
+ * value that the users requests. Malloc'ed. */
+ char *valueFormat; /* Sprintf conversion specifier used for
+ * the value. */
+ char digitFormat[10]; /* Sprintf conversion specifier computed from
+ * digits and other information; used for
+ * the value. */
+
+ char *valueStr; /* Values List. Malloc'ed. */
+ Tcl_Obj *listObj; /* Pointer to the list object being used */
+ int eIndex; /* Holds the current index into elements */
+ int nElements; /* Holds the current count of elements */
+
+} Spinbox;
+
+/*
+ * 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.
+ * ENTRY_DELETED: This entry has been effectively destroyed.
+ * VALIDATING: Non-zero means we are in a validateCmd
+ * VALIDATE_VAR: Non-zero means we are attempting to validate
+ * the entry's textvariable with validateCmd
+ * VALIDATE_ABORT: Non-zero if validatecommand signals an abort
+ * for current procedure and make no changes
+ */
+
+#define REDRAW_PENDING 1
+#define BORDER_NEEDED 2
+#define CURSOR_ON 4
+#define GOT_FOCUS 8
+#define UPDATE_SCROLLBAR 0x10
+#define GOT_SELECTION 0x20
+#define ENTRY_DELETED 0x40
+#define VALIDATING 0x80
+#define VALIDATE_VAR 0x100
+#define VALIDATE_ABORT 0x200
+
+/*
+ * 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
+
+/*
+ * A comparison function for double values. For Spinboxes.
+ */
+#define MIN_DBL_VAL 1E-9
+#define DOUBLES_EQ(d1, d2) (fabs((d1) - (d2)) < MIN_DBL_VAL)
+
+/*
+ * The following enum is used to define a type for the -state option
+ * of the Entry widget. These values are used as indices into the
+ * string table below.
+ */
+
+enum state {
+ STATE_DISABLED, STATE_NORMAL, STATE_READONLY
+};
+
+static char *stateStrings[] = {
+ "disabled", "normal", "readonly", (char *) NULL
+};
+
+/*
+ * Definitions for -validate option values:
+ */
+
+static char *validateStrings[] = {
+ "all", "key", "focus", "focusin", "focusout", "none", (char *) NULL
+};
+enum validateType {
+ VALIDATE_ALL, VALIDATE_KEY, VALIDATE_FOCUS,
+ VALIDATE_FOCUSIN, VALIDATE_FOCUSOUT, VALIDATE_NONE,
+ /*
+ * These extra enums are for use with EntryValidateChange
+ */
+ VALIDATE_FORCED, VALIDATE_DELETE, VALIDATE_INSERT, VALIDATE_BUTTON
+};
+#define DEF_ENTRY_VALIDATE "none"
+#define DEF_ENTRY_INVALIDCMD ""
+
+/*
+ * Information used for Entry objv parsing.
+ */
+
+static Tk_OptionSpec entryOptSpec[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),
+ 0, (ClientData) DEF_ENTRY_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BORDER, "-disabledbackground", "disabledBackground",
+ "DisabledBackground", DEF_ENTRY_DISABLED_BG_COLOR, -1,
+ Tk_Offset(Entry, disabledBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_DISABLED_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_ENTRY_DISABLED_FG, -1,
+ Tk_Offset(Entry, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1,
+ Tk_Offset(Entry, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0,
+ 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
+ -1, Tk_Offset(Entry, highlightBgColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Entry, highlightWidth), 0, 0, 0},
+ {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_ENTRY_INSERT_BG,
+ -1, Tk_Offset(Entry, insertBorder),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
+ "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1,
+ Tk_Offset(Entry, insertBorderWidth), 0,
+ (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0},
+ {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-invcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-invalidcommand", 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0},
+ {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground",
+ "ReadonlyBackground", DEF_ENTRY_READONLY_BG_COLOR, -1,
+ Tk_Offset(Entry, readonlyBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_READONLY_BG_MONO, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder),
+ 0, (ClientData) DEF_ENTRY_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1,
+ Tk_Offset(Entry, selBorderWidth),
+ 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr),
+ 0, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING, "-show", "show", "Show",
+ DEF_ENTRY_SHOW, -1, Tk_Offset(Entry, showChar),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate",
+ DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate),
+ 0, (ClientData) validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ (char *) NULL, -1, Tk_Offset(Entry, validateCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-vcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-validatecommand", 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * Information used for Spinbox objv parsing.
+ */
+
+#define DEF_SPINBOX_REPEAT_DELAY "400"
+#define DEF_SPINBOX_REPEAT_INTERVAL "100"
+
+#define DEF_SPINBOX_CMD ""
+
+#define DEF_SPINBOX_FROM "0"
+#define DEF_SPINBOX_TO "0"
+#define DEF_SPINBOX_INCREMENT "1"
+#define DEF_SPINBOX_FORMAT ""
+
+#define DEF_SPINBOX_VALUES ""
+#define DEF_SPINBOX_WRAP "0"
+
+static Tk_OptionSpec sbOptSpec[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Background",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(Spinbox, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),
+ 0, (ClientData) DEF_ENTRY_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-buttonbackground", "Button.background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(Spinbox, buttonBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_CURSOR, "-buttoncursor", "Button.cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(Spinbox, bCursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-buttondownrelief", "Button.relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, bdRelief),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-buttonuprelief", "Button.relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, buRelief),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_SPINBOX_CMD, -1, Tk_Offset(Spinbox, command),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BORDER, "-disabledbackground", "disabledBackground",
+ "DisabledBackground", DEF_ENTRY_DISABLED_BG_COLOR, -1,
+ Tk_Offset(Entry, disabledBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_DISABLED_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_ENTRY_DISABLED_FG, -1,
+ Tk_Offset(Entry, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1,
+ Tk_Offset(Entry, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0,
+ 0, 0},
+ {TK_OPTION_STRING, "-format", "format", "Format",
+ DEF_SPINBOX_FORMAT, -1, Tk_Offset(Spinbox, reqFormat),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-from", "from", "From",
+ DEF_SPINBOX_FROM, -1, Tk_Offset(Spinbox, fromValue), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
+ -1, Tk_Offset(Entry, highlightBgColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Entry, highlightWidth), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-increment", "increment", "Increment",
+ DEF_SPINBOX_INCREMENT, -1, Tk_Offset(Spinbox, increment), 0, 0, 0},
+ {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_ENTRY_INSERT_BG, -1, Tk_Offset(Entry, insertBorder),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
+ "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1,
+ Tk_Offset(Entry, insertBorderWidth), 0,
+ (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0},
+ {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-invcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-invalidcommand", 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground",
+ "ReadonlyBackground", DEF_ENTRY_READONLY_BG_COLOR, -1,
+ Tk_Offset(Entry, readonlyBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_READONLY_BG_MONO, 0},
+ {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SPINBOX_REPEAT_DELAY, -1, Tk_Offset(Spinbox, repeatDelay),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SPINBOX_REPEAT_INTERVAL, -1, Tk_Offset(Spinbox, repeatInterval),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder),
+ 0, (ClientData) DEF_ENTRY_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1,
+ Tk_Offset(Entry, selBorderWidth),
+ 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr),
+ 0, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-to", "to", "To",
+ DEF_SPINBOX_TO, -1, Tk_Offset(Spinbox, toValue), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate",
+ DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate),
+ 0, (ClientData) validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ (char *) NULL, -1, Tk_Offset(Entry, validateCmd),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ DEF_SPINBOX_VALUES, -1, Tk_Offset(Spinbox, valueStr),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-vcmd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-validatecommand", 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0},
+ {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap",
+ DEF_SPINBOX_WRAP, -1, Tk_Offset(Spinbox, wrap), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following tables define the entry widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the entry widget command.
+ */
+
+static CONST char *entryCmdNames[] = {
+ "bbox", "cget", "configure", "delete", "get", "icursor", "index",
+ "insert", "scan", "selection", "validate", "xview", (char *) NULL
+};
+
+enum entryCmd {
+ COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELETE,
+ COMMAND_GET, COMMAND_ICURSOR, COMMAND_INDEX, COMMAND_INSERT,
+ COMMAND_SCAN, COMMAND_SELECTION, COMMAND_VALIDATE, COMMAND_XVIEW
+};
+
+static CONST char *selCmdNames[] = {
+ "adjust", "clear", "from", "present", "range", "to", (char *) NULL
+};
+
+enum selCmd {
+ SELECTION_ADJUST, SELECTION_CLEAR, SELECTION_FROM,
+ SELECTION_PRESENT, SELECTION_RANGE, SELECTION_TO
+};
+
+/*
+ * The following tables define the spinbox widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the spinbox widget command.
+ */
+
+static CONST char *sbCmdNames[] = {
+ "bbox", "cget", "configure", "delete", "get", "icursor", "identify",
+ "index", "insert", "invoke", "scan", "selection", "set",
+ "validate", "xview", (char *) NULL
+};
+
+enum sbCmd {
+ SB_CMD_BBOX, SB_CMD_CGET, SB_CMD_CONFIGURE, SB_CMD_DELETE,
+ SB_CMD_GET, SB_CMD_ICURSOR, SB_CMD_IDENTIFY, SB_CMD_INDEX,
+ SB_CMD_INSERT, SB_CMD_INVOKE, SB_CMD_SCAN, SB_CMD_SELECTION,
+ SB_CMD_SET, SB_CMD_VALIDATE, SB_CMD_XVIEW
+};
+
+static CONST char *sbSelCmdNames[] = {
+ "adjust", "clear", "element", "from", "present", "range", "to",
+ (char *) NULL
+};
+
+enum sbselCmd {
+ SB_SEL_ADJUST, SB_SEL_CLEAR, SB_SEL_ELEMENT, SB_SEL_FROM,
+ SB_SEL_PRESENT, SB_SEL_RANGE, SB_SEL_TO
+};
+
+/*
+ * Extra for selection of elements
+ */
+
+static CONST char *selElementNames[] = {
+ "none", "buttondown", "buttonup", (char *) NULL, "entry"
+};
+enum selelement {
+ SEL_NONE, SEL_BUTTONDOWN, SEL_BUTTONUP, SEL_NULL, SEL_ENTRY
+};
+
+/*
+ * 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 objc,
+ Tcl_Obj *CONST objv[], int flags));
+static void DeleteChars _ANSI_ARGS_((Entry *entryPtr, int index,
+ int count));
+static void DestroyEntry _ANSI_ARGS_((char *memPtr));
+static void DisplayEntry _ANSI_ARGS_((ClientData clientData));
+static void EntryBlinkProc _ANSI_ARGS_((ClientData clientData));
+static void EntryCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+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,
+ CONST char *value));
+static void EntrySelectTo _ANSI_ARGS_((
+ Entry *entryPtr, int index));
+static char * EntryTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static void EntryUpdateScrollbar _ANSI_ARGS_((Entry *entryPtr));
+static int EntryValidate _ANSI_ARGS_((Entry *entryPtr,
+ char *cmd));
+static int EntryValidateChange _ANSI_ARGS_((Entry *entryPtr,
+ char *change, CONST char *new, int index,
+ int type));
+static void ExpandPercents _ANSI_ARGS_((Entry *entryPtr,
+ CONST char *before, char *change, CONST char *new,
+ int index, int type, Tcl_DString *dsPtr));
+static void EntryValueChanged _ANSI_ARGS_((Entry *entryPtr,
+ CONST char *newValue));
+static void EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr,
+ double *firstPtr, double *lastPtr));
+static int EntryWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void EntryWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int GetEntryIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Entry *entryPtr, char *string, int *indexPtr));
+static void InsertChars _ANSI_ARGS_((Entry *entryPtr, int index,
+ char *string));
+
+/*
+ * These forward declarations are the spinbox specific ones:
+ */
+
+static int SpinboxWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int GetSpinboxElement _ANSI_ARGS_((Spinbox *sbPtr,
+ int x, int y));
+static int SpinboxInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+ Spinbox *sbPtr, int element));
+static int ComputeFormat _ANSI_ARGS_((Spinbox *sbPtr));
+
+/*
+ * The structure below defines widget class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs entryClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ EntryWorldChanged, /* worldChangedProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_EntryObjCmd --
+ *
+ * This procedure is invoked to process the "entry" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_EntryObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Entry *entryPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ char *tmp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, Tk will return the cached value.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, entryOptSpec);
+
+ /*
+ * 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). Only the non-NULL/0
+ * data must be initialized as memset covers the rest.
+ */
+
+ entryPtr = (Entry *) ckalloc(sizeof(Entry));
+ memset((VOID *) entryPtr, 0, sizeof(Entry));
+
+ entryPtr->tkwin = tkwin;
+ entryPtr->display = Tk_Display(tkwin);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd,
+ (ClientData) entryPtr, EntryCmdDeletedProc);
+ entryPtr->optionTable = optionTable;
+ entryPtr->type = TK_ENTRY;
+ tmp = (char *) ckalloc(1);
+ tmp[0] = '\0';
+ entryPtr->string = tmp;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->state = STATE_NORMAL;
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->inset = XPAD;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->validate = VALIDATE_NONE;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the listbox,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve((ClientData) entryPtr->tkwin);
+
+ Tk_SetClass(entryPtr->tkwin, "Entry");
+ Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
+ Tk_CreateEventHandler(entryPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ EntryEventProc, (ClientData) entryPtr);
+ Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
+
+ if ((Tk_InitOptions(interp, (char *) entryPtr, optionTable, tkwin)
+ != TCL_OK) ||
+ (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK)) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryWidgetObjCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EntryWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about entry widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ int cmdIndex, selIndex, result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the widget command by looking up the second token in
+ * the list of valid command names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], entryCmdNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve((ClientData) entryPtr);
+ switch ((enum entryCmd) cmdIndex) {
+ case COMMAND_BBOX: {
+ int index, x, y, width, height;
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->textLayout, index, &x, &y,
+ &width, &height);
+ sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX,
+ y + entryPtr->layoutY, width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,
+ entryPtr->optionTable, objv[2], entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+
+ case COMMAND_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr,
+ entryPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0);
+ }
+ break;
+ }
+
+ case COMMAND_DELETE: {
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &first) != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]),
+ &last) != TCL_OK) {
+ goto error;
+ }
+ }
+ if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
+ DeleteChars(entryPtr, first, last - first);
+ }
+ break;
+ }
+
+ case COMMAND_GET: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ break;
+ }
+
+ case COMMAND_ICURSOR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &entryPtr->insertPos) != TCL_OK) {
+ goto error;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case COMMAND_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+
+ case COMMAND_INSERT: {
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state == STATE_NORMAL) {
+ InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ }
+ break;
+ }
+
+ case COMMAND_SCAN: {
+ int x;
+ char *minorCmd;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x");
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ goto error;
+ }
+
+ minorCmd = Tcl_GetString(objv[2]);
+ if (minorCmd[0] == 'm'
+ && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) {
+ entryPtr->scanMarkX = x;
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ } else if ((minorCmd[0] == 'd')
+ && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) {
+ EntryScanTo(entryPtr, x);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"",
+ Tcl_GetString(objv[2]), "\": must be mark or dragto",
+ (char *) NULL);
+ goto error;
+ }
+ break;
+ }
+
+ case COMMAND_SELECTION: {
+ int index, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?index?");
+ goto error;
+ }
+
+ /*
+ * Parse the selection sub-command, using the command
+ * table "selCmdNames" defined above.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], selCmdNames,
+ "selection option", 0, &selIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Disabled entries don't allow the selection to be modified.
+ */
+
+ if (entryPtr->state == STATE_DISABLED) {
+ goto done;
+ }
+
+ switch(selIndex) {
+ case SELECTION_ADJUST: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ int half1, half2;
+
+ half1 = (entryPtr->selectFirst
+ + entryPtr->selectLast)/2;
+ half2 = (entryPtr->selectFirst
+ + entryPtr->selectLast + 1)/2;
+ if (index < half1) {
+ entryPtr->selectAnchor = entryPtr->selectLast;
+ } else if (index > half2) {
+ entryPtr->selectAnchor = entryPtr->selectFirst;
+ } else {
+ /*
+ * We're at about the halfway point in the
+ * selection; just keep the existing anchor.
+ */
+ }
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+ }
+
+ case SELECTION_CLEAR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+ goto done;
+ }
+
+ case SELECTION_FROM: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ entryPtr->selectAnchor = index;
+ break;
+ }
+
+ case SELECTION_PRESENT: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst < 0) {
+ Tcl_SetResult(interp, "0", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "1", TCL_STATIC);
+ }
+ goto done;
+ }
+
+ case SELECTION_RANGE: {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "start end");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[4]),& index2) != TCL_OK) {
+ goto error;
+ }
+ if (index >= index2) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else {
+ entryPtr->selectFirst = index;
+ entryPtr->selectLast = index2;
+ }
+ if (!(entryPtr->flags & GOT_SELECTION)
+ && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY,
+ EntryLostSelection, (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case SELECTION_TO: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+ }
+ }
+ break;
+ }
+
+ case COMMAND_VALIDATE: {
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ selIndex = entryPtr->validate;
+ entryPtr->validate = VALIDATE_ALL;
+ code = EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FORCED);
+ if (entryPtr->validate != VALIDATE_NONE) {
+ entryPtr->validate = selIndex;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK)));
+ break;
+ }
+
+ case COMMAND_XVIEW: {
+ int index;
+
+ if (objc == 2) {
+ double first, last;
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(buf, "%g %g", first, last);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ goto done;
+ } else if (objc == 3) {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ double fraction;
+ int count;
+
+ index = entryPtr->leftIndex;
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction,
+ &count)) {
+ case TK_SCROLL_ERROR: {
+ goto error;
+ }
+ case TK_SCROLL_MOVETO: {
+ index = (int) ((fraction * entryPtr->numChars) + 0.5);
+ break;
+ }
+ case TK_SCROLL_PAGES: {
+ int charsPerPage;
+
+ charsPerPage = ((Tk_Width(entryPtr->tkwin)
+ - 2 * entryPtr->inset)
+ / entryPtr->avgWidth) - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ index += count * charsPerPage;
+ break;
+ }
+ case TK_SCROLL_UNITS: {
+ index += count;
+ break;
+ }
+ }
+ }
+ if (index >= entryPtr->numChars) {
+ index = entryPtr->numChars - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ entryPtr->leftIndex = index;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release((ClientData) entryPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) entryPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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((char *)entryPtr->string);
+ if (entryPtr->textVarName != NULL) {
+ Tcl_UntraceVar(entryPtr->interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, (ClientData) entryPtr);
+ }
+ if (entryPtr->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
+ if (entryPtr->displayString != entryPtr->string) {
+ ckfree((char *)entryPtr->displayString);
+ }
+ if (entryPtr->type == TK_SPINBOX) {
+ Spinbox *sbPtr = (Spinbox *) entryPtr;
+
+ if (sbPtr->listObj != NULL) {
+ Tcl_DecrRefCount(sbPtr->listObj);
+ sbPtr->listObj = NULL;
+ }
+ if (sbPtr->formatBuf) {
+ ckfree(sbPtr->formatBuf);
+ }
+ }
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable,
+ entryPtr->tkwin);
+ Tcl_Release((ClientData) entryPtr->tkwin);
+ entryPtr->tkwin = NULL;
+
+ ckfree((char *) entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureEntry --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * an entry widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for entryPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureEntry(interp, entryPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Entry *entryPtr; /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ Tk_SavedOptions savedOptions;
+ Tk_3DBorder border;
+ Tcl_Obj *errorResult = NULL;
+ Spinbox *sbPtr = (Spinbox *) entryPtr; /* Only used when this widget
+ * is of type TK_SPINBOX */
+ char *oldValues = NULL; /* lint initialization */
+ char *oldFormat = NULL; /* lint initialization */
+ int error;
+ int oldExport = 0; /* lint initialization */
+ int valuesChanged = 0; /* lint initialization */
+ double oldFrom = 0.0; /* lint initialization */
+ double oldTo = 0.0; /* lint initialization */
+
+ /*
+ * 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);
+ }
+
+ /*
+ * Store old values that we need to effect certain behavior if
+ * they change value
+ */
+ oldExport = entryPtr->exportSelection;
+ if (entryPtr->type == TK_SPINBOX) {
+ oldValues = sbPtr->valueStr;
+ oldFormat = sbPtr->reqFormat;
+ oldFrom = sbPtr->fromValue;
+ oldTo = sbPtr->toValue;
+ }
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) entryPtr,
+ entryPtr->optionTable, objc, objv,
+ entryPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few other options also need special processing, such as parsing
+ * the geometry and setting the background from a 3-D border.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED) &&
+ (entryPtr->disabledBorder != NULL)) {
+ border = entryPtr->disabledBorder;
+ } else if ((entryPtr->state == STATE_READONLY) &&
+ (entryPtr->readonlyBorder != NULL)) {
+ border = entryPtr->readonlyBorder;
+ } else {
+ border = entryPtr->normalBorder;
+ }
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, border);
+
+ if (entryPtr->insertWidth <= 0) {
+ entryPtr->insertWidth = 2;
+ }
+ if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
+ entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ if (sbPtr->fromValue > sbPtr->toValue) {
+ Tcl_SetResult(interp,
+ "-to value must be greater than -from value",
+ TCL_VOLATILE);
+ continue;
+ }
+
+ if (sbPtr->reqFormat && (oldFormat != sbPtr->reqFormat)) {
+ /*
+ * Make sure that the given format is somewhat correct, and
+ * calculate the minimum space we'll need for the values as
+ * strings.
+ */
+ int min, max;
+ size_t formatLen, formatSpace = TCL_DOUBLE_SPACE;
+ char fbuf[4], *fmt = sbPtr->reqFormat;
+
+ formatLen = strlen(fmt);
+ if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) {
+ badFormatOpt:
+ Tcl_AppendResult(interp, "bad spinbox format specifier \"",
+ sbPtr->reqFormat, "\"", (char *) NULL);
+ continue;
+ }
+ if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3)
+ && (max >= 0)) {
+ formatSpace = min + max + 1;
+ } else if (((sscanf(fmt, "%%.%d%[f]", &min, fbuf) == 2)
+ || (sscanf(fmt, "%%%d%[f]", &min, fbuf) == 2)
+ || (sscanf(fmt, "%%%d.%[f]", &min, fbuf) == 2))
+ && (min >= 0)) {
+ formatSpace = min + 1;
+ } else {
+ goto badFormatOpt;
+ }
+ if (formatSpace < TCL_DOUBLE_SPACE) {
+ formatSpace = TCL_DOUBLE_SPACE;
+ }
+ sbPtr->formatBuf = ckrealloc(sbPtr->formatBuf, formatSpace);
+ /*
+ * We perturb the value of oldFrom to allow us to go into
+ * the branch below that will reformat the displayed value.
+ */
+ oldFrom = sbPtr->fromValue - 1;
+ }
+
+ /*
+ * See if we have to rearrange our listObj data
+ */
+ if (oldValues != sbPtr->valueStr) {
+ if (sbPtr->listObj != NULL) {
+ Tcl_DecrRefCount(sbPtr->listObj);
+ }
+ sbPtr->listObj = NULL;
+ if (sbPtr->valueStr != NULL) {
+ Tcl_Obj *newObjPtr;
+ int nelems;
+
+ newObjPtr = Tcl_NewStringObj(sbPtr->valueStr, -1);
+ if (Tcl_ListObjLength(interp, newObjPtr, &nelems)
+ != TCL_OK) {
+ valuesChanged = -1;
+ continue;
+ }
+ sbPtr->listObj = newObjPtr;
+ Tcl_IncrRefCount(sbPtr->listObj);
+ sbPtr->nElements = nelems;
+ sbPtr->eIndex = 0;
+ valuesChanged++;
+ }
+ }
+ }
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or
+ * off-time just changed. Set validate temporarily to none,
+ * so the configure doesn't cause it to be triggered.
+ */
+
+ if (entryPtr->flags & GOT_FOCUS) {
+ int validate = entryPtr->validate;
+ entryPtr->validate = VALIDATE_NONE;
+ EntryFocusProc(entryPtr, 1);
+ entryPtr->validate = validate;
+ }
+
+ /*
+ * Claim the selection if we've suddenly started exporting it.
+ */
+
+ if (entryPtr->exportSelection && (!oldExport)
+ && (entryPtr->selectFirst != -1)
+ && !(entryPtr->flags & GOT_SELECTION)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * Recompute the window's geometry and arrange for it to be
+ * redisplayed.
+ */
+
+ Tk_SetInternalBorder(entryPtr->tkwin,
+ entryPtr->borderWidth + entryPtr->highlightWidth);
+ if (entryPtr->highlightWidth <= 0) {
+ entryPtr->highlightWidth = 0;
+ }
+ entryPtr->inset = entryPtr->highlightWidth
+ + entryPtr->borderWidth + XPAD;
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * If the entry is tied to the value of a variable, create the variable if
+ * it doesn't exist, and set the entry's value from the variable's value.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ CONST char *value;
+
+ value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ EntryValueChanged(entryPtr, NULL);
+ } else {
+ EntrySetValue(entryPtr, value);
+ }
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ ComputeFormat(sbPtr);
+
+ if (valuesChanged > 0) {
+ Tcl_Obj *objPtr;
+
+ /*
+ * No check for error return, because there shouldn't be one
+ * given the check for valid list above
+ */
+ Tcl_ListObjIndex(interp, sbPtr->listObj, 0, &objPtr);
+ EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
+ } else if ((sbPtr->valueStr == NULL)
+ && !DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)
+ && (!DOUBLES_EQ(sbPtr->fromValue, oldFrom)
+ || !DOUBLES_EQ(sbPtr->toValue, oldTo))) {
+ /*
+ * If the valueStr is empty and -from && -to are specified, check
+ * to see if the current string is within the range. If not,
+ * it will be constrained to the nearest edge. If the current
+ * string isn't a double value, we set it to -from.
+ */
+ int code;
+ double dvalue;
+
+ code = Tcl_GetDouble(NULL, entryPtr->string, &dvalue);
+ if (code != TCL_OK) {
+ dvalue = sbPtr->fromValue;
+ } else {
+ if (dvalue > sbPtr->toValue) {
+ dvalue = sbPtr->toValue;
+ } else if (dvalue < sbPtr->fromValue) {
+ dvalue = sbPtr->fromValue;
+ }
+ }
+ sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);
+ EntryValueChanged(entryPtr, sbPtr->formatBuf);
+ }
+ }
+
+ /*
+ * Set up a trace on the variable's value after we've possibly
+ * constrained the value according to new -from/-to values.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ Tcl_TraceVar(interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, (ClientData) entryPtr);
+ }
+
+ EntryWorldChanged((ClientData) entryPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EntryWorldChanged --
+ *
+ * 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 = None;
+ unsigned long mask;
+ Tk_3DBorder border;
+ XColor *colorPtr;
+ Entry *entryPtr = (Entry *) instanceData;
+
+ entryPtr->avgWidth = Tk_TextWidth(entryPtr->tkfont, "0", 1);
+ if (entryPtr->avgWidth == 0) {
+ entryPtr->avgWidth = 1;
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ /*
+ * Compute the button width for a spinbox
+ */
+
+ entryPtr->xWidth = entryPtr->avgWidth + 2 * (1+XPAD);
+ if (entryPtr->xWidth < 11) {
+ entryPtr->xWidth = 11; /* we want a min visible size */
+ }
+ }
+
+ /*
+ * Default background and foreground are from the normal state.
+ * In a disabled state, both of those may be overridden; in the readonly
+ * state, the background may be overridden.
+ */
+
+ border = entryPtr->normalBorder;
+ colorPtr = entryPtr->fgColorPtr;
+ switch (entryPtr->state) {
+ case STATE_DISABLED:
+ if (entryPtr->disabledBorder != NULL) {
+ border = entryPtr->disabledBorder;
+ }
+ if (entryPtr->dfgColorPtr != NULL) {
+ colorPtr = entryPtr->dfgColorPtr;
+ }
+ break;
+ case STATE_READONLY:
+ if (entryPtr->readonlyBorder != NULL) {
+ border = entryPtr->readonlyBorder;
+ }
+ break;
+ }
+
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, border);
+ gcValues.foreground = colorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
+ 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_GetGC(entryPtr->tkwin, mask, &gcValues);
+ 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. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ Tk_Window tkwin = entryPtr->tkwin;
+ int baseY, selStartX, selEndX, cursorX;
+ int showSelection, xBound;
+ Tk_FontMetrics fm;
+ Pixmap pixmap;
+ Tk_3DBorder border;
+
+ entryPtr->flags &= ~REDRAW_PENDING;
+ if ((entryPtr->flags & ENTRY_DELETED) || !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;
+
+ /*
+ * Preserve/Release because updating the scrollbar can have
+ * the side-effect of destroying or unmapping the entry widget.
+ */
+
+ Tcl_Preserve((ClientData) entryPtr);
+ EntryUpdateScrollbar(entryPtr);
+
+ if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) {
+ Tcl_Release((ClientData) entryPtr);
+ return;
+ }
+ Tcl_Release((ClientData) 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 - entryPtr->xWidth;
+ 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.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED) &&
+ (entryPtr->disabledBorder != NULL)) {
+ border = entryPtr->disabledBorder;
+ } else if ((entryPtr->state == STATE_READONLY) &&
+ (entryPtr->readonlyBorder != NULL)) {
+ border = entryPtr->readonlyBorder;
+ } else {
+ border = entryPtr->normalBorder;
+ }
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ if (showSelection && (entryPtr->state != STATE_DISABLED)
+ && (entryPtr->selectLast > entryPtr->leftIndex)) {
+ if (entryPtr->selectFirst <= entryPtr->leftIndex) {
+ selStartX = entryPtr->leftX;
+ } else {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst,
+ &selStartX, NULL, NULL, NULL);
+ selStartX += entryPtr->layoutX;
+ }
+ if ((selStartX - entryPtr->selBorderWidth) < xBound) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast,
+ &selEndX, NULL, NULL, NULL);
+ selEndX += entryPtr->layoutX;
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->selBorder,
+ selStartX - entryPtr->selBorderWidth,
+ baseY - fm.ascent - entryPtr->selBorderWidth,
+ (selEndX - selStartX) + 2*entryPtr->selBorderWidth,
+ (fm.ascent + fm.descent) + 2*entryPtr->selBorderWidth,
+ entryPtr->selBorderWidth, TK_RELIEF_RAISED);
+ }
+ }
+
+ /*
+ * Draw a special background for the insertion cursor, overriding
+ * even the selection background. As a special hack to keep the
+ * cursor visible when the insertion cursor color is the same as
+ * the color for selected text (e.g., on mono displays), write
+ * background in the cursor area (instead of nothing) when the
+ * cursor isn't on. Otherwise the selection would hide the cursor.
+ */
+
+ if ((entryPtr->state == STATE_NORMAL) && (entryPtr->flags & GOT_FOCUS)) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, &cursorX, NULL,
+ NULL, NULL);
+ cursorX += entryPtr->layoutX;
+ cursorX -= (entryPtr->insertWidth)/2;
+ Tk_SetCaretPos(entryPtr->tkwin, cursorX, baseY - fm.ascent,
+ fm.ascent + fm.descent);
+ if (entryPtr->insertPos >= entryPtr->leftIndex) {
+ 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, border,
+ 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->state != STATE_DISABLED)
+ && (entryPtr->selTextGC != entryPtr->textGC)
+ && (entryPtr->selectFirst < entryPtr->selectLast)) {
+ int selFirst;
+
+ if (entryPtr->selectFirst < entryPtr->leftIndex) {
+ selFirst = entryPtr->leftIndex;
+ } else {
+ selFirst = entryPtr->selectFirst;
+ }
+ Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC,
+ entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
+ selFirst, entryPtr->selectLast);
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ int startx, height, inset, pad, tHeight, xWidth;
+ Spinbox *sbPtr = (Spinbox *) entryPtr;
+
+ /*
+ * Draw the spin button controls.
+ */
+ xWidth = entryPtr->xWidth;
+ pad = XPAD + 1;
+ inset = entryPtr->inset - XPAD;
+ startx = Tk_Width(tkwin) - (xWidth + inset);
+ height = (Tk_Height(tkwin) - 2*inset)/2;
+#if 0
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset, xWidth, height, 1, sbPtr->buRelief);
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset+height, xWidth, height, 1, sbPtr->bdRelief);
+#else
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset, xWidth, height, 1,
+ (sbPtr->selElement == SEL_BUTTONUP) ?
+ TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset+height, xWidth, height, 1,
+ (sbPtr->selElement == SEL_BUTTONDOWN) ?
+ TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+#endif
+
+ xWidth -= 2*pad;
+ /*
+ * Only draw the triangles if we have enough display space
+ */
+ if ((xWidth > 1)) {
+ XPoint points[3];
+ int starty, space, offset;
+
+ space = height - 2*pad;
+ /*
+ * Ensure width of triangle is odd to guarantee a sharp tip
+ */
+ if (!(xWidth % 2)) {
+ xWidth++;
+ }
+ tHeight = (xWidth + 1) / 2;
+ if (tHeight > space) {
+ tHeight = space;
+ }
+ space = (space - tHeight) / 2;
+ startx += pad;
+ starty = inset + height - pad - space;
+ offset = (sbPtr->selElement == SEL_BUTTONUP);
+ /*
+ * The points are slightly different for the up and down arrows
+ * because (for *.x), we need to account for a bug in the way
+ * XFillPolygon draws triangles, and we want to shift
+ * the arrows differently when allowing for depressed behavior.
+ */
+ points[0].x = startx + offset;
+ points[0].y = starty + (offset ? 0 : -1);
+ points[1].x = startx + xWidth/2 + offset;
+ points[1].y = starty - tHeight + (offset ? 0 : -1);
+ points[2].x = startx + xWidth + offset;
+ points[2].y = points[0].y;
+ XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC,
+ points, 3, Convex, CoordModeOrigin);
+
+ starty = inset + height + pad + space;
+ offset = (sbPtr->selElement == SEL_BUTTONDOWN);
+ points[0].x = startx + 1 + offset;
+ points[0].y = starty + (offset ? 1 : 0);
+ points[1].x = startx + xWidth/2 + offset;
+ points[1].y = starty + tHeight + (offset ? 0 : -1);
+ points[2].x = startx - 1 + xWidth + offset;
+ points[2].y = points[0].y;
+ XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC,
+ points, 3, Convex, CoordModeOrigin);
+ }
+ }
+
+ /*
+ * Draw the border and focus highlight last, so they will overwrite
+ * any text that extends past the viewable part of the window.
+ */
+
+ xBound = entryPtr->highlightWidth;
+ if (entryPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, border, xBound, xBound,
+ Tk_Width(tkwin) - 2 * xBound,
+ Tk_Height(tkwin) - 2 * xBound,
+ entryPtr->borderWidth, entryPtr->relief);
+ }
+ if (xBound > 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap);
+ if (entryPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, xBound, pixmap);
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, xBound, 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;
+
+ if (entryPtr->displayString != entryPtr->string) {
+ ckfree((char *)entryPtr->displayString);
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * If we're displaying a special character instead of the value of
+ * the entry, recompute the displayString.
+ */
+
+ if (entryPtr->showChar != NULL) {
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX];
+ int size;
+
+ /*
+ * Normalize the special character so we can safely duplicate it
+ * in the display string. If we didn't do this, then two malformed
+ * characters might end up looking like one valid UTF character in
+ * the resulting string.
+ */
+
+ Tcl_UtfToUniChar(entryPtr->showChar, &ch);
+ size = Tcl_UniCharToUtf(ch, buf);
+
+ entryPtr->numDisplayBytes = entryPtr->numChars * size;
+ p = (char *) ckalloc((unsigned) (entryPtr->numDisplayBytes + 1));
+ entryPtr->displayString = p;
+
+ for (i = entryPtr->numChars; --i >= 0; ) {
+ p += Tcl_UniCharToUtf(ch, p);
+ }
+ *p = '\0';
+ }
+
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont,
+ entryPtr->displayString, entryPtr->numChars, 0,
+ entryPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height);
+
+ entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2;
+
+ /*
+ * Recompute where the leftmost character on the display will
+ * be drawn (entryPtr->leftX) and adjust leftIndex if necessary
+ * so that we don't let characters hang off the edge of the
+ * window unless the entire window is full.
+ */
+
+ overflow = totalLength -
+ (Tk_Width(entryPtr->tkwin) - 2*entryPtr->inset - entryPtr->xWidth);
+ 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
+ - entryPtr->xWidth - totalLength;
+ } else {
+ entryPtr->leftX = (Tk_Width(entryPtr->tkwin)
+ - entryPtr->xWidth - 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++;
+ }
+ 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;
+ }
+ }
+
+ /*
+ * Add one extra length for the spin buttons
+ */
+ width += entryPtr->xWidth;
+
+ 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, value)
+ Entry *entryPtr; /* Entry that is to get the new elements. */
+ int index; /* Add the new elements before this
+ * character index. */
+ char *value; /* New characters to add (NULL-terminated
+ * string). */
+{
+ int byteIndex, byteCount, oldChars, charsAdded, newByteCount;
+ CONST char *string;
+ char *new;
+
+ string = entryPtr->string;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = strlen(value);
+ if (byteCount == 0) {
+ return;
+ }
+
+ newByteCount = entryPtr->numBytes + byteCount + 1;
+ new = (char *) ckalloc((unsigned) newByteCount);
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, value);
+ strcpy(new + byteIndex + byteCount, string + byteIndex);
+
+ if ((entryPtr->validate == VALIDATE_KEY ||
+ entryPtr->validate == VALIDATE_ALL) &&
+ EntryValidateChange(entryPtr, value, new, index,
+ VALIDATE_INSERT) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+
+ ckfree((char *)string);
+ entryPtr->string = new;
+
+ /*
+ * The following construction is used because inserting improperly
+ * formed UTF-8 sequences between other improperly formed UTF-8
+ * sequences could result in actually forming valid UTF-8 sequences;
+ * the number of characters added may not be Tcl_NumUtfChars(string, -1),
+ * because of context. The actual number of characters added is how
+ * many characters are in the string now minus the number that
+ * used to be there.
+ */
+
+ oldChars = entryPtr->numChars;
+ entryPtr->numChars = Tcl_NumUtfChars(new, -1);
+ charsAdded = entryPtr->numChars - oldChars;
+ entryPtr->numBytes += byteCount;
+
+ if (entryPtr->displayString == string) {
+ entryPtr->displayString = new;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * Inserting characters invalidates all indexes into the string.
+ * Touch up the indexes so that they still refer to the same
+ * characters (at new positions). When updating the selection
+ * end-points, don't include the new text in the selection unless
+ * it was completely surrounded by the selection.
+ */
+
+ if (entryPtr->selectFirst >= index) {
+ entryPtr->selectFirst += charsAdded;
+ }
+ if (entryPtr->selectLast > index) {
+ entryPtr->selectLast += charsAdded;
+ }
+ if ((entryPtr->selectAnchor > index)
+ || (entryPtr->selectFirst >= index)) {
+ entryPtr->selectAnchor += charsAdded;
+ }
+ if (entryPtr->leftIndex > index) {
+ entryPtr->leftIndex += charsAdded;
+ }
+ if (entryPtr->insertPos >= index) {
+ entryPtr->insertPos += charsAdded;
+ }
+ EntryValueChanged(entryPtr, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ Entry *entryPtr; /* Entry widget to modify. */
+ int index; /* Index of first character to delete. */
+ int count; /* How many characters to delete. */
+{
+ int byteIndex, byteCount, newByteCount;
+ CONST char *string;
+ char *new, *todelete;
+
+ if ((index + count) > entryPtr->numChars) {
+ count = entryPtr->numChars - index;
+ }
+ if (count <= 0) {
+ return;
+ }
+
+ string = entryPtr->string;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string + byteIndex);
+
+ newByteCount = entryPtr->numBytes + 1 - byteCount;
+ new = (char *) ckalloc((unsigned) newByteCount);
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, string + byteIndex + byteCount);
+
+ todelete = (char *) ckalloc((unsigned) (byteCount + 1));
+ memcpy(todelete, string + byteIndex, (size_t) byteCount);
+ todelete[byteCount] = '\0';
+
+ if ((entryPtr->validate == VALIDATE_KEY ||
+ entryPtr->validate == VALIDATE_ALL) &&
+ EntryValidateChange(entryPtr, todelete, new, index,
+ VALIDATE_DELETE) != TCL_OK) {
+ ckfree(new);
+ ckfree(todelete);
+ return;
+ }
+
+ ckfree(todelete);
+ ckfree((char *)entryPtr->string);
+ entryPtr->string = new;
+ entryPtr->numChars -= count;
+ entryPtr->numBytes -= byteCount;
+
+ if (entryPtr->displayString == string) {
+ entryPtr->displayString = new;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * Deleting characters results in the remaining characters being
+ * renumbered. Update the various indexes into the string to reflect
+ * this change.
+ */
+
+ if (entryPtr->selectFirst >= index) {
+ if (entryPtr->selectFirst >= (index + count)) {
+ entryPtr->selectFirst -= count;
+ } else {
+ entryPtr->selectFirst = index;
+ }
+ }
+ if (entryPtr->selectLast >= index) {
+ if (entryPtr->selectLast >= (index + count)) {
+ entryPtr->selectLast -= count;
+ } else {
+ entryPtr->selectLast = index;
+ }
+ }
+ if (entryPtr->selectLast <= entryPtr->selectFirst) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ }
+ if (entryPtr->selectAnchor >= index) {
+ if (entryPtr->selectAnchor >= (index+count)) {
+ entryPtr->selectAnchor -= count;
+ } else {
+ entryPtr->selectAnchor = index;
+ }
+ }
+ if (entryPtr->leftIndex > index) {
+ if (entryPtr->leftIndex >= (index + count)) {
+ entryPtr->leftIndex -= count;
+ } else {
+ entryPtr->leftIndex = index;
+ }
+ }
+ if (entryPtr->insertPos >= index) {
+ if (entryPtr->insertPos >= (index + count)) {
+ entryPtr->insertPos -= count;
+ } else {
+ entryPtr->insertPos = index;
+ }
+ }
+ EntryValueChanged(entryPtr, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, newValue)
+ Entry *entryPtr; /* Entry whose value just changed. */
+ CONST char *newValue; /* If this value is not NULL, we first
+ * force the value of the entry to this */
+{
+ if (newValue != NULL) {
+ EntrySetValue(entryPtr, 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)
+ Entry *entryPtr; /* Entry whose value is to be changed. */
+ CONST char *value; /* New text to display in entry. */
+{
+ CONST char *oldSource;
+ int code, valueLen, malloced = 0;
+
+ if (strcmp(value, entryPtr->string) == 0) {
+ return;
+ }
+ valueLen = strlen(value);
+
+ if (entryPtr->flags & VALIDATE_VAR) {
+ entryPtr->flags |= VALIDATE_ABORT;
+ } else {
+ /*
+ * If we validate, we create a copy of the value, as it may
+ * point to volatile memory, like the value of the -textvar
+ * which may get freed during validation
+ */
+ char *tmp = (char *) ckalloc((unsigned) (valueLen + 1));
+ strcpy(tmp, value);
+ value = tmp;
+ malloced = 1;
+
+ entryPtr->flags |= VALIDATE_VAR;
+ code = EntryValidateChange(entryPtr, (char *) NULL, value, -1,
+ VALIDATE_FORCED);
+ entryPtr->flags &= ~VALIDATE_VAR;
+ /*
+ * If VALIDATE_ABORT has been set, then this operation should be
+ * aborted because the validatecommand did something else instead
+ */
+ if (entryPtr->flags & VALIDATE_ABORT) {
+ entryPtr->flags &= ~VALIDATE_ABORT;
+ ckfree((char *)value);
+ return;
+ }
+ }
+
+ oldSource = entryPtr->string;
+ ckfree((char *)entryPtr->string);
+
+ if (malloced) {
+ entryPtr->string = value;
+ } else {
+ char *tmp = (char *) ckalloc((unsigned) (valueLen + 1));
+ strcpy(tmp, value);
+ entryPtr->string = tmp;
+ }
+ entryPtr->numBytes = valueLen;
+ entryPtr->numChars = Tcl_NumUtfChars(value, valueLen);
+
+ if (entryPtr->displayString == oldSource) {
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ if (entryPtr->selectFirst >= 0) {
+ if (entryPtr->selectFirst >= entryPtr->numChars) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else if (entryPtr->selectLast > entryPtr->numChars) {
+ entryPtr->selectLast = entryPtr->numChars;
+ }
+ }
+ if (entryPtr->leftIndex >= entryPtr->numChars) {
+ if (entryPtr->numChars > 0) {
+ entryPtr->leftIndex = entryPtr->numChars - 1;
+ } else {
+ entryPtr->leftIndex = 0;
+ }
+ }
+ if (entryPtr->insertPos > entryPtr->numChars) {
+ entryPtr->insertPos = entryPtr->numChars;
+ }
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on entries.
+ *
+ * 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 ((entryPtr->type == TK_SPINBOX) && (eventPtr->type == MotionNotify)) {
+ Spinbox *sbPtr = (Spinbox *) clientData;
+ int elem;
+
+ elem = GetSpinboxElement(sbPtr, eventPtr->xmotion.x,
+ eventPtr->xmotion.y);
+ if (elem != sbPtr->curElement) {
+ Tk_Cursor cursor;
+
+ sbPtr->curElement = elem;
+ if (elem == SEL_ENTRY) {
+ cursor = entryPtr->cursor;
+ } else if ((elem == SEL_BUTTONDOWN) || (elem == SEL_BUTTONUP)) {
+ cursor = sbPtr->bCursor;
+ } else {
+ cursor = None;
+ }
+ if (cursor != None) {
+ Tk_DefineCursor(entryPtr->tkwin, cursor);
+ } else {
+ Tk_UndefineCursor(entryPtr->tkwin);
+ }
+ }
+ return;
+ }
+
+ switch (eventPtr->type) {
+ case Expose:
+ EventuallyRedraw(entryPtr);
+ entryPtr->flags |= BORDER_NEEDED;
+ break;
+ case DestroyNotify:
+ if (!(entryPtr->flags & ENTRY_DELETED)) {
+ entryPtr->flags |= (ENTRY_DELETED | VALIDATE_ABORT);
+ Tcl_DeleteCommandFromToken(entryPtr->interp,
+ entryPtr->widgetCmd);
+ if (entryPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayEntry, clientData);
+ }
+ Tcl_EventuallyFree(clientData, DestroyEntry);
+ }
+ break;
+ case ConfigureNotify:
+ Tcl_Preserve((ClientData) entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ Tcl_Release((ClientData) entryPtr);
+ break;
+ case FocusIn:
+ case FocusOut:
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ EntryFocusProc(entryPtr, (eventPtr->type == FocusIn));
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (!(entryPtr->flags & ENTRY_DELETED)) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetEntryIndex --
+ *
+ * Parse an index into an entry and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the character index (into entryPtr) corresponding to
+ * string. The index value is guaranteed to lie between 0 and
+ * the number of characters in the string, inclusive. If an
+ * error occurs then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetEntryIndex(interp, entryPtr, string, indexPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ Entry *entryPtr; /* Entry for which the index is being
+ * specified. */
+ char *string; /* Specifies character in entryPtr. */
+ int *indexPtr; /* Where to store converted character
+ * index. */
+{
+ size_t length;
+
+ length = strlen(string);
+
+ if (string[0] == 'a') {
+ if (strncmp(string, "anchor", length) == 0) {
+ *indexPtr = entryPtr->selectAnchor;
+ } else {
+ badIndex:
+
+ /*
+ * Some of the paths here leave messages in the interp's result,
+ * so we have to clear it out before storing our own message.
+ */
+
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "bad ",
+ (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox",
+ " 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 < 0) {
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "selection isn't in widget ",
+ Tk_PathName(entryPtr->tkwin), (char *) NULL);
+ 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, maxWidth;
+
+ if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) {
+ goto badIndex;
+ }
+ if (x < entryPtr->inset) {
+ x = entryPtr->inset;
+ }
+ roundUp = 0;
+ maxWidth = Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->xWidth - 1;
+ if (x > maxWidth) {
+ x = maxWidth;
+ 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;
+ }
+ }
+ 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)
+ Entry *entryPtr; /* Information about widget. */
+ int x; /* X-coordinate to use for scan operation. */
+{
+ int newLeftIndex;
+
+ /*
+ * Compute new leftIndex for entry by amplifying the difference
+ * between the current position and the place where the scan
+ * started (the "mark" position). If we run off the left or right
+ * side of the entry, then reset the mark point so that the current
+ * position continues to correspond to the edge of the window.
+ * This means that the picture will start dragging as soon as the
+ * mouse reverses direction (without this reset, might have to slide
+ * mouse a long ways back before the picture starts moving again).
+ */
+
+ newLeftIndex = entryPtr->scanMarkIndex
+ - (10 * (x - entryPtr->scanMarkX)) / entryPtr->avgWidth;
+ if (newLeftIndex >= entryPtr->numChars) {
+ newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars - 1;
+ entryPtr->scanMarkX = x;
+ }
+ if (newLeftIndex < 0) {
+ newLeftIndex = entryPtr->scanMarkIndex = 0;
+ entryPtr->scanMarkX = x;
+ }
+
+ if (newLeftIndex != entryPtr->leftIndex) {
+ entryPtr->leftIndex = newLeftIndex;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ if (newLeftIndex != entryPtr->leftIndex) {
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ entryPtr->scanMarkX = x;
+ }
+ EventuallyRedraw(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ Entry *entryPtr; /* Information about widget. */
+ int index; /* Character index of element that is to
+ * become the "other" end of the selection. */
+{
+ int newFirst, newLast;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ 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; /* Byte offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place selection. */
+ int maxBytes; /* Maximum number of bytes to place at
+ * buffer, not including terminating NULL
+ * character. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ int byteCount;
+ CONST char *string;
+ CONST char *selStart, *selEnd;
+
+ if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) {
+ return -1;
+ }
+ string = entryPtr->displayString;
+ selStart = Tcl_UtfAtIndex(string, entryPtr->selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ entryPtr->selectLast - entryPtr->selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > maxBytes) {
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryLostSelection --
+ *
+ * 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 >= 0) && 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)
+ Entry *entryPtr; /* Information about widget. */
+{
+ if ((entryPtr->flags & ENTRY_DELETED) || !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->xWidth - entryPtr->layoutX - 1, 0);
+ if (charsInWindow < entryPtr->numChars) {
+ charsInWindow++;
+ }
+ charsInWindow -= entryPtr->leftIndex;
+ if (charsInWindow == 0) {
+ charsInWindow = 1;
+ }
+
+ *firstPtr = (double) entryPtr->leftIndex / entryPtr->numChars;
+ *lastPtr = (double) (entryPtr->leftIndex + charsInWindow)
+ / entryPtr->numChars;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryUpdateScrollbar --
+ *
+ * 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[TCL_DOUBLE_SPACE * 2];
+ 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 ");
+ Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin));
+ Tcl_AddErrorInfo(interp, ")");
+ 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. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+
+ if ((entryPtr->state == STATE_DISABLED) ||
+ (entryPtr->state == STATE_READONLY) ||
+ !(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)
+ 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);
+ }
+ if (entryPtr->validate == VALIDATE_ALL ||
+ entryPtr->validate == VALIDATE_FOCUS ||
+ entryPtr->validate == VALIDATE_FOCUSIN) {
+ EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FOCUSIN);
+ }
+ } else {
+ entryPtr->flags &= ~(GOT_FOCUS | CURSOR_ON);
+ entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ if (entryPtr->validate == VALIDATE_ALL ||
+ entryPtr->validate == VALIDATE_FOCUS ||
+ entryPtr->validate == VALIDATE_FOCUSOUT) {
+ EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FOCUSOUT);
+ }
+ }
+ 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. */
+ CONST char *name1; /* Not used. */
+ CONST char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ CONST 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 = "";
+ }
+ EntrySetValue(entryPtr, value);
+ return (char *) NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryValidate --
+ *
+ * This procedure is invoked when any character is added or
+ * removed from the entry widget, or a focus has trigerred validation.
+ *
+ * Results:
+ * TCL_OK if the validatecommand passes the new string.
+ * TCL_BREAK if the vcmd executed OK, but rejects the string.
+ * TCL_ERROR if an error occurred while executing the vcmd
+ * or a valid Tcl_Bool is not returned.
+ *
+ * Side effects:
+ * An error condition may arise
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EntryValidate(entryPtr, cmd)
+ register Entry *entryPtr; /* Entry that needs validation. */
+ register char *cmd; /* Validation command (NULL-terminated
+ * string). */
+{
+ register Tcl_Interp *interp = entryPtr->interp;
+ int code, bool;
+
+ code = Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+
+ /*
+ * We accept TCL_OK and TCL_RETURN as valid return codes from the
+ * command callback.
+ */
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AddErrorInfo(interp, "\n\t(in validation command executed by ");
+ Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin));
+ Tcl_AddErrorInfo(interp, ")");
+ Tcl_BackgroundError(interp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The command callback should return an acceptable Tcl boolean.
+ */
+ if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
+ &bool) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\nvalid boolean not returned by validation command");
+ Tcl_BackgroundError(interp);
+ Tcl_SetResult(interp, NULL, 0);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, NULL, 0);
+ return (bool ? TCL_OK : TCL_BREAK);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryValidateChange --
+ *
+ * This procedure is invoked when any character is added or
+ * removed from the entry widget, or a focus has trigerred validation.
+ *
+ * Results:
+ * TCL_OK if the validatecommand accepts 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
+EntryValidateChange(entryPtr, change, new, index, type)
+ register Entry *entryPtr; /* Entry that needs validation. */
+ char *change; /* Characters to be added/deleted
+ * (NULL-terminated string). */
+ CONST char *new; /* Potential new value of entry string */
+ int index; /* index of insert/delete, -1 otherwise */
+ int type; /* forced, delete, insert,
+ * focusin or focusout */
+{
+ int code, varValidate = (entryPtr->flags & VALIDATE_VAR);
+ char *p;
+ Tcl_DString script;
+
+ if (entryPtr->validateCmd == NULL ||
+ entryPtr->validate == VALIDATE_NONE) {
+ return (varValidate ? TCL_ERROR : TCL_OK);
+ }
+
+ /*
+ * 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 (entryPtr->flags & VALIDATING) {
+ entryPtr->validate = VALIDATE_NONE;
+ return (varValidate ? TCL_ERROR : TCL_OK);
+ }
+
+ entryPtr->flags |= VALIDATING;
+
+ /*
+ * Now form command string and run through the -validatecommand
+ */
+
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, entryPtr->validateCmd,
+ change, new, index, type, &script);
+ Tcl_DStringAppend(&script, "", 1);
+
+ p = Tcl_DStringValue(&script);
+ code = EntryValidate(entryPtr, p);
+ Tcl_DStringFree(&script);
+
+ /*
+ * If e->validate has become VALIDATE_NONE during the validation, or
+ * we now have VALIDATE_VAR set (from EntrySetValue) and didn't before,
+ * it means that a loop condition almost occured. Do not allow
+ * this validation result to finish.
+ */
+
+ if (entryPtr->validate == VALIDATE_NONE
+ || (!varValidate && (entryPtr->flags & VALIDATE_VAR))) {
+ code = TCL_ERROR;
+ }
+
+ /*
+ * It's possible that the user deleted the entry during validation.
+ * In that case, abort future validation and return an error.
+ */
+
+ if (entryPtr->flags & ENTRY_DELETED) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If validate will return ERROR, then disallow further validations
+ * Otherwise, if it didn't accept the new string (returned TCL_BREAK)
+ * then eval the invalidCmd (if it's set)
+ */
+
+ if (code == TCL_ERROR) {
+ entryPtr->validate = VALIDATE_NONE;
+ } else if (code == TCL_BREAK) {
+ /*
+ * If we were doing forced validation (like via a variable
+ * trace) and the command returned 0, the we turn off validation
+ * because we assume that textvariables have precedence in
+ * managing the value. We also don't call the invcmd, as it
+ * may want to do entry manipulation which the setting of the
+ * var will later wipe anyway.
+ */
+
+ if (varValidate) {
+ entryPtr->validate = VALIDATE_NONE;
+ } else if (entryPtr->invalidCmd != NULL) {
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, entryPtr->invalidCmd,
+ change, new, index, type, &script);
+ Tcl_DStringAppend(&script, "", 1);
+ p = Tcl_DStringValue(&script);
+ if (Tcl_EvalEx(entryPtr->interp, p, -1,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) != TCL_OK) {
+ Tcl_AddErrorInfo(entryPtr->interp,
+ "\n\t(in invalidcommand executed by entry)");
+ Tcl_BackgroundError(entryPtr->interp);
+ code = TCL_ERROR;
+ entryPtr->validate = VALIDATE_NONE;
+ }
+ Tcl_DStringFree(&script);
+
+ /*
+ * It's possible that the user deleted the entry during validation.
+ * In that case, abort future validation and return an error.
+ */
+
+ if (entryPtr->flags & ENTRY_DELETED) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ entryPtr->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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExpandPercents(entryPtr, before, change, new, index, type, dsPtr)
+ register Entry *entryPtr; /* Entry that needs validation. */
+ register CONST char *before;
+ /* Command containing percent
+ * expressions to be replaced. */
+ char *change; /* Characters to added/deleted
+ * (NULL-terminated string). */
+ CONST char *new; /* Potential new value of entry string */
+ int index; /* index of insert/delete */
+ int type; /* INSERT or DELETE */
+ 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, length;
+ register CONST char *string;
+ Tcl_UniChar ch;
+ char numStorage[2*TCL_INTEGER_SPACE];
+
+ while (1) {
+ if (*before == '\0') {
+ break;
+ }
+ /*
+ * Find everything up to the next % character and append it
+ * to the result string.
+ */
+
+ string = before;
+ /* No need to convert '%', as it is in ascii range */
+ string = Tcl_UtfFindFirst(before, '%');
+ if (string == (char *) NULL) {
+ Tcl_DStringAppend(dsPtr, before, -1);
+ break;
+ } else if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, string-before);
+ before = string;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ before++; /* skip over % */
+ if (*before != '\0') {
+ before += Tcl_UtfToUniChar(before, &ch);
+ } else {
+ ch = '%';
+ }
+ if (type == VALIDATE_BUTTON) {
+ /*
+ * -command %-substitution
+ */
+ switch (ch) {
+ case 's': /* Current string value of spinbox */
+ string = entryPtr->string;
+ break;
+ case 'd': /* direction, up or down */
+ string = change;
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+ } else {
+ /*
+ * -validatecommand / -invalidcommand %-substitution
+ */
+ switch (ch) {
+ case 'd': /* Type of call that caused validation */
+ switch (type) {
+ case VALIDATE_INSERT:
+ number = 1;
+ break;
+ case VALIDATE_DELETE:
+ number = 0;
+ break;
+ default:
+ number = -1;
+ break;
+ }
+ sprintf(numStorage, "%d", number);
+ string = numStorage;
+ break;
+ case 'i': /* index of insert/delete */
+ sprintf(numStorage, "%d", index);
+ string = numStorage;
+ break;
+ case 'P': /* 'Peeked' new value of the string */
+ string = new;
+ break;
+ case 's': /* Current string value of spinbox */
+ string = entryPtr->string;
+ break;
+ case 'S': /* string to be inserted/deleted, if any */
+ string = change;
+ break;
+ case 'v': /* type of validation currently set */
+ string = validateStrings[entryPtr->validate];
+ break;
+ case 'V': /* type of validation in effect */
+ switch (type) {
+ case VALIDATE_INSERT:
+ case VALIDATE_DELETE:
+ string = validateStrings[VALIDATE_KEY];
+ break;
+ case VALIDATE_FORCED:
+ string = "forced";
+ break;
+ default:
+ string = validateStrings[type];
+ break;
+ }
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+ }
+
+ spaceNeeded = Tcl_ScanCountedElement(string, -1, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertCountedElement(string, -1,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SpinboxObjCmd --
+ *
+ * This procedure is invoked to process the "spinbox" 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_SpinboxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Entry *entryPtr;
+ register Spinbox *sbPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ char *tmp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, Tk will return the cached value.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, sbOptSpec);
+
+ /*
+ * 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). Only the non-NULL/0
+ * data must be initialized as memset covers the rest.
+ */
+
+ sbPtr = (Spinbox *) ckalloc(sizeof(Spinbox));
+ entryPtr = (Entry *) sbPtr;
+ memset((VOID *) sbPtr, 0, sizeof(Spinbox));
+
+ entryPtr->tkwin = tkwin;
+ entryPtr->display = Tk_Display(tkwin);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(entryPtr->tkwin), SpinboxWidgetObjCmd,
+ (ClientData) sbPtr, EntryCmdDeletedProc);
+ entryPtr->optionTable = optionTable;
+ entryPtr->type = TK_SPINBOX;
+ tmp = (char *) ckalloc(1);
+ tmp[0] = '\0';
+ entryPtr->string = tmp;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->state = STATE_NORMAL;
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->inset = XPAD;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->validate = VALIDATE_NONE;
+
+ sbPtr->selElement = SEL_NONE;
+ sbPtr->curElement = SEL_NONE;
+ sbPtr->bCursor = None;
+ sbPtr->repeatDelay = 400;
+ sbPtr->repeatInterval = 100;
+ sbPtr->fromValue = 0.0;
+ sbPtr->toValue = 100.0;
+ sbPtr->increment = 1.0;
+ sbPtr->formatBuf = (char *) ckalloc(TCL_DOUBLE_SPACE);
+ sbPtr->bdRelief = TK_RELIEF_FLAT;
+ sbPtr->buRelief = TK_RELIEF_FLAT;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the listbox,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve((ClientData) entryPtr->tkwin);
+
+ Tk_SetClass(entryPtr->tkwin, "Spinbox");
+ Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
+ Tk_CreateEventHandler(entryPtr->tkwin,
+ PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask,
+ EntryEventProc, (ClientData) entryPtr);
+ Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
+
+ if (Tk_InitOptions(interp, (char *) sbPtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+ }
+ if (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SpinboxWidgetObjCmd --
+ *
+ * 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
+SpinboxWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about spinbox widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ Spinbox *sbPtr = (Spinbox *) clientData;
+ int cmdIndex, selIndex, result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the widget command by looking up the second token in
+ * the list of valid command names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], sbCmdNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve((ClientData) entryPtr);
+ switch ((enum sbCmd) cmdIndex) {
+ case SB_CMD_BBOX: {
+ int index, x, y, width, height;
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->textLayout, index, &x, &y,
+ &width, &height);
+ sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX,
+ y + entryPtr->layoutY, width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+
+ case SB_CMD_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,
+ entryPtr->optionTable, objv[2], entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+
+ case SB_CMD_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr,
+ entryPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0);
+ }
+ break;
+ }
+
+ case SB_CMD_DELETE: {
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &first) != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]),
+ &last) != TCL_OK) {
+ goto error;
+ }
+ }
+ if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
+ DeleteChars(entryPtr, first, last - first);
+ }
+ break;
+ }
+
+ case SB_CMD_GET: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ break;
+ }
+
+ case SB_CMD_ICURSOR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &entryPtr->insertPos) != TCL_OK) {
+ goto error;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case SB_CMD_IDENTIFY: {
+ int x, y, elem;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) ||
+ (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ elem = GetSpinboxElement(sbPtr, x, y);
+ if (elem != SEL_NONE) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ selElementNames[elem], -1);
+ }
+ break;
+ }
+
+ case SB_CMD_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+
+ case SB_CMD_INSERT: {
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state == STATE_NORMAL) {
+ InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ }
+ break;
+ }
+
+ case SB_CMD_INVOKE: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "elemName");
+ goto error;
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[2],
+ selElementNames, "element", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state != STATE_DISABLED) {
+ if (SpinboxInvoke(interp, sbPtr, cmdIndex) != TCL_OK) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case SB_CMD_SCAN: {
+ int x;
+ char *minorCmd;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x");
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ goto error;
+ }
+
+ minorCmd = Tcl_GetString(objv[2]);
+ if (minorCmd[0] == 'm'
+ && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) {
+ entryPtr->scanMarkX = x;
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ } else if ((minorCmd[0] == 'd')
+ && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) {
+ EntryScanTo(entryPtr, x);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"",
+ Tcl_GetString(objv[2]), "\": must be mark or dragto",
+ (char *) NULL);
+ goto error;
+ }
+ break;
+ }
+
+ case SB_CMD_SELECTION: {
+ int index, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?index?");
+ goto error;
+ }
+
+ /*
+ * Parse the selection sub-command, using the command
+ * table "sbSelCmdNames" defined above.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], sbSelCmdNames,
+ "selection option", 0, &selIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Disabled entries don't allow the selection to be modified.
+ */
+
+ if (entryPtr->state == STATE_DISABLED) {
+ goto done;
+ }
+
+ switch(selIndex) {
+ case SB_SEL_ADJUST: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ int half1, half2;
+
+ half1 = (entryPtr->selectFirst
+ + entryPtr->selectLast)/2;
+ half2 = (entryPtr->selectFirst
+ + entryPtr->selectLast + 1)/2;
+ if (index < half1) {
+ entryPtr->selectAnchor = entryPtr->selectLast;
+ } else if (index > half2) {
+ entryPtr->selectAnchor = entryPtr->selectFirst;
+ } else {
+ /*
+ * We're at about the halfway point in the
+ * selection; just keep the existing anchor.
+ */
+ }
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+ }
+
+ case SB_SEL_CLEAR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+ goto done;
+ }
+
+ case SB_SEL_FROM: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ entryPtr->selectAnchor = index;
+ break;
+ }
+
+ case SB_SEL_PRESENT: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj((entryPtr->selectFirst >= 0)));
+ goto done;
+ }
+
+ case SB_SEL_RANGE: {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "start end");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[4]),& index2) != TCL_OK) {
+ goto error;
+ }
+ if (index >= index2) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else {
+ entryPtr->selectFirst = index;
+ entryPtr->selectLast = index2;
+ }
+ if (!(entryPtr->flags & GOT_SELECTION)
+ && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY,
+ EntryLostSelection, (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+
+ case SB_SEL_TO: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+ }
+
+ case SB_SEL_ELEMENT: {
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?elemName?");
+ goto error;
+ }
+ if (objc == 3) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ selElementNames[sbPtr->selElement], -1);
+ } else {
+ int lastElement = sbPtr->selElement;
+
+ result = Tcl_GetIndexFromObj(interp, objv[3],
+ selElementNames, "selection element", 0,
+ &(sbPtr->selElement));
+ if (result != TCL_OK) {
+ goto error;
+ }
+ if (lastElement != sbPtr->selElement) {
+ EventuallyRedraw(entryPtr);
+ }
+ }
+ break;
+ }
+ }
+ break;
+ }
+
+ case SB_CMD_SET: {
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?string?");
+ goto error;
+ }
+ if (objc == 3) {
+ EntryValueChanged(entryPtr, Tcl_GetString(objv[2]));
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ break;
+ }
+
+ case SB_CMD_VALIDATE: {
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ goto error;
+ }
+ selIndex = entryPtr->validate;
+ entryPtr->validate = VALIDATE_ALL;
+ code = EntryValidateChange(entryPtr, (char *) NULL,
+ entryPtr->string, -1, VALIDATE_FORCED);
+ if (entryPtr->validate != VALIDATE_NONE) {
+ entryPtr->validate = selIndex;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK)));
+ break;
+ }
+
+ case SB_CMD_XVIEW: {
+ int index;
+
+ if (objc == 2) {
+ double first, last;
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(buf, "%g %g", first, last);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ goto done;
+ } else if (objc == 3) {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ double fraction;
+ int count;
+
+ index = entryPtr->leftIndex;
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction,
+ &count)) {
+ case TK_SCROLL_ERROR: {
+ goto error;
+ }
+ case TK_SCROLL_MOVETO: {
+ index = (int) ((fraction * entryPtr->numChars) + 0.5);
+ break;
+ }
+ case TK_SCROLL_PAGES: {
+ int charsPerPage;
+
+ charsPerPage = ((Tk_Width(entryPtr->tkwin)
+ - 2 * entryPtr->inset - entryPtr->xWidth)
+ / entryPtr->avgWidth) - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ index += count * charsPerPage;
+ break;
+ }
+ case TK_SCROLL_UNITS: {
+ index += count;
+ break;
+ }
+ }
+ }
+ if (index >= entryPtr->numChars) {
+ index = entryPtr->numChars - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ entryPtr->leftIndex = index;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release((ClientData) entryPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) entryPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetSpinboxElement --
+ *
+ * Return the element associated with an x,y coord.
+ *
+ * Results:
+ * Element type as enum selelement.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetSpinboxElement(sbPtr, x, y)
+ Spinbox *sbPtr; /* Spinbox for which the index is being
+ * specified. */
+ int x; /* x coord */
+ int y; /* y coord */
+{
+ Entry *entryPtr = (Entry *) sbPtr;
+
+ if ((x < 0) || (y < 0) || (y > Tk_Height(entryPtr->tkwin))
+ || (x > Tk_Width(entryPtr->tkwin))) {
+ return SEL_NONE;
+ }
+
+ if (x > (Tk_Width(entryPtr->tkwin) - entryPtr->inset - entryPtr->xWidth)) {
+ if (y > (Tk_Height(entryPtr->tkwin) / 2)) {
+ return SEL_BUTTONDOWN;
+ } else {
+ return SEL_BUTTONUP;
+ }
+ }
+ return SEL_ENTRY;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SpinboxInvoke --
+ *
+ * This procedure is invoked when the invoke method for the
+ * widget is called.
+ *
+ * Results:
+ * TCL_OK.
+ *
+ * Side effects:
+ * An background error condition may arise when invoking the
+ * callback. The widget value may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SpinboxInvoke(interp, sbPtr, element)
+ register Tcl_Interp *interp; /* Current interpreter. */
+ register Spinbox *sbPtr; /* Spinbox to invoke. */
+ int element; /* element to invoke, either the "up"
+ * or "down" button. */
+{
+ Entry *entryPtr = (Entry *) sbPtr;
+ char *type;
+ int code, up;
+ Tcl_DString script;
+
+ switch (element) {
+ case SEL_BUTTONUP:
+ type = "up";
+ up = 1;
+ break;
+ case SEL_BUTTONDOWN:
+ type = "down";
+ up = 0;
+ break;
+ default:
+ return TCL_OK;
+ }
+
+ if (fabs(sbPtr->increment) > MIN_DBL_VAL) {
+ if (sbPtr->listObj != NULL) {
+ Tcl_Obj *objPtr;
+
+ Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr);
+ if (strcmp(Tcl_GetString(objPtr), entryPtr->string)) {
+ /*
+ * Somehow the string changed from what we expected,
+ * so let's do a search on the list to see if the current
+ * value is there. If not, move to the first element of
+ * the list.
+ */
+ int i, listc, elemLen, length = entryPtr->numChars;
+ char *bytes;
+ Tcl_Obj **listv;
+
+ Tcl_ListObjGetElements(interp, sbPtr->listObj, &listc, &listv);
+ for (i = 0; i < listc; i++) {
+ bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+ if ((length == elemLen) &&
+ (memcmp(bytes, entryPtr->string,
+ (size_t) length) == 0)) {
+ sbPtr->eIndex = i;
+ break;
+ }
+ }
+ }
+ if (up) {
+ if (++sbPtr->eIndex >= sbPtr->nElements) {
+ if (sbPtr->wrap) {
+ sbPtr->eIndex = 0;
+ } else {
+ sbPtr->eIndex = sbPtr->nElements-1;
+ }
+ }
+ } else {
+ if (--sbPtr->eIndex < 0) {
+ if (sbPtr->wrap) {
+ sbPtr->eIndex = sbPtr->nElements-1;
+ } else {
+ sbPtr->eIndex = 0;
+ }
+ }
+ }
+ Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr);
+ EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
+ } else if (!DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)) {
+ double dvalue;
+
+ if (Tcl_GetDouble(NULL, entryPtr->string, &dvalue) != TCL_OK) {
+ /*
+ * If the string is empty, or isn't a valid double value,
+ * just use the -from value
+ */
+ dvalue = sbPtr->fromValue;
+ } else {
+ if (up) {
+ dvalue += sbPtr->increment;
+ if (dvalue > sbPtr->toValue) {
+ if (sbPtr->wrap) {
+ dvalue = sbPtr->fromValue;
+ } else {
+ dvalue = sbPtr->toValue;
+ }
+ } else if (dvalue < sbPtr->fromValue) {
+ /*
+ * It's possible that when pressing up, we are
+ * still less than the fromValue, because the
+ * user may have manipulated the value by hand.
+ */
+ dvalue = sbPtr->fromValue;
+ }
+ } else {
+ dvalue -= sbPtr->increment;
+ if (dvalue < sbPtr->fromValue) {
+ if (sbPtr->wrap) {
+ dvalue = sbPtr->toValue;
+ } else {
+ dvalue = sbPtr->fromValue;
+ }
+ } else if (dvalue > sbPtr->toValue) {
+ /*
+ * It's possible that when pressing down, we are
+ * still greater than the toValue, because the
+ * user may have manipulated the value by hand.
+ */
+ dvalue = sbPtr->toValue;
+ }
+ }
+ }
+ sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);
+ EntryValueChanged(entryPtr, sbPtr->formatBuf);
+ }
+ }
+
+ if (sbPtr->command != NULL) {
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, sbPtr->command, type, "", 0,
+ VALIDATE_BUTTON, &script);
+ Tcl_DStringAppend(&script, "", 1);
+
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&script), -1,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+ Tcl_DStringFree(&script);
+
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n\t(in command executed by spinbox)");
+ Tcl_BackgroundError(interp);
+ /*
+ * Yes, it's an error, but a bg one, so we return OK
+ */
+ return TCL_OK;
+ }
+
+ Tcl_SetResult(interp, NULL, 0);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFormat --
+ *
+ * This procedure is invoked to recompute the "format" fields
+ * of a spinbox's widget record, which determines how the value
+ * of the dial is converted to a string.
+ *
+ * Results:
+ * Tcl result code.
+ *
+ * Side effects:
+ * The format fields of the spinbox are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ComputeFormat(sbPtr)
+ Spinbox *sbPtr; /* Information about dial 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 dial's range.
+ */
+
+ if (sbPtr->reqFormat) {
+ sbPtr->valueFormat = sbPtr->reqFormat;
+ return TCL_OK;
+ }
+
+ maxValue = fabs(sbPtr->fromValue);
+ x = fabs(sbPtr->toValue);
+ if (x > maxValue) {
+ maxValue = x;
+ }
+ if (maxValue == 0) {
+ maxValue = 1;
+ }
+ mostSigDigit = (int) floor(log10(maxValue));
+
+ if (fabs(sbPtr->increment) > MIN_DBL_VAL) {
+ /*
+ * A increment was specified, so use it.
+ */
+ leastSigDigit = (int) floor(log10(sbPtr->increment));
+ } 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(sbPtr->digitFormat, "%%.%df", afterDecimal);
+ } else {
+ sprintf(sbPtr->digitFormat, "%%.%de", numDigits-1);
+ }
+ sbPtr->valueFormat = sbPtr->digitFormat;
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkError.c b/tcl/generic/tkError.c
new file mode 100644
index 00000000000..77909331a6f
--- /dev/null
+++ b/tcl/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/tcl/generic/tkEvent.c b/tcl/generic/tkEvent.c
new file mode 100644
index 00000000000..602b044bc08
--- /dev/null
+++ b/tcl/generic/tkEvent.c
@@ -0,0 +1,1459 @@
+/*
+ * 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-2000 Ajuba Solutions.
+ *
+ * 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;
+
+/*
+ * For each call to Tk_CreateGenericHandler, an instance of the following
+ * structure will be created. All of the active handlers are linked into a
+ * list.
+ */
+
+typedef struct GenericHandler {
+ Tk_GenericProc *proc; /* Procedure to dispatch on all X events. */
+ ClientData clientData; /* Client data to pass to procedure. */
+ int deleteFlag; /* Flag to set when this handler is deleted. */
+ struct GenericHandler *nextPtr;
+ /* Next handler in list of all generic
+ * handlers, or NULL for end of list. */
+} GenericHandler;
+
+/*
+ * There's a potential problem if Tk_HandleEvent is entered recursively.
+ * A handler cannot be deleted physically until we have returned from
+ * calling it. Otherwise, we're looking at unallocated memory in advancing to
+ * its `next' entry. We deal with the problem by using the `delete flag' and
+ * deleting handlers only when it's known that there's no handler active.
+ *
+ */
+
+/*
+ * The following structure is used for queueing X-style events on the
+ * Tcl event queue.
+ */
+
+typedef struct TkWindowEvent {
+ Tcl_Event header; /* Standard information for all events. */
+ 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 */
+};
+
+
+/*
+ * The structure below is used to store Data for the Event module that
+ * must be kept thread-local. The "dataKey" is used to fetch the
+ * thread-specific storage for the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int handlersActive; /* The following variable has a non-zero
+ * value when a handler is active. */
+ InProgress *pendingPtr; /* Topmost search in progress, or
+ * NULL if none. */
+
+ GenericHandler *genericList; /* First handler in the list, or NULL. */
+ GenericHandler *lastGenericPtr; /* Last handler in list. */
+
+ GenericHandler *cmList; /* First handler in the list, or NULL. */
+ GenericHandler *lastCmPtr; /* Last handler in list. */
+
+ /*
+ * If someone has called Tk_RestrictEvents, the information below
+ * keeps track of it.
+ */
+
+ Tk_RestrictProc *restrictProc;
+ /* Procedure to call. NULL means no
+ * restrictProc is currently in effect. */
+ ClientData restrictArg; /* Argument to pass to restrictProc. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for procedures that are only referenced locally within
+ * this file.
+ */
+
+static void DelayedMotionProc _ANSI_ARGS_((ClientData clientData));
+static int WindowEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static int TkXErrorHandler _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errEventPtr));
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the event handler to be deleted, or return
+ * immediately if it doesn't exist.
+ */
+
+ for (handlerPtr = winPtr->handlerList, prevPtr = NULL; ;
+ 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 = tsdPtr->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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler));
+
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->deleteFlag = 0;
+ handlerPtr->nextPtr = NULL;
+ if (tsdPtr->genericList == NULL) {
+ tsdPtr->genericList = handlerPtr;
+ } else {
+ tsdPtr->lastGenericPtr->nextPtr = handlerPtr;
+ }
+ tsdPtr->lastGenericPtr = handlerPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteGenericHandler --
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (handler = tsdPtr->genericList; handler; handler = handler->nextPtr) {
+ if ((handler->proc == proc) && (handler->clientData == clientData)) {
+ handler->deleteFlag = 1;
+ }
+ }
+}
+
+/*--------------------------------------------------------------
+ *
+ * Tk_CreateClientMessageHandler --
+ *
+ * Register a procedure to be called on each ClientMessage event.
+ * ClientMessage handlers are useful for Drag&Drop extensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * From now on, whenever a ClientMessage event is received that isn't
+ * a WM_PROTOCOL event or SelectionEvent, invoke proc, giving it
+ * tkwin and the event as arguments.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateClientMessageHandler(proc)
+ Tk_ClientMessageProc *proc; /* Procedure to call on event. */
+{
+ GenericHandler *handlerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * We use a GenericHandler struct, because it's basically the same,
+ * except with an extra clientData field we'll never use.
+ */
+ handlerPtr = (GenericHandler *)
+ ckalloc (sizeof (GenericHandler));
+
+ handlerPtr->proc = (Tk_GenericProc *) proc;
+ handlerPtr->clientData = NULL; /* never used */
+ handlerPtr->deleteFlag = 0;
+ handlerPtr->nextPtr = NULL;
+ if (tsdPtr->cmList == NULL) {
+ tsdPtr->cmList = handlerPtr;
+ } else {
+ tsdPtr->lastCmPtr->nextPtr = handlerPtr;
+ }
+ tsdPtr->lastCmPtr = handlerPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteClientMessageHandler --
+ *
+ * Delete a previously-created ClientMessage 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 TkClientMessageEventProc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteClientMessageHandler(proc)
+ Tk_ClientMessageProc *proc;
+{
+ GenericHandler * handler;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (handler = tsdPtr->cmList; handler != NULL;
+ handler = handler->nextPtr) {
+ if (handler->proc == (Tk_GenericProc *) proc) {
+ handler->deleteFlag = 1;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventInit --
+ *
+ * This procedures initializes all the event module
+ * structures used by the current thread. It must be
+ * called before any other procedure in this file is
+ * called.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkEventInit _ANSI_ARGS_((void))
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->handlersActive = 0;
+ tsdPtr->pendingPtr = NULL;
+ tsdPtr->genericList = NULL;
+ tsdPtr->lastGenericPtr = NULL;
+ tsdPtr->cmList = NULL;
+ tsdPtr->lastCmPtr = NULL;
+ tsdPtr->restrictProc = NULL;
+ tsdPtr->restrictArg = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkXErrorHandler --
+ *
+ * TkXErrorHandler is an error handler, to be installed
+ * via Tk_CreateErrorHandler, that will set a flag if an
+ * X error occurred.
+ *
+ * Results:
+ * Always returns 0, indicating that the X error was
+ * handled.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TkXErrorHandler (clientData, errEventPtr)
+ ClientData clientData; /* Pointer to flag we set */
+ XErrorEvent *errEventPtr; /* X error info */
+{
+ int *error;
+
+ error = (int *) clientData;
+ *error = 1;
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParentXId --
+ *
+ * Returns the parent of the given window, or "None"
+ * if the window doesn't exist.
+ *
+ * Results:
+ * Returns an X window ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Window
+ParentXId(display, w)
+ Display *display;
+ Window w;
+{
+ Tk_ErrorHandler handler;
+ int gotXError;
+ Status status;
+ Window parent;
+ Window root;
+ Window *childList;
+ unsigned int nChildren;
+
+ /* Handle errors ourselves. */
+
+ gotXError = 0;
+ handler = Tk_CreateErrorHandler(display, -1, -1, -1,
+ TkXErrorHandler, (ClientData) (&gotXError));
+
+ /* Get the parent window. */
+
+ status = XQueryTree(display, w, &root, &parent, &childList, &nChildren);
+
+ /* Do some cleanup; gotta return "None" if we got an error. */
+
+ Tk_DeleteErrorHandler(handler);
+ XSync(display, False);
+ if (status != 0 && childList != NULL) {
+ XFree(childList);
+ }
+ if (status == 0) {
+ parent = None;
+ }
+
+ return parent;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ Window parentXId;
+ TkDisplay *dispPtr;
+ Tcl_Interp *interp = (Tcl_Interp *) NULL;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Hack for simulated X-events: Correct the state field
+ * of the event record to match with the ButtonPress
+ * and ButtonRelease events.
+ */
+
+ if (eventPtr->type==ButtonPress) {
+ dispPtr = TkGetDisplay(eventPtr->xbutton.display);
+ eventPtr->xbutton.state |= dispPtr->mouseButtonState;
+ switch (eventPtr->xbutton.button) {
+ case 1: dispPtr->mouseButtonState |= Button1Mask; break;
+ case 2: dispPtr->mouseButtonState |= Button2Mask; break;
+ case 3: dispPtr->mouseButtonState |= Button3Mask; break;
+ }
+ } else if (eventPtr->type==ButtonRelease) {
+ dispPtr = TkGetDisplay(eventPtr->xbutton.display);
+ switch (eventPtr->xbutton.button) {
+ case 1: dispPtr->mouseButtonState &= ~Button1Mask; break;
+ case 2: dispPtr->mouseButtonState &= ~Button2Mask; break;
+ case 3: dispPtr->mouseButtonState &= ~Button3Mask; break;
+ }
+ eventPtr->xbutton.state |= dispPtr->mouseButtonState;
+ } else if (eventPtr->type==MotionNotify) {
+ dispPtr = TkGetDisplay(eventPtr->xmotion.display);
+ eventPtr->xmotion.state |= dispPtr->mouseButtonState;
+ }
+
+ /*
+ * Next, invoke all the generic event handlers (those that are
+ * invoked for all events). If a generic event handler reports that
+ * an event is fully processed, go no further.
+ */
+
+ for (genPrevPtr = NULL, genericPtr = tsdPtr->genericList;
+ genericPtr != NULL; ) {
+ if (genericPtr->deleteFlag) {
+ if (!tsdPtr->handlersActive) {
+ GenericHandler *tmpPtr;
+
+ /*
+ * This handler needs to be deleted and there are no
+ * calls pending through the handler, so now is a safe
+ * time to delete it.
+ */
+
+ tmpPtr = genericPtr->nextPtr;
+ if (genPrevPtr == NULL) {
+ tsdPtr->genericList = tmpPtr;
+ } else {
+ genPrevPtr->nextPtr = tmpPtr;
+ }
+ if (tmpPtr == NULL) {
+ tsdPtr->lastGenericPtr = genPrevPtr;
+ }
+ (void) ckfree((char *) genericPtr);
+ genericPtr = tmpPtr;
+ continue;
+ }
+ } else {
+ int done;
+
+ tsdPtr->handlersActive++;
+ done = (*genericPtr->proc)(genericPtr->clientData, eventPtr);
+ tsdPtr->handlersActive--;
+ 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). Also, if the window's parent is a
+ * Tk window that has the TK_PROP_PROPCHANGE flag set, then
+ * we must propagate the PropertyNotify event up to the parent.
+ */
+
+ if (eventPtr->type != PropertyNotify) {
+ return;
+ }
+
+ TkSelPropProc(eventPtr);
+
+ /* Get handlerWindow's parent. */
+
+ parentXId = ParentXId(eventPtr->xany.display, handlerWindow);
+ if (parentXId == None) {
+ return;
+ }
+
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, parentXId);
+ if (winPtr == NULL) {
+ return;
+ }
+
+ if (!(winPtr->flags & TK_PROP_PROPCHANGE)) {
+ return;
+ }
+
+ handlerWindow = parentXId;
+ }
+
+ /*
+ * 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). XIM is only ever enabled on
+ * Unix, but this hasn't been factored out of the generic code yet.
+ */
+ dispPtr = winPtr->dispPtr;
+ if ((dispPtr->flags & TK_DISPLAY_USE_IM)) {
+ if (!(winPtr->flags & (TK_CHECKED_IC|TK_ALREADY_DEAD))) {
+ winPtr->flags |= TK_CHECKED_IC;
+ if (dispPtr->inputMethod != NULL) {
+#if TK_XIM_SPOT
+ if (dispPtr->flags & TK_DISPLAY_XIM_SPOT) {
+ XVaNestedList preedit_attr;
+ XPoint spot = {0, 0};
+
+ if (dispPtr->inputXfs == NULL) {
+ /*
+ * We only need to create one XFontSet
+ */
+ char **missing_list;
+ int missing_count;
+ char *def_string;
+
+ dispPtr->inputXfs = XCreateFontSet(dispPtr->display,
+ "-*-*-*-R-Normal--14-130-75-75-*-*",
+ &missing_list, &missing_count, &def_string);
+ if (missing_count > 0) {
+ XFreeStringList(missing_list);
+ }
+ }
+
+ preedit_attr = XVaCreateNestedList(0, XNSpotLocation,
+ &spot, XNFontSet, dispPtr->inputXfs, NULL);
+ if (winPtr->inputContext != NULL)
+ panic("inputContext not NULL");
+ winPtr->inputContext = XCreateIC(dispPtr->inputMethod,
+ XNInputStyle, XIMPreeditPosition|XIMStatusNothing,
+ XNClientWindow, winPtr->window,
+ XNFocusWindow, winPtr->window,
+ XNPreeditAttributes, preedit_attr,
+ NULL);
+ XFree(preedit_attr);
+ } else
+#endif
+ if (winPtr->inputContext != NULL)
+ panic("inputContext not NULL");
+ winPtr->inputContext = XCreateIC(dispPtr->inputMethod,
+ XNInputStyle, XIMPreeditNothing|XIMStatusNothing,
+ XNClientWindow, winPtr->window,
+ XNFocusWindow, winPtr->window,
+ NULL);
+ }
+ }
+ 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 = tsdPtr->pendingPtr;
+ tsdPtr->pendingPtr = &ip;
+ if (mask == 0) {
+ if ((eventPtr->type == SelectionClear)
+ || (eventPtr->type == SelectionRequest)
+ || (eventPtr->type == SelectionNotify)) {
+ TkSelEventProc((Tk_Window) winPtr, eventPtr);
+ } else if (eventPtr->type == ClientMessage) {
+ if (eventPtr->xclient.message_type ==
+ Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS")) {
+ TkWmProtocolEventProc(winPtr, eventPtr);
+ } else {
+ /*
+ * Finally, invoke any ClientMessage event handlers.
+ */
+
+ for (genPrevPtr = NULL, genericPtr = tsdPtr->cmList;
+ genericPtr != NULL; ) {
+ if (genericPtr->deleteFlag) {
+ if (!tsdPtr->handlersActive) {
+ GenericHandler *tmpPtr;
+
+ /*
+ * This handler needs to be deleted and there are
+ * no calls pending through any handlers, so now
+ * is a safe time to delete it.
+ */
+
+ tmpPtr = genericPtr->nextPtr;
+ if (genPrevPtr == NULL) {
+ tsdPtr->cmList = tmpPtr;
+ } else {
+ genPrevPtr->nextPtr = tmpPtr;
+ }
+ if (tmpPtr == NULL) {
+ tsdPtr->lastGenericPtr = genPrevPtr;
+ }
+ (void) ckfree((char *) genericPtr);
+ genericPtr = tmpPtr;
+ continue;
+ }
+ } else {
+ int done;
+
+ tsdPtr->handlersActive++;
+ done = (*(Tk_ClientMessageProc *)genericPtr->proc)
+ ((Tk_Window) winPtr, eventPtr);
+ tsdPtr->handlersActive--;
+ if (done) {
+ break;
+ }
+ }
+ genPrevPtr = genericPtr;
+ genericPtr = genPrevPtr->nextPtr;
+ }
+ }
+ }
+ } 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.
+ */
+
+ /*
+ * ...well, except when we use the tkwm patches, in which case
+ * we DO handle CreateNotify events, so we gotta pass 'em through.
+ */
+
+ if ((ip.winPtr != None)
+ && ((mask != SubstructureNotifyMask)
+ || (eventPtr->type == CreateNotify))) {
+ TkBindEventProc(winPtr, eventPtr);
+ }
+ }
+ tsdPtr->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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * While deleting all the handlers, be careful to check for
+ * Tk_HandleEvent being about to process one of the deleted
+ * handlers. If it is, tell it to quit (all of the handlers
+ * are being deleted).
+ */
+
+ while (winPtr->handlerList != NULL) {
+ handlerPtr = winPtr->handlerList;
+ winPtr->handlerList = handlerPtr->nextPtr;
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->nextHandler == handlerPtr) {
+ ipPtr->nextHandler = NULL;
+ }
+ if (ipPtr->winPtr == winPtr) {
+ ipPtr->winPtr = None;
+ }
+ }
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->pendingPtr == NULL) {
+ return dispPtr->lastEventTime;
+ }
+ eventPtr = tsdPtr->pendingPtr->eventPtr;
+ switch (eventPtr->type) {
+ case ButtonPress:
+ case ButtonRelease:
+ return eventPtr->xbutton.time;
+ case KeyPress:
+ case KeyRelease:
+ return eventPtr->xkey.time;
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ prev = tsdPtr->restrictProc;
+ *prevArgPtr = tsdPtr->restrictArg;
+ tsdPtr->restrictProc = proc;
+ tsdPtr->restrictArg = arg;
+ return prev;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CollapseMotionEvents --
+ *
+ * This procedure controls whether we collapse motion events in a
+ * particular display or not.
+ *
+ * Results:
+ * The return value is the previous collapse value in effect.
+ *
+ * Side effects:
+ * Filtering of motion events may be changed after calling this.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_CollapseMotionEvents(display, collapse)
+ Display *display; /* Display handling these events. */
+ int collapse; /* boolean value that specifies whether
+ * motion events should be collapsed. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) display;
+ int prev = (dispPtr->flags & TK_DISPLAY_COLLAPSE_MOTION_EVENTS);
+
+ if (collapse) {
+ dispPtr->flags |= TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+ }
+ 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 = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ return;
+ }
+ if (dispPtr->display == eventPtr->xany.display) {
+ break;
+ }
+ }
+
+ /*
+ * Don't filter motion events if the user
+ * defaulting to true (1), which could be set to false (0) when the
+ * user wishes to receive all the motion data)
+ */
+ if (!(dispPtr->flags & TK_DISPLAY_COLLAPSE_MOTION_EVENTS)) {
+ wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent));
+ wevPtr->header.proc = WindowEventProc;
+ wevPtr->event = *eventPtr;
+ Tcl_QueueEvent(&wevPtr->header, position);
+ return;
+ }
+
+ 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_TopWinHierarchy(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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!(flags & TCL_WINDOW_EVENTS)) {
+ return 0;
+ }
+ if (tsdPtr->restrictProc != NULL) {
+ result = (*tsdPtr->restrictProc)(tsdPtr->restrictArg, &wevPtr->event);
+ if (result != TK_PROCESS_EVENT) {
+ if (result == TK_DEFER_EVENT) {
+ return 0;
+ } else {
+ /*
+ * TK_DELETE_EVENT: return and say we processed the event,
+ * even though we didn't do anything at all.
+ */
+ 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/tcl/generic/tkFileFilter.c b/tcl/generic/tkFileFilter.c
new file mode 100644
index 00000000000..2263ebe4dca
--- /dev/null
+++ b/tcl/generic/tkFileFilter.c
@@ -0,0 +1,485 @@
+/*
+ * 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,
+ CONST char * patternsStr, CONST 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,
+ CONST 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;
+ CONST char ** listArgv = NULL;
+ CONST 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 */
+ CONST char * patternsStr; /* A TCL list of glob patterns. */
+ CONST 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 */
+{
+ CONST char ** globList = NULL;
+ int globCount;
+ CONST 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((unsigned int) 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((unsigned int) len);
+ strcpy(globPtr->pattern, globList[i]);
+ }
+ } else {
+ globPtr->pattern = (char*)ckalloc((unsigned int) 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 */
+ CONST 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/tcl/generic/tkFileFilter.h b/tcl/generic/tkFileFilter.h
new file mode 100644
index 00000000000..1550d76b45b
--- /dev/null
+++ b/tcl/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/tcl/generic/tkFocus.c b/tcl/generic/tkFocus.c
new file mode 100644
index 00000000000..2839aa16d1e
--- /dev/null
+++ b/tcl/generic/tkFocus.c
@@ -0,0 +1,1058 @@
+/*
+ * 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;
+
+/*
+ * 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));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FocusObjCmd --
+ *
+ * This procedure is invoked to process the "focus" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FocusObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *focusOptions[] = {
+ "-displayof", "-force", "-lastfor", (char *) NULL
+ };
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *newPtr, *focusWinPtr, *topLevelPtr;
+ ToplevelFocusInfo *tlFocusPtr;
+ char *windowName;
+ int index;
+
+ /*
+ * If invoked with no arguments, just return the current focus window.
+ */
+
+ if (objc == 1) {
+ focusWinPtr = TkGetFocusWin(winPtr);
+ if (focusWinPtr != NULL) {
+ Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * If invoked with a single argument beginning with "." then focus
+ * on that window.
+ */
+
+ if (objc == 2) {
+ windowName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+
+ /*
+ * The empty string case exists for backwards compatibility.
+ */
+
+ if (windowName[0] == '\0') {
+ return TCL_OK;
+ }
+ if (windowName[0] == '.') {
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!(newPtr->flags & TK_ALREADY_DEAD)) {
+ TkSetFocusWin(newPtr, 0);
+ }
+ return TCL_OK;
+ }
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], focusOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case 0: { /* -displayof */
+ windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ newPtr = TkGetFocusWin(newPtr);
+ if (newPtr != NULL) {
+ Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC);
+ }
+ break;
+ }
+ case 1: { /* -force */
+ windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+
+ /*
+ * The empty string case exists for backwards compatibility.
+ */
+
+ if (windowName[0] == '\0') {
+ return TCL_OK;
+ }
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ TkSetFocusWin(newPtr, 1);
+ break;
+ }
+ case 2: { /* -lastfor */
+ windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (topLevelPtr = newPtr; topLevelPtr != NULL;
+ topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr->flags & TK_TOP_HIERARCHY) {
+ for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ Tcl_SetResult(interp,
+ tlFocusPtr->focusWinPtr->pathName,
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ break;
+ }
+ default: {
+ panic("bad const entries to focusOptions in focus command");
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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)) {
+ TkSetFocusWin(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 (dispPtr->focusDebug) {
+ 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 (dispPtr->focusDebug) {
+ printf("Defocussed implicit Async\n");
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr,
+ (TkWindow *) NULL);
+ XSetInputFocus(dispPtr->display, PointerRoot, RevertToPointerRoot,
+ CurrentTime);
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ return retValue;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetFocusWin --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetFocusWin(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);
+
+ /*
+ * If force is set, we should make sure we grab the focus regardless
+ * of the current focus window since under Windows, we may need to
+ * take control away from another application.
+ */
+
+ if (winPtr == displayFocusPtr->focusWinPtr && !force) {
+ return;
+ }
+
+ /*
+ * Find the top-level window for winPtr, then find (or create)
+ * a record for the top-level. Also see whether winPtr and all its
+ * ancestors are mapped.
+ */
+
+ 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_HIERARCHY) {
+ 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;
+
+ /*
+ * Certain special windows like those used for send and clipboard
+ * have no mainPtr.
+ */
+
+ if (winPtr->mainPtr == NULL)
+ return;
+
+ /*
+ * 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 (dispPtr->focusDebug) {
+ 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 (dispPtr->focusDebug) {
+ printf("forwarding focus to %s after %s died\n",
+ tlFocusPtr->topLevelPtr->pathName,
+ winPtr->pathName);
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr,
+ tlFocusPtr->topLevelPtr);
+ displayFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
+ 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 (winPtr->dispPtr->focusDebug) {
+ printf("auto-focussing on %s, force %d\n", winPtr->pathName,
+ displayFocusPtr->forceFocus);
+ }
+ Tk_DeleteEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
+ FocusMapProc, clientData);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ TkSetFocusWin(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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusFree --
+ *
+ * Free resources associated with maintaining the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This mainPtr should no long access focus information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusFree(mainPtr)
+ TkMainInfo *mainPtr; /* Record that identifies a particular
+ * application. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+ ToplevelFocusInfo *tlFocusPtr;
+
+ while (mainPtr->displayFocusPtr != NULL) {
+ displayFocusPtr = mainPtr->displayFocusPtr;
+ mainPtr->displayFocusPtr = mainPtr->displayFocusPtr->nextPtr;
+ ckfree((char *) displayFocusPtr);
+ }
+ while (mainPtr->tlFocusPtr != NULL) {
+ tlFocusPtr = mainPtr->tlFocusPtr;
+ mainPtr->tlFocusPtr = mainPtr->tlFocusPtr->nextPtr;
+ ckfree((char *) tlFocusPtr);
+ }
+}
diff --git a/tcl/generic/tkFont.c b/tcl/generic/tkFont.c
new file mode 100644
index 00000000000..33b3acf4c44
--- /dev/null
+++ b/tcl/generic/tkFont.c
@@ -0,0 +1,3759 @@
+/*
+ * tkFont.c --
+ *
+ * This file maintains a database of fonts for the Tk toolkit.
+ * It also provides several utility procedures for measuring and
+ * displaying text.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkFont.h"
+
+/*
+ * The following structure is used to keep track of all the fonts that
+ * exist in the current application. It must be stored in the
+ * TkMainInfo for the application.
+ */
+
+typedef struct TkFontInfo {
+ Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font.
+ * Keys are string font names, values are
+ * TkFont pointers. */
+ Tcl_HashTable namedTable; /* Map a name to a set of attributes for a
+ * font, used when constructing a Tk_Font from
+ * a named font description. Keys are
+ * strings, values are NamedFont pointers. */
+ TkMainInfo *mainPtr; /* Application that owns this structure. */
+ int updatePending; /* Non-zero when a World Changed event has
+ * already been queued to handle a change to
+ * a named font. */
+} TkFontInfo;
+
+/*
+ * The following data structure is used to keep track of the font attributes
+ * for each named font that has been defined. The named font is only deleted
+ * when the last reference to it goes away.
+ */
+
+typedef struct NamedFont {
+ 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 numBytes; /* The number of bytes in this chunk. */
+ int numChars; /* The number of characters in this chunk. */
+ int numDisplayChars; /* The number of characters to display when
+ * this chunk is displayed. Can be less than
+ * numChars if extra space characters were
+ * absorbed by the end of the chunk. This
+ * will be < 0 if this is a chunk that is
+ * holding a tab or newline. */
+ 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}
+};
+
+/*
+ * The following structure and defines specify the valid builtin options
+ * when configuring a set of font attributes.
+ */
+
+static CONST 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
+
+/*
+ * Hardcoded font aliases. These are used to describe (mostly) identical
+ * fonts whose names differ from platform to platform. If the
+ * user-supplied font name matches any of the names in one of the alias
+ * lists, the other names in the alias list are also automatically tried.
+ */
+
+static char *timesAliases[] = {
+ "Times", /* Unix. */
+ "Times New Roman", /* Windows. */
+ "New York", /* Mac. */
+ NULL
+};
+
+static char *helveticaAliases[] = {
+ "Helvetica", /* Unix. */
+ "Arial", /* Windows. */
+ "Geneva", /* Mac. */
+ NULL
+};
+
+static char *courierAliases[] = {
+ "Courier", /* Unix and Mac. */
+ "Courier New", /* Windows. */
+ NULL
+};
+
+static char *minchoAliases[] = {
+ "mincho", /* Unix. */
+ "\357\274\255\357\274\263 \346\230\216\346\234\235",
+ /* Windows (MS mincho). */
+ "\346\234\254\346\230\216\346\234\235\342\210\222\357\274\255",
+ /* Mac (honmincho-M). */
+ NULL
+};
+
+static char *gothicAliases[] = {
+ "gothic", /* Unix. */
+ "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257",
+ /* Windows (MS goshikku). */
+ "\344\270\270\343\202\264\343\202\267\343\203\203\343\202\257\342\210\222\357\274\255",
+ /* Mac (goshikku-M). */
+ NULL
+};
+
+static char *dingbatsAliases[] = {
+ "dingbats", "zapfdingbats", "itc zapfdingbats",
+ /* Unix. */
+ /* Windows. */
+ "zapf dingbats", /* Mac. */
+ NULL
+};
+
+static char **fontAliases[] = {
+ timesAliases,
+ helveticaAliases,
+ courierAliases,
+ minchoAliases,
+ gothicAliases,
+ dingbatsAliases,
+ NULL
+};
+
+/*
+ * Hardcoded font classes. If the character cannot be found in the base
+ * font, the classes are examined in order to see if some other similar
+ * font should be examined also.
+ */
+
+static char *systemClass[] = {
+ "fixed", /* Unix. */
+ /* Windows. */
+ "chicago", "osaka", "sistemny", /* Mac. */
+ NULL
+};
+
+static char *serifClass[] = {
+ "times", "palatino", "mincho", /* All platforms. */
+ "song ti", /* Unix. */
+ "ms serif", "simplified arabic", /* Windows. */
+ "latinski", /* Mac. */
+ NULL
+};
+
+static char *sansClass[] = {
+ "helvetica", "gothic", /* All platforms. */
+ /* Unix. */
+ "ms sans serif", "traditional arabic",
+ /* Windows. */
+ "bastion", /* Mac. */
+ NULL
+};
+
+static char *monoClass[] = {
+ "courier", "gothic", /* All platforms. */
+ "fangsong ti", /* Unix. */
+ "simplified arabic fixed", /* Windows. */
+ "monaco", "pryamoy", /* Mac. */
+ NULL
+};
+
+static char *symbolClass[] = {
+ "symbol", "dingbats", "wingdings", NULL
+};
+
+static char **fontFallbacks[] = {
+ systemClass,
+ serifClass,
+ sansClass,
+ monoClass,
+ symbolClass,
+ NULL
+};
+
+/*
+ * Global fallbacks. If the character could not be found in the preferred
+ * fallback list, this list is examined. If the character still cannot be
+ * found, all font families in the system are examined.
+ */
+
+static char *globalFontClass[] = {
+ "symbol", /* All platforms. */
+ /* Unix. */
+ "lucida sans unicode", /* Windows. */
+ "bitstream cyberbit", /* Windows popular CJK font */
+ "chicago", /* Mac. */
+ NULL
+};
+
+#define GetFontAttributes(tkfont) \
+ ((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)
+
+#define GetFontMetrics(tkfont) \
+ ((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)
+
+
+static int ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
+ TkFontAttributes *faPtr));
+static int CreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *name,
+ TkFontAttributes *faPtr));
+static void DupFontObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static int FieldSpecified _ANSI_ARGS_((CONST char *field));
+static void FreeFontObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
+static LayoutChunk * NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
+ int *maxPtr, CONST char *start, int numChars,
+ int curX, int newX, int y));
+static int ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ TkFontAttributes *faPtr));
+static void RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));
+static int SetFontFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static void TheWorldHasChanged _ANSI_ARGS_((
+ ClientData clientData));
+static void UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
+ Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));
+
+/*
+ * The following structure defines the implementation of the "font" Tcl
+ * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of
+ * each font object points to the TkFont structure for the font, or
+ * NULL.
+ */
+
+Tcl_ObjType tkFontObjType = {
+ "font", /* name */
+ FreeFontObjProc, /* freeIntRepProc */
+ DupFontObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetFontFromAny /* setFromAnyProc */
+};
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the font
+ * package on a per application basis.
+ *
+ * Results:
+ * Stores a token in the mainPtr to hold information needed by this
+ * package on a per application basis.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+TkFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ TkFontInfo *fiPtr;
+
+ fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
+ Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS);
+ fiPtr->mainPtr = mainPtr;
+ fiPtr->updatePending = 0;
+ mainPtr->fontInfoPtr = fiPtr;
+
+ TkpFontPkgInit(mainPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgFree --
+ *
+ * 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, *searchPtr;
+ Tcl_HashSearch search;
+ int fontsLeft;
+
+ fiPtr = mainPtr->fontInfoPtr;
+
+ fontsLeft = 0;
+ for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ searchPtr != NULL;
+ searchPtr = Tcl_NextHashEntry(&search)) {
+ fontsLeft++;
+ fprintf(stderr, "Font %s still in cache.\n",
+ Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
+ }
+#ifdef PURIFY
+ if (fontsLeft) {
+ panic("TkFontPkgFree: all fonts should have been freed already");
+ }
+#endif
+ 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 CONST 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_AllocFontFromObj(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 = Tcl_GetString(objv[2]);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
+ nfPtr = NULL; /* lint. */
+ if (namedHashPtr != NULL) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ }
+ if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
+ Tcl_AppendResult(interp, "named font \"", string,
+ "\" doesn't exist", NULL);
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ objPtr = NULL;
+ } else if (objc == 4) {
+ objPtr = objv[3];
+ } else {
+ result = ConfigAttributesObj(interp, tkwin, objc - 3,
+ objv + 3, &nfPtr->fa);
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
+ return result;
+ }
+ return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
+ }
+ case FONT_CREATE: {
+ int skip, i;
+ char *name;
+ char buf[16 + TCL_INTEGER_SPACE];
+ TkFontAttributes fa;
+ Tcl_HashEntry *namedHashPtr;
+
+ skip = 3;
+ if (objc < 3) {
+ name = NULL;
+ } else {
+ name = Tcl_GetString(objv[2]);
+ if (name[0] == '-') {
+ name = NULL;
+ }
+ }
+ if (name == NULL) {
+ /*
+ * No font name specified. Generate one of the form "fontX".
+ */
+
+ for (i = 1; ; i++) {
+ sprintf(buf, "font%d", i);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);
+ if (namedHashPtr == NULL) {
+ break;
+ }
+ }
+ name = buf;
+ skip = 2;
+ }
+ TkInitFontAttributes(&fa);
+ if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
+ &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, name, NULL);
+ break;
+ }
+ case FONT_DELETE: {
+ int i;
+ char *string;
+ NamedFont *nfPtr;
+ Tcl_HashEntry *namedHashPtr;
+
+ /*
+ * Delete the named font. If there are still widgets using this
+ * font, then it isn't deleted right away.
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
+ return TCL_ERROR;
+ }
+ for (i = 2; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
+ if (namedHashPtr == NULL) {
+ Tcl_AppendResult(interp, "named font \"", string,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->refCount != 0) {
+ nfPtr->deletePending = 1;
+ } else {
+ 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;
+ Tcl_Obj *resultPtr;
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? text");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3 + skip], &length);
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ case FONT_METRICS: {
+ Tk_Font tkfont;
+ int skip, index, i;
+ CONST TkFontMetrics *fmPtr;
+ static CONST char *switches[] = {
+ "-ascent", "-descent", "-linespace", "-fixed", NULL
+ };
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if ((objc < 3) || ((objc - skip) > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? ?option?");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ objc -= skip;
+ objv += skip;
+ fmPtr = GetFontMetrics(tkfont);
+ if (objc == 3) {
+ char buf[64 + TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
+ fmPtr->ascent, fmPtr->descent,
+ fmPtr->ascent + fmPtr->descent,
+ fmPtr->fixed);
+ Tcl_AppendResult(interp, buf, NULL);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], switches,
+ "metric", 0, &index) != TCL_OK) {
+ Tk_FreeFont(tkfont);
+ return TCL_ERROR;
+ }
+ i = 0; /* Needed only to prevent compiler
+ * 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;
+ NamedFont *nfPtr;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *namedHashPtr;
+ Tcl_Obj *strPtr, *resultPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "names");
+ return TCL_ERROR;
+ }
+ resultPtr = Tcl_GetObjResult(interp);
+ namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (namedHashPtr != NULL) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->deletePending == 0) {
+ string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
+ strPtr = Tcl_NewStringObj(string, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ namedHashPtr = Tcl_NextHashEntry(&search);
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets --
+ *
+ * Called when the attributes of a named font changes. Updates all
+ * the instantiated fonts that depend on that named font and then
+ * uses the brute force approach and prepares every widget to
+ * recompute its geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Things get queued for redisplay.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateDependentFonts(fiPtr, tkwin, namedHashPtr)
+ TkFontInfo *fiPtr; /* Info about application's fonts. */
+ Tk_Window tkwin; /* A window in the application. */
+ Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
+{
+ Tcl_HashEntry *cacheHashPtr;
+ Tcl_HashSearch search;
+ TkFont *fontPtr;
+ NamedFont *nfPtr;
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->refCount == 0) {
+ /*
+ * Well nobody's using this named font, so don't have to tell
+ * any widgets to recompute themselves.
+ */
+
+ return;
+ }
+
+ cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ while (cacheHashPtr != NULL) {
+ for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
+ fontPtr != NULL; fontPtr = fontPtr->nextPtr) {
+ if (fontPtr->namedHashPtr == namedHashPtr) {
+ TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
+ if (fiPtr->updatePending == 0) {
+ fiPtr->updatePending = 1;
+ Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
+ }
+ }
+ }
+ cacheHashPtr = Tcl_NextHashEntry(&search);
+ }
+}
+
+static void
+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. */
+{
+ Tk_ClassWorldChangedProc *proc;
+ proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
+ if (proc != NULL) {
+ (*proc)(winPtr->instanceData);
+ }
+
+ /*
+ * Notify all the descendants of this window that the world has changed.
+ *
+ * This could be done recursively or iteratively. The recursive version
+ * is easier to implement and understand, and typically, windows with a
+ * -font option will be leaf nodes in the widget heirarchy (buttons,
+ * labels, etc.), so the recursion depth will be shallow.
+ *
+ * However, the additional overhead of the recursive calls may become
+ * a performance problem if typical usage alters such that -font'ed widgets
+ * appear high in the heirarchy, causing deep recursion. This could happen
+ * with text widgets, or more likely with the (not yet existant) labeled
+ * frame widget. With these widgets it is possible, even likely, that a
+ * -font'ed widget (text or labeled frame) will not be a leaf node, but
+ * will instead have many descendants. If this is ever found to cause
+ * a performance problem, it may be worth investigating an iterative
+ * version of the code below.
+ */
+ for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ RecomputeWidgets(winPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CreateNamedFont --
+ *
+ * Create the specified named font with the given attributes in the
+ * named font table associated with the interp.
+ *
+ * Results:
+ * Returns TCL_OK if the font was successfully created, or TCL_ERROR
+ * if the named font already existed. If TCL_ERROR is returned, an
+ * error message is left in the interp's result.
+ *
+ * Side effects:
+ * Assume there used to exist a named font by the specified name, and
+ * that the named font had been deleted, but there were still some
+ * widgets using the named font at the time it was deleted. If a
+ * new named font is created with the same name, all those widgets
+ * that were using the old named font will be redisplayed using
+ * the new named font's attributes.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+CreateNamedFont(interp, tkwin, name, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tk_Window tkwin; /* A window associated with interp. */
+ CONST char *name; /* Name for the new named font. */
+ TkFontAttributes *faPtr; /* Attributes for the new named font. */
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *namedHashPtr;
+ int new;
+ NamedFont *nfPtr;
+
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+
+ namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
+
+ if (new == 0) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->deletePending == 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "named font \"", name,
+ "\" already exists", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Recreating a named font with the same name as a previous
+ * named font. Some widgets were still using that named
+ * font, so they need to get redisplayed.
+ */
+
+ nfPtr->fa = *faPtr;
+ nfPtr->deletePending = 0;
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
+ return TCL_OK;
+ }
+
+ nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
+ nfPtr->deletePending = 0;
+ Tcl_SetHashValue(namedHashPtr, nfPtr);
+ nfPtr->fa = *faPtr;
+ 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 the interp's result.
+ *
+ * Side effects:
+ * The font is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
+ * database is cleaned up when fonts aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFont(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interp for database and error return. */
+ Tk_Window tkwin; /* For display on which font will be used. */
+ CONST char *string; /* String describing font, as: named font,
+ * native format, or parseable string. */
+{
+ Tk_Font tkfont;
+ Tcl_Obj *strPtr;
+
+ strPtr = Tcl_NewStringObj((char *) string, -1);
+ Tcl_IncrRefCount(strPtr);
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
+ Tcl_DecrRefCount(strPtr);
+ return tkfont;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_AllocFontFromObj --
+ *
+ * Given a string description of a font, map the description to a
+ * corresponding Tk_Font that represents the font.
+ *
+ * Results:
+ * The return value is token for the font, or NULL if an error
+ * prevented the font from being created. If NULL is returned, an
+ * error message will be left in interp's result object.
+ *
+ * Side effects:
+ * The font is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
+ * database is cleaned up when fonts aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_AllocFontFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for database and error return. */
+ Tk_Window tkwin; /* For screen on which font will be used. */
+ Tcl_Obj *objPtr; /* Object describing font, as: named font,
+ * native format, or parseable string. */
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
+ TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
+ int new, descent;
+ NamedFont *nfPtr;
+
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ if (objPtr->typePtr != &tkFontObjType) {
+ SetFontFromAny(interp, objPtr);
+ }
+
+ oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (oldFontPtr != NULL) {
+ if (oldFontPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkFont that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeFontObjProc(objPtr);
+ oldFontPtr = NULL;
+ } else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
+ oldFontPtr->resourceRefCount++;
+ return (Tk_Font) oldFontPtr;
+ }
+ }
+
+ /*
+ * Next, search the list of fonts that have the name we want, to see
+ * if one of them is for the right screen.
+ */
+
+ new = 0;
+ if (oldFontPtr != NULL) {
+ cacheHashPtr = oldFontPtr->cacheHashPtr;
+ FreeFontObjProc(objPtr);
+ } else {
+ cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
+ Tcl_GetString(objPtr), &new);
+ }
+ firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
+ for (fontPtr = firstFontPtr; (fontPtr != NULL);
+ fontPtr = fontPtr->nextPtr) {
+ if (Tk_Screen(tkwin) == fontPtr->screen) {
+ fontPtr->resourceRefCount++;
+ fontPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+ return (Tk_Font) fontPtr;
+ }
+ }
+
+ /*
+ * The desired font isn't in the table. Make a new one.
+ */
+
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
+ Tcl_GetString(objPtr));
+ if (namedHashPtr != NULL) {
+ /*
+ * Construct a font based on a named font.
+ */
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ nfPtr->refCount++;
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
+ } else {
+ /*
+ * Native font?
+ */
+
+ fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
+ if (fontPtr == NULL) {
+ TkFontAttributes fa;
+ Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);
+
+ if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) {
+ if (new) {
+ Tcl_DeleteHashEntry(cacheHashPtr);
+ }
+ Tcl_DecrRefCount(dupObjPtr);
+ return NULL;
+ }
+ Tcl_DecrRefCount(dupObjPtr);
+
+ /*
+ * String contained the attributes inline.
+ */
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
+ }
+ }
+
+ fontPtr->resourceRefCount = 1;
+ fontPtr->objRefCount = 1;
+ fontPtr->cacheHashPtr = cacheHashPtr;
+ fontPtr->namedHashPtr = namedHashPtr;
+ fontPtr->screen = Tk_Screen(tkwin);
+ fontPtr->nextPtr = firstFontPtr;
+ Tcl_SetHashValue(cacheHashPtr, fontPtr);
+
+ Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = fontPtr->fm.maxWidth;
+ }
+ fontPtr->tabWidth *= 8;
+
+ /*
+ * Make sure the tab width isn't zero (some fonts may not have enough
+ * 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 = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlineHeight = 1;
+ }
+ if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
+ /*
+ * If this set of values would cause the bottom of the underline
+ * bar to stick below the descent of the font, jack the underline
+ * up a bit higher.
+ */
+
+ fontPtr->underlineHeight = descent - fontPtr->underlinePos;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlinePos--;
+ fontPtr->underlineHeight = 1;
+ }
+ }
+
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+ return (Tk_Font) fontPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetFontFromObj --
+ *
+ * Find the font that corresponds to a given object. The font must
+ * have already been created by Tk_GetFont or Tk_AllocFontFromObj.
+ *
+ * Results:
+ * The return value is a token for the font that matches objPtr
+ * and is suitable for use in tkwin.
+ *
+ * Side effects:
+ * If the object is not already a font ref, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFontFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window that the font will be used in. */
+ Tcl_Obj *objPtr; /* The object from which to get the font. */
+{
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ TkFont *fontPtr;
+ Tcl_HashEntry *hashPtr;
+
+ if (objPtr->typePtr != &tkFontObjType) {
+ SetFontFromAny((Tcl_Interp *) NULL, objPtr);
+ }
+
+ fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (fontPtr != NULL) {
+ if (fontPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkFont that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeFontObjProc(objPtr);
+ fontPtr = NULL;
+ } else if (Tk_Screen(tkwin) == fontPtr->screen) {
+ return (Tk_Font) fontPtr;
+ }
+ }
+
+ /*
+ * Next, search the list of fonts that have the name we want, to see
+ * if one of them is for the right screen.
+ */
+
+ if (fontPtr != NULL) {
+ hashPtr = fontPtr->cacheHashPtr;
+ FreeFontObjProc(objPtr);
+ } else {
+ hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
+ }
+ if (hashPtr != NULL) {
+ for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL;
+ fontPtr = fontPtr->nextPtr) {
+ if (Tk_Screen(tkwin) == fontPtr->screen) {
+ fontPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+ return (Tk_Font) fontPtr;
+ }
+ }
+ }
+
+ panic("Tk_GetFontFromObj called with non-existent font!");
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFontFromAny --
+ *
+ * Convert the internal representation of a Tcl object to the
+ * font internal form.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * The object is left with its typePtr pointing to tkFontObjType.
+ * The TkFont pointer is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetFontFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tkFontObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfFont(tkfont)
+ Tk_Font tkfont; /* Font whose name is desired. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ return fontPtr->cacheHashPtr->key.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, *prevPtr;
+ NamedFont *nfPtr;
+
+ if (tkfont == NULL) {
+ return;
+ }
+ fontPtr = (TkFont *) tkfont;
+ fontPtr->resourceRefCount--;
+ if (fontPtr->resourceRefCount > 0) {
+ return;
+ }
+ if (fontPtr->namedHashPtr != NULL) {
+ /*
+ * This font derived from a named font. Reduce the reference
+ * count on the named font and free it if no-one else is
+ * using it.
+ */
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
+ nfPtr->refCount--;
+ if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
+ Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
+ ckfree((char *) nfPtr);
+ }
+ }
+
+ prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr);
+ if (prevPtr == fontPtr) {
+ if (fontPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
+ } else {
+ Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != fontPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = fontPtr->nextPtr;
+ }
+
+ TkpDeleteFont(fontPtr);
+ if (fontPtr->objRefCount == 0) {
+ ckfree((char *) fontPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeFontFromObj --
+ *
+ * Called to release a font inside a Tcl_Obj *. Decrements the refCount
+ * of the font and removes it from the hash tables if necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with font is decremented, and
+ * only deallocated when no one is using it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeFontFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window this font lives in. Needed
+ * for the screen value. */
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ Tk_FreeFont(Tk_GetFontFromObj(tkwin, objPtr));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeFontObjProc --
+ *
+ * This proc is called to release an object reference to a font.
+ * Called when the object's internal rep is released or when
+ * the cached fontPtr needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it
+ * and the hash ref count go to zero, the font's resources
+ * are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeFontObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (fontPtr != NULL) {
+ fontPtr->objRefCount--;
+ if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) {
+ ckfree((char *) fontPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupFontObjProc --
+ *
+ * When a cached font object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The font's objRefCount is incremented and the internal rep
+ * of the copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupFontObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ TkFont *fontPtr = (TkFont *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+
+ if (fontPtr != NULL) {
+ fontPtr->objRefCount++;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontId --
+ *
+ * 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;
+ Tk_Uid 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 {
+ Tcl_UniChar ch;
+
+ /*
+ * Inline, capitalize the first letter of each word, lowercase the
+ * rest of the letters in each word, and then take out the spaces
+ * between the words. This may make the DString shorter, which is
+ * safe to do.
+ */
+
+ Tcl_DStringAppend(dsPtr, family, -1);
+
+ src = dest = Tcl_DStringValue(dsPtr) + len;
+ upper = 1;
+ for (; *src != '\0'; ) {
+ while (isspace(UCHAR(*src))) { /* INTL: ISO space */
+ src++;
+ upper = 1;
+ }
+ src += Tcl_UtfToUniChar(src, &ch);
+ if (upper) {
+ ch = Tcl_UniCharToUpper(ch);
+ upper = 0;
+ } else {
+ ch = Tcl_UniCharToLower(ch);
+ }
+ dest += Tcl_UniCharToUtf(ch, dest);
+ }
+ *dest = '\0';
+ Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+ if (family != Tcl_DStringValue(dsPtr) + len) {
+ Tcl_DStringAppend(dsPtr, family, -1);
+ 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.size;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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, numBytes)
+ Tk_Font tkfont; /* Font in which text will be measured. */
+ CONST char *string; /* String whose width will be computed. */
+ int numBytes; /* Number of bytes to consider from
+ * string, or < 0 for strlen(). */
+{
+ int width;
+
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+ Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
+ return width;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineChars --
+ *
+ * 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, firstByte,
+ lastByte)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context for actually drawing
+ * line. */
+ Tk_Font tkfont; /* Font used in GC; must have been allocated
+ * by Tk_GetFont(). Used for character
+ * dimensions, etc. */
+ CONST char *string; /* String containing characters to be
+ * underlined or overstruck. */
+ int x, y; /* Coordinates at which first character of
+ * string is drawn. */
+ int firstByte; /* Index of first byte of first character. */
+ int lastByte; /* Index of first byte after the last
+ * character. */
+{
+ TkFont *fontPtr;
+ int startX, endX;
+
+ fontPtr = (TkFont *) tkfont;
+
+ Tk_MeasureChars(tkfont, string, firstByte, -1, 0, &startX);
+ Tk_MeasureChars(tkfont, string, lastByte, -1, 0, &endX);
+
+ XFillRectangle(display, drawable, gc, x + startX,
+ y + fontPtr->underlinePos, (unsigned int) (endX - startX),
+ (unsigned int) fontPtr->underlineHeight);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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, bytesThisChunk, maxChunks;
+ int baseline, height, curX, newX, maxWidth;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ CONST TkFontMetrics *fmPtr;
+ Tcl_DString lineBuffer;
+ int *lineLengths;
+ int curLine, layoutHeight;
+
+ Tcl_DStringInit(&lineBuffer);
+
+ fontPtr = (TkFont *) tkfont;
+ if ((fontPtr == NULL) || (string == NULL)) {
+ if (widthPtr != NULL) {
+ *widthPtr = 0;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = 0;
+ }
+ return NULL;
+ }
+
+ fmPtr = &fontPtr->fm;
+
+ height = fmPtr->ascent + fmPtr->descent;
+
+ if (numChars < 0) {
+ numChars = Tcl_NumUtfChars(string, -1);
+ }
+ if (wrapLength == 0) {
+ wrapLength = -1;
+ }
+
+ maxChunks = 1;
+
+ layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
+ + (maxChunks - 1) * sizeof(LayoutChunk));
+ layoutPtr->tkfont = tkfont;
+ layoutPtr->string = string;
+ layoutPtr->numChunks = 0;
+
+ baseline = fmPtr->ascent;
+ maxWidth = 0;
+
+ /*
+ * Divide the string up into simple strings and measure each string.
+ */
+
+ curX = 0;
+
+ end = Tcl_UtfAtIndex(string, numChars);
+ special = string;
+
+ flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
+ flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;
+ for (start = string; start < end; ) {
+ if (start >= special) {
+ /*
+ * Find the next special character in the string.
+ *
+ * INTL: Note that it is safe to increment by byte, because we are
+ * looking for 7-bit characters that will appear unchanged in
+ * UTF-8. At some point we may need to support the full Unicode
+ * whitespace set.
+ */
+
+ for (special = start; special < end; special++) {
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*special == '\n') || (*special == '\r')) {
+ break;
+ }
+ }
+ 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) {
+ bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
+ wrapLength - curX, flags, &newX);
+ newX += curX;
+ flags &= ~TK_AT_LEAST_ONE;
+ if (bytesThisChunk > 0) {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
+ bytesThisChunk, curX, newX, baseline);
+
+ start += bytesThisChunk;
+ curX = newX;
+ }
+ }
+
+ if ((start == special) && (special < end)) {
+ /*
+ * Handle the special character.
+ *
+ * INTL: Special will be pointing at a 7-bit character so we
+ * can safely treat it as a single byte.
+ */
+
+ chunkPtr = NULL;
+ if (*special == '\t') {
+ newX = curX + fontPtr->tabWidth;
+ newX -= newX % fontPtr->tabWidth;
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
+ 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, curX,
+ 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))) { /* INTL: ISO space */
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*start == '\n') || (*start == '\r')) {
+ break;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*start == '\t') {
+ break;
+ }
+ }
+ start++;
+ }
+ if (chunkPtr != NULL) {
+ CONST char *end;
+
+ /*
+ * Append all the extra spaces on this line to the end of the
+ * last text chunk. This is a little tricky because we are
+ * switching back and forth between characters and bytes.
+ */
+
+ end = chunkPtr->start + chunkPtr->numBytes;
+ bytesThisChunk = start - end;
+ if (bytesThisChunk > 0) {
+ bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk,
+ -1, 0, &chunkPtr->totalWidth);
+ chunkPtr->numBytes += bytesThisChunk;
+ chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk);
+ chunkPtr->totalWidth += curX;
+ }
+ }
+
+ wrapLine:
+ flags |= TK_AT_LEAST_ONE;
+
+ /*
+ * 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.
+ */
+
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
+
+ curX = 0;
+ baseline += height;
+ }
+
+ /*
+ * If last line ends with a newline, then we need to make a 0 width
+ * chunk on the next line. Otherwise "Hello" and "Hello\n" are the
+ * same height.
+ */
+
+ if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
+ if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
+ curX, baseline);
+ chunkPtr->numDisplayChars = -1;
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
+ baseline += height;
+ }
+ }
+
+ layoutPtr->width = maxWidth;
+ layoutHeight = baseline - fmPtr->ascent;
+ if (layoutPtr->numChunks == 0) {
+ layoutHeight = height;
+
+ /*
+ * This fake chunk is used by the other procedures so that they can
+ * pretend that there is a chunk with no chars in it, which makes
+ * the coding simpler.
+ */
+
+ layoutPtr->numChunks = 1;
+ layoutPtr->chunks[0].start = string;
+ layoutPtr->chunks[0].numBytes = 0;
+ layoutPtr->chunks[0].numChars = 0;
+ layoutPtr->chunks[0].numDisplayChars = -1;
+ layoutPtr->chunks[0].x = 0;
+ layoutPtr->chunks[0].y = fmPtr->ascent;
+ layoutPtr->chunks[0].totalWidth = 0;
+ layoutPtr->chunks[0].displayWidth = 0;
+ } else {
+ /*
+ * Using maximum line length, shift all the chunks so that the lines
+ * are all justified correctly.
+ */
+
+ curLine = 0;
+ chunkPtr = layoutPtr->chunks;
+ y = chunkPtr->y;
+ lineLengths = (int *) Tcl_DStringValue(&lineBuffer);
+ for (n = 0; n < layoutPtr->numChunks; n++) {
+ int extra;
+
+ if (chunkPtr->y != y) {
+ curLine++;
+ y = chunkPtr->y;
+ }
+ extra = maxWidth - lineLengths[curLine];
+ if (justify == TK_JUSTIFY_CENTER) {
+ chunkPtr->x += extra / 2;
+ } else if (justify == TK_JUSTIFY_RIGHT) {
+ chunkPtr->x += extra;
+ }
+ chunkPtr++;
+ }
+ }
+
+ if (widthPtr != NULL) {
+ *widthPtr = layoutPtr->width;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = layoutHeight;
+ }
+ Tcl_DStringFree(&lineBuffer);
+
+ return (Tk_TextLayout) layoutPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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;
+ CONST char *firstByte;
+ CONST char *lastByte;
+ LayoutChunk *chunkPtr;
+
+ layoutPtr = (TextLayout *) layout;
+ if (layoutPtr == NULL) {
+ return;
+ }
+
+ if (lastChar < 0) {
+ lastChar = 100000000;
+ }
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ numDisplayChars = chunkPtr->numDisplayChars;
+ if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
+ if (firstChar <= 0) {
+ drawX = 0;
+ firstChar = 0;
+ firstByte = chunkPtr->start;
+ } else {
+ firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
+ Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
+ firstByte - chunkPtr->start, -1, 0, &drawX);
+ }
+ if (lastChar < numDisplayChars) {
+ numDisplayChars = lastChar;
+ }
+ lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
+ Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
+ firstByte, lastByte - firstByte,
+ x + chunkPtr->x + drawX, y + chunkPtr->y);
+ }
+ firstChar -= chunkPtr->numChars;
+ lastChar -= chunkPtr->numChars;
+ if (lastChar <= 0) {
+ break;
+ }
+ 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, numChars;
+
+ if (y < 0) {
+ /*
+ * Point lies above any line in this layout. Return the index of
+ * the first char.
+ */
+
+ return 0;
+ }
+
+ /*
+ * Find which line contains the point.
+ */
+
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ lastPtr = chunkPtr = layoutPtr->chunks;
+ numChars = 0;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ baseline = chunkPtr->y;
+ if (y < baseline + fontPtr->fm.descent) {
+ if (x < chunkPtr->x) {
+ /*
+ * Point is to the left of all chunks on this line. Return
+ * the index of the first character on this line.
+ */
+
+ return numChars;
+ }
+ if (x >= layoutPtr->width) {
+ /*
+ * If point lies off right side of the text layout, return
+ * the last char in the last chunk on this line. Without
+ * this, it might return the index of the first char that
+ * was located outside of the text layout.
+ */
+
+ 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 numChars;
+ }
+ n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
+ chunkPtr->numBytes, x - chunkPtr->x,
+ 0, &dummy);
+ return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
+ }
+ numChars += chunkPtr->numChars;
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ i++;
+ }
+
+ /*
+ * Point is to the right of all chars in all the chunks on this
+ * line. Return the index just past the last char in the last
+ * chunk on this line.
+ */
+
+ pos = numChars;
+ if (i < layoutPtr->numChunks) {
+ pos--;
+ }
+ return pos;
+ }
+ numChars += chunkPtr->numChars;
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ }
+
+ /*
+ * Point lies below any line in this text layout. Return the index
+ * just past the last char.
+ */
+
+ 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;
+ CONST char *end;
+
+ if (index < 0) {
+ return 0;
+ }
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ tkfont = layoutPtr->tkfont;
+ fontPtr = (TkFont *) tkfont;
+
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->numDisplayChars < 0) {
+ if (index == 0) {
+ x = chunkPtr->x;
+ w = chunkPtr->totalWidth;
+ goto check;
+ }
+ } else if (index < chunkPtr->numChars) {
+ end = Tcl_UtfAtIndex(chunkPtr->start, index);
+ if (xPtr != NULL) {
+ Tk_MeasureChars(tkfont, chunkPtr->start,
+ end - chunkPtr->start, -1, 0, &x);
+ x += chunkPtr->x;
+ }
+ if (widthPtr != NULL) {
+ Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
+ -1, 0, &w);
+ }
+ goto check;
+ }
+ index -= chunkPtr->numChars;
+ chunkPtr++;
+ }
+ if (index == 0) {
+ /*
+ * 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:
+ * The interp's result is modified to hold the Postscript code that
+ * will render the text layout.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_TextLayoutToPostscript(interp, layout)
+ Tcl_Interp *interp; /* Filled with Postscript code. */
+ Tk_TextLayout layout; /* The layout to be rendered. */
+{
+#define MAXUSE 128
+ char buf[MAXUSE+30];
+ LayoutChunk *chunkPtr;
+ int i, j, used, c, baseline;
+ Tcl_UniChar ch;
+ CONST char *p, *last_p,*glyphname;
+ TextLayout *layoutPtr;
+ char uindex[5]="\0\0\0\0";
+ char one_char[5];
+ int charsize;
+ int bytecount=0;
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ baseline = chunkPtr->y;
+ used = 0;
+ buf[used++] = '[';
+ buf[used++] = '(';
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (baseline != chunkPtr->y) {
+ buf[used++] = ')';
+ buf[used++] = ']';
+ buf[used++] = '\n';
+ buf[used++] = '[';
+ buf[used++] = '(';
+ baseline = chunkPtr->y;
+ }
+ if (chunkPtr->numDisplayChars <= 0) {
+ if (chunkPtr->start[0] == '\t') {
+ buf[used++] = '\\';
+ buf[used++] = 't';
+ }
+ } else {
+ p = chunkPtr->start;
+ for (j = 0; j < chunkPtr->numDisplayChars; j++) {
+ /*
+ * INTL: For now we just treat the characters as binary
+ * data and display the lower byte. Eventually this should
+ * be revised to handle international postscript fonts.
+ */
+ last_p=p;
+ p +=(charsize= Tcl_UtfToUniChar(p,&ch));
+ Tcl_UtfToExternal(interp,NULL,last_p,charsize,0,NULL,one_char,4,
+ NULL,&bytecount,NULL);
+ if (bytecount == 1) {
+ c = UCHAR(one_char[0]);
+ /* c = UCHAR( ch & 0xFF) */;
+ if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
+ || (c >= UCHAR(0x7f))) {
+ /*
+ * Tricky point: the "03" is necessary in the sprintf
+ * below, so that a full three digits of octal are
+ * always generated. Without the "03", a number
+ * following this sequence could be interpreted by
+ * Postscript as part of this sequence.
+ */
+
+ sprintf(buf + used, "\\%03o", c);
+ used += 4;
+ } else {
+ buf[used++] = c;
+ }
+ } else {
+ /* This character doesn't belong to system character set.
+ * So, we must use full glyph name */
+ sprintf(uindex,"%04X",ch); /* endianness? */
+ if ((glyphname = Tcl_GetVar2( interp , "::tk::psglyphs",uindex,0))) {
+ if (used > 0 && buf [used-1] == '(')
+ --used;
+ else
+ buf[used++] = ')';
+ buf[used++] = '/';
+ while( (*glyphname) && (used < (MAXUSE+27)))
+ buf[used++] = *glyphname++ ;
+ buf[used++] = '(';
+ }
+
+ }
+ 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++] = ']';
+ buf[used++] = '\n';
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ConfigAttributesObj --
+ *
+ * Process command line options to fill in fields of a properly
+ * initialized font attributes structure.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned, an
+ * 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 *optionPtr, *valuePtr;
+ char *value;
+
+ for (i = 0; i < objc; i += 2) {
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((i+2 >= objc) && (objc & 1)) {
+ /*
+ * This test occurs after Tcl_GetIndexFromObj() so that
+ * "font create xyz -xyz" will return the error message
+ * that "-xyz" is a bad option, rather than that the value
+ * for "-xyz" is missing.
+ */
+
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetString(optionPtr), "\" option missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case FONT_FAMILY: {
+ value = Tcl_GetString(valuePtr);
+ faPtr->family = Tk_GetUid(value);
+ break;
+ }
+ case FONT_SIZE: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->size = n;
+ break;
+ }
+ case FONT_WEIGHT: {
+ n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
+ if (n == TK_FW_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->weight = n;
+ break;
+ }
+ case FONT_SLANT: {
+ n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr);
+ if (n == TK_FS_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->slant = n;
+ break;
+ }
+ case FONT_UNDERLINE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->underline = n;
+ break;
+ }
+ case FONT_OVERSTRIKE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->overstrike = n;
+ break;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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;
+ CONST char *str;
+ Tcl_Obj *optionPtr, *valuePtr, *resultPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+
+ start = 0;
+ end = FONT_NUMFIELDS;
+ if (objPtr != NULL) {
+ if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ start = index;
+ end = index + 1;
+ }
+
+ valuePtr = NULL;
+ for (i = start; i < end; i++) {
+ switch (i) {
+ case FONT_FAMILY:
+ str = faPtr->family;
+ valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));
+ break;
+
+ case FONT_SIZE:
+ valuePtr = Tcl_NewIntObj(faPtr->size);
+ break;
+
+ case FONT_WEIGHT:
+ str = TkFindStateString(weightMap, faPtr->weight);
+ valuePtr = Tcl_NewStringObj(str, -1);
+ break;
+
+ case FONT_SLANT:
+ str = TkFindStateString(slantMap, faPtr->slant);
+ valuePtr = Tcl_NewStringObj(str, -1);
+ break;
+
+ case FONT_UNDERLINE:
+ valuePtr = Tcl_NewBooleanObj(faPtr->underline);
+ break;
+
+ case FONT_OVERSTRIKE:
+ valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
+ break;
+ }
+ if (objPtr != NULL) {
+ Tcl_SetObjResult(interp, valuePtr);
+ return TCL_OK;
+ }
+ optionPtr = Tcl_NewStringObj(fontOpt[i], -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseFontNameObj --
+ *
+ * Converts a object into a set of font attributes that can be used
+ * to construct a font.
+ *
+ * The string rep of the object can be one of the following forms:
+ * XLFD (see X documentation)
+ * "family [size] [style1 [style2 ...]"
+ * "-option value [-option value ...]"
+ *
+ * Results:
+ * The return value is TCL_ERROR if the object was syntactically
+ * invalid. In that case an error message is left in interp's
+ * result object. Otherwise, fills the font attribute buffer with
+ * the values parsed from the string and returns TCL_OK;
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseFontNameObj(interp, tkwin, objPtr, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. Must not be
+ * NULL. */
+ Tk_Window tkwin; /* For display on which font is used. */
+ Tcl_Obj *objPtr; /* Parseable font description object. */
+ TkFontAttributes *faPtr; /* Filled with attributes parsed from font
+ * name. Any attributes that were not
+ * specified in font name are filled with
+ * default values. */
+{
+ char *dash;
+ int objc, result, i, n;
+ Tcl_Obj **objv;
+ char *string;
+
+ TkInitFontAttributes(faPtr);
+
+ string = Tcl_GetString(objPtr);
+ if (*string == '-') {
+ /*
+ * This may be an XLFD or an "-option value" string.
+ *
+ * If the string begins with "-*" or a "-foundry-family-*" pattern,
+ * then consider it an XLFD.
+ */
+
+ if (string[1] == '*') {
+ goto xlfd;
+ }
+ dash = strchr(string + 1, '-');
+ if ((dash != NULL)
+ && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */
+ goto xlfd;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
+ }
+
+ if (*string == '*') {
+ /*
+ * This is appears to be an XLFD. Under Unix, all valid XLFDs were
+ * already handled by TkpGetNativeFont. If we are here, either we
+ * have something that initially looks like an XLFD but isn't or we
+ * have encountered an XLFD on Windows or Mac.
+ */
+
+ xlfd:
+ result = TkFontParseXLFD(string, faPtr, NULL);
+ if (result == TCL_OK) {
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Wasn't an XLFD or "-option value" string. Try it as a
+ * "font size style" list.
+ */
+
+ if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
+ || (objc < 1)) {
+ Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
+ if (objc > 1) {
+ if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->size = n;
+ }
+
+ i = 2;
+ if (objc == 3) {
+ if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i = 0;
+ }
+ for ( ; i < objc; i++) {
+ n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
+ if (n != TK_FW_UNKNOWN) {
+ faPtr->weight = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
+ if (n != TK_FS_UNKNOWN) {
+ faPtr->slant = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
+ if (n != 0) {
+ faPtr->underline = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
+ if (n != 0) {
+ faPtr->overstrike = n;
+ continue;
+ }
+
+ /*
+ * Unknown style.
+ */
+
+ Tcl_AppendResult(interp, "unknown font style \"",
+ Tcl_GetString(objv[i]), "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NewChunk --
+ *
+ * Helper function for Tk_ComputeTextLayout(). Encapsulates a
+ * measured set of characters in a chunk that can be quickly
+ * drawn.
+ *
+ * Results:
+ * A pointer to the new chunk in the text layout.
+ *
+ * Side effects:
+ * The text layout is reallocated to hold more chunks as necessary.
+ *
+ * Currently, Tk_ComputeTextLayout() stores contiguous ranges of
+ * "normal" characters in a chunk, along with individual tab
+ * and newline chars in their own chunks. All characters in the
+ * text layout are accounted for.
+ *
+ *---------------------------------------------------------------------------
+ */
+static LayoutChunk *
+NewChunk(layoutPtrPtr, maxPtr, start, numBytes, curX, newX, y)
+ TextLayout **layoutPtrPtr;
+ int *maxPtr;
+ CONST char *start;
+ int numBytes;
+ int curX;
+ int newX;
+ int y;
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int maxChunks, numChars;
+ size_t s;
+
+ layoutPtr = *layoutPtrPtr;
+ maxChunks = *maxPtr;
+ if (layoutPtr->numChunks == maxChunks) {
+ maxChunks *= 2;
+ s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
+ layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);
+
+ *layoutPtrPtr = layoutPtr;
+ *maxPtr = maxChunks;
+ }
+ numChars = Tcl_NumUtfChars(start, numBytes);
+ chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
+ chunkPtr->start = start;
+ chunkPtr->numBytes = numBytes;
+ chunkPtr->numChars = numChars;
+ chunkPtr->numDisplayChars = numChars;
+ chunkPtr->x = curX;
+ chunkPtr->y = y;
+ chunkPtr->totalWidth = newX - curX;
+ chunkPtr->displayWidth = newX - curX;
+ layoutPtr->numChunks++;
+
+ return chunkPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontParseXLFD --
+ *
+ * Break up a fully specified XLFD into a set of font attributes.
+ *
+ * Results:
+ * Return value is TCL_ERROR if string was not a fully specified XLFD.
+ * Otherwise, fills font attribute buffer with the values parsed
+ * from the XLFD and returns TCL_OK.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontParseXLFD(string, faPtr, xaPtr)
+ CONST char *string; /* Parseable font description string. */
+ TkFontAttributes *faPtr; /* Filled with attributes parsed from font
+ * name. Any attributes that were not
+ * specified in font name are filled with
+ * default values. */
+ TkXLFDAttributes *xaPtr; /* Filled with X-specific attributes parsed
+ * from font name. Any attributes that were
+ * not specified in font name are filled with
+ * default values. May be NULL if such
+ * information is not desired. */
+{
+ char *src;
+ CONST char *str;
+ int i, j;
+ char *field[XLFD_NUMFIELDS + 2];
+ Tcl_DString ds;
+ TkXLFDAttributes xa;
+
+ if (xaPtr == NULL) {
+ xaPtr = &xa;
+ }
+ TkInitFontAttributes(faPtr);
+ TkInitXLFDAttributes(xaPtr);
+
+ memset(field, '\0', sizeof(field));
+
+ str = string;
+ if (*str == '-') {
+ str++;
+ }
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, (char *) str, -1);
+ src = Tcl_DStringValue(&ds);
+
+ field[0] = src;
+ for (i = 0; *src != '\0'; src++) {
+ if (!(*src & 0x80)
+ && Tcl_UniCharIsUpper(UCHAR(*src))) {
+ *src = (char) Tcl_UniCharToLower(UCHAR(*src));
+ }
+ if (*src == '-') {
+ i++;
+ if (i == XLFD_NUMFIELDS) {
+ continue;
+ }
+ *src = '\0';
+ field[i] = src + 1;
+ if (i > XLFD_NUMFIELDS) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
+ * but it is (strictly) malformed, because the first * is eliding both
+ * the Setwidth and the Addstyle fields. If the Addstyle field is a
+ * number, then assume the above incorrect form was used and shift all
+ * the rest of the fields right by one, so the number gets interpreted
+ * as a pixelsize. This fix is so that we don't get a million reports
+ * that "it works under X (as a native font name), but gives a syntax
+ * error under Windows (as a parsed set of attributes)".
+ */
+
+ if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
+ if (atoi(field[XLFD_ADD_STYLE]) != 0) {
+ for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
+ field[j + 1] = field[j];
+ }
+ 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])) {
+ faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
+ }
+ if (FieldSpecified(field[XLFD_WEIGHT])) {
+ faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
+ field[XLFD_WEIGHT]);
+ }
+ if (FieldSpecified(field[XLFD_SLANT])) {
+ xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
+ field[XLFD_SLANT]);
+ if (xaPtr->slant == TK_FS_ROMAN) {
+ faPtr->slant = TK_FS_ROMAN;
+ } else {
+ faPtr->slant = TK_FS_ITALIC;
+ }
+ }
+ if (FieldSpecified(field[XLFD_SETWIDTH])) {
+ xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
+ field[XLFD_SETWIDTH]);
+ }
+
+ /* XLFD_ADD_STYLE ignored. */
+
+ /*
+ * Pointsize in tenths of a point, but treat it as tenths of a pixel
+ * for historical compatibility.
+ */
+
+ faPtr->size = 12;
+
+ if (FieldSpecified(field[XLFD_POINT_SIZE])) {
+ if (field[XLFD_POINT_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the point size specified as follows:
+ *
+ * [ N1 N2 N3 N4 ]
+ *
+ * where N1 is the point size (in points, not decipoints!), and
+ * N2, N3, and N4 are some additional numbers that I don't know
+ * the purpose of, so I ignore them.
+ */
+
+ faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
+ &faPtr->size) == TCL_OK) {
+ faPtr->size /= 10;
+ } else {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Pixel height of font. If specified, overrides pointsize.
+ */
+
+ 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.
+ */
+
+ faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
+ &faPtr->size) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ faPtr->size = -faPtr->size;
+
+ /* XLFD_RESOLUTION_X ignored. */
+
+ /* XLFD_RESOLUTION_Y ignored. */
+
+ /* XLFD_SPACING ignored. */
+
+ /* XLFD_AVERAGE_WIDTH ignored. */
+
+ if (FieldSpecified(field[XLFD_CHARSET])) {
+ xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]);
+ } else {
+ xaPtr->charset = Tk_GetUid("iso8859-1");
+ }
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 != '?');
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontGetPixels --
+ *
+ * Given a font size specification (as described in the TkFontAttributes
+ * structure) return the number of pixels it represents.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontGetPixels(tkwin, size)
+ Tk_Window tkwin; /* For point->pixel conversion factor. */
+ int size; /* Font size. */
+{
+ double d;
+
+ if (size < 0) {
+ return -size;
+ }
+
+ d = size * 25.4 / 72.0;
+ d *= WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ return (int) (d + 0.5);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontGetPoints --
+ *
+ * Given a font size specification (as described in the TkFontAttributes
+ * structure) return the number of points it represents.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontGetPoints(tkwin, size)
+ Tk_Window tkwin; /* For pixel->point conversion factor. */
+ int size; /* Font size. */
+{
+ double d;
+
+ if (size >= 0) {
+ return size;
+ }
+
+ d = -size * 72.0 / 25.4;
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ return (int) (d + 0.5);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetAliasList --
+ *
+ * Given a font name, find the list of all aliases for that font
+ * name. One of the names in this list will probably be the name
+ * that this platform expects when asking for the font.
+ *
+ * Results:
+ * As above. The return value is NULL if the font name has no
+ * aliases.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char **
+TkFontGetAliasList(faceName)
+ CONST char *faceName; /* Font name to test for aliases. */
+{
+ int i, j;
+
+ for (i = 0; fontAliases[i] != NULL; i++) {
+ for (j = 0; fontAliases[i][j] != NULL; j++) {
+ if (strcasecmp(faceName, fontAliases[i][j]) == 0) {
+ return fontAliases[i];
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetFallbacks --
+ *
+ * Get the list of font fallbacks that the platform-specific code
+ * can use to try to find the closest matching font the name
+ * requested.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char ***
+TkFontGetFallbacks()
+{
+ return fontFallbacks;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetGlobalClass --
+ *
+ * Get the list of fonts to try if the requested font name does not
+ * exist and no fallbacks for that font name could be used either.
+ * The names in this list are considered preferred over all the other
+ * font names in the system when looking for a last-ditch fallback.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char **
+TkFontGetGlobalClass()
+{
+ return globalFontClass;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetSymbolClass --
+ *
+ * Get the list of fonts that are symbolic; used if the operating
+ * system cannot apriori identify symbolic fonts on its own.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char **
+TkFontGetSymbolClass()
+{
+ return symbolClass;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugFont --
+ *
+ * This procedure returns debugging information about a font.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkFont
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkFont structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugFont(tkwin, name)
+ Tk_Window tkwin; /* The window in which the font will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkFont *fontPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(
+ &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name);
+ if (hashPtr != NULL) {
+ fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr);
+ if (fontPtr == NULL) {
+ panic("TkDebugFont found empty hash table entry");
+ }
+ for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(fontPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(fontPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFontGetFirstTextLayout --
+ *
+ * This procedure returns the first chunk of a Tk_TextLayout,
+ * i.e. until the first font change on the first line (or the
+ * whole first line if there is no such font change).
+ *
+ * Results:
+ * The return value is the byte length of the chunk, the chunk
+ * itself is copied into dst and its Tk_Font into font.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkFontGetFirstTextLayout(
+ Tk_TextLayout layout, /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ Tk_Font * font,
+ char * dst)
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int numBytesInChunk;
+
+ layoutPtr = (TextLayout *)layout;
+ if ((layoutPtr==NULL)
+ || (layoutPtr->numChunks==0)
+ || (layoutPtr->chunks->numDisplayChars <= 0)) {
+ dst[0] = '\0';
+ return 0;
+ }
+ chunkPtr = layoutPtr->chunks;
+ numBytesInChunk = chunkPtr->numBytes;
+ strncpy(dst, chunkPtr->start, (size_t) numBytesInChunk);
+ *font = layoutPtr->tkfont;
+ return numBytesInChunk;
+}
diff --git a/tcl/generic/tkFont.h b/tcl/generic/tkFont.h
new file mode 100644
index 00000000000..ee99ae74e21
--- /dev/null
+++ b/tcl/generic/tkFont.h
@@ -0,0 +1,226 @@
+/*
+ * tkFont.h --
+ *
+ * Declarations for interfaces between the generic and platform-
+ * specific parts of the font package. This information is not
+ * visible outside of the font package.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKFONT
+#define _TKFONT
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * The following structure keeps track of the attributes of a font. It can
+ * be used to keep track of either the desired attributes or the actual
+ * attributes gotten when the font was instantiated.
+ */
+
+typedef struct TkFontAttributes {
+ Tk_Uid family; /* Font family, or NULL to represent
+ * plaform-specific default system font. */
+ int size; /* Pointsize of font, 0 for default size, or
+ * negative number meaning pixel size. */
+ int weight; /* Weight flag; see below for def'n. */
+ int slant; /* Slant flag; see below for def'n. */
+ int underline; /* Non-zero for underline font. */
+ int overstrike; /* Non-zero for overstrike font. */
+} TkFontAttributes;
+
+/*
+ * 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 resourceRefCount; /* Number of active uses of this font (each
+ * active use corresponds to a call to
+ * Tk_AllocFontFromTable or Tk_GetFont).
+ * If this count is 0, then this TkFont
+ * structure is no longer valid and it isn't
+ * present in a hash table: it is being
+ * kept around only because there are objects
+ * referring to it. The structure is freed
+ * when resourceRefCount and objRefCount
+ * are both 0. */
+ int objRefCount; /* The number of Tcl objects that reference
+ * this structure. */
+ Tcl_HashEntry *cacheHashPtr;/* Entry in font cache for this structure,
+ * used when deleting it. */
+ Tcl_HashEntry *namedHashPtr;/* Pointer to hash table entry that
+ * corresponds to the named font that the
+ * tkfont was based on, or NULL if the tkfont
+ * was not based on a named font. */
+ Screen *screen; /* The screen where this font is valid. */
+ int tabWidth; /* Width of tabs in this font (pixels). */
+ int underlinePos; /* Offset from baseline to origin of
+ * underline bar (used for drawing underlines
+ * on a non-underlined font). */
+ int underlineHeight; /* Height of underline bar (used for drawing
+ * underlines on a non-underlined font). */
+
+ /*
+ * Fields used in the generic code that are filled in by
+ * platform-specific code.
+ */
+
+ Font fid; /* For backwards compatibility with XGCValues
+ * structures. Remove when TkGCValues is
+ * implemented. */
+ TkFontAttributes fa; /* Actual font attributes obtained when the
+ * the font was created, as opposed to the
+ * desired attributes passed in to
+ * TkpGetFontFromAttributes(). The desired
+ * metrics can be determined from the string
+ * that was used to create this font. */
+ TkFontMetrics fm; /* Font metrics determined when font was
+ * created. */
+ struct TkFont *nextPtr; /* Points to the next TkFont structure with
+ * the same name. All fonts with the
+ * same name (but different displays) are
+ * chained together off a single entry in
+ * a hash table. */
+} TkFont;
+
+/*
+ * The following structure is used to return attributes when parsing an
+ * XLFD. The extra information is of interest to the Unix-specific code
+ * when attempting to find the closest matching font.
+ */
+
+typedef struct TkXLFDAttributes {
+ Tk_Uid foundry; /* The foundry of the font. */
+ int slant; /* The tristate value for the slant, which
+ * is significant under X. */
+ int setwidth; /* The proportionate width, see below for
+ * definition. */
+ Tk_Uid charset; /* The actual charset string. */
+} TkXLFDAttributes;
+
+/*
+ * Possible values for the "setwidth" field in a TkXLFDAttributes structure.
+ * The setwidth is whether characters are considered wider or narrower than
+ * normal.
+ */
+
+#define TK_SW_NORMAL 0
+#define TK_SW_CONDENSE 1
+#define TK_SW_EXPAND 2
+#define TK_SW_UNKNOWN 3 /* Unknown setwidth. This value may be
+ * stored in the setwidth field. */
+
+/*
+ * The following defines specify the meaning of the fields in a fully
+ * qualified XLFD.
+ */
+
+#define XLFD_FOUNDRY 0
+#define XLFD_FAMILY 1
+#define XLFD_WEIGHT 2
+#define XLFD_SLANT 3
+#define XLFD_SETWIDTH 4
+#define XLFD_ADD_STYLE 5
+#define XLFD_PIXEL_SIZE 6
+#define XLFD_POINT_SIZE 7
+#define XLFD_RESOLUTION_X 8
+#define XLFD_RESOLUTION_Y 9
+#define XLFD_SPACING 10
+#define XLFD_AVERAGE_WIDTH 11
+#define XLFD_CHARSET 12
+#define XLFD_NUMFIELDS 13 /* Number of fields in XLFD. */
+
+/*
+ * Low-level API exported by generic code to platform-specific code.
+ */
+
+#define TkInitFontAttributes(fa) memset((fa), 0, sizeof(TkFontAttributes));
+#define TkInitXLFDAttributes(xa) memset((xa), 0, sizeof(TkXLFDAttributes));
+
+EXTERN int TkFontParseXLFD _ANSI_ARGS_((CONST char *string,
+ TkFontAttributes *faPtr, TkXLFDAttributes *xaPtr));
+EXTERN char ** TkFontGetAliasList _ANSI_ARGS_((CONST char *faceName));
+EXTERN char *** TkFontGetFallbacks _ANSI_ARGS_((void));
+EXTERN int TkFontGetPixels _ANSI_ARGS_((Tk_Window tkwin,
+ int size));
+EXTERN int TkFontGetPoints _ANSI_ARGS_((Tk_Window tkwin,
+ int size));
+EXTERN char ** TkFontGetGlobalClass _ANSI_ARGS_((void));
+EXTERN char ** TkFontGetSymbolClass _ANSI_ARGS_((void));
+
+/*
+ * Low-level API exported by platform-specific code to generic code.
+ */
+
+EXTERN void TkpDeleteFont _ANSI_ARGS_((TkFont *tkFontPtr));
+EXTERN void TkpFontPkgInit _ANSI_ARGS_((TkMainInfo *mainPtr));
+EXTERN TkFont * TkpGetFontFromAttributes _ANSI_ARGS_((
+ TkFont *tkFontPtr, Tk_Window tkwin,
+ CONST TkFontAttributes *faPtr));
+EXTERN void TkpGetFontFamilies _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin));
+EXTERN TkFont * TkpGetNativeFont _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char *name));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKFONT */
diff --git a/tcl/generic/tkFrame.c b/tcl/generic/tkFrame.c
new file mode 100644
index 00000000000..0bf63824032
--- /dev/null
+++ b/tcl/generic/tkFrame.c
@@ -0,0 +1,1929 @@
+/*
+ * tkFrame.c --
+ *
+ * This module implements "frame", "labelframe" and "toplevel" widgets
+ * for the Tk toolkit. Frames are windows with a background color
+ * and possibly a 3-D effect, but not much else in the way of
+ * attributes.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following enum is used to define the type of the frame.
+ */
+
+enum FrameType {
+ TYPE_FRAME, TYPE_TOPLEVEL, TYPE_LABELFRAME
+};
+
+/*
+ * 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. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ char *className; /* Class name for widget (from configuration
+ * option). Malloc-ed. */
+ enum FrameType type; /* Type of widget, such as TYPE_FRAME. */
+ 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. */
+ Tcl_Obj *padXPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave on left and
+ * right of child area. */
+ int padX; /* Integer value corresponding to padXPtr. */
+ Tcl_Obj *padYPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave above and
+ * below child area. */
+ int padY; /* Integer value corresponding to padYPtr. */
+} Frame;
+
+/*
+ * A data structure of the following type is kept for each labelframe
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Frame frame; /* A pointer to the generic frame structure.
+ * This must be the first element of the
+ * Labelframe. */
+
+ /*
+ * Labelframe specific configuration settings.
+ */
+
+ Tcl_Obj *textPtr; /* Value of -text option: specifies text to
+ * display in button. */
+ Tk_Font tkfont; /* Value of -font option: specifies font
+ * to use for display text. */
+ XColor *textColorPtr; /* Value of -fg option: specifies foreground
+ * color in normal mode. */
+ int labelAnchor; /* Value of -labelanchor option: specifies
+ * where to place the label. */
+ Tk_Window labelWin; /* Value of -labelwidget option: Window to
+ * use as label for the frame. */
+
+ /*
+ * Labelframe specific fields for use with configuration settings above.
+ */
+
+ GC textGC; /* GC for drawing text in normal mode. */
+ Tk_TextLayout textLayout; /* Stored text layout information. */
+ XRectangle labelBox; /* The label's actual size and position. */
+ int labelReqWidth; /* The label's requested width. */
+ int labelReqHeight; /* The label's requested height. */
+ int labelTextX, labelTextY; /* Position of the text to be drawn. */
+
+} Labelframe;
+
+/*
+ * The following macros define how many extra pixels to leave
+ * around a label's text.
+ */
+
+#define LABELSPACING 1
+#define LABELMARGIN 4
+
+/*
+ * 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 enum is used to define a type for the -labelanchor option
+ * of the Labelframe widget. These values are used as indices into the
+ * string table below.
+ */
+
+enum labelanchor {
+ LABELANCHOR_E, LABELANCHOR_EN, LABELANCHOR_ES,
+ LABELANCHOR_N, LABELANCHOR_NE, LABELANCHOR_NW,
+ LABELANCHOR_S, LABELANCHOR_SE, LABELANCHOR_SW,
+ LABELANCHOR_W, LABELANCHOR_WN, LABELANCHOR_WS
+};
+
+static char *labelAnchorStrings[] = {
+ "e", "en", "es", "n", "ne", "nw", "s", "se", "sw", "w", "wn", "ws",
+ (char *) NULL
+};
+
+/*
+ * Information used for parsing configuration options. There are
+ * one common table used by all and one table for each widget class.
+ */
+
+static Tk_OptionSpec commonOptSpec[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_FRAME_BG_COLOR, -1, Tk_Offset(Frame, border),
+ TK_OPTION_NULL_OK, (ClientData) DEF_FRAME_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_STRING, "-colormap", "colormap", "Colormap",
+ DEF_FRAME_COLORMAP, -1, Tk_Offset(Frame, colormapName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-container", "container", "Container",
+ DEF_FRAME_CONTAINER, -1, Tk_Offset(Frame, isContainer),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_FRAME_CURSOR, -1, Tk_Offset(Frame, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_FRAME_HEIGHT, -1, Tk_Offset(Frame, height),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_FRAME_HIGHLIGHT_BG, -1,
+ Tk_Offset(Frame, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_FRAME_HIGHLIGHT, -1, Tk_Offset(Frame, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_FRAME_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Frame, highlightWidth), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_FRAME_PADX, Tk_Offset(Frame, padXPtr),
+ Tk_Offset(Frame, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_FRAME_PADY, Tk_Offset(Frame, padYPtr),
+ Tk_Offset(Frame, padY), 0, 0, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_FRAME_TAKE_FOCUS, -1, Tk_Offset(Frame, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-visual", "visual", "Visual",
+ DEF_FRAME_VISUAL, -1, Tk_Offset(Frame, visualName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_FRAME_WIDTH, -1, Tk_Offset(Frame, width),
+ 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, 0, 0}
+};
+
+static Tk_OptionSpec frameOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_FRAME_CLASS, -1, Tk_Offset(Frame, className),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief),
+ 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0}
+};
+
+static Tk_OptionSpec toplevelOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_TOPLEVEL_CLASS, -1, Tk_Offset(Frame, className),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-menu", "menu", "Menu",
+ DEF_TOPLEVEL_MENU, -1, Tk_Offset(Frame, menuName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-screen", "screen", "Screen",
+ DEF_TOPLEVEL_SCREEN, -1, Tk_Offset(Frame, screenName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-use", "use", "Use",
+ DEF_TOPLEVEL_USE, -1, Tk_Offset(Frame, useThis),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0}
+};
+
+static Tk_OptionSpec labelframeOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_LABELFRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_LABELFRAME_CLASS, -1, Tk_Offset(Frame, className),
+ 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_LABELFRAME_FONT, -1, Tk_Offset(Labelframe, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_LABELFRAME_FG, -1, Tk_Offset(Labelframe, textColorPtr), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-labelanchor", "labelAnchor", "LabelAnchor",
+ DEF_LABELFRAME_LABELANCHOR, -1, Tk_Offset(Labelframe, labelAnchor),
+ 0, (ClientData) labelAnchorStrings, 0},
+ {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget",
+ (char *) NULL, -1, Tk_Offset(Labelframe, labelWin),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABELFRAME_RELIEF, -1, Tk_Offset(Frame, relief),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_LABELFRAME_TEXT, Tk_Offset(Labelframe, textPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0}
+};
+
+/*
+ * Class names for widgets, indexed by FrameType.
+ */
+
+static char *classNames[] = {"Frame", "Toplevel", "Labelframe"};
+
+/*
+ * The following table maps from FrameType to the option template for
+ * that class of widgets.
+ */
+
+static Tk_OptionSpec *optionSpecs[] = {
+ frameOptSpec,
+ toplevelOptSpec,
+ labelframeOptSpec,
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ComputeFrameGeometry _ANSI_ARGS_((Frame *framePtr));
+static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp,
+ Frame *framePtr, int objc, Tcl_Obj *CONST objv[]));
+static int CreateFrame _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST argv[],
+ enum FrameType type, char *appName));
+static void DestroyFrame _ANSI_ARGS_((char *memPtr));
+static void DestroyFramePartly _ANSI_ARGS_((Frame *framePtr));
+static void DisplayFrame _ANSI_ARGS_((ClientData clientData));
+static void FrameCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void FrameEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void FrameLostSlaveProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void FrameRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void FrameStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int FrameWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static void FrameWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static void MapFrame _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The structure below defines frame class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs frameClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ FrameWorldChanged /* worldChangedProc */
+};
+
+/*
+ * The structure below defines the official type record for the
+ * labelframe's geometry manager:
+ */
+
+static Tk_GeomMgr frameGeomType = {
+ "labelframe", /* name */
+ FrameRequestProc, /* requestProc */
+ FrameLostSlaveProc /* lostSlaveProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FrameObjCmd, Tk_ToplevelObjCmd, Tk_LabelframeObjCmd --
+ *
+ * These procedures are invoked to process the "frame",
+ * "toplevel" and "labelframe" 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 CreateFrame to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FrameObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_FRAME,
+ (char *) NULL);
+}
+
+int
+Tk_ToplevelObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_TOPLEVEL,
+ (char *) NULL);
+}
+
+int
+Tk_LabelframeObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_LABELFRAME,
+ (char *) NULL);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCreateFrame --
+ *
+ * This procedure is the old command procedure for the "frame"
+ * and "toplevel" commands. Now it is used 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; /* Either NULL or pointer to option table. */
+ 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 there is no main
+ * window associated with the interpreter.
+ * Gives the base name to use for the
+ * new application. */
+{
+ int result, i;
+ Tcl_Obj **objv = (Tcl_Obj **) ckalloc((argc+1) * sizeof(Tcl_Obj **));
+ for (i=0; i<argc; i++) {
+ objv[i] = Tcl_NewStringObj(argv[i], -1);
+ Tcl_IncrRefCount(objv[i]);
+ }
+ objv[argc] = NULL;
+ result = CreateFrame(clientData, interp, argc, objv,
+ toplevel ? TYPE_TOPLEVEL : TYPE_FRAME, appName);
+ for (i=0; i<argc; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ ckfree((char *) objv);
+ return result;
+}
+
+static int
+CreateFrame(clientData, interp, objc, objv, type, appName)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ enum FrameType type; /* What widget type to create. */
+ char *appName; /* Should only be non-NULL if there are no
+ * Main window associated with the interpreter.
+ * Gives the base name to use for the
+ * new application. */
+{
+ Tk_Window tkwin;
+ Frame *framePtr;
+ Tk_OptionTable optionTable;
+ Tk_Window new;
+ CONST char *className, *screenName, *visualName, *colormapName, *arg, *useOption;
+ int i, c, depth;
+ size_t length;
+ unsigned int mask;
+ Colormap colormap;
+ Visual *visual;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
+
+ /*
+ * 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 < objc; i += 2) {
+ arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ if (length < 2) {
+ continue;
+ }
+ c = arg[1];
+ if ((c == 'c') && (strncmp(arg, "-class", length) == 0)
+ && (length >= 3)) {
+ className = Tcl_GetString(objv[i+1]);
+ } else if ((c == 'c')
+ && (strncmp(arg, "-colormap", length) == 0)) {
+ colormapName = Tcl_GetString(objv[i+1]);
+ } else if ((c == 's') && (type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-screen", length) == 0)) {
+ screenName = Tcl_GetString(objv[i+1]);
+ } else if ((c == 'u') && (type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-use", length) == 0)) {
+ useOption = Tcl_GetString(objv[i+1]);
+ } else if ((c == 'v')
+ && (strncmp(arg, "-visual", length) == 0)) {
+ visualName = Tcl_GetString(objv[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 = (type == TYPE_TOPLEVEL) ? "" : NULL;
+ }
+
+ /*
+ * Main window associated with interpreter.
+ * If we're called by Tk_Init to create a
+ * new application, then this is NULL.
+ */
+
+ tkwin = Tk_MainWindow(interp);
+ if (tkwin != NULL) {
+ new = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[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 = classNames[type];
+ }
+ }
+ 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 (type == TYPE_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.
+ */
+
+ if (type == TYPE_LABELFRAME) {
+ framePtr = (Frame *) ckalloc(sizeof(Labelframe));
+ memset((void *) framePtr, 0, (sizeof(Labelframe)));
+ } else {
+ framePtr = (Frame *) ckalloc(sizeof(Frame));
+ memset((void *) framePtr, 0, (sizeof(Frame)));
+ }
+ framePtr->tkwin = new;
+ framePtr->display = Tk_Display(new);
+ framePtr->interp = interp;
+ framePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(new), FrameWidgetObjCmd,
+ (ClientData) framePtr, FrameCmdDeletedProc);
+ framePtr->optionTable = optionTable;
+ framePtr->type = type;
+ framePtr->colormap = colormap;
+ framePtr->relief = TK_RELIEF_FLAT;
+ framePtr->cursor = None;
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+ labelframePtr->labelAnchor = LABELANCHOR_NW;
+ labelframePtr->textGC = None;
+ }
+
+ /*
+ * Store backreference to frame widget in window structure.
+ */
+ Tk_SetClassProcs(new, &frameClass, (ClientData) framePtr);
+
+ mask = ExposureMask | StructureNotifyMask | FocusChangeMask;
+ if (type == TYPE_TOPLEVEL) {
+ mask |= ActivateMask;
+ }
+ Tk_CreateEventHandler(new, mask, FrameEventProc, (ClientData) framePtr);
+ if ((Tk_InitOptions(interp, (char *) framePtr, optionTable, new)
+ != TCL_OK) ||
+ (ConfigureFrame(interp, framePtr, objc-2, objv+2) != 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.", (char *) NULL);
+ goto error;
+ }
+ }
+ if (type == TYPE_TOPLEVEL) {
+ Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr);
+ }
+ Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC);
+ return TCL_OK;
+
+ error:
+ if (new != NULL) {
+ Tk_DestroyWindow(new);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameWidgetObjCmd --
+ *
+ * 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
+FrameWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about frame widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *frameOptions[] = {
+ "cget", "configure", (char *) NULL
+ };
+ enum options {
+ FRAME_CGET, FRAME_CONFIGURE
+ };
+ register Frame *framePtr = (Frame *) clientData;
+ int result = TCL_OK, index;
+ size_t length;
+ int c, i;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], frameOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) framePtr);
+ switch ((enum options) index) {
+ case FRAME_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) framePtr,
+ framePtr->optionTable, objv[2], framePtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+ case FRAME_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) framePtr,
+ framePtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ framePtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ /*
+ * Don't allow the options -class, -colormap, -container,
+ * -newcmap, -screen, -use, or -visual to be changed.
+ */
+
+ for (i = 2; i < objc; i++) {
+ char *arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ if (length < 2) {
+ continue;
+ }
+ c = arg[1];
+ if (((c == 'c') && (strncmp(arg, "-class", length) == 0)
+ && (length >= 2))
+ || ((c == 'c')
+ && (strncmp(arg, "-colormap", length) == 0)
+ && (length >= 3))
+ || ((c == 'c')
+ && (strncmp(arg, "-container", length) == 0)
+ && (length >= 3))
+ || ((c == 's') && (framePtr->type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-screen", length) == 0))
+ || ((c == 'u') && (framePtr->type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-use", length) == 0))
+ || ((c == 'v')
+ && (strncmp(arg, "-visual", length) == 0))) {
+ Tcl_AppendResult(interp, "can't modify ", arg,
+ " option after widget is created", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ result = ConfigureFrame(interp, framePtr, objc-2, objv+2);
+ }
+ break;
+ }
+ }
+
+ 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;
+ register Labelframe *labelframePtr = (Labelframe *) memPtr;
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ Tk_FreeTextLayout(labelframePtr->textLayout);
+ if (labelframePtr->textGC != None) {
+ Tk_FreeGC(framePtr->display, labelframePtr->textGC);
+ }
+ }
+ if (framePtr->colormap != None) {
+ Tk_FreeColormap(framePtr->display, framePtr->colormap);
+ }
+ ckfree((char *) framePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyFramePartly --
+ *
+ * This procedure is invoked to clean up everything that needs
+ * tkwin to be defined when deleted. During the destruction
+ * process tkwin is always set to NULL and this procedure must
+ * be called before that happens.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Some things associated with the frame are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyFramePartly(framePtr)
+ Frame *framePtr; /* Info about frame widget. */
+{
+ register Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ if (framePtr->type == TYPE_LABELFRAME && labelframePtr->labelWin != NULL) {
+ Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask,
+ FrameStructureProc, (ClientData) framePtr);
+ Tk_ManageGeometry(labelframePtr->labelWin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) {
+ Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin);
+ }
+ Tk_UnmapWindow(labelframePtr->labelWin);
+ labelframePtr->labelWin = NULL;
+ }
+
+ Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable,
+ framePtr->tkwin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureFrame --
+ *
+ * This procedure is called to process an objv/objc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a frame widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for framePtr; old resources get freed, if there
+ * were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureFrame(interp, framePtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Frame *framePtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc; /* Number of valid entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ Tk_SavedOptions savedOptions;
+ char *oldMenuName;
+ Tk_Window oldWindow = NULL;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ /*
+ * 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 (framePtr->type == TYPE_LABELFRAME) {
+ oldWindow = labelframePtr->labelWin;
+ }
+ if (Tk_SetOptions(interp, (char *) framePtr,
+ framePtr->optionTable, objc, objv,
+ framePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ if (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+ return TCL_ERROR;
+ } else {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few of the options require additional processing.
+ */
+
+ 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 (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+
+ if (framePtr->border != NULL) {
+ Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border);
+ } else {
+ Tk_SetWindowBackgroundPixmap(framePtr->tkwin, None);
+ }
+
+ if (framePtr->highlightWidth < 0) {
+ framePtr->highlightWidth = 0;
+ }
+ if (framePtr->padX < 0) {
+ framePtr->padX = 0;
+ }
+ if (framePtr->padY < 0) {
+ framePtr->padY = 0;
+ }
+
+ /*
+ * If a -labelwidget is specified, check that it is valid and set
+ * up geometry management for it.
+ */
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ if (oldWindow != labelframePtr->labelWin) {
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ FrameStructureProc, (ClientData) framePtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ Tk_UnmaintainGeometry(oldWindow, framePtr->tkwin);
+ Tk_UnmapWindow(oldWindow);
+ }
+ if (labelframePtr->labelWin != NULL) {
+ Tk_Window ancestor, parent, sibling = NULL;
+
+ /*
+ * Make sure that the frame is either the parent of the
+ * window used as label or a descendant of that
+ * parent. Also, don't allow a top-level window to be
+ * managed inside the frame.
+ */
+
+ parent = Tk_Parent(labelframePtr->labelWin);
+ for (ancestor = framePtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ sibling = ancestor;
+ if (Tk_IsTopLevel(ancestor)) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't use ",
+ Tk_PathName(labelframePtr->labelWin),
+ " as label in this frame", (char *) NULL);
+ labelframePtr->labelWin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_IsTopLevel(labelframePtr->labelWin)) {
+ goto badWindow;
+ }
+ if (labelframePtr->labelWin == framePtr->tkwin) {
+ goto badWindow;
+ }
+ Tk_CreateEventHandler(labelframePtr->labelWin,
+ StructureNotifyMask, FrameStructureProc,
+ (ClientData) framePtr);
+ Tk_ManageGeometry(labelframePtr->labelWin, &frameGeomType,
+ (ClientData) framePtr);
+
+ /*
+ * If the frame is not parent to the label, make
+ * sure the label is above its sibling in the stacking
+ * order.
+ */
+
+ if (sibling != NULL) {
+ Tk_RestackWindow(labelframePtr->labelWin, Above, sibling);
+ }
+ }
+ }
+ }
+
+ FrameWorldChanged((ClientData) framePtr);
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FrameWorldChanged --
+ *
+ * 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:
+ * Frame will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FrameWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ Frame *framePtr = (Frame *) instanceData;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+ Tk_Window tkwin = framePtr->tkwin;
+ XGCValues gcValues;
+ GC gc;
+ int anyTextLabel, anyWindowLabel;
+ int bWidthLeft, bWidthRight, bWidthTop, bWidthBottom;
+ char *labelText;
+
+ anyTextLabel = (framePtr->type == TYPE_LABELFRAME) &&
+ (labelframePtr->textPtr != NULL) &&
+ (labelframePtr->labelWin == NULL);
+ anyWindowLabel = (framePtr->type == TYPE_LABELFRAME) &&
+ (labelframePtr->labelWin != NULL);
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ /*
+ * The textGC is needed even in the labelWin case, so it's
+ * always created for a labelframe.
+ */
+
+ gcValues.font = Tk_FontId(labelframePtr->tkfont);
+ gcValues.foreground = labelframePtr->textColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ gc = Tk_GetGC(tkwin, GCForeground | GCFont | GCGraphicsExposures,
+ &gcValues);
+ if (labelframePtr->textGC != None) {
+ Tk_FreeGC(framePtr->display, labelframePtr->textGC);
+ }
+ labelframePtr->textGC = gc;
+
+ /*
+ * Calculate label size.
+ */
+
+ labelframePtr->labelReqWidth = labelframePtr->labelReqHeight = 0;
+
+ if (anyTextLabel) {
+ labelText = Tcl_GetString(labelframePtr->textPtr);
+ Tk_FreeTextLayout(labelframePtr->textLayout);
+ labelframePtr->textLayout = Tk_ComputeTextLayout(labelframePtr->tkfont,
+ labelText, -1, 0, TK_JUSTIFY_CENTER, 0,
+ &labelframePtr->labelReqWidth, &labelframePtr->labelReqHeight);
+ labelframePtr->labelReqWidth += 2 * LABELSPACING;
+ labelframePtr->labelReqHeight += 2 * LABELSPACING;
+ } else if (anyWindowLabel) {
+ labelframePtr->labelReqWidth = Tk_ReqWidth(labelframePtr->labelWin);
+ labelframePtr->labelReqHeight = Tk_ReqHeight(labelframePtr->labelWin);
+ }
+
+ /*
+ * Make sure label size is at least as big as the border.
+ * This simplifies later calculations and gives a better
+ * appearance with thick borders.
+ */
+
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ if (labelframePtr->labelReqHeight < framePtr->borderWidth) {
+ labelframePtr->labelReqHeight = framePtr->borderWidth;
+ }
+ } else {
+ if (labelframePtr->labelReqWidth < framePtr->borderWidth) {
+ labelframePtr->labelReqWidth = framePtr->borderWidth;
+ }
+ }
+ }
+
+ /*
+ * Calculate individual border widths.
+ */
+
+ bWidthBottom = bWidthTop = bWidthRight = bWidthLeft =
+ framePtr->borderWidth + framePtr->highlightWidth;
+
+ bWidthLeft += framePtr->padX;
+ bWidthRight += framePtr->padX;
+ bWidthTop += framePtr->padY;
+ bWidthBottom += framePtr->padY;
+
+ if (anyTextLabel || anyWindowLabel) {
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ bWidthRight += labelframePtr->labelReqWidth -
+ framePtr->borderWidth;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ bWidthTop += labelframePtr->labelReqHeight - framePtr->borderWidth;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ bWidthBottom += labelframePtr->labelReqHeight -
+ framePtr->borderWidth;
+ break;
+ default:
+ bWidthLeft += labelframePtr->labelReqWidth - framePtr->borderWidth;
+ break;
+ }
+ }
+
+ Tk_SetInternalBorderEx(tkwin, bWidthLeft, bWidthRight, bWidthTop,
+ bWidthBottom);
+
+ ComputeFrameGeometry(framePtr);
+
+ /*
+ * A labelframe should request size for its label.
+ */
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ int minwidth = labelframePtr->labelReqWidth;
+ int minheight = labelframePtr->labelReqHeight;
+ int padding = framePtr->highlightWidth;
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+ padding *= 2;
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ minwidth += padding;
+ minheight += framePtr->borderWidth + framePtr->highlightWidth;
+ } else {
+ minheight += padding;
+ minwidth += framePtr->borderWidth + framePtr->highlightWidth;
+ }
+ Tk_SetMinimumRequestSize(tkwin, minwidth, minheight);
+ }
+
+ if ((framePtr->width > 0) || (framePtr->height > 0)) {
+ Tk_GeometryRequest(tkwin, framePtr->width, framePtr->height);
+ }
+
+ if (Tk_IsMapped(tkwin)) {
+ if (!(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
+ }
+ framePtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFrameGeometry --
+ *
+ * This procedure is called to compute various geometrical
+ * information for a frame, 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 *framePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeFrameGeometry(framePtr)
+ register Frame *framePtr; /* Information about widget. */
+{
+ int otherWidth, otherHeight, otherWidthT, otherHeightT, padding;
+ int maxWidth, maxHeight;
+ Tk_Window tkwin;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ /*
+ * We have nothing to do here unless there is a label.
+ */
+
+ if (framePtr->type != TYPE_LABELFRAME) return;
+ if ((labelframePtr->textPtr == NULL) &&
+ (labelframePtr->labelWin == NULL)) return;
+
+ tkwin = framePtr->tkwin;
+
+ /*
+ * Calculate the available size for the label
+ */
+
+ labelframePtr->labelBox.width = labelframePtr->labelReqWidth;
+ labelframePtr->labelBox.height = labelframePtr->labelReqHeight;
+
+ padding = framePtr->highlightWidth;
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+ padding *= 2;
+
+ maxHeight = Tk_Height(tkwin);
+ maxWidth = Tk_Width(tkwin);
+
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ maxWidth -= padding;
+ if (maxWidth < 1) maxWidth = 1;
+ } else {
+ maxHeight -= padding;
+ if (maxHeight < 1) maxHeight = 1;
+ }
+ if (labelframePtr->labelBox.width > maxWidth) {
+ labelframePtr->labelBox.width = maxWidth;
+ }
+ if (labelframePtr->labelBox.height > maxHeight) {
+ labelframePtr->labelBox.height = maxHeight;
+ }
+
+ /*
+ * Calculate label and text position.
+ * The text's position is based on the requested size (= the text's
+ * real size) to get proper alignment if the text does not fit.
+ */
+
+ otherWidth = Tk_Width(tkwin) - labelframePtr->labelBox.width;
+ otherHeight = Tk_Height(tkwin) - labelframePtr->labelBox.height;
+ otherWidthT = Tk_Width(tkwin) - labelframePtr->labelReqWidth;
+ otherHeightT = Tk_Height(tkwin) - labelframePtr->labelReqHeight;
+ padding = framePtr->highlightWidth;
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ labelframePtr->labelTextX = otherWidthT - padding;
+ labelframePtr->labelBox.x = otherWidth - padding;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ labelframePtr->labelTextY = padding;
+ labelframePtr->labelBox.y = padding;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ labelframePtr->labelTextY = otherHeightT - padding;
+ labelframePtr->labelBox.y = otherHeight - padding;
+ break;
+ default:
+ labelframePtr->labelTextX = padding;
+ labelframePtr->labelBox.x = padding;
+ break;
+ }
+
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_NW:
+ case LABELANCHOR_SW:
+ labelframePtr->labelTextX = padding;
+ labelframePtr->labelBox.x = padding;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_S:
+ labelframePtr->labelTextX = otherWidthT / 2;
+ labelframePtr->labelBox.x = otherWidth / 2;
+ break;
+ case LABELANCHOR_NE:
+ case LABELANCHOR_SE:
+ labelframePtr->labelTextX = otherWidthT - padding;
+ labelframePtr->labelBox.x = otherWidth - padding;
+ break;
+ case LABELANCHOR_EN:
+ case LABELANCHOR_WN:
+ labelframePtr->labelTextY = padding;
+ labelframePtr->labelBox.y = padding;
+ break;
+ case LABELANCHOR_E:
+ case LABELANCHOR_W:
+ labelframePtr->labelTextY = otherHeightT / 2;
+ labelframePtr->labelBox.y = otherHeight / 2;
+ break;
+ default:
+ labelframePtr->labelTextY = otherHeightT - padding;
+ labelframePtr->labelBox.y = otherHeight - padding;
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ int bdX1, bdY1, bdX2, bdY2, hlWidth;
+ Pixmap pixmap;
+ TkRegion clipRegion = NULL;
+
+ framePtr->flags &= ~REDRAW_PENDING;
+ if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)
+ || framePtr->isContainer) {
+ return;
+ }
+
+ /*
+ * Highlight shall always be drawn if it exists, so do that first.
+ */
+
+ hlWidth = framePtr->highlightWidth;
+
+ if (hlWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(framePtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ if (framePtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(framePtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, hlWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, hlWidth,
+ Tk_WindowId(tkwin));
+ }
+ }
+
+ /*
+ * If -background is set to "", no interior is drawn.
+ */
+
+ if (framePtr->border == NULL) return;
+
+ if (framePtr->type != TYPE_LABELFRAME) {
+ /*
+ * There is no label so there is just a simple rectangle to draw.
+ */
+
+ noLabel:
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ framePtr->border, hlWidth, hlWidth,
+ Tk_Width(tkwin) - 2 * hlWidth,
+ Tk_Height(tkwin) - 2 * hlWidth,
+ framePtr->borderWidth, framePtr->relief);
+ } else {
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ if ((labelframePtr->textPtr == NULL) &&
+ (labelframePtr->labelWin == NULL)) {
+ goto noLabel;
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws the
+ * frame 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(framePtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ /*
+ * Clear the pixmap.
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap, framePtr->border, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Calculate how the label affects the border's position.
+ */
+
+ bdX1 = bdY1 = hlWidth;
+ bdX2 = Tk_Width(tkwin) - hlWidth;
+ bdY2 = Tk_Height(tkwin) - hlWidth;
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ bdX2 -= (labelframePtr->labelBox.width - framePtr->borderWidth)
+ / 2;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ /*
+ * Since the glyphs of the text tend to be in the lower part
+ * we favor a lower border position by rounding up.
+ */
+
+ bdY1 += (labelframePtr->labelBox.height - framePtr->borderWidth +1)
+ / 2;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ bdY2 -= (labelframePtr->labelBox.height - framePtr->borderWidth)
+ / 2;
+ break;
+ default:
+ bdX1 += (labelframePtr->labelBox.width - framePtr->borderWidth)
+ / 2;
+ break;
+ }
+
+ /*
+ * Draw border
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, framePtr->border, bdX1, bdY1,
+ bdX2 - bdX1, bdY2 - bdY1, framePtr->borderWidth,
+ framePtr->relief);
+
+ if (labelframePtr->labelWin == NULL) {
+ /*
+ * Clear behind the label
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap,
+ framePtr->border, labelframePtr->labelBox.x,
+ labelframePtr->labelBox.y, labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Draw label.
+ * If there is not room for the entire label, use clipping to
+ * get a nice appearance.
+ */
+
+ if ((labelframePtr->labelBox.width < labelframePtr->labelReqWidth)
+ || (labelframePtr->labelBox.height <
+ labelframePtr->labelReqHeight)) {
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&labelframePtr->labelBox, clipRegion,
+ clipRegion);
+ TkSetRegion(framePtr->display, labelframePtr->textGC,
+ clipRegion);
+ }
+
+ Tk_DrawTextLayout(framePtr->display, pixmap,
+ labelframePtr->textGC, labelframePtr->textLayout,
+ labelframePtr->labelTextX + LABELSPACING,
+ labelframePtr->labelTextY + LABELSPACING, 0, -1);
+
+ if (clipRegion != NULL) {
+ XSetClipMask(framePtr->display, labelframePtr->textGC, None);
+ TkDestroyRegion(clipRegion);
+ }
+ } else {
+ /*
+ * Reposition and map the window (but in different ways depending
+ * on whether the frame is the window's parent).
+ */
+
+ if (framePtr->tkwin == Tk_Parent(labelframePtr->labelWin)) {
+ if ((labelframePtr->labelBox.x != Tk_X(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.y !=
+ Tk_Y(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.width !=
+ Tk_Width(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.height !=
+ Tk_Height(labelframePtr->labelWin))) {
+ Tk_MoveResizeWindow(labelframePtr->labelWin,
+ labelframePtr->labelBox.x, labelframePtr->labelBox.y,
+ labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height);
+ }
+ Tk_MapWindow(labelframePtr->labelWin);
+ } else {
+ Tk_MaintainGeometry(labelframePtr->labelWin, framePtr->tkwin,
+ labelframePtr->labelBox.x, labelframePtr->labelBox.y,
+ labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height);
+ }
+ }
+
+
+ /*
+ * Everything's been redisplayed; now copy the pixmap onto the screen
+ * and free up the pixmap.
+ */
+
+ XCopyArea(framePtr->display, pixmap, Tk_WindowId(tkwin),
+ labelframePtr->textGC, hlWidth, hlWidth,
+ (unsigned) (Tk_Width(tkwin) - 2 * hlWidth),
+ (unsigned) (Tk_Height(tkwin) - 2 * hlWidth),
+ hlWidth, hlWidth);
+ Tk_FreePixmap(framePtr->display, pixmap);
+ }
+
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ ComputeFrameGeometry(framePtr);
+ 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).
+ */
+
+ /*
+ * Since the tkwin pointer will be gone when we reach
+ * DestroyFrame, we must free all options now.
+ */
+
+ DestroyFramePartly(framePtr);
+
+ 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) {
+ /*
+ * Some options need tkwin to be freed, so we free them here,
+ * before setting tkwin to NULL.
+ */
+
+ DestroyFramePartly(framePtr);
+
+ 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;
+ if (framePtr == NULL) {
+ panic("TkInstallFrameMenu couldn't get frame pointer");
+ }
+ TkpMenuNotifyToplevelCreate(winPtr->mainPtr->interp,
+ framePtr->menuName);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that's managed as label for the frame.
+ * This procudure's only purpose is to clean up when windows
+ * are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the frame when it is
+ * deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing frame. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ Labelframe *labelframePtr = (Labelframe *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ /*
+ * This should only happen in a labelframe but it doesn't
+ * hurt to be careful.
+ */
+
+ if (labelframePtr->frame.type == TYPE_LABELFRAME) {
+ labelframePtr->labelWin = NULL;
+ FrameWorldChanged((ClientData) labelframePtr);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameRequestProc --
+ *
+ * This procedure is invoked whenever a window that's associated
+ * with a frame 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 frame.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for frame. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ Frame *framePtr = (Frame *) clientData;
+
+ FrameWorldChanged((ClientData) framePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameLostSlaveProc --
+ *
+ * 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 frame-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Frame structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ Frame *framePtr = (Frame *) clientData;
+ Labelframe *labelframePtr = (Labelframe *) clientData;
+
+ /*
+ * This should only happen in a labelframe but it doesn't
+ * hurt to be careful.
+ */
+
+ if (labelframePtr->frame.type == TYPE_LABELFRAME) {
+ Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask,
+ FrameStructureProc, (ClientData) labelframePtr);
+ if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) {
+ Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin);
+ }
+ Tk_UnmapWindow(labelframePtr->labelWin);
+ labelframePtr->labelWin = NULL;
+ }
+ FrameWorldChanged((ClientData) framePtr);
+}
diff --git a/tcl/generic/tkGC.c b/tcl/generic/tkGC.c
new file mode 100644
index 00000000000..8096d39e7d1
--- /dev/null
+++ b/tcl/generic/tkGC.c
@@ -0,0 +1,398 @@
+/*
+ * 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 "tkInt.h"
+
+/*
+ * One of the following data structures exists for each GC that is
+ * currently active. The structure is indexed with two hash tables,
+ * one based on the values in the graphics context and the other
+ * based on the display and GC identifier.
+ */
+
+typedef struct {
+ GC gc; /* Graphics context. */
+ Display *display; /* Display to which gc belongs. */
+ int refCount; /* Number of active uses of gc. */
+ Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting
+ * this structure). */
+} TkGC;
+
+typedef struct {
+ XGCValues values; /* Desired values for GC. */
+ Display *display; /* Display for which GC is valid. */
+ int screenNum; /* screen number of display */
+ int depth; /* and depth for which GC is valid. */
+} ValueKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void GCInit _ANSI_ARGS_((TkDisplay *dispPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetGC --
+ *
+ * Given a desired set of values for a graphics context, find
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ ValueKey valueKey;
+ Tcl_HashEntry *valueHashPtr, *idHashPtr;
+ register TkGC *gcPtr;
+ int new;
+ Drawable d, freeDrawable;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (dispPtr->gcInit <= 0) {
+ GCInit(dispPtr);
+ }
+
+ /*
+ * 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);
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable,
+ (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;
+ idHashPtr = Tcl_CreateHashEntry(&dispPtr->gcIdTable,
+ (char *) gcPtr->gc, &new);
+ if (!new) {
+ panic("GC already registered in Tk_GetGC");
+ }
+ Tcl_SetHashValue(valueHashPtr, gcPtr);
+ Tcl_SetHashValue(idHashPtr, gcPtr);
+ if (freeDrawable != None) {
+ Tk_FreePixmap(valueKey.display, freeDrawable);
+ }
+
+ return gcPtr->gc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ Tcl_HashEntry *idHashPtr;
+ register TkGC *gcPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->gcInit) {
+ panic("Tk_FreeGC called before Tk_GetGC");
+ }
+ if (dispPtr->gcInit < 0) {
+ /*
+ * The GCCleanup has been called, and remaining GCs have been
+ * freed. This may still get called by other things shutting
+ * down, but the GCs should no longer be in use.
+ */
+ return;
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->gcIdTable, (char *) gc);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeGC received unknown gc argument");
+ }
+ gcPtr = (TkGC *) Tcl_GetHashValue(idHashPtr);
+ gcPtr->refCount--;
+ if (gcPtr->refCount == 0) {
+ Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(idHashPtr);
+ ckfree((char *) gcPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGCCleanup --
+ *
+ * Frees the structures used for GC management.
+ * We need to have it called near the end, when other cleanup that
+ * calls Tk_FreeGC is all done.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * GC resources are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGCCleanup(dispPtr)
+ TkDisplay *dispPtr; /* display to clean up resources in */
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ TkGC *gcPtr;
+
+ for (entryPtr = Tcl_FirstHashEntry(&dispPtr->gcIdTable, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ gcPtr = (TkGC *) Tcl_GetHashValue(entryPtr);
+ /*
+ * This call is not needed, as it is only used on Unix to restore
+ * the Id to the stack pool, and we don't want to use them anymore.
+ * Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ */
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(entryPtr);
+ ckfree((char *) gcPtr);
+ }
+ Tcl_DeleteHashTable(&dispPtr->gcValueTable);
+ Tcl_DeleteHashTable(&dispPtr->gcIdTable);
+ dispPtr->gcInit = -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GCInit --
+ *
+ * Initialize the structures used for GC management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GCInit(dispPtr)
+ TkDisplay *dispPtr;
+{
+ if (dispPtr->gcInit < 0) {
+ panic("called GCInit after GCCleanup");
+ }
+ dispPtr->gcInit = 1;
+ Tcl_InitHashTable(&dispPtr->gcValueTable, sizeof(ValueKey)/sizeof(int));
+ Tcl_InitHashTable(&dispPtr->gcIdTable, TCL_ONE_WORD_KEYS);
+}
diff --git a/tcl/generic/tkGeometry.c b/tcl/generic/tkGeometry.c
new file mode 100644
index 00000000000..fed10c9a6fe
--- /dev/null
+++ b/tcl/generic/tkGeometry.c
@@ -0,0 +1,700 @@
+/*
+ * 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;
+
+/*
+ * 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_SetInternalBorderEx --
+ *
+ * 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 widths are recorded for the window, and all geometry
+ * managers of all children are notified so that can re-layout, if
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetInternalBorderEx(tkwin, left, right, top, bottom)
+ Tk_Window tkwin; /* Window that will have internal border. */
+ int left, right; /* Width of internal border, in pixels. */
+ int top, bottom;
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ register int changed = 0;
+
+ if (left < 0) {
+ left = 0;
+ }
+ if (left != winPtr->internalBorderLeft) {
+ winPtr->internalBorderLeft = left;
+ changed = 1;
+ }
+
+ if (right < 0) {
+ right = 0;
+ }
+ if (right != winPtr->internalBorderRight) {
+ winPtr->internalBorderRight = right;
+ changed = 1;
+ }
+
+ if (top < 0) {
+ top = 0;
+ }
+ if (top != winPtr->internalBorderTop) {
+ winPtr->internalBorderTop = top;
+ changed = 1;
+ }
+
+ if (bottom < 0) {
+ bottom = 0;
+ }
+ if (bottom != winPtr->internalBorderBottom) {
+ winPtr->internalBorderBottom = bottom;
+ changed = 1;
+ }
+
+ /*
+ * 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.
+ */
+
+ if (changed) {
+ Tk_ResizeWindow(tkwin, Tk_Width(tkwin), Tk_Height(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. */
+{
+ Tk_SetInternalBorderEx(tkwin, width, width, width, width);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetMinimumRequestSize --
+ *
+ * Notify relevant geometry managers that a window has a minimum
+ * request size.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The minimum request size is recorded for the window, and
+ * a new size is requested for the window, if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetMinimumRequestSize(tkwin, minWidth, minHeight)
+ Tk_Window tkwin; /* Window that will have internal border. */
+ int minWidth, minHeight; /* Minimum requested size, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if ((winPtr->minReqWidth == minWidth) &&
+ (winPtr->minReqHeight == minHeight)) {
+ return;
+ }
+
+ winPtr->minReqWidth = minWidth;
+ winPtr->minReqHeight = minHeight;
+
+ /*
+ * The changed min size may cause geometry managers to get a
+ * different result, so make them recompute.
+ * 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;
+ TkDisplay *dispPtr = ((TkWindow *) master)->dispPtr;
+
+ if (master == Tk_Parent(slave)) {
+ /*
+ * If the slave is a direct descendant of the master, don't bother
+ * setting up the extra infrastructure for management, just make a
+ * call to Tk_MoveResizeWindow; the parent/child relationship will
+ * take care of the rest.
+ */
+ Tk_MoveResizeWindow(slave, x, y, width, height);
+
+ /*
+ * Map the slave if the master is already mapped; otherwise, wait
+ * until the master is mapped later (in which case mapping the slave
+ * is taken care of elsewhere).
+ */
+ if (Tk_IsMapped(master)) {
+ Tk_MapWindow(slave);
+ }
+ return;
+ }
+
+ if (!dispPtr->geomInit) {
+ dispPtr->geomInit = 1;
+ Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there is already a MaintainMaster structure for the master;
+ * if not, then create one.
+ */
+
+ parent = Tk_Parent(slave);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->maintainHashTable,
+ (char *) master, &new);
+ if (!new) {
+ masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
+ } else {
+ masterPtr = (MaintainMaster *) ckalloc(sizeof(MaintainMaster));
+ masterPtr->ancestor = master;
+ masterPtr->checkScheduled = 0;
+ masterPtr->slavePtr = NULL;
+ 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;
+ TkDisplay *dispPtr = ((TkWindow *) slave)->dispPtr;
+
+ if (master == Tk_Parent(slave)) {
+ /*
+ * If the slave is a direct descendant of the master,
+ * Tk_MaintainGeometry will not have set up any of the extra
+ * infrastructure. Don't even bother to look for it, just return.
+ */
+ return;
+ }
+
+ if (!dispPtr->geomInit) {
+ dispPtr->geomInit = 1;
+ Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ if (!(((TkWindow *) slave)->flags & TK_ALREADY_DEAD)) {
+ Tk_UnmapWindow(slave);
+ }
+ hPtr = Tcl_FindHashEntry(&dispPtr->maintainHashTable, (char *) master);
+ if (hPtr == NULL) {
+ return;
+ }
+ masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
+ slavePtr = masterPtr->slavePtr;
+ if (slavePtr->slave == slave) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ } 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/tcl/generic/tkGet.c b/tcl/generic/tkGet.c
new file mode 100644
index 00000000000..f102fac9b74
--- /dev/null
+++ b/tcl/generic/tkGet.c
@@ -0,0 +1,751 @@
+/*
+ * tkGet.c --
+ *
+ * This file contains a number of "Tk_GetXXX" procedures, which
+ * parse text strings into useful forms for Tk. This file has
+ * the simpler procedures, like Tk_GetDirection and Tk_GetUid.
+ * The more complex procedures like Tk_GetColor are in separate
+ * files.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * One of these structures is created per thread to store
+ * thread-specific data. In this case, it is used to house the
+ * Tk_Uid structs used by each thread. The "dataKey" below is
+ * used to locate the ThreadSpecificData for the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_HashTable uidTable;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+static void FreeUidThreadExitProc _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The following tables defines the string values for reliefs, which are
+ * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
+ */
+
+static CONST char *anchorStrings[] = {
+ "n", "ne", "e", "se", "s", "sw", "w", "nw", "center", (char *) NULL
+};
+static CONST char *justifyStrings[] = {
+ "left", "right", "center", (char *) NULL
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetAnchorFromObj --
+ *
+ * Return a Tk_Anchor value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *objPtr; /* The object we are trying to get the
+ * value from. */
+ Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that
+ * corresponds to the string value of
+ * objPtr. */
+{
+ int index, code;
+
+ code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0,
+ &index);
+ if (code == TCL_OK) {
+ *anchorPtr = (Tk_Anchor) index;
+ }
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAnchor --
+ *
+ * Given a string, return the corresponding Tk_Anchor.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * position is stored at *anchorPtr; otherwise TCL_ERROR
+ * is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchor(interp, string, anchorPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJoinStyle(interp, string, joinPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetCapStyle(interp, string, capPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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_GetJustifyFromObj --
+ *
+ * Return a Tk_Justify value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *objPtr; /* The object we are trying to get the
+ * value from. */
+ Tk_Justify *justifyPtr; /* Where to place the Tk_Justify that
+ * corresponds to the string value of
+ * objPtr. */
+{
+ int index, code;
+
+ code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
+ "justification", 0, &index);
+ if (code == TCL_OK) {
+ *justifyPtr = (Tk_Justify) index;
+ }
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJustify --
+ *
+ * Given a string, return the corresponding Tk_Justify.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * justification is stored at *justifyPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJustify(interp, string, justifyPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ CONST 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeUidThreadExitProc --
+ *
+ * Cleans up memory used for Tk_Uids in the thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All information in the identifier table is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeUidThreadExitProc(clientData)
+ ClientData clientData; /* Not used. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_DeleteHashTable(&tsdPtr->uidTable);
+ tsdPtr->initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashTable *tablePtr = &tsdPtr->uidTable;
+
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+ Tcl_CreateThreadExitHandler(FreeUidThreadExitProc, NULL);
+ tsdPtr->initialized = 1;
+ }
+ return (Tk_Uid) Tcl_GetHashKey(tablePtr,
+ Tcl_CreateHashEntry(tablePtr, string, &dummy));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetScreenMM --
+ *
+ * Given a string, returns the number of screen millimeters
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * screen distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+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. */
+ CONST 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
+ * the interp's 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. */
+ CONST char *string; /* String describing a number of pixels. */
+ int *intPtr; /* Place to store converted result. */
+{
+ double d;
+
+ if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (d < 0) {
+ *intPtr = (int) (d - 0.5);
+ } else {
+ *intPtr = (int) (d + 0.5);
+ }
+ return TCL_OK;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetDoublePixels --
+ *
+ * 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
+ * pixel distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetDoublePixels(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. */
+ CONST char *string; /* String describing a number of pixels. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod((char *) 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;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+
diff --git a/tcl/generic/tkGrab.c b/tcl/generic/tkGrab.c
new file mode 100644
index 00000000000..b5493a997cd
--- /dev/null
+++ b/tcl/generic/tkGrab.c
@@ -0,0 +1,1599 @@
+/*
+ * tkGrab.c --
+ *
+ * This file provides procedures that implement grabs for Tk.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * The grab state machine has four states: ungrabbed, button pressed,
+ * grabbed, and button pressed while grabbed. In addition, there are
+ * three pieces of grab state information: the current grab window,
+ * the current restrict window, and whether the mouse is captured.
+ *
+ * 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_GrabObjCmd --
+ *
+ * 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_GrabObjCmd(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 globalGrab;
+ Tk_Window tkwin;
+ TkDisplay *dispPtr;
+ char *arg;
+ int index;
+ int len;
+ static CONST char *optionStrings[] = { "current", "release",
+ "set", "status", (char *) NULL };
+
+ static CONST char *flagStrings[] = { "-global", (char *) NULL };
+
+ enum options { GRABCMD_CURRENT, GRABCMD_RELEASE,
+ GRABCMD_SET, GRABCMD_STATUS };
+
+ if (objc < 2) {
+ /*
+ * Can't use Tcl_WrongNumArgs here because we want the message to
+ * read:
+ * wrong # args: should be "cmd ?-global window" or "cmd option
+ * ?arg arg ...?"
+ * We can fake it with Tcl_WrongNumArgs if we assume the command name
+ * is "grab", but if it has been aliased, the message will be
+ * incorrect.
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_GetString(objv[0]), " ?-global? window\" or \"",
+ Tcl_GetString(objv[0]), " option ?arg arg ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * First check for a window name or "-global" as the first argument.
+ */
+
+ arg = Tcl_GetStringFromObj(objv[1], &len);
+ if (arg[0] == '.') {
+ /* [grab window] */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, arg, (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 0);
+ } else if (arg[0] == '-' && len > 1) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], flagStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* [grab -global window] */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 1);
+ }
+
+ /*
+ * First argument is not a window name and not "-global", find out
+ * which option it is.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case GRABCMD_CURRENT: {
+ /* [grab current ?window?] */
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "current ?window?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ Tcl_SetResult(interp,
+ dispPtr->eventualGrabWinPtr->pathName, TCL_STATIC);
+ }
+ } else {
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ Tcl_AppendElement(interp,
+ dispPtr->eventualGrabWinPtr->pathName);
+ }
+ }
+ }
+ return TCL_OK;
+ }
+
+ case GRABCMD_RELEASE: {
+ /* [grab release window] */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "release window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tk_Ungrab(tkwin);
+ }
+ break;
+ }
+
+ case GRABCMD_SET: {
+ /* [grab set ?-global? window] */
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "set ?-global? window");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ globalGrab = 0;
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ } else {
+ globalGrab = 1;
+ /*
+ * We could just test the argument by hand instead of using
+ * Tcl_GetIndexFromObj; the benefit of using the function is
+ * that it sets up the error message for us, so we are
+ * certain to be consistant with the rest of Tcl.
+ */
+ if (Tcl_GetIndexFromObj(interp, objv[2], flagStrings, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[3]), (Tk_Window) clientData);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, globalGrab);
+ }
+
+ case GRABCMD_STATUS: {
+ /* [grab status window] */
+ TkWindow *winPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "status window");
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), (Tk_Window) clientData);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = winPtr->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != winPtr) {
+ Tcl_SetResult(interp, "none", TCL_STATIC);
+ } else if (dispPtr->grabFlags & GRAB_GLOBAL) {
+ Tcl_SetResult(interp, "global", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "local", TCL_STATIC);
+ }
+ break;
+ }
+ }
+
+ 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 the interp's result will hold an error message.
+ *
+ * Side effects:
+ * Once this call completes successfully, no window outside the
+ * tree rooted at tkwin will receive pointer- or keyboard-related
+ * events until the next call to Tk_Ungrab. If a previous grab was
+ * in effect within this application, then it is replaced with a new
+ * one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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:
+ Tcl_SetResult(interp, "grab failed: another application has grab",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ if (!grabGlobal) {
+ 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) {
+ Tcl_SetResult(interp, "grab failed: window not viewable",
+ TCL_STATIC);
+ } else if (grabResult == AlreadyGrabbed) {
+ goto alreadyGrabbed;
+ } else if (grabResult == GrabFrozen) {
+ Tcl_SetResult(interp,
+ "grab failed: keyboard or pointer frozen", TCL_STATIC);
+ } else if (grabResult == GrabInvalidTime) {
+ Tcl_SetResult(interp, "grab failed: invalid time",
+ TCL_STATIC);
+ } else {
+ char msg[64 + TCL_INTEGER_SPACE];
+
+ sprintf(msg, "grab failed for unknown reason (code %d)",
+ grabResult);
+ Tcl_AppendResult(interp, msg, (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ 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_HIERARCHY)) {
+ 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_HIERARCHY) {
+ 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_HIERARCHY) {
+ 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_HIERARCHY) {
+ 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_HIERARCHY) {
+ 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_HIERARCHY) {
+ 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_HIERARCHY) {
+ 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/tcl/generic/tkGrid.c b/tcl/generic/tkGrid.c
new file mode 100644
index 00000000000..9a94970dcba
--- /dev/null
+++ b/tcl/generic/tkGrid.c
@@ -0,0 +1,3087 @@
+/*
+ * 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 */
+
+/*
+ * Pre-allocate room for uniform groups during layout.
+ */
+
+#define UNIFORM_PREALLOC 10
+
+/*
+ * 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. */
+ Tk_Uid uniform; /* Value of -uniform option. It is used to
+ * group slots that should have the same
+ * size. */
+ 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. */
+ Tk_Uid uniform; /* Value of -uniform option. It is used to
+ * group slots that should have the same
+ * size. */
+ 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. Some is of this space is on each
+ * side. This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int padLeft, padTop; /* The part of padX or padY to use on the
+ * left or top of the widget, respectively.
+ * By default, this is half of padX or padY. */
+ 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
+
+
+/*
+ * Structure to gather information about uniform groups during layout.
+ */
+
+typedef struct UniformGroup {
+ Tk_Uid group;
+ int minSize;
+} UniformGroup;
+
+/*
+ * 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
+
+/*
+ * 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 objc, Tcl_Obj *CONST objv[]));
+static void DestroyGrid _ANSI_ARGS_((char *memPtr));
+static Gridder *GetGrid _ANSI_ARGS_((Tk_Window tkwin));
+static int GridBboxCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridForgetRemoveCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridInfoCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridLocationCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridPropagateCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridRowColumnConfigureCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridSizeCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int GridSlavesCommand _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+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 Tcl_Obj *NewPairObj _ANSI_ARGS_((Tcl_Interp*, int, int));
+static Tcl_Obj *NewQuadObj _ANSI_ARGS_((Tcl_Interp*, int, int, int, int));
+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));
+
+/*
+ * Prototypes for procedures contained in other files but not exported
+ * using tkIntDecls.h
+ */
+
+void TkPrintPadAmount _ANSI_ARGS_((Tcl_Interp*, char*, int, int));
+int TkParsePadAmount _ANSI_ARGS_((Tcl_Interp*, Tk_Window, Tcl_Obj*, int*, int*));
+
+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_GridObjCmd(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;
+ static CONST char *optionStrings[] = {
+ "bbox", "columnconfigure", "configure", "forget",
+ "info", "location", "propagate", "remove",
+ "rowconfigure", "size", "slaves", (char *) NULL };
+ enum options {
+ GRID_BBOX, GRID_COLUMNCONFIGURE, GRID_CONFIGURE, GRID_FORGET,
+ GRID_INFO, GRID_LOCATION, GRID_PROPAGATE, GRID_REMOVE,
+ GRID_ROWCONFIGURE, GRID_SIZE, GRID_SLAVES };
+ int index;
+
+
+ if (objc >= 2) {
+ char *argv1 = Tcl_GetString(objv[1]);
+ if ((argv1[0] == '.') || (argv1[0] == REL_SKIP) ||
+ (argv1[0] == REL_VERT)) {
+ return ConfigureSlaves(interp, tkwin, objc-1, objv+1);
+ }
+ }
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case GRID_BBOX:
+ return GridBboxCommand(tkwin, interp, objc, objv);
+ case GRID_CONFIGURE:
+ return ConfigureSlaves(interp, tkwin, objc-2, objv+2);
+ case GRID_FORGET:
+ case GRID_REMOVE:
+ return GridForgetRemoveCommand(tkwin, interp, objc, objv);
+ case GRID_INFO:
+ return GridInfoCommand(tkwin, interp, objc, objv);
+ case GRID_LOCATION:
+ return GridLocationCommand(tkwin, interp, objc, objv);
+ case GRID_PROPAGATE:
+ return GridPropagateCommand(tkwin, interp, objc, objv);
+ case GRID_SIZE:
+ return GridSizeCommand(tkwin, interp, objc, objv);
+ case GRID_SLAVES:
+ return GridSlavesCommand(tkwin, interp, objc, objv);
+
+ /*
+ * 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.
+ */
+
+ case GRID_COLUMNCONFIGURE:
+ case GRID_ROWCONFIGURE:
+ return GridRowColumnConfigureCommand(tkwin, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ Tcl_SetResult(interp, "Internal error in grid.", TCL_STATIC);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridBboxCommand --
+ *
+ * Implementation of the [grid bbox] subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Places bounding box information in the interp's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridBboxCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ GridMaster *gridPtr; /* pointer to grid data */
+ 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 (objc!=3 && objc != 5 && objc != 7) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master ?column row ?column row??");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (objc >= 5) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &column) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[4], &row) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ column2 = column;
+ row2 = row;
+ }
+
+ if (objc == 7) {
+ if (Tcl_GetIntFromObj(interp, objv[5], &column2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[6], &row2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ gridPtr = masterPtr->masterDataPtr;
+ if (gridPtr == NULL) {
+ Tcl_SetObjResult(interp, NewQuadObj(interp, 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)) {
+ Tcl_SetObjResult(interp, NewQuadObj(interp, 0, 0, 0, 0));
+ return TCL_OK;
+ }
+ if (objc == 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;
+ }
+
+ Tcl_SetObjResult(interp, NewQuadObj(interp,
+ x + gridPtr->startX, y + gridPtr->startY, width, height));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridForgetRemoveCommand --
+ *
+ * Implementation of the [grid forget]/[grid remove] subcommands.
+ * See the user documentation for details on what these do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Removes a window from a grid layout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridForgetRemoveCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window slave;
+ Gridder *slavePtr;
+ int i;
+ char *string = Tcl_GetString(objv[1]);
+ char c = string[0];
+
+ for (i = 2; i < objc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i], &slave) != TCL_OK) {
+ 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->padLeft = slavePtr->padTop = 0;
+ slavePtr->iPadX = slavePtr->iPadY = 0;
+ slavePtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ if (slavePtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, (ClientData) slavePtr);
+ }
+ slavePtr->flags = 0;
+ slavePtr->sticky = 0;
+ }
+ Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridInfoCommand --
+ *
+ * Implementation of the [grid info] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts gridding information in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridInfoCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Gridder *slavePtr;
+ Tk_Window slave;
+ char buffer[64 + TCL_INTEGER_SPACE * 4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ Tcl_AppendElement(interp, "-in");
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
+ sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d",
+ slavePtr->column, slavePtr->row,
+ slavePtr->numCols, slavePtr->numRows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
+ TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY);
+ TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX);
+ TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY);
+ StickyToString(slavePtr->sticky, buffer);
+ Tcl_AppendResult(interp, " -sticky ", buffer, (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridLocationCommand --
+ *
+ * Implementation of the [grid location] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts location information in the interpreter's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridLocationCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ GridMaster *gridPtr; /* pointer to grid data */
+ 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 (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master x y");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixelsFromObj(interp, master, objv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_GetPixelsFromObj(interp, master, objv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr = GetGrid(master);
+ if (masterPtr->masterDataPtr == NULL) {
+ Tcl_SetObjResult(interp, NewPairObj(interp, -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) {
+ Tcl_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 */
+ }
+ }
+
+ Tcl_SetObjResult(interp, NewPairObj(interp, i, j));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridPropagateCommand --
+ *
+ * Implementation of the [grid propagate] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May alter geometry propagation for a widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridPropagateCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ int propagate, old;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+ if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(!(masterPtr->flags & DONT_PROPAGATE)));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &propagate) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Only request a relayout if the propagation bit changes */
+
+ old = !(masterPtr->flags & DONT_PROPAGATE);
+ if (propagate != old) {
+ if (propagate) {
+ masterPtr->flags &= ~DONT_PROPAGATE;
+ } else {
+ 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);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridRowColumnConfigureCommand --
+ *
+ * Implementation of the [grid rowconfigure] and [grid columnconfigure]
+ * subcommands. See the user documentation for details on what these
+ * do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on arguments; see user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridRowColumnConfigureCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ SlotInfo *slotPtr = NULL;
+ int slot; /* the column or row number */
+ int slotType; /* COLUMN or ROW */
+ int size; /* the configuration value */
+ int checkOnly; /* check the size only */
+ int lObjc; /* Number of items in index list */
+ Tcl_Obj **lObjv; /* array of indices */
+ int ok; /* temporary TCL result code */
+ int i, j;
+ char *string;
+ static CONST char *optionStrings[] = {
+ "-minsize", "-pad", "-uniform", "-weight", (char *) NULL };
+ enum options { ROWCOL_MINSIZE, ROWCOL_PAD, ROWCOL_UNIFORM, ROWCOL_WEIGHT };
+ int index;
+
+ if (((objc % 2 != 0) && (objc > 6)) || (objc < 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master index ?-option value...?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objv[3], &lObjc, &lObjv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetString(objv[1]);
+ checkOnly = ((objc == 4) || (objc == 5));
+ masterPtr = GetGrid(master);
+ slotType = (*string == 'c') ? COLUMN : ROW;
+ if (checkOnly && lObjc > 1) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[3]),
+ " must be a single element.", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (j = 0; j < lObjc; j++) {
+ if (Tcl_GetIntFromObj(interp, lObjv[j], &slot) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ok = CheckSlotData(masterPtr, slot, slotType, checkOnly);
+ if ((ok != TCL_OK) && ((objc < 4) || (objc > 5))) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ",
+ Tcl_GetString(objv[1]), ": \"", Tcl_GetString(lObjv[j]),
+ "\" is out of range", (char *) NULL);
+ 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 (objc == 4) {
+ int minsize = 0, pad = 0, weight = 0;
+ Tk_Uid uniform = NULL;
+ Tcl_Obj *res = Tcl_NewListObj(0, NULL);
+
+ if (ok == TCL_OK) {
+ minsize = slotPtr[slot].minSize;
+ pad = slotPtr[slot].pad;
+ weight = slotPtr[slot].weight;
+ uniform = slotPtr[slot].uniform;
+ }
+
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-minsize", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(minsize));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-pad", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(pad));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-uniform", -1));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj(uniform == NULL ? "" : uniform, -1));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-weight", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(weight));
+ Tcl_SetObjResult(interp, res);
+ 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 < objc; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == ROWCOL_MINSIZE) {
+ if (objc == 5) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].minSize : 0));
+ } else if (Tk_GetPixelsFromObj(interp, master, objv[i+1], &size)
+ != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].minSize = size;
+ }
+ }
+ else if (index == ROWCOL_WEIGHT) {
+ int wt;
+ if (objc == 5) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].weight : 0));
+ } else if (Tcl_GetIntFromObj(interp, objv[i+1], &wt)
+ != TCL_OK) {
+ return TCL_ERROR;
+ } else if (wt < 0) {
+ Tcl_AppendResult(interp, "invalid arg \"",
+ Tcl_GetString(objv[i]),
+ "\": should be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].weight = wt;
+ }
+ }
+ else if (index == ROWCOL_UNIFORM) {
+ if (objc == 5) {
+ Tk_Uid value;
+ value = (ok == TCL_OK) ? slotPtr[slot].uniform : "";
+ if (value == NULL) {
+ value = "";
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
+ } else {
+ slotPtr[slot].uniform = Tk_GetUid(Tcl_GetString(objv[i+1]));
+ if (slotPtr[slot].uniform != NULL &&
+ slotPtr[slot].uniform[0] == 0) {
+ slotPtr[slot].uniform = NULL;
+ }
+ }
+ }
+ else if (index == ROWCOL_PAD) {
+ if (objc == 5) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].pad : 0));
+ } else if (Tk_GetPixelsFromObj(interp, master, objv[i+1], &size)
+ != TCL_OK) {
+ return TCL_ERROR;
+ } else if (size < 0) {
+ Tcl_AppendResult(interp, "invalid arg \"",
+ Tcl_GetString(objv[i]),
+ "\": should be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].pad = size;
+ }
+ }
+ }
+ }
+
+ /*
+ * If we changed a property, re-arrange the table,
+ * and check for constraint shrinkage.
+ */
+
+ if (objc != 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)
+ && (slotPtr[last].uniform == NULL)) {
+ 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)
+ && (slotPtr[last].uniform == NULL)) {
+ 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);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridSizeCommand --
+ *
+ * Implementation of the [grid size] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts grid size information in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridSizeCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ GridMaster *gridPtr; /* pointer to grid data */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ gridPtr = masterPtr->masterDataPtr;
+ Tcl_SetObjResult(interp, NewPairObj(interp,
+ MAX(gridPtr->columnEnd, gridPtr->columnMax),
+ MAX(gridPtr->rowEnd, gridPtr->rowMax)));
+ } else {
+ Tcl_SetObjResult(interp, NewPairObj(interp, 0, 0));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridSlavesCommand --
+ *
+ * Implementation of the [grid slaves] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Places a list of slaves of the specified window in the
+ * interpreter's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridSlavesCommand(tkwin, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ Gridder *slavePtr;
+ int i, value;
+ int row = -1, column = -1;
+ static CONST char *optionStrings[] = {
+ "-column", "-row", (char *) NULL };
+ enum options { SLAVES_COLUMN, SLAVES_ROW };
+ int index;
+ Tcl_Obj *res;
+
+ if ((objc < 3) || ((objc % 2) == 0)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?-option value...?");
+ return TCL_ERROR;
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value < 0) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[i]),
+ " is an invalid value: should NOT be < 0",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (index == SLAVES_COLUMN) {
+ column = value;
+ } else {
+ row = value;
+ }
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ res = Tcl_NewListObj(0, NULL);
+ 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_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin), -1));
+ }
+ Tcl_SetObjResult(interp, res);
+ 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 && !(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->padLeft;
+ *widthPtr -= slavePtr->padX;
+ *yPtr += slavePtr->padTop;
+ *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 += Tk_InternalBorderLeft(masterPtr->tkwin) +
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ height += Tk_InternalBorderTop(masterPtr->tkwin) +
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+
+ if (width < Tk_MinReqWidth(masterPtr->tkwin)) {
+ width = Tk_MinReqWidth(masterPtr->tkwin);
+ }
+ if (height < Tk_MinReqHeight(masterPtr->tkwin)) {
+ height = Tk_MinReqHeight(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) -
+ Tk_InternalBorderLeft(masterPtr->tkwin) -
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ realHeight = Tk_Height(masterPtr->tkwin) -
+ Tk_InternalBorderTop(masterPtr->tkwin) -
+ Tk_InternalBorderBottom(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_InternalBorderLeft(masterPtr->tkwin);
+ slotPtr->startY += Tk_InternalBorderTop(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. */
+ UniformGroup uniformPre[UNIFORM_PREALLOC];
+ /* Pre-allocated space for uniform groups. */
+ UniformGroup *uniformGroupPtr;
+ /* Uniform groups data. */
+ int uniformGroups; /* Number of currently used uniform groups. */
+ int uniformGroupsAlloced; /* Size of allocated space for uniform groups.
+ */
+ int weight, minSize;
+
+ /*
+ * 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 *) ckalloc(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].uniform = slotPtr[slot].uniform;
+ layoutPtr[slot].pad = slotPtr[slot].pad;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+ for(;slot<gridCount;slot++) {
+ layoutPtr[slot].minSize = 0;
+ layoutPtr[slot].weight = 0;
+ layoutPtr[slot].uniform = NULL;
+ 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 2b.
+ * Consider demands on uniform sizes.
+ */
+
+ uniformGroupPtr = uniformPre;
+ uniformGroupsAlloced = UNIFORM_PREALLOC;
+ uniformGroups = 0;
+
+ for (slot = 0; slot < gridCount; slot++) {
+ if (layoutPtr[slot].uniform != NULL) {
+ for (start = 0; start < uniformGroups; start++) {
+ if (uniformGroupPtr[start].group == layoutPtr[slot].uniform) {
+ break;
+ }
+ }
+ if (start >= uniformGroups) {
+ /*
+ * Have not seen that group before, set up data for it.
+ */
+
+ if (uniformGroups >= uniformGroupsAlloced) {
+ /*
+ * We need to allocate more space.
+ */
+
+ size_t oldSize = uniformGroupsAlloced
+ * sizeof(UniformGroup);
+ size_t newSize = (uniformGroupsAlloced + UNIFORM_PREALLOC)
+ * sizeof(UniformGroup);
+ UniformGroup *new = (UniformGroup *) ckalloc(newSize);
+ UniformGroup *old = uniformGroupPtr;
+ memcpy((VOID *) new, (VOID *) old, oldSize);
+ if (old != uniformPre) {
+ ckfree((char *) old);
+ }
+ uniformGroupPtr = new;
+ uniformGroupsAlloced += UNIFORM_PREALLOC;
+ }
+ uniformGroups++;
+ uniformGroupPtr[start].group = layoutPtr[slot].uniform;
+ uniformGroupPtr[start].minSize = 0;
+ }
+ weight = layoutPtr[slot].weight;
+ weight = weight > 0 ? weight : 1;
+ minSize = (layoutPtr[slot].minSize + weight - 1) / weight;
+ if (minSize > uniformGroupPtr[start].minSize) {
+ uniformGroupPtr[start].minSize = minSize;
+ }
+ }
+ }
+
+ /*
+ * Data has been gathered about uniform groups. Now relayout accordingly.
+ */
+
+ if (uniformGroups > 0) {
+ for (slot = 0; slot < gridCount; slot++) {
+ if (layoutPtr[slot].uniform != NULL) {
+ for (start = 0; start < uniformGroups; start++) {
+ if (uniformGroupPtr[start].group ==
+ layoutPtr[slot].uniform) {
+ weight = layoutPtr[slot].weight;
+ weight = weight > 0 ? weight : 1;
+ layoutPtr[slot].minSize =
+ uniformGroupPtr[start].minSize * weight;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+ if (uniformGroupPtr != uniformPre) {
+ ckfree((char *) uniformGroupPtr);
+ }
+
+ /*
+ * 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) {
+ ckfree((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;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->gridInit) {
+ Tcl_InitHashTable(&dispPtr->gridHashTable, TCL_ONE_WORD_KEYS);
+ dispPtr->gridInit = 1;
+ }
+
+ /*
+ * See if there's already grid for this window. If not,
+ * then create a new one.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->gridHashTable, (char *) tkwin, &new);
+ if (!new) {
+ return (Gridder *) Tcl_GetHashValue(hPtr);
+ }
+ gridPtr = (Gridder *) ckalloc(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->padLeft = gridPtr->padTop = 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 *) ckalloc(newSize);
+ SlotInfo *old = (slotType == ROW) ?
+ masterPtr->masterDataPtr->rowPtr :
+ masterPtr->masterDataPtr->columnPtr;
+ memcpy((VOID *) new, (VOID *) old, oldSize );
+ memset((VOID *) (new+numSlot), 0, newSize - oldSize );
+ ckfree((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 *) ckalloc(sizeof(GridMaster));
+ size = sizeof(SlotInfo) * TYPICAL_SIZE;
+
+ gridPtr->columnEnd = 0;
+ gridPtr->columnMax = 0;
+ gridPtr->columnPtr = (SlotInfo *) ckalloc(size);
+ gridPtr->columnSpace = TYPICAL_SIZE;
+ gridPtr->rowEnd = 0;
+ gridPtr->rowMax = 0;
+ gridPtr->rowPtr = (SlotInfo *) ckalloc(size);
+ gridPtr->rowSpace = TYPICAL_SIZE;
+ gridPtr->startX = 0;
+ gridPtr->startY = 0;
+
+ 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 Tcl_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) {
+ ckfree((char *) gridPtr->masterDataPtr -> rowPtr);
+ }
+ if (gridPtr->masterDataPtr->columnPtr != NULL) {
+ ckfree((char *) gridPtr->masterDataPtr -> columnPtr);
+ }
+ ckfree((char *) gridPtr->masterDataPtr);
+ }
+ ckfree((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;
+ TkDisplay *dispPtr = ((TkWindow *) gridPtr->tkwin)->dispPtr;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+ if (gridPtr->doubleBw != 2*Tk_Changes(gridPtr->tkwin)->border_width) {
+ 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(&dispPtr->gridHashTable,
+ (char *) gridPtr->tkwin));
+ if (gridPtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr);
+ }
+ gridPtr->tkwin = NULL;
+ Tcl_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 the interp's result is set to contain an error message.
+ *
+ * Side effects:
+ * Slave windows get taken over by the grid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(interp, tkwin, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int objc; /* Number of elements in argv. */
+ Tcl_Obj *CONST objv[]; /* Argument objects: 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, tmp;
+ int 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 */
+ int numSkip; /* number of 'x' found */
+ static CONST char *optionStrings[] = {
+ "-column", "-columnspan", "-in", "-ipadx", "-ipady",
+ "-padx", "-pady", "-row", "-rowspan", "-sticky",
+ (char *) NULL };
+ enum options {
+ CONF_COLUMN, CONF_COLUMNSPAN, CONF_IN, CONF_IPADX, CONF_IPADY,
+ CONF_PADX, CONF_PADY, CONF_ROW, CONF_ROWSPAN, CONF_STICKY };
+ int index;
+ char *string;
+ char firstChar, prevChar;
+
+ /*
+ * Count the number of windows, or window short-cuts.
+ */
+
+ firstChar = 0;
+ for (numWindows = i = 0; i < objc; i++) {
+ prevChar = firstChar;
+ string = Tcl_GetStringFromObj(objv[i], (int *) &length);
+ firstChar = string[0];
+
+ if (firstChar == '.') {
+ numWindows++;
+ continue;
+ }
+ if (length > 1 && i == 0) {
+ Tcl_AppendResult(interp, "bad argument \"", string,
+ "\": must be name of window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (length > 1 && firstChar == '-') {
+ break;
+ }
+ if (length > 1) {
+ Tcl_AppendResult(interp, "unexpected parameter, \"",
+ string, "\", in configure list. ",
+ "Should be window name or option", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_HORIZ) && ((numWindows == 0) ||
+ (prevChar == REL_SKIP) || (prevChar == 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, \"",
+ string, "\" should be '-', 'x', or '^'", (char *) NULL);
+ return TCL_ERROR;
+ }
+ numWindows = i;
+
+ if ((objc - 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++) {
+ string = Tcl_GetString(objv[j]);
+ firstChar = string[0];
+
+ /*
+ * '^' 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;
+ defaultColumnSpan++) {
+ char *string = Tcl_GetString(objv[j + defaultColumnSpan]);
+ if (*string != REL_HORIZ) {
+ break;
+ }
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[j], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_TopWinHierarchy(slave)) {
+ Tcl_AppendResult(interp, "can't manage \"", Tcl_GetString(objv[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 < objc; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == CONF_COLUMN) {
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK ||
+ tmp < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad column value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->column = tmp;
+ } else if (index == CONF_COLUMNSPAN) {
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK ||
+ tmp <= 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad columnspan value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->numCols = tmp;
+ } else if (index == CONF_IN) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other) !=
+ TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (other == slave) {
+ Tcl_SetResult(interp, "Window can't be managed in itself",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(other);
+ InitMasterData(masterPtr);
+ } else if (index == CONF_IPADX) {
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipadx value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp*2;
+ } else if (index == CONF_IPADY) {
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipady value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadY = tmp*2;
+ } else if (index == CONF_PADX) {
+ if (TkParsePadAmount(interp, tkwin, objv[i+1],
+ &slavePtr->padLeft, &slavePtr->padX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_PADY) {
+ if (TkParsePadAmount(interp, tkwin, objv[i+1],
+ &slavePtr->padTop, &slavePtr->padY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_ROW) {
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK
+ || tmp < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad grid value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->row = tmp;
+ } else if (index == CONF_ROWSPAN) {
+ if ((Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK)
+ || tmp <= 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad rowspan value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->numRows = tmp;
+ } else if (index == CONF_STICKY) {
+ int sticky = StringToSticky(Tcl_GetString(objv[i+1]));
+ if (sticky == -1) {
+ Tcl_AppendResult(interp, "bad stickyness value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be a string containing n, e, s, and/or w",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->sticky = sticky;
+ }
+ }
+
+ /*
+ * 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_TopWinHierarchy(ancestor)) {
+ Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[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 ", Tcl_GetString(objv[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;
+ numSkip = 0;
+ for (j = 0; j < numWindows; j++) {
+ struct Gridder *otherPtr;
+ int match; /* found a match for the ^ */
+ int lastRow, lastColumn; /* implied end of table */
+
+ string = Tcl_GetString(objv[j]);
+ firstChar = string[0];
+
+ if (firstChar == '.') {
+ lastWindow = string;
+ numSkip = 0;
+ }
+ if (firstChar == REL_SKIP) {
+ numSkip++;
+ }
+ if (firstChar != REL_VERT) {
+ continue;
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_AppendResult(interp, "can't use '^', cant find master",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Count the number of consecutive ^'s starting from this position */
+ for (width = 1; width + j < numWindows; width++) {
+ char *string = Tcl_GetString(objv[j+width]);
+ if (*string != REL_VERT) break;
+ }
+
+ /*
+ * Find the implied grid location of the ^
+ */
+
+ if (lastWindow == NULL) {
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ lastRow = masterPtr->masterDataPtr->rowEnd - 2;
+ } else {
+ lastRow = 0;
+ }
+ lastColumn = 0;
+ } else {
+ other = Tk_NameToWindow(interp, lastWindow, tkwin);
+ otherPtr = GetGrid(other);
+ lastRow = otherPtr->row + otherPtr->numRows - 2;
+ lastColumn = otherPtr->column + otherPtr->numCols;
+ }
+
+ lastColumn += numSkip;
+
+ for (match=0, slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+
+ if (slavePtr->column == lastColumn
+ && slavePtr->row + slavePtr->numRows - 1 == lastRow) {
+ if (slavePtr->numCols <= width) {
+ slavePtr->numRows++;
+ match++;
+ j += slavePtr->numCols - 1;
+ lastWindow = Tk_PathName(slavePtr->tkwin);
+ numSkip = 0;
+ break;
+ }
+ }
+ }
+ if (!match) {
+ Tcl_AppendResult(interp, "can't find slave to extend with \"^\".",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewPairObj --
+ *
+ * Creates a new list object and fills it with two integer objects.
+ *
+ * Results:
+ * The newly created list object is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewPairObj(interp, val1, val2)
+ Tcl_Interp *interp; /* Current interpreter. */
+ int val1, val2;
+{
+ Tcl_Obj *res = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val2));
+ return res;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewQuadObj --
+ *
+ * Creates a new list object and fills it with four integer objects.
+ *
+ * Results:
+ * The newly created list object is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewQuadObj(interp, val1, val2, val3, val4)
+ Tcl_Interp *interp; /* Current interpreter. */
+ int val1, val2, val3, val4;
+{
+ Tcl_Obj *res = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val2));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val3));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(val4));
+ return res;
+}
diff --git a/tcl/generic/tkImage.c b/tcl/generic/tkImage.c
new file mode 100644
index 00000000000..98e5dcbee53
--- /dev/null
+++ b/tcl/generic/tkImage.c
@@ -0,0 +1,1060 @@
+/*
+ * tkImage.c --
+ *
+ * This module implements the image protocol, which allows lots
+ * of different kinds of images to be used in lots of different
+ * widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+ int deleted; /* Flag set when image is being deleted. */
+ TkWindow *winPtr; /* Main window of interpreter (used to
+ * detect when the world is falling apart.) */
+} ImageMaster;
+
+typedef struct ThreadSpecificData {
+ Tk_ImageType *imageTypeList;/* First in a list of all known image
+ * types. */
+ Tk_ImageType *oldImageTypeList;/* First in a list of all known old-style image
+ * types. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for local procedures:
+ */
+
+static void DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));
+static void EventuallyDeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldImageType, 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_CreateOldImageType(typePtr)
+ Tk_ImageType *typePtr; /* Structure describing the type. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreateImageType previously. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ typePtr->nextPtr = tsdPtr->oldImageTypeList;
+ tsdPtr->oldImageTypeList = typePtr;
+}
+
+void
+Tk_CreateImageType(typePtr)
+ Tk_ImageType *typePtr; /* Structure describing the type. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreateImageType previously. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ typePtr->nextPtr = tsdPtr->imageTypeList;
+ tsdPtr->imageTypeList = typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageObjCmd --
+ *
+ * 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_ImageObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ static CONST char *imageOptions[] = {
+ "create", "delete", "height", "inuse", "names", "type", "types",
+ "width", (char *) NULL
+ };
+ enum options {
+ IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_INUSE, IMAGE_NAMES,
+ IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH
+ };
+ TkWindow *winPtr = (TkWindow *) clientData;
+ int i, new, firstOption, index;
+ Tk_ImageType *typePtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ char idString[16 + TCL_INTEGER_SPACE], *name;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], imageOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case IMAGE_CREATE: {
+ char *arg;
+ Tcl_Obj **args;
+ int oldimage = 0;
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type ?name? ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the image type.
+ */
+
+ arg = Tcl_GetString(objv[2]);
+ for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ if ((*arg == typePtr->name[0])
+ && (strcmp(arg, typePtr->name) == 0)) {
+ break;
+ }
+ }
+ if (typePtr == NULL) {
+ oldimage = 1;
+ for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ if ((*arg == typePtr->name[0])
+ && (strcmp(arg, typePtr->name) == 0)) {
+ break;
+ }
+ }
+ }
+ if (typePtr == NULL) {
+ Tcl_AppendResult(interp, "image type \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Figure out a name to use for the new image.
+ */
+
+ if ((objc == 3) || (*(arg = Tcl_GetString(objv[3])) == '-')) {
+ dispPtr->imageId++;
+ sprintf(idString, "image%d", dispPtr->imageId);
+ name = idString;
+ firstOption = 3;
+ } else {
+ name = arg;
+ 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;
+ masterPtr->deleted = 0;
+ masterPtr->winPtr = winPtr->mainPtr->winPtr;
+ Tcl_Preserve((ClientData) masterPtr->winPtr);
+ 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.
+ */
+
+ objv += firstOption;
+ objc -= firstOption;
+ args = (Tcl_Obj **) objv;
+ if (oldimage) {
+ int i;
+ args = (Tcl_Obj **) ckalloc((objc+1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ args[i] = (Tcl_Obj *) Tcl_GetString(objv[i]);
+ }
+ args[objc] = NULL;
+ }
+ Tcl_Preserve((ClientData) masterPtr);
+ if ((*typePtr->createProc)(interp, name, objc,
+ args, typePtr, (Tk_ImageMaster) masterPtr,
+ &masterPtr->masterData) != TCL_OK) {
+ EventuallyDeleteImage(masterPtr);
+ Tcl_Release((ClientData) masterPtr);
+ if (oldimage) {
+ ckfree((char *) args);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_Release((ClientData) masterPtr);
+ if (oldimage) {
+ ckfree((char *) args);
+ }
+ masterPtr->typePtr = typePtr;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ imagePtr->instanceData = (*typePtr->getProc)(
+ imagePtr->tkwin, masterPtr->masterData);
+ }
+ Tcl_SetResult(interp,
+ Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr),
+ TCL_STATIC);
+ break;
+ }
+ case IMAGE_DELETE: {
+ for (i = 2; i < objc; i++) {
+ char *arg = Tcl_GetString(objv[i]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr));
+ }
+ break;
+ }
+ case IMAGE_HEIGHT: {
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height);
+ break;
+ }
+
+ case IMAGE_INUSE: {
+ int count = 0;
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL && masterPtr->instancePtr != NULL) {
+ count = 1;
+ }
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), count);
+ break;
+ }
+
+ case IMAGE_NAMES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(
+ &winPtr->mainPtr->imageTable, hPtr));
+ }
+ break;
+ }
+
+ case IMAGE_TYPE: {
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL) {
+ Tcl_SetResult(interp, masterPtr->typePtr->name, TCL_STATIC);
+ }
+ break;
+ }
+ case IMAGE_TYPES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ Tcl_AppendElement(interp, typePtr->name);
+ }
+ for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ Tcl_AppendElement(interp, typePtr->name);
+ }
+ break;
+ }
+ case IMAGE_WIDTH: {
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->width);
+ break;
+ }
+ }
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST 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 the interp's result.
+ *
+ * Side effects:
+ * Tk records the fact that the widget is using the image, and
+ * it will invoke changeProc later if the widget needs redisplay
+ * (i.e. its size changes or some of its pixels change). The
+ * caller must eventually invoke Tk_FreeImage when it no longer
+ * needs the image.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ CONST 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_PostscriptImage --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptImage(image, interp, tkwin, psinfo, x, y, width, height, prepass)
+ Tk_Image image; /* Token for image to redisplay. */
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psinfo; /* postscript info */
+ int x, y; /* Upper-left pixel of region in image that
+ * needs to be redisplayed. */
+ int width, height; /* Dimensions of region to redraw. */
+ int prepass;
+{
+ Image *imagePtr = (Image *) image;
+ int result;
+ XImage *ximage;
+ Pixmap pmap;
+ GC newGC;
+ XGCValues gcValues;
+
+ if (imagePtr->masterPtr->typePtr == NULL) {
+ /*
+ * No master for image, so nothing to display on postscript.
+ */
+ return TCL_OK;
+ }
+
+ /*
+ * Check if an image specific postscript-generation function
+ * exists; otherwise go on with generic code.
+ */
+
+ if (imagePtr->masterPtr->typePtr->postscriptProc != NULL) {
+ return (*imagePtr->masterPtr->typePtr->postscriptProc)(
+ imagePtr->masterPtr->masterData, interp, tkwin, psinfo,
+ x, y, width, height, prepass);
+ }
+
+ if (prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * Create a Pixmap, tell the image to redraw itself there, and then
+ * generate an XImage from the Pixmap. We can then read pixel
+ * values out of the XImage.
+ */
+
+ pmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ width, height, Tk_Depth(tkwin));
+
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ newGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ if (newGC != None) {
+ XFillRectangle(Tk_Display(tkwin), pmap, newGC,
+ 0, 0, (unsigned int)width, (unsigned int)height);
+ Tk_FreeGC(Tk_Display(tkwin), newGC);
+ }
+
+ Tk_RedrawImage(image, x, y, width, height, pmap, 0, 0);
+
+ ximage = XGetImage(Tk_Display(tkwin), pmap, 0, 0,
+ (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap);
+
+ Tk_FreePixmap(Tk_Display(tkwin), pmap);
+
+ if (ximage == NULL) {
+ /* The XGetImage() function is apparently not
+ * implemented on this system. Just ignore it.
+ */
+ return TCL_OK;
+ }
+ result = TkPostscriptImage(interp, tkwin, psinfo, ximage, x, y,
+ width, height);
+
+ XDestroyImage(ximage);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ CONST 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) {
+ if ((masterPtr->winPtr->flags & TK_ALREADY_DEAD) == 0) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ }
+ Tcl_Release((ClientData) masterPtr->winPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyDeleteImage --
+ *
+ * Arrange for an image to be deleted when it is safe to do so.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Image will get freed, though not until it is no longer
+ * Tcl_Preserve()d by anything. May be called multiple times on
+ * the same image without ill effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EventuallyDeleteImage(masterPtr)
+ ImageMaster *masterPtr; /* Pointer to main data structure for image. */
+{
+ if (!masterPtr->deleted) {
+ masterPtr->deleted = 1;
+ Tcl_EventuallyFree((ClientData) masterPtr,
+ (Tcl_FreeProc *)DeleteImage);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ EventuallyDeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr));
+ }
+ 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. */
+ CONST 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetTSOrigin --
+ *
+ * Set the pattern origin of the tile to a common point (i.e. the
+ * origin (0,0) of the top level window) so that tiles from two
+ * different widgets will match up. This done by setting the
+ * GCTileStipOrigin field is set to the translated origin of the
+ * toplevel window in the hierarchy.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * The GCTileStipOrigin is reset in the GC. This will cause the
+ * tile origin to change when the GC is used for drawing.
+ *
+ *----------------------------------------------------------------------
+ */
+/*ARGSUSED*/
+void
+Tk_SetTSOrigin(tkwin, gc, x, y)
+ Tk_Window tkwin;
+ GC gc;
+ int x, y;
+{
+ while (!Tk_TopWinHierarchy(tkwin)) {
+ x -= Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+ y -= Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+ tkwin = Tk_Parent(tkwin);
+ }
+ XSetTSOrigin(Tk_Display(tkwin), gc, x, y);
+}
+
diff --git a/tcl/generic/tkImgBmap.c b/tcl/generic/tkImgBmap.c
new file mode 100644
index 00000000000..9eaa8db6b5f
--- /dev/null
+++ b/tcl/generic/tkImgBmap.c
@@ -0,0 +1,1297 @@
+/*
+ * 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.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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));
+static int ImgBmapPostscript _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psinfo, int x, int y,
+ int width, int height, int prepass));
+
+Tk_ImageType tkBitmapImageType = {
+ "bitmap", /* name */
+ ImgBmapCreate, /* createProc */
+ ImgBmapGet, /* getProc */
+ ImgBmapDisplay, /* displayProc */
+ ImgBmapFree, /* freeProc */
+ ImgBmapDelete, /* deleteProc */
+ ImgBmapPostscript, /* postscriptProc */
+ (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, Tcl_Obj *CONST objv[]));
+static void ImgBmapCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ImgBmapConfigureInstance _ANSI_ARGS_((
+ BitmapInstance *instancePtr));
+static int ImgBmapConfigureMaster _ANSI_ARGS_((
+ BitmapMaster *masterPtr, int argc, Tcl_Obj *CONST objv[],
+ 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, argv, 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 argv[]; /* 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;
+
+ masterPtr = (BitmapMaster *) ckalloc(sizeof(BitmapMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateObjCommand(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;
+ if (ImgBmapConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgBmapDelete((ClientData) masterPtr);
+ return TCL_ERROR;
+ }
+ *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 the masterPtr->interp's result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match
+ * the new configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapConfigureMaster(masterPtr, objc, objv, flags)
+ BitmapMaster *masterPtr; /* Pointer to data structure describing
+ * overall bitmap image to (reconfigure). */
+ int objc; /* Number of entries in objv. */
+ Tcl_Obj *CONST objv[]; /* 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;
+
+ CONST char **argv = (CONST char **) ckalloc((objc+1) * sizeof(char *));
+ for (dummy1 = 0; dummy1 < objc; dummy1++) {
+ argv[dummy1]=Tcl_GetString(objv[dummy1]);
+ }
+ argv[objc] = NULL;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
+ configSpecs, objc, argv, (char *) masterPtr, flags)
+ != TCL_OK) {
+ ckfree((char *) argv);
+ return TCL_ERROR;
+ }
+ ckfree((char *) argv);
+
+ /*
+ * 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) {
+ Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ masterPtr->maskData = TkGetBitmapData(masterPtr->interp,
+ masterPtr->maskDataString, masterPtr->maskFileString,
+ &maskWidth, &maskHeight, &dummy1, &dummy2);
+ if (masterPtr->maskData == NULL) {
+ return TCL_ERROR;
+ }
+ if ((maskWidth != masterPtr->width)
+ || (maskHeight != masterPtr->height)) {
+ ckfree(masterPtr->maskData);
+ masterPtr->maskData = NULL;
+ Tcl_SetResult(masterPtr->interp,
+ "bitmap and mask have different sizes", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * 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;
+ Pixmap oldMask;
+
+ /*
+ * 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);
+ }
+
+ /*
+ * Careful: We have to allocate a new mask Pixmap before deleting
+ * the old one. Otherwise, The XID allocator will always return
+ * the same XID for the new Pixmap as was used for the old Pixmap.
+ * And that will prevent the mask from changing in the GC below.
+ */
+ oldMask = instancePtr->mask;
+ instancePtr->mask = None;
+ if (masterPtr->maskData != NULL) {
+ instancePtr->mask = XCreateBitmapFromData(
+ Tk_Display(instancePtr->tkwin),
+ RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
+ masterPtr->maskData, (unsigned) masterPtr->width,
+ (unsigned) masterPtr->height);
+ }
+ if (oldMask != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldMask);
+ }
+
+ if (masterPtr->data != NULL) {
+ gcValues.foreground = instancePtr->fg->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground|GCGraphicsExposures;
+ if (instancePtr->bg != NULL) {
+ gcValues.background = instancePtr->bg->pixel;
+ mask |= GCBackground;
+ if (instancePtr->mask != None) {
+ gcValues.clip_mask = instancePtr->mask;
+ mask |= GCClipMask;
+ }
+ } else {
+ gcValues.clip_mask = instancePtr->bitmap;
+ mask |= GCClipMask;
+ }
+ gc = Tk_GetGC(instancePtr->tkwin, mask, &gcValues);
+ } 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 the interp's result.
+ *
+ * Side effects:
+ * A bitmap is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr,
+ hotXPtr, hotYPtr)
+ Tcl_Interp *interp; /* For reporting errors, or NULL. */
+ char *string; /* String describing bitmap. May
+ * be NULL. */
+ char *fileName; /* Name of file containing bitmap
+ * description. Used only if string
+ * is NULL. Must not be NULL if
+ * string is NULL. */
+ int *widthPtr, *heightPtr; /* Dimensions of bitmap get returned
+ * here. */
+ int *hotXPtr, *hotYPtr; /* Position of hot spot or -1,-1. */
+{
+ int width, height, numBytes, hotX, hotY;
+ CONST char *expandedFileName;
+ char *p, *end;
+ 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;
+ }
+
+ if (Tcl_SetChannelOption(interp, pi.chan, "-translation", "binary")
+ != TCL_OK) {
+ return NULL;
+ }
+ if (Tcl_SetChannelOption(interp, pi.chan, "-encoding", "binary")
+ != TCL_OK) {
+ 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) {
+ Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC);
+ }
+
+ errorCleanup:
+ if (data != NULL) {
+ ckfree(data);
+ }
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ 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, objc, objv)
+ ClientData clientData; /* Information about the image master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *bmapOptions[] = {"cget", "configure", (char *) NULL};
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+ int code, index;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], bmapOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case 0: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, Tcl_GetString(objv[2]), 0);
+ }
+ case 1: {
+ if (objc == 2) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ } else if (objc == 3) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr,
+ Tcl_GetString(objv[2]), 0);
+ } else {
+ code = ImgBmapConfigureMaster(masterPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return code;
+ }
+ default: {
+ panic("bad const entries to bmapOptions in ImgBmapCmd");
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapPsImagemask --
+ *
+ * This procedure generates postscript suitable for rendering a
+ * single bitmap of an image. A single bitmap image might contain both
+ * a foreground and a background bitmap. This routine is called once
+ * for each such bitmap in a bitmap image.
+ *
+ * Prior to invoking this routine, the following setup has occurred:
+ *
+ * 1. The postscript foreground color has been set to the color
+ * used to render the bitmap.
+ *
+ * 2. The origin of the postscript coordinate system is set to
+ * the lower left corner of the bitmap.
+ *
+ * 3. The postscript coordinate system has been scaled so that
+ * the entire bitmap is one unit squared.
+ *
+ * Some postscript implementations cannot handle bitmap strings
+ * longer than about 60k characters. If the bitmap data is that big
+ * or bigger, then we render it by splitting it into several smaller
+ * bitmaps.
+ *
+ * Results:
+ * Returns TCL_OK on success. Returns TCL_ERROR and leaves and error
+ * message in interp->result if there is a problem.
+ *
+ * Side effects:
+ * Postscript code is appended to interp->result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapPsImagemask(interp, width, height, data)
+ Tcl_Interp *interp; /* Append postscript to this interpreter */
+ int width, height; /* Width and height of the bitmap in pixels */
+ char *data; /* Data for the bitmap */
+{
+ int i, j, nBytePerRow;
+ char buffer[200];
+
+ /*
+ * The bit order of bitmaps in Tk is the opposite of the bit order that
+ * postscript uses. (In Tk, the least significant bit is on the right
+ * side of the bitmap and in postscript the least significant bit is shown
+ * on the left.) The following array is used to reverse the order of bits
+ * within a byte so that the bits will be in the order postscript expects.
+ */
+ static unsigned char bit_reverse[] = {
+ 0, 128, 64, 192, 32, 160, 96, 224, 16, 144, 80, 208, 48, 176, 112, 240,
+ 8, 136, 72, 200, 40, 168, 104, 232, 24, 152, 88, 216, 56, 184, 120, 248,
+ 4, 132, 68, 196, 36, 164, 100, 228, 20, 148, 84, 212, 52, 180, 116, 244,
+ 12, 140, 76, 204, 44, 172, 108, 236, 28, 156, 92, 220, 60, 188, 124, 252,
+ 2, 130, 66, 194, 34, 162, 98, 226, 18, 146, 82, 210, 50, 178, 114, 242,
+ 10, 138, 74, 202, 42, 170, 106, 234, 26, 154, 90, 218, 58, 186, 122, 250,
+ 6, 134, 70, 198, 38, 166, 102, 230, 22, 150, 86, 214, 54, 182, 118, 246,
+ 14, 142, 78, 206, 46, 174, 110, 238, 30, 158, 94, 222, 62, 190, 126, 254,
+ 1, 129, 65, 193, 33, 161, 97, 225, 17, 145, 81, 209, 49, 177, 113, 241,
+ 9, 137, 73, 201, 41, 169, 105, 233, 25, 153, 89, 217, 57, 185, 121, 249,
+ 5, 133, 69, 197, 37, 165, 101, 229, 21, 149, 85, 213, 53, 181, 117, 245,
+ 13, 141, 77, 205, 45, 173, 109, 237, 29, 157, 93, 221, 61, 189, 125, 253,
+ 3, 131, 67, 195, 35, 163, 99, 227, 19, 147, 83, 211, 51, 179, 115, 243,
+ 11, 139, 75, 203, 43, 171, 107, 235, 27, 155, 91, 219, 59, 187, 123, 251,
+ 7, 135, 71, 199, 39, 167, 103, 231, 23, 151, 87, 215, 55, 183, 119, 247,
+ 15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255,
+ };
+
+ if (width*height > 60000) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "unable to generate postscript for bitmaps "
+ "larger than 60000 pixels", 0);
+ return TCL_ERROR;
+ }
+ sprintf(buffer, "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n",
+ width, height, width, -height, height);
+ Tcl_AppendResult(interp, buffer, 0);
+ nBytePerRow = (width+7)/8;
+ for(i=0; i<height; i++){
+ for(j=0; j<nBytePerRow; j++){
+ sprintf(buffer, " %02x", bit_reverse[0xff & data[i*nBytePerRow + j]]);
+ Tcl_AppendResult(interp, buffer, 0);
+ }
+ Tcl_AppendResult(interp, "\n", 0);
+ }
+ Tcl_AppendResult(interp, ">} imagemask \n", 0);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapPostscript --
+ *
+ * This procedure generates postscript for rendering a bitmap image.
+ *
+ * Results:
+ * On success, this routine writes postscript code into interp->result
+ * and returns TCL_OK TCL_ERROR is returned and an error
+ * message is left in interp->result if anything goes wrong.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapPostscript(clientData, interp, tkwin, psinfo, x, y, width, height,
+ prepass)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psinfo;
+ int x, y, width, height, prepass;
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+ char buffer[200];
+
+ if (prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * There is nothing to do for bitmaps with zero width or height
+ */
+ if( width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<=0 ){
+ return TCL_OK;
+ }
+
+ /*
+ * Translate the origin of the coordinate system to be the lower-left
+ * corner of the bitmap and adjust the scale of the coordinate system
+ * so that entire bitmap covers one square unit of the page.
+ * The calling function put a "gsave" into the postscript and
+ * will add a "grestore" at after this routine returns, so it is safe
+ * to make whatever changes are necessary here.
+ */
+ if( x!=0 || y!=0 ){
+ sprintf(buffer, "%d %d moveto\n", x, y);
+ Tcl_AppendResult(interp, buffer, 0);
+ }
+ if( width!=1 || height!=1 ){
+ sprintf(buffer, "%d %d scale\n", width, height);
+ Tcl_AppendResult(interp, buffer, 0);
+ }
+
+ /*
+ * Color the background, if there is one. This step is skipped if the
+ * background is transparent. If the background is not transparent and
+ * there is no background mask, then color the complete rectangle that
+ * encloses the bitmap. If there is a background mask, then only apply
+ * color to the bits specified by the mask.
+ */
+ if ((masterPtr->bgUid != NULL) && (masterPtr->bgUid[0] != '\000')) {
+ XColor color;
+ XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid,
+ &color);
+ if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (masterPtr->maskData == NULL) {
+ Tcl_AppendResult(interp,
+ "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto "
+ "closepath fill\n", 0
+ );
+ } else if (ImgBmapPsImagemask(interp, masterPtr->width,
+ masterPtr->height, masterPtr->maskData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Draw the bitmap foreground, assuming there is one.
+ */
+ if ( (masterPtr->fgUid != NULL) && (masterPtr->data != NULL) ) {
+ XColor color;
+ XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->fgUid,
+ &color);
+ if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (ImgBmapPsImagemask(interp, masterPtr->width, masterPtr->height,
+ masterPtr->data) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkImgGIF.c b/tcl/generic/tkImgGIF.c
new file mode 100644
index 00000000000..632f900165f
--- /dev/null
+++ b/tcl/generic/tkImgGIF.c
@@ -0,0 +1,2121 @@
+/*
+ * tkImgGIF.c --
+ *
+ * A photo image file handler for GIF files. Reads 87a and 89a GIF
+ * files. At present, there only is a file 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"
+
+/*
+ * Non-ASCII encoding support:
+ * Most data in a GIF image is binary and is treated as such. However,
+ * a few key bits are stashed in ASCII. If we try to compare those pieces
+ * to the char they represent, it will fail on any non-ASCII (eg, EBCDIC)
+ * system. To accomodate these systems, we test against the numeric value
+ * of the ASCII characters instead of the characters themselves. This is
+ * encoding independant.
+ */
+
+static CONST char GIF87a[] = { /* ASCII GIF87a */
+ 0x47, 0x49, 0x46, 0x38, 0x37, 0x61, 0x00
+};
+static CONST char GIF89a[] = { /* ASCII GIF89a */
+ 0x47, 0x49, 0x46, 0x38, 0x39, 0x61, 0x00
+};
+# define GIF_TERMINATOR 0x3b /* ASCII ; */
+# define GIF_EXTENSION 0x21 /* ASCII ! */
+# define GIF_START 0x2c /* ASCII , */
+
+/*
+ * 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
+ */
+
+typedef struct ThreadSpecificData {
+ int fromData;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The format record for the GIF file format:
+ */
+
+static int FileMatchGIF _ANSI_ARGS_((Tcl_Channel chan, CONST char *fileName,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp));
+static int FileReadGIF _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, CONST char *fileName, Tcl_Obj *format,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY));
+static int StringMatchGIF _ANSI_ARGS_(( Tcl_Obj *dataObj,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp));
+static int StringReadGIF _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *dataObj,
+ Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY));
+static int FileWriteGIF _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *filename, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr));
+static int CommonWriteGIF _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel handle, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr));
+
+Tk_PhotoImageFormat tkImgFmtGIF = {
+ "gif", /* name */
+ FileMatchGIF, /* fileMatchProc */
+ StringMatchGIF, /* stringMatchProc */
+ FileReadGIF, /* fileReadProc */
+ StringReadGIF, /* stringReadProc */
+ FileWriteGIF, /* 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)
+
+/*
+ * 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 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, format, widthPtr, heightPtr, interp)
+ Tcl_Channel chan; /* The image file, open for reading. */
+ CONST char *fileName; /* The name of the image file. */
+ Tcl_Obj *format; /* User-specified format object, or NULL. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here if the file is a valid
+ * raw GIF file. */
+ Tcl_Interp *interp; /* not used */
+{
+ 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 the interp's result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is
+ * added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadGIF(interp, chan, fileName, format, 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. */
+ CONST char *fileName; /* The name of the image file. */
+ Tcl_Obj *format; /* User-specified format object, 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, index = 0, argc = 0, i;
+ Tcl_Obj **objv;
+ Tk_PhotoImageBlock block;
+ unsigned char buf[100];
+ unsigned char *trashBuffer = NULL;
+ int bitPixel;
+ unsigned char colorMap[MAXCOLORMAPSIZE][4];
+ int transparent = -1;
+ static CONST char *optionStrings[] = {
+ "-index", NULL
+ };
+
+ if (format && Tcl_ListObjGetElements(interp, format,
+ &argc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (i = 1; i < argc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option name", 0,
+ &nBytes) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i == (argc-1)) {
+ Tcl_AppendResult(interp, "no value given for \"",
+ Tcl_GetStringFromObj(objv[i], NULL),
+ "\" option", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ 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;
+ block.offset[3] = 3;
+ block.pixelPtr = NULL;
+
+ 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) {
+ /*
+ * GIF terminator.
+ */
+
+ Tcl_AppendResult(interp,"no image data for this index",
+ (char *) NULL);
+ goto error;
+ }
+
+ if (buf[0] == GIF_EXTENSION) {
+ /*
+ * This is a GIF extension.
+ */
+
+ if (Fread(buf, 1, 1, chan) != 1) {
+ Tcl_SetResult(interp,
+ "error reading extension function code in GIF image",
+ TCL_STATIC);
+ goto error;
+ }
+ if (DoExtension(chan, buf[0], &transparent) < 0) {
+ Tcl_SetResult(interp, "error reading extension in GIF image",
+ TCL_STATIC);
+ goto error;
+ }
+ continue;
+ }
+
+ if (buf[0] != GIF_START) {
+ /*
+ * Not a valid start character; ignore it.
+ */
+ continue;
+ }
+
+ if (Fread(buf, 1, 9, chan) != 9) {
+ Tcl_SetResult(interp,
+ "couldn't read left/top/width/height in GIF image",
+ TCL_STATIC);
+ goto error;
+ }
+
+ fileWidth = LM_to_uint(buf[4],buf[5]);
+ fileHeight = LM_to_uint(buf[6],buf[7]);
+
+ bitPixel = 1<<((buf[8]&0x07)+1);
+
+ if (index--) {
+ /*
+ * This is not the image we want to read: skip it.
+ */
+ if (BitSet(buf[8], LOCALCOLORMAP)) {
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp,
+ "error reading color map", (char *) NULL);
+ goto error;
+ }
+ }
+
+ /*
+ * If we've not yet allocated a trash buffer, do so now.
+ */
+ if (trashBuffer == NULL) {
+ nBytes = fileWidth * fileHeight * 3;
+ trashBuffer =
+ (unsigned char *) ckalloc((unsigned int) nBytes);
+ }
+
+ /*
+ * Slurp! Process the data for this image and stuff it in
+ * a trash buffer.
+ *
+ * Yes, it might be more efficient here to *not* store the
+ * data (we're just going to throw it away later).
+ * However, I elected to implement it this way for good
+ * reasons. First, I wanted to avoid duplicating the
+ * (fairly complex) LWZ decoder in ReadImage. Fine, you
+ * say, why didn't you just modify it to allow the use of
+ * a NULL specifier for the output buffer? I tried that,
+ * but it negatively impacted the performance of what I
+ * think will be the common case: reading the first image
+ * in the file. Rather than marginally improve the speed
+ * of the less frequent case, I chose to maintain high
+ * performance for the common case.
+ */
+ if (ReadImage(interp, (char *) trashBuffer, chan, fileWidth,
+ fileHeight, colorMap, 0, 0, 0, 0, 0, -1) != TCL_OK) {
+ goto error;
+ }
+ continue;
+ }
+
+ /*
+ * If a trash buffer has been allocated, free it now.
+ */
+ if (trashBuffer != NULL) {
+ ckfree((char *)trashBuffer);
+ trashBuffer = NULL;
+ }
+ if (BitSet(buf[8], LOCALCOLORMAP)) {
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp, "error reading color map",
+ (char *) NULL);
+ goto error;
+ }
+ }
+
+ index = LM_to_uint(buf[0],buf[1]);
+ srcX -= index;
+ if (srcX<0) {
+ destX -= srcX; width += srcX;
+ srcX = 0;
+ }
+
+ if (width > fileWidth) {
+ width = fileWidth;
+ }
+
+ index = LM_to_uint(buf[2],buf[3]);
+ srcY -= index;
+ if (index > srcY) {
+ destY -= srcY; height += srcY;
+ srcY = 0;
+ }
+ if (height > fileHeight) {
+ height = fileHeight;
+ }
+
+ if ((width <= 0) || (height <= 0)) {
+ block.pixelPtr = 0;
+ goto noerror;
+ }
+
+ block.width = width;
+ block.height = height;
+ block.pixelSize = (transparent>=0) ? 4 : 3;
+ block.offset[3] = (transparent>=0) ? 3 : 0;
+ block.pitch = block.pixelSize * fileWidth;
+ nBytes = block.pitch * fileHeight;
+ block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+
+ if (ReadImage(interp, (char *) block.pixelPtr, chan, fileWidth,
+ fileHeight, colorMap, fileWidth, fileHeight, srcX, srcY,
+ BitSet(buf[8], INTERLACE), transparent) != TCL_OK) {
+ goto error;
+ }
+ break;
+ }
+
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height,
+ TK_PHOTO_COMPOSITE_SET);
+
+ noerror:
+ if (block.pixelPtr) {
+ ckfree((char *) block.pixelPtr);
+ }
+ Tcl_AppendResult(interp, tkImgFmtGIF.name, (char *) NULL);
+ return TCL_OK;
+
+ error:
+ if (block.pixelPtr) {
+ 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, format, widthPtr, heightPtr, interp)
+ Tcl_Obj *dataObj; /* the object containing the image data */
+ Tcl_Obj *format; /* the image format object, or NULL */
+ int *widthPtr; /* where to put the string width */
+ int *heightPtr; /* where to put the string height */
+ Tcl_Interp *interp; /* not used */
+{
+ unsigned char *data, header[10];
+ int got, length;
+ MFile handle;
+
+ data = Tcl_GetByteArrayFromObj(dataObj, &length);
+
+ /*
+ * Header is a minimum of 10 bytes.
+ */
+ if (length < 10) {
+ return 0;
+ }
+
+ /*
+ * Check whether the data is Base64 encoded.
+ */
+
+ if ((strncmp(GIF87a, (char *) data, 6) != 0) &&
+ (strncmp(GIF89a, (char *) 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 the interp's result.
+ *
+ * Side effects:
+ * new data is added to the image given by imageHandle. This
+ * procedure calls FileReadGif by redefining the operation of
+ * fprintf temporarily.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringReadGIF(interp, dataObj, format, imageHandle,
+ destX, destY, width, height, srcX, srcY)
+ Tcl_Interp *interp; /* interpreter for reporting errors in */
+ Tcl_Obj *dataObj; /* object containing the image */
+ Tcl_Obj *format; /* format object, or NULL */
+ Tk_PhotoHandle imageHandle; /* the image to write this data into */
+ int destX, destY; /* The rectangular region of the */
+ int width, height; /* image to copy */
+ int srcX, srcY;
+{
+ int result;
+ MFile handle;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_Channel dataSrc;
+ char *data;
+
+ /*
+ * Check whether the data is Base64 encoded
+ */
+ data = (char *) Tcl_GetByteArrayFromObj(dataObj, NULL);
+ if ((strncmp(GIF87a, data, 6) != 0) && (strncmp(GIF89a, data, 6) != 0)) {
+ mInit((unsigned char *)data, &handle);
+ tsdPtr->fromData = 1;
+ dataSrc = (Tcl_Channel) &handle;
+ } else {
+ tsdPtr->fromData = 2;
+ mInit((unsigned char *)data, &handle);
+ dataSrc = (Tcl_Channel) &handle;
+ }
+ result = FileReadGIF(interp, dataSrc, "inline data",
+ format, imageHandle, destX, destY, width, height, srcX, srcY);
+ tsdPtr->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;
+ }
+
+ if (buffer) {
+ 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;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadImage --
+ *
+ * Process a GIF image from a given source, with a given height,
+ * width, transparency, etc.
+ *
+ * This code is based on the code found in the ImageMagick GIF decoder,
+ * which is (c) 2000 ImageMagick Studio.
+ *
+ * Some thoughts on our implementation:
+ * It sure would be nice if ReadImage didn't take 11 parameters! I think
+ * that if we were smarter, we could avoid doing that.
+ *
+ * Possible further optimizations: we could pull the GetCode function
+ * directly into ReadImage, which would improve our speed.
+ *
+ * Results:
+ * Processes a GIF image and loads the pixel data into a memory array.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 initialCodeSize;
+ int v;
+ int xpos = 0, ypos = 0, pass = 0, i;
+ register char *pixelPtr;
+ CONST static int interlaceStep[] = { 8, 8, 4, 2 };
+ CONST static int interlaceStart[] = { 0, 4, 2, 1 };
+ unsigned short prefix[(1 << MAX_LWZ_BITS)];
+ unsigned char append[(1 << MAX_LWZ_BITS)];
+ unsigned char stack[(1 << MAX_LWZ_BITS)*2];
+ register unsigned char *top;
+ int codeSize, clearCode, inCode, endCode, oldCode, maxCode;
+ int code, firstCode;
+
+ /*
+ * Initialize the decoder
+ */
+ if (! ReadOK(chan, &initialCodeSize, 1)) {
+ Tcl_AppendResult(interp, "error reading GIF image: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ 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;
+
+ /*
+ * Initialize the decoder.
+ *
+ * Set values for "special" numbers:
+ * clear code reset the decoder
+ * end code stop decoding
+ * code size size of the next code to retrieve
+ * max code next available table position
+ */
+ clearCode = 1 << (int) initialCodeSize;
+ endCode = clearCode + 1;
+ codeSize = (int) initialCodeSize + 1;
+ maxCode = clearCode + 2;
+ oldCode = -1;
+ firstCode = -1;
+
+ memset((void *)prefix, 0, (1 << MAX_LWZ_BITS) * sizeof(short));
+ memset((void *)append, 0, (1 << MAX_LWZ_BITS) * sizeof(char));
+ for (i = 0; i < clearCode; i++) {
+ append[i] = i;
+ }
+ top = stack;
+
+ GetCode(chan, 0, 1);
+
+ /*
+ * Read until we finish the image
+ */
+ for (i = 0, ypos = 0; i < rows; i++) {
+ for (xpos = 0; xpos < len; ) {
+
+ if (top == stack) {
+ /*
+ * Bummer -- our stack is empty. Now we have to work!
+ */
+ code = GetCode(chan, codeSize, 0);
+ if (code < 0) {
+ return TCL_OK;
+ }
+
+ if (code > maxCode || code == endCode) {
+ /*
+ * If we're doing things right, we should never
+ * receive a code that is greater than our current
+ * maximum code. If we do, bail, because our decoder
+ * does not yet have that code set up.
+ *
+ * If the code is the magic endCode value, quit.
+ */
+ return TCL_OK;
+ }
+
+ if (code == clearCode) {
+ /*
+ * Reset the decoder.
+ */
+ codeSize = initialCodeSize + 1;
+ maxCode = clearCode + 2;
+ oldCode = -1;
+ continue;
+ }
+
+ if (oldCode == -1) {
+ /*
+ * Last pass reset the decoder, so the first code we
+ * see must be a singleton. Seed the stack with it,
+ * and set up the old/first code pointers for
+ * insertion into the string table. We can't just
+ * roll this into the clearCode test above, because
+ * at that point we have not yet read the next code.
+ */
+ *top++ = append[code];
+ oldCode = code;
+ firstCode = code;
+ continue;
+ }
+
+ inCode = code;
+
+ if (code == maxCode) {
+ /*
+ * maxCode is always one bigger than our highest assigned
+ * code. If the code we see is equal to maxCode, then
+ * we are about to add a new string to the table. ???
+ */
+ *top++ = firstCode;
+ code = oldCode;
+ }
+
+ while (code > clearCode) {
+ /*
+ * Populate the stack by tracing the string in the
+ * string table from its tail to its head
+ */
+ *top++ = append[code];
+ code = prefix[code];
+ }
+ firstCode = append[code];
+
+ /*
+ * If there's no more room in our string table, quit.
+ * Otherwise, add a new string to the table
+ */
+ if (maxCode >= (1 << MAX_LWZ_BITS)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Push the head of the string onto the stack.
+ */
+ *top++ = firstCode;
+
+ /*
+ * Add a new string to the string table
+ */
+ prefix[maxCode] = oldCode;
+ append[maxCode] = firstCode;
+ maxCode++;
+
+ /*
+ * maxCode tells us the maximum code value we can accept.
+ * If we see that we need more bits to represent it than
+ * we are requesting from the unpacker, we need to increase
+ * the number we ask for.
+ */
+ if ((maxCode >= (1 << codeSize))
+ && (maxCode < (1<<MAX_LWZ_BITS))) {
+ codeSize++;
+ }
+ oldCode = inCode;
+ }
+
+ /*
+ * Pop the next color index off the stack.
+ */
+ v = *(--top);
+ if (v < 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * If pixelPtr is null, we're skipping this image (presumably
+ * there are more in the file and we will be called to read
+ * one of them later)
+ */
+ *pixelPtr++ = cmap[v][CM_RED];
+ *pixelPtr++ = cmap[v][CM_GREEN];
+ *pixelPtr++ = cmap[v][CM_BLUE];
+ if (transparent >= 0) {
+ *pixelPtr++ = cmap[v][CM_ALPHA];
+ }
+ xpos++;
+
+ }
+
+ /*
+ * If interlacing, the next ypos is not just +1
+ */
+ if (interlace) {
+ ypos += interlaceStep[pass];
+ while (ypos >= height) {
+ pass++;
+ if (pass > 3) {
+ return TCL_OK;
+ }
+ ypos = interlaceStart[pass];
+ }
+ } else {
+ ypos++;
+ }
+ pixelPtr = imagePtr + (ypos) * len * ((transparent>=0)?4:3);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCode --
+ *
+ * Extract the next compression code from the file. In GIF's, the
+ * compression codes are between 3 and 12 bits long and are then
+ * packed into 8 bit bytes, left to right, for example:
+ * bbbaaaaa
+ * dcccccbb
+ * eeeedddd
+ * ...
+ * We use a byte buffer read from the file and a sliding window
+ * to unpack the bytes. Thanks to ImageMagick for the sliding window
+ * idea.
+ * args: chan the channel to read from
+ * code_size size of the code to extract
+ * flag boolean indicating whether the extractor
+ * should be reset or not
+ *
+ * Results:
+ * code the next compression code
+ *
+ * Side effects:
+ * May consume more input from chan.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetCode(chan, code_size, flag)
+ Tcl_Channel chan;
+ int code_size;
+ int flag;
+{
+ static unsigned char buf[280];
+ static int bytes = 0, done;
+ static unsigned char *c;
+
+ static unsigned int window;
+ static int bitsInWindow = 0;
+ int ret;
+
+ if (flag) {
+ /*
+ * Initialize the decoder.
+ */
+ bitsInWindow = 0;
+ bytes = 0;
+ window = 0;
+ done = 0;
+ c = NULL;
+ return 0;
+ }
+
+ while (bitsInWindow < code_size) {
+ /*
+ * Not enough bits in our window to cover the request.
+ */
+ if (done) {
+ return -1;
+ }
+ if (bytes == 0) {
+ /*
+ * Not enough bytes in our buffer to add to the window.
+ */
+ bytes = GetDataBlock(chan, buf);
+ c = buf;
+ if (bytes <= 0) {
+ done = 1;
+ break;
+ }
+ }
+ /*
+ * Tack another byte onto the window, see if that's enough.
+ */
+ window += (*c) << bitsInWindow;
+ c++;
+ bitsInWindow += 8;
+ bytes--;
+ }
+
+
+ /*
+ * The next code will always be the last code_size bits of the window.
+ */
+ ret = window & ((1 << code_size) - 1);
+
+ /*
+ * Shift data in the window to put the next code at the end.
+ */
+ window >>= code_size;
+ bitsInWindow -= 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->c;
+ }
+
+ 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;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ MFile *handle;
+
+ switch (tsdPtr->fromData) {
+ case 1:
+ return Mread(dst, hunk, count, (MFile *) chan);
+ case 2:
+ handle = (MFile *) chan;
+ memcpy((VOID *)dst, (VOID *) handle->data, (size_t) (hunk * count));
+ handle->data += hunk * count;
+ return (int)(hunk * count);
+ default:
+ return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
+ }
+}
+
+
+/*
+ * ChanWriteGIF - writes a image in GIF format.
+ *-------------------------------------------------------------------------
+ * Author: Lolo
+ * Engeneering Projects Area
+ * Department of Mining
+ * University of Oviedo
+ * e-mail zz11425958@zeus.etsimo.uniovi.es
+ * lolo@pcsig22.etsimo.uniovi.es
+ * Date: Fri September 20 1996
+ *
+ * Modified for transparency handling (gif89a) and miGIF compression
+ * by Jan Nijtmans <j.nijtmans@chello.nl>
+ *
+ *----------------------------------------------------------------------
+ * FileWriteGIF-
+ *
+ * This procedure is called by the photo image type to write
+ * GIF format data from a photo image into a given file
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in interp->result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /*
+ * Types, defines and variables needed to write and compress a GIF.
+ */
+
+typedef int (* ifunptr) _ANSI_ARGS_((void));
+
+#define LSB(a) ((unsigned char) (((short)(a)) & 0x00FF))
+#define MSB(a) ((unsigned char) (((short)(a)) >> 8))
+
+#define GIFBITS 12
+#define HSIZE 5003 /* 80% occupancy */
+
+static int ssize;
+static int csize;
+static int rsize;
+static unsigned char *pixelo;
+static int pixelSize;
+static int pixelPitch;
+static int greenOffset;
+static int blueOffset;
+static int alphaOffset;
+static int num;
+static unsigned char mapa[MAXCOLORMAPSIZE][3];
+
+/*
+ * Definition of new functions to write GIFs
+ */
+
+static int color _ANSI_ARGS_((int red,int green, int blue,
+ unsigned char mapa[MAXCOLORMAPSIZE][3]));
+static void compress _ANSI_ARGS_((int init_bits, Tcl_Channel handle,
+ ifunptr readValue));
+static int nuevo _ANSI_ARGS_((int red, int green ,int blue,
+ unsigned char mapa[MAXCOLORMAPSIZE][3]));
+static void savemap _ANSI_ARGS_((Tk_PhotoImageBlock *blockPtr,
+ unsigned char mapa[MAXCOLORMAPSIZE][3]));
+static int ReadValue _ANSI_ARGS_((void));
+
+static int
+FileWriteGIF(interp, filename, format, blockPtr)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ CONST char *filename;
+ Tcl_Obj *format;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ Tcl_Channel chan = NULL;
+ int result;
+
+ chan = Tcl_OpenFileChannel(interp, (char *) filename, "w", 0644);
+ if (!chan) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ result = CommonWriteGIF(interp, chan, format, blockPtr);
+ if (Tcl_Close(interp, chan) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ return result;
+}
+
+#define Mputc(c,handle) Tcl_Write(handle,(char *) &c,1)
+
+static int
+CommonWriteGIF(interp, handle, format, blockPtr)
+ Tcl_Interp *interp;
+ Tcl_Channel handle;
+ Tcl_Obj *format;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ int resolution;
+
+ long width,height,x;
+ unsigned char c;
+ unsigned int top,left;
+
+ top = 0;
+ left = 0;
+
+ pixelSize = blockPtr->pixelSize;
+ greenOffset = blockPtr->offset[1]-blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2]-blockPtr->offset[0];
+ alphaOffset = blockPtr->offset[0];
+ if (alphaOffset < blockPtr->offset[2]) {
+ alphaOffset = blockPtr->offset[2];
+ }
+ if (++alphaOffset < pixelSize) {
+ alphaOffset -= blockPtr->offset[0];
+ } else {
+ alphaOffset = 0;
+ }
+
+ Tcl_Write(handle, (char *) (alphaOffset ? GIF89a : GIF87a), 6);
+
+ for (x=0 ; x<MAXCOLORMAPSIZE ; x++) {
+ mapa[x][CM_RED] = 255;
+ mapa[x][CM_GREEN] = 255;
+ mapa[x][CM_BLUE] = 255;
+ }
+
+
+ width = blockPtr->width;
+ height = blockPtr->height;
+ pixelo = blockPtr->pixelPtr + blockPtr->offset[0];
+ pixelPitch = blockPtr->pitch;
+ savemap(blockPtr,mapa);
+ if (num >= MAXCOLORMAPSIZE) {
+ Tcl_AppendResult(interp, "too many colors", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (num<2) {
+ num = 2;
+ }
+ c = LSB(width);
+ Mputc(c,handle);
+ c = MSB(width);
+ Mputc(c,handle);
+ c = LSB(height);
+ Mputc(c,handle);
+ c = MSB(height);
+ Mputc(c,handle);
+
+ resolution = 0;
+ while (num >> resolution) {
+ resolution++;
+ }
+ c = 111 + resolution * 17;
+ Mputc(c,handle);
+
+ num = 1 << resolution;
+
+ /*
+ * background color
+ */
+
+ c = 0;
+ Mputc(c,handle);
+
+ /*
+ * zero for future expansion.
+ */
+
+ Mputc(c,handle);
+
+ for (x=0 ; x<num ; x++) {
+ c = mapa[x][CM_RED];
+ Mputc(c,handle);
+ c = mapa[x][CM_GREEN];
+ Mputc(c,handle);
+ c = mapa[x][CM_BLUE];
+ Mputc(c,handle);
+ }
+
+ /*
+ * Write out extension for transparent colour index, if necessary.
+ */
+
+ if (alphaOffset) {
+ c = GIF_EXTENSION;
+ Mputc(c, handle);
+ Tcl_Write(handle, "\371\4\1\0\0\0", 7);
+ }
+
+ c = GIF_START;
+ Mputc(c,handle);
+ c = LSB(top);
+ Mputc(c,handle);
+ c = MSB(top);
+ Mputc(c,handle);
+ c = LSB(left);
+ Mputc(c,handle);
+ c = MSB(left);
+ Mputc(c,handle);
+
+ c = LSB(width);
+ Mputc(c,handle);
+ c = MSB(width);
+ Mputc(c,handle);
+
+ c = LSB(height);
+ Mputc(c,handle);
+ c = MSB(height);
+ Mputc(c,handle);
+
+ c = 0;
+ Mputc(c,handle);
+ c = resolution;
+ Mputc(c,handle);
+
+ ssize = rsize = blockPtr->width;
+ csize = blockPtr->height;
+ compress(resolution+1, handle, ReadValue);
+
+ c = 0;
+ Mputc(c,handle);
+ c = GIF_TERMINATOR;
+ Mputc(c,handle);
+
+ return TCL_OK;
+}
+
+static int
+color(red, green, blue, mapa)
+ int red;
+ int green;
+ int blue;
+ unsigned char mapa[MAXCOLORMAPSIZE][3];
+{
+ int x;
+ for (x=(alphaOffset != 0) ; x<=MAXCOLORMAPSIZE ; x++) {
+ if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) &&
+ (mapa[x][CM_BLUE] == blue)) {
+ return x;
+ }
+ }
+ return -1;
+}
+
+
+static int
+nuevo(red, green, blue, mapa)
+ int red,green,blue;
+ unsigned char mapa[MAXCOLORMAPSIZE][3];
+{
+ int x = (alphaOffset != 0);
+ for (; x<=num ; x++) {
+ if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) &&
+ (mapa[x][CM_BLUE] == blue)) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static void
+savemap(blockPtr,mapa)
+ Tk_PhotoImageBlock *blockPtr;
+ unsigned char mapa[MAXCOLORMAPSIZE][3];
+{
+ unsigned char *colores;
+ int x,y;
+ unsigned char red,green,blue;
+
+ if (alphaOffset) {
+ num = 0;
+ mapa[0][CM_RED] = 0xd9;
+ mapa[0][CM_GREEN] = 0xd9;
+ mapa[0][CM_BLUE] = 0xd9;
+ } else {
+ num = -1;
+ }
+
+ for(y=0 ; y<blockPtr->height ; y++) {
+ colores = blockPtr->pixelPtr + blockPtr->offset[0]
+ + y * blockPtr->pitch;
+ for(x=0 ; x<blockPtr->width ; x++) {
+ if (!alphaOffset || (colores[alphaOffset] != 0)) {
+ red = colores[0];
+ green = colores[greenOffset];
+ blue = colores[blueOffset];
+ if (nuevo(red,green,blue,mapa)) {
+ num++;
+ if (num >= MAXCOLORMAPSIZE) {
+ return;
+ }
+ mapa[num][CM_RED] = red;
+ mapa[num][CM_GREEN] = green;
+ mapa[num][CM_BLUE] = blue;
+ }
+ }
+ colores += pixelSize;
+ }
+ }
+ return;
+}
+
+static int
+ReadValue()
+{
+ unsigned int col;
+
+ if (csize == 0) {
+ return EOF;
+ }
+ if (alphaOffset && (pixelo[alphaOffset] == 0)) {
+ col = 0;
+ } else {
+ col = color(pixelo[0], pixelo[greenOffset], pixelo[blueOffset], mapa);
+ }
+ pixelo += pixelSize;
+ if (--ssize <= 0) {
+ ssize = rsize;
+ csize--;
+ pixelo += pixelPitch - (rsize * pixelSize);
+ }
+
+ return col;
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------
+ *
+ * miGIF Compression - mouse and ivo's GIF-compatible compression
+ *
+ * -run length encoding compression routines-
+ *
+ * Copyright (C) 1998 Hutchison Avenue Software Corporation
+ * http://www.hasc.com
+ * info@hasc.com
+ *
+ * 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." The Hutchison Avenue Software Corporation
+ * disclaims all warranties, either express or implied, including but
+ * not limited to implied warranties of merchantability and fitness
+ * for a particular purpose, with respect to this code and
+ * accompanying documentation.
+ *
+ * The miGIF compression routines do not, strictly speaking, generate
+ * files conforming to the GIF spec, since the image data is not
+ * LZW-compressed (this is the point: in order to avoid transgression
+ * of the Unisys patent on the LZW algorithm.) However, miGIF
+ * generates data streams that any reasonably sane LZW decompresser
+ * will decompress to what we want.
+ *
+ * miGIF compression uses run length encoding. It compresses
+ * horizontal runs of pixels of the same color. This type of
+ * compression gives good results on images with many runs, for
+ * example images with lines, text and solid shapes on a solid-colored
+ * background. It gives little or no compression on images with few
+ * runs, for example digital or scanned photos.
+ *
+ * der Mouse
+ * mouse@rodents.montreal.qc.ca
+ * 7D C8 61 52 5D E7 2D 39 4E F1 31 3E E8 B3 27 4B
+ *
+ * ivo@hasc.com
+ *
+ * The Graphics Interchange Format(c) is the Copyright property of
+ * CompuServe Incorporated. GIF(sm) is a Service Mark property of
+ * CompuServe Incorporated.
+ *
+ *-----------------------------------------------------------------------
+ */
+
+static int rl_pixel;
+static int rl_basecode;
+static int rl_count;
+static int rl_table_pixel;
+static int rl_table_max;
+static int just_cleared;
+static int out_bits;
+static int out_bits_init;
+static int out_count;
+static int out_bump;
+static int out_bump_init;
+static int out_clear;
+static int out_clear_init;
+static int max_ocodes;
+static int code_clear;
+static int code_eof;
+static unsigned int obuf;
+static int obits;
+static Tcl_Channel ofile;
+static unsigned char oblock[256];
+static int oblen;
+
+/*
+ * Used only when debugging GIF compression code
+ */
+/* #define MIGIF_DEBUGGING_ENVARS */
+
+#ifdef MIGIF_DEBUGGING_ENVARS
+
+static int verbose_set = 0;
+static int verbose;
+#define MIGIF_VERBOSE (verbose_set?verbose:set_verbose())
+#define DEBUGMSG(printf_args) if (MIGIF_VERBOSE) { printf printf_args; }
+
+static int
+set_verbose(void)
+{
+ verbose = !!getenv("MIGIF_VERBOSE");
+ verbose_set = 1;
+ return verbose;
+}
+
+static CONST char *
+binformat(v, nbits)
+ unsigned int v;
+ int nbits;
+{
+ static char bufs[8][64];
+ static int bhand = 0;
+ unsigned int bit;
+ int bno;
+ char *bp;
+
+ bhand--;
+ if (bhand < 0) {
+ bhand = (sizeof(bufs) / sizeof(bufs[0])) - 1;
+ }
+ bp = &bufs[bhand][0];
+ for (bno=nbits-1,bit=((unsigned int)1)<<bno ; bno>=0 ; bno--,bit>>=1) {
+ *bp++ = (v & bit) ? '1' : '0';
+ if (((bno&3) == 0) && (bno != 0)) {
+ *bp++ = '.';
+ }
+ }
+ *bp = '\0';
+ return &bufs[bhand][0];
+}
+
+#else
+
+#define MIGIF_VERBOSE 0
+#define DEBUGMSG(printf_args) /* do nothing */
+
+#endif
+
+static void
+write_block()
+{
+ int i;
+ unsigned char c;
+
+ if (MIGIF_VERBOSE) {
+ printf("write_block %d:", oblen);
+ for (i=0 ; i<oblen ; i++) {
+ printf(" %02x", oblock[i]);
+ }
+ printf("\n");
+ }
+ c = oblen;
+ Tcl_Write(ofile, (char *) &c, 1);
+ Tcl_Write(ofile, (char *) &oblock[0], oblen);
+ oblen = 0;
+}
+
+static void
+block_out(c)
+ unsigned char c;
+{
+ DEBUGMSG(("block_out %s\n", binformat(c, 8)));
+ oblock[oblen++] = c;
+ if (oblen >= 255) {
+ write_block();
+ }
+}
+
+static void
+block_flush()
+{
+ DEBUGMSG(("block_flush\n"));
+ if (oblen > 0) {
+ write_block();
+ }
+}
+
+static void
+output(val)
+ int val;
+{
+ DEBUGMSG(("output %s [%s %d %d]\n", binformat(val, out_bits),
+ binformat(obuf, obits), obits, out_bits));
+ obuf |= val << obits;
+ obits += out_bits;
+ while (obits >= 8) {
+ block_out(obuf&0xff);
+ obuf >>= 8;
+ obits -= 8;
+ }
+ DEBUGMSG(("output leaving [%s %d]\n", binformat(obuf, obits), obits));
+}
+
+static void
+output_flush()
+{
+ DEBUGMSG(("output_flush\n"));
+ if (obits > 0) {
+ block_out(obuf);
+ }
+ block_flush();
+}
+
+static void
+did_clear()
+{
+ DEBUGMSG(("did_clear\n"));
+ out_bits = out_bits_init;
+ out_bump = out_bump_init;
+ out_clear = out_clear_init;
+ out_count = 0;
+ rl_table_max = 0;
+ just_cleared = 1;
+}
+
+static void
+output_plain(c)
+ int c;
+{
+ DEBUGMSG(("output_plain %s\n", binformat(c, out_bits)));
+ just_cleared = 0;
+ output(c);
+ out_count++;
+ if (out_count >= out_bump) {
+ out_bits++;
+ out_bump += 1 << (out_bits - 1);
+ }
+ if (out_count >= out_clear) {
+ output(code_clear);
+ did_clear();
+ }
+}
+
+static unsigned int
+isqrt(x)
+ unsigned int x;
+{
+ unsigned int r;
+ unsigned int v;
+
+ if (x < 2) {
+ return x;
+ }
+ for (v=x,r=1 ; v ; v>>=2,r<<=1);
+ while (1) {
+ v = ((x / r) + r) / 2;
+ if (v==r || v==r+1) {
+ return r;
+ }
+ r = v;
+ }
+}
+
+static unsigned int
+compute_triangle_count(count, nrepcodes)
+ unsigned int count;
+ unsigned int nrepcodes;
+{
+ unsigned int perrep;
+ unsigned int cost;
+
+ cost = 0;
+ perrep = (nrepcodes * (nrepcodes+1)) / 2;
+ while (count >= perrep) {
+ cost += nrepcodes;
+ count -= perrep;
+ }
+ if (count > 0) {
+ unsigned int n;
+ n = isqrt(count);
+ while (n*(n+1) >= 2*count) {
+ n--;
+ }
+ while (n*(n+1) < 2*count) {
+ n++;
+ }
+ cost += n;
+ }
+ return cost;
+}
+
+static void
+max_out_clear()
+{
+ out_clear = max_ocodes;
+}
+
+static void
+reset_out_clear()
+{
+ out_clear = out_clear_init;
+ if (out_count >= out_clear) {
+ output(code_clear);
+ did_clear();
+ }
+}
+
+static void
+rl_flush_fromclear(count)
+ int count;
+{
+ int n;
+
+ DEBUGMSG(("rl_flush_fromclear %d\n", count));
+ max_out_clear();
+ rl_table_pixel = rl_pixel;
+ n = 1;
+ while (count > 0) {
+ if (n == 1) {
+ rl_table_max = 1;
+ output_plain(rl_pixel);
+ count--;
+ } else if (count >= n) {
+ rl_table_max = n;
+ output_plain(rl_basecode+n-2);
+ count -= n;
+ } else if (count == 1) {
+ rl_table_max++;
+ output_plain(rl_pixel);
+ count = 0;
+ } else {
+ rl_table_max++;
+ output_plain(rl_basecode+count-2);
+ count = 0;
+ }
+ if (out_count == 0) {
+ n = 1;
+ } else {
+ n++;
+ }
+ }
+ reset_out_clear();
+ DEBUGMSG(("rl_flush_fromclear leaving table_max=%d\n", rl_table_max));
+}
+
+static void
+rl_flush_clearorrep(count)
+ int count;
+{
+ int withclr;
+
+ DEBUGMSG(("rl_flush_clearorrep %d\n", count));
+ withclr = 1 + compute_triangle_count(count, max_ocodes);
+ if (withclr < count) {
+ output(code_clear);
+ did_clear();
+ rl_flush_fromclear(count);
+ } else {
+ for (; count>0 ; count--) {
+ output_plain(rl_pixel);
+ }
+ }
+}
+
+static void
+rl_flush_withtable(count)
+ int count;
+{
+ int repmax;
+ int repleft;
+ int leftover;
+
+ DEBUGMSG(("rl_flush_withtable %d\n", count));
+ repmax = count / rl_table_max;
+ leftover = count % rl_table_max;
+ repleft = (leftover ? 1 : 0);
+ if (out_count+repmax+repleft > max_ocodes) {
+ repmax = max_ocodes - out_count;
+ leftover = count - (repmax * rl_table_max);
+ repleft = 1 + compute_triangle_count(leftover, max_ocodes);
+ }
+ DEBUGMSG(("rl_flush_withtable repmax=%d leftover=%d repleft=%d\n",
+ repmax, leftover, repleft));
+ if (1+(int)compute_triangle_count(count, max_ocodes) < repmax+repleft) {
+ output(code_clear);
+ did_clear();
+ rl_flush_fromclear(count);
+ return;
+ }
+ max_out_clear();
+ for (; repmax>0 ; repmax--) {
+ output_plain(rl_basecode + rl_table_max - 2);
+ }
+ if (leftover) {
+ if (just_cleared) {
+ rl_flush_fromclear(leftover);
+ } else if (leftover == 1) {
+ output_plain(rl_pixel);
+ } else {
+ output_plain(rl_basecode + leftover - 2);
+ }
+ }
+ reset_out_clear();
+}
+
+static void
+rl_flush()
+{
+ DEBUGMSG(("rl_flush [ %d %d\n", rl_count, rl_pixel));
+ if (rl_count == 1) {
+ output_plain(rl_pixel);
+ rl_count = 0;
+ DEBUGMSG(("rl_flush ]\n"));
+ return;
+ }
+ if (just_cleared) {
+ rl_flush_fromclear(rl_count);
+ } else if ((rl_table_max < 2) || (rl_table_pixel != rl_pixel)) {
+ rl_flush_clearorrep(rl_count);
+ } else {
+ rl_flush_withtable(rl_count);
+ }
+ DEBUGMSG(("rl_flush ]\n"));
+ rl_count = 0;
+}
+
+
+static void
+compress(init_bits, handle, readValue)
+ int init_bits;
+ Tcl_Channel handle;
+ ifunptr readValue;
+{
+ int c;
+
+ ofile = handle;
+ obuf = 0;
+ obits = 0;
+ oblen = 0;
+ code_clear = 1 << (init_bits - 1);
+ code_eof = code_clear + 1;
+ rl_basecode = code_eof + 1;
+ out_bump_init = (1 << (init_bits - 1)) - 1;
+ /*
+ * For images with a lot of runs, making out_clear_init larger
+ * will give better compression.
+ */
+ out_clear_init = (init_bits <= 3) ? 9 : (out_bump_init-1);
+#ifdef MIGIF_DEBUGGING_ENVARS
+ {
+ const char *ocienv;
+ ocienv = getenv("MIGIF_OUT_CLEAR_INIT");
+ if (ocienv) {
+ out_clear_init = atoi(ocienv);
+ DEBUGMSG(("[overriding out_clear_init to %d]\n", out_clear_init));
+ }
+ }
+#endif
+ out_bits_init = init_bits;
+ max_ocodes = (1 << GIFBITS) - ((1 << (out_bits_init - 1)) + 3);
+ did_clear();
+ output(code_clear);
+ rl_count = 0;
+ while (1) {
+ c = readValue();
+ if ((rl_count > 0) && (c != rl_pixel)) {
+ rl_flush();
+ }
+ if (c == EOF) {
+ break;
+ }
+ if (rl_pixel == c) {
+ rl_count++;
+ } else {
+ rl_pixel = c;
+ rl_count = 1;
+ }
+ }
+ output(code_eof);
+ output_flush();
+}
+
+/*
+ *-----------------------------------------------------------------------
+ *
+ * End of miGIF section - See copyright notice at start of section.
+ *
+ *-----------------------------------------------------------------------
+ */
diff --git a/tcl/generic/tkImgPPM.c b/tcl/generic/tkImgPPM.c
new file mode 100644
index 00000000000..c509648cb1c
--- /dev/null
+++ b/tcl/generic/tkImgPPM.c
@@ -0,0 +1,432 @@
+/*
+ * 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$
+ */
+
+#define USE_OLD_IMAGE
+
+#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 the interp's result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is
+ * added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "%d", maxIntensity);
+ Tcl_AppendResult(interp, "PPM image file \"", fileName,
+ "\" has bad maximum intensity value ", buffer,
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ 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.offset[3] = 0;
+ block.width = width;
+ block.pitch = block.pixelSize * fileWidth;
+
+ Tk_PhotoExpand(imageHandle, destX + width, destY + height);
+
+ if (srcY > 0) {
+ Tcl_Seek(chan, (Tcl_WideInt)(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,
+ TK_PHOTO_COMPOSITE_SET);
+ 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 the interp's result.
+ *
+ * Side effects:
+ * Data is written to the file given by "fileName".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileWritePPM(interp, fileName, formatString, blockPtr)
+ Tcl_Interp *interp;
+ char *fileName;
+ char *formatString;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ Tcl_Channel chan;
+ int w, h;
+ int greenOffset, blueOffset, nBytes;
+ unsigned char *pixelPtr, *pixLinePtr;
+ char header[16 + TCL_INTEGER_SPACE * 2];
+
+ chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ 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;
+ 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;
+ }
+ i = 0;
+ for (numFields = 0; numFields < 4; numFields++) {
+ /*
+ * Skip comments and white space.
+ */
+
+ while (1) {
+ while (isspace(UCHAR(c))) {
+ 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');
+ }
+
+ /*
+ * 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++;
+ }
+ }
+ 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/tcl/generic/tkImgPhoto.c b/tcl/generic/tkImgPhoto.c
new file mode 100644
index 00000000000..d2b0cb02711
--- /dev/null
+++ b/tcl/generic/tkImgPhoto.c
@@ -0,0 +1,5623 @@
+/*
+ * tkImgPhoto.c --
+ *
+ * Implements images of type "photo" for Tk. Photo images are
+ * stored in full color (32 bits per pixel) and displayed using
+ * dithering if necessary.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2002 Donal K. Fellows
+ *
+ * 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"
+#include "tclMath.h"
+#include <ctype.h>
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+/*
+ * Declaration for internal Xlib function used here:
+ */
+
+extern int _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.
+ */
+#ifdef COLOR_WINDOW
+#undef COLOR_WINDOW
+#endif
+
+#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 *dataString; /* Object to use as contents of image. */
+ Tcl_Obj *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. */
+ Tcl_Obj *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. */
+ Tcl_Obj *format; /* Value specified for -format option. */
+ XColor *background; /* Value specified for -background option. */
+ int compositingRule; /* Value specified for -compositingrule opt */
+};
+
+/*
+ * 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_COMPOSITE: Set if -compositingrule option allowed/spec'd.
+ * 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_COMPOSITE 2
+#define OPT_FORMAT 4
+#define OPT_FROM 8
+#define OPT_GRAYSCALE 0x10
+#define OPT_SHRINK 0x20
+#define OPT_SUBSAMPLE 0x40
+#define OPT_TO 0x80
+#define OPT_ZOOM 0x100
+
+/*
+ * List of option names. The order here must match the order of
+ * declarations of the OPT_* constants above.
+ */
+
+static char *optionNames[] = {
+ "-background",
+ "-compositingrule",
+ "-format",
+ "-from",
+ "-grayscale",
+ "-shrink",
+ "-subsample",
+ "-to",
+ "-zoom",
+ (char *) NULL
+};
+
+/*
+ * Message to generate when an attempt to resize an image fails due
+ * to memory problems.
+ */
+#define TK_PHOTO_ALLOC_FAILURE_MESSAGE \
+ "not enough free memory for image buffer"
+
+/*
+ * Functions used in the type record for photo images.
+ */
+
+static int ImgPhotoCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int objc, 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));
+static int ImgPhotoPostscript _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, int x, int y, int width,
+ int height, int prepass));
+
+/*
+ * The type record itself for photo images:
+ */
+
+Tk_ImageType tkPhotoImageType = {
+ "photo", /* name */
+ ImgPhotoCreate, /* createProc */
+ ImgPhotoGet, /* getProc */
+ ImgPhotoDisplay, /* displayProc */
+ ImgPhotoFree, /* freeProc */
+ ImgPhotoDelete, /* deleteProc */
+ ImgPhotoPostscript, /* postscriptProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+typedef struct ThreadSpecificData {
+ Tk_PhotoImageFormat *formatList; /* Pointer to the first in the
+ * list of known photo image formats.*/
+ Tk_PhotoImageFormat *oldFormatList; /* Pointer to the first in the
+ * list of known photo image formats.*/
+ int initialized; /* set to 1 if we've initialized the strucuture */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * 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, "-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))
+
+/*
+ * Forward declarations
+ */
+
+static void PhotoFormatThreadExitProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ImgPhotoCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int ParseSubcommandOptions _ANSI_ARGS_((
+ struct SubcommandOptions *optPtr,
+ Tcl_Interp *interp, int allowedOptions,
+ int *indexPtr, int objc, Tcl_Obj *CONST objv[]));
+static void ImgPhotoCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ImgPhotoConfigureMaster _ANSI_ARGS_((
+ Tcl_Interp *interp, PhotoMaster *masterPtr,
+ int objc, Tcl_Obj *CONST objv[], int flags));
+static void ImgPhotoConfigureInstance _ANSI_ARGS_((
+ PhotoInstance *instancePtr));
+static int 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_Obj *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+static char * ImgGetPhoto _ANSI_ARGS_((PhotoMaster *masterPtr,
+ Tk_PhotoImageBlock *blockPtr,
+ struct SubcommandOptions *optPtr));
+static int IsValidPalette _ANSI_ARGS_((PhotoInstance *instancePtr,
+ CONST 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, Tcl_Obj *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr, int *oldformat));
+static int MatchStringFormat _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *data, Tcl_Obj *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr, int *oldformat));
+static Tcl_ObjCmdProc * PhotoOptionFind _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj *obj));
+static void DitherInstance _ANSI_ARGS_((PhotoInstance *instancePtr,
+ int x, int y, int width, int height));
+static void PhotoOptionCleanupProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+
+#undef MIN
+#define MIN(a, b) ((a) < (b)? (a): (b))
+#undef MAX
+#define MAX(a, b) ((a) > (b)? (a): (b))
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldPhotoImageFormat, 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PhotoFormatThreadExitProc(clientData)
+ ClientData clientData; /* not used */
+{
+ Tk_PhotoImageFormat *freePtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ while (tsdPtr->oldFormatList != NULL) {
+ freePtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = tsdPtr->oldFormatList->nextPtr;
+ ckfree((char *) freePtr->name);
+ ckfree((char *) freePtr);
+ }
+ while (tsdPtr->formatList != NULL) {
+ freePtr = tsdPtr->formatList;
+ tsdPtr->formatList = tsdPtr->formatList->nextPtr;
+ ckfree((char *) freePtr->name);
+ ckfree((char *) freePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldPhotoImageFormat, 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_CreateOldPhotoImageFormat(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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
+ }
+ copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
+ *copyPtr = *formatPtr;
+ copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
+ strcpy(copyPtr->name, formatPtr->name);
+ copyPtr->nextPtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = copyPtr;
+}
+
+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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
+ }
+ copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
+ *copyPtr = *formatPtr;
+ copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
+ strcpy(copyPtr->name, formatPtr->name);
+ if (isupper((unsigned char) *formatPtr->name)) {
+ copyPtr->nextPtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = copyPtr;
+ } else {
+ copyPtr->nextPtr = tsdPtr->formatList;
+ tsdPtr->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, 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[]; /* 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, objc, 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, objc, objv)
+ ClientData clientData; /* Information about photo master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int oldformat = 0;
+ static CONST char *photoOptions[] = {
+ "blank", "cget", "configure", "copy", "data", "get", "put",
+ "read", "redither", "transparency", "write", (char *) NULL
+ };
+ enum options {
+ PHOTO_BLANK, PHOTO_CGET, PHOTO_CONFIGURE, PHOTO_COPY, PHOTO_DATA,
+ PHOTO_GET, PHOTO_PUT, PHOTO_READ, PHOTO_REDITHER, PHOTO_TRANS,
+ PHOTO_WRITE
+ };
+
+ PhotoMaster *masterPtr = (PhotoMaster *) clientData;
+ int result, index;
+ int x, y, width, height;
+ int dataWidth, dataHeight;
+ struct SubcommandOptions options;
+ int listArgc;
+ CONST char **listArgv;
+ CONST char **srcArgv;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+ Tk_Window tkwin;
+ XColor color;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight;
+ int matched;
+ Tcl_Channel chan;
+ Tk_PhotoHandle srcHandle;
+ size_t length;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], photoOptions, "option", 0,
+ &index) != TCL_OK) {
+ Tcl_ObjCmdProc *proc;
+ proc = PhotoOptionFind(interp, objv[1]);
+ if (proc == (Tcl_ObjCmdProc *) NULL) {
+ return TCL_ERROR;
+ }
+ return proc(clientData, interp, objc, objv);
+ }
+
+ switch ((enum options) index) {
+ case PHOTO_BLANK:
+ /*
+ * photo blank command - just call Tk_PhotoBlank.
+ */
+
+ if (objc == 2) {
+ Tk_PhotoBlank(masterPtr);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ return TCL_ERROR;
+ }
+ break;
+
+ case PHOTO_CGET: {
+ char *arg;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetStringFromObj(objv[2], (int *) &length);
+ if (strncmp(arg,"-data", length) == 0) {
+ if (masterPtr->dataString) {
+ Tcl_SetObjResult(interp, masterPtr->dataString);
+ }
+ return TCL_OK;
+ }
+ if (strncmp(arg,"-format", length) == 0) {
+ if (masterPtr->format) {
+ Tcl_SetObjResult(interp, masterPtr->format);
+ }
+ return TCL_OK;
+ }
+ Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, Tcl_GetString(objv[2]), 0);
+ break;
+ }
+
+ case PHOTO_CONFIGURE:
+ /*
+ * photo configure command - handle this in the standard way.
+ */
+
+ if (objc == 2) {
+ Tcl_Obj *obj, *subobj;
+ result = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ if (result != TCL_OK) {
+ return result;
+ }
+ obj = Tcl_NewObj();
+ subobj = Tcl_NewStringObj("-data {} {} {}", 14);
+ if (masterPtr->dataString) {
+ Tcl_ListObjAppendElement(interp, subobj, masterPtr->dataString);
+ } else {
+ Tcl_AppendStringsToObj(subobj, " {}", (char *) NULL);
+ }
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewStringObj("-format {} {} {}", 16);
+ if (masterPtr->format) {
+ Tcl_ListObjAppendElement(interp, subobj, masterPtr->format);
+ } else {
+ Tcl_AppendStringsToObj(subobj, " {}", (char *) NULL);
+ }
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_ListObjAppendList(interp, obj, Tcl_GetObjResult(interp));
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 3) {
+ char *arg = Tcl_GetStringFromObj(objv[2], (int *) &length);
+ if (!strncmp(arg, "-data", length)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "-data {} {} {}", (char *) NULL);
+ if (masterPtr->dataString) {
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ masterPtr->dataString);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " {}", (char *) NULL);
+ }
+ return TCL_OK;
+ } else if (!strncmp(arg, "-format", length)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "-format {} {} {}", (char *) NULL);
+ if (masterPtr->format) {
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ masterPtr->format);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " {}", (char *) NULL);
+ }
+ return TCL_OK;
+ } else {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, arg, 0);
+ }
+ }
+ return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+
+ case PHOTO_COPY:
+ /*
+ * 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;
+ options.compositingRule = TK_PHOTO_COMPOSITE_OVERLAY;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK |
+ OPT_COMPOSITE, &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (options.name == NULL || index < objc) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "source-image ?-compositingrule rule? ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the source image and get a pointer to its image data.
+ * Check the values given for the -from option.
+ */
+
+ srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name));
+ if (srcHandle == NULL) {
+ Tcl_AppendResult(interp, "image \"",
+ Tcl_GetString(options.name), "\" 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) || (options.fromX2 < 0)) {
+ options.fromX2 = block.width;
+ options.fromY2 = block.height;
+ }
+ if (!(options.options & OPT_TO) || (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) {
+ if (ImgPhotoSetSize(masterPtr, options.toX2,
+ options.toY2) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * 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,
+ options.compositingRule);
+
+ break;
+
+ case PHOTO_DATA: {
+ 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, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name != NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options?");
+ 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 = tsdPtr->formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((strncasecmp(Tcl_GetString(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 \"",
+ Tcl_GetString(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);
+
+ result = ((int (*) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *formatString,
+ Tk_PhotoImageBlock *blockPtr, VOID *dummy))) stringWriteProc)
+ (interp, options.format, &block, (VOID *) NULL);
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ return result;
+ break;
+ }
+
+ case PHOTO_GET: {
+ /*
+ * photo get command - first parse and check parameters.
+ */
+
+ char string[TCL_INTEGER_SPACE * 3];
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[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);
+ break;
+ }
+
+ case PHOTO_PUT:
+ /*
+ * 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, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?options?");
+ return TCL_ERROR;
+ }
+
+ if (MatchStringFormat(interp, options.name ? objv[2]:NULL,
+ options.format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) == TCL_OK) {
+ Tcl_Obj *format, *data;
+
+ 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;
+ }
+ format = options.format;
+ data = objv[2];
+ if (oldformat) {
+ if (format) {
+ format = (Tcl_Obj *) Tcl_GetString(format);
+ }
+ data = (Tcl_Obj *) Tcl_GetString(data);
+ }
+ if ((*imageFormat->stringReadProc)(interp, data,
+ format, (Tk_PhotoHandle) masterPtr,
+ options.toX, options.toY, imageWidth, imageHeight,
+ 0, 0) != 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, Tcl_GetString(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) || (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;
+ block.offset[3] = 0;
+ Tk_PhotoPutBlock((ClientData)masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY, TK_PHOTO_COMPOSITE_SET);
+ ckfree((char *) block.pixelPtr);
+ break;
+
+ case PHOTO_READ: {
+ Tcl_Obj *format;
+
+ /*
+ * 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, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?options?");
+ 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,
+ Tcl_GetString(options.name), "r", 0);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ if (MatchFileFormat(interp, chan,
+ Tcl_GetString(options.name), options.format, &imageFormat,
+ &imageWidth, &imageHeight, &oldformat) != 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) {
+ if (ImgPhotoSetSize(masterPtr, options.toX + width,
+ options.toY + height) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Call the handler's file read procedure to read the data
+ * into the image.
+ */
+
+ format = options.format;
+ if (oldformat && format) {
+ format = (Tcl_Obj *) Tcl_GetString(format);
+ }
+ result = (*imageFormat->fileReadProc)(interp, chan,
+ Tcl_GetString(options.name),
+ format, (Tk_PhotoHandle) masterPtr, options.toX,
+ options.toY, width, height, options.fromX, options.fromY);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return result;
+ break;
+ }
+
+ case PHOTO_REDITHER:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call Dither if any part of the image is not correctly
+ * dithered at present.
+ */
+
+ x = masterPtr->ditherX;
+ y = masterPtr->ditherY;
+ if (masterPtr->ditherX != 0) {
+ Tk_DitherPhoto((Tk_PhotoHandle) masterPtr, x, y,
+ masterPtr->width - x, 1);
+ }
+ if (masterPtr->ditherY < masterPtr->height) {
+ x = 0;
+ Tk_DitherPhoto((Tk_PhotoHandle)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);
+ }
+ break;
+
+ case PHOTO_TRANS: {
+ static CONST char *photoTransOptions[] = {
+ "get", "set", (char *) NULL
+ };
+ enum transOptions {
+ PHOTO_TRANS_GET, PHOTO_TRANS_SET
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], photoTransOptions, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum transOptions) index) {
+ case PHOTO_TRANS_GET: {
+ XRectangle testBox;
+ TkRegion testRegion;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]),
+ " transparency get: coordinates out of range",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ testBox.x = x;
+ testBox.y = y;
+ testBox.width = 1;
+ testBox.height = 1;
+ /* What a way to do a test! */
+ testRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&testBox, testRegion, testRegion);
+ TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion);
+ TkClipBox(testRegion, &testBox);
+ TkDestroyRegion(testRegion);
+
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ (testBox.width==0 && testBox.height==0));
+ return TCL_OK;
+ }
+
+ case PHOTO_TRANS_SET: {
+ int transFlag;
+ XRectangle setBox;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y boolean");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[5],
+ &transFlag) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]),
+ " transparency set: coordinates out of range",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ setBox.x = x;
+ setBox.y = y;
+ setBox.width = 1;
+ setBox.height = 1;
+ pixelPtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+
+ if (transFlag) {
+ /*
+ * Make pixel transparent.
+ */
+ TkRegion clearRegion = TkCreateRegion();
+
+ TkUnionRectWithRegion(&setBox, clearRegion, clearRegion);
+ TkSubtractRegion(masterPtr->validRegion, clearRegion,
+ masterPtr->validRegion);
+ TkDestroyRegion(clearRegion);
+ /*
+ * Set the alpha value correctly.
+ */
+ pixelPtr[3] = 0;
+ } else {
+ /*
+ * Make pixel opaque.
+ */
+ TkUnionRectWithRegion(&setBox, masterPtr->validRegion,
+ masterPtr->validRegion);
+ pixelPtr[3] = 255;
+ }
+
+ /*
+ * Inform the generic image code that the image
+ * has (potentially) changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, 1, 1,
+ masterPtr->width, masterPtr->height);
+ masterPtr->flags &= ~IMAGE_CHANGED;
+ }
+
+ }
+ return TCL_OK;
+ }
+
+ case PHOTO_WRITE: {
+ char *data;
+ Tcl_Obj *format;
+
+ /*
+ * 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, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?options?");
+ 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) || (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 = tsdPtr->formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((options.format == NULL)
+ || (strncasecmp(Tcl_GetString(options.format),
+ imageFormat->name, strlen(imageFormat->name)) == 0)) {
+ matched = 1;
+ if (imageFormat->fileWriteProc != NULL) {
+ break;
+ }
+ }
+ }
+ if (imageFormat == NULL) {
+ oldformat = 1;
+ for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((options.format == NULL)
+ || (strncasecmp(Tcl_GetString(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 \"",
+ Tcl_GetString(options.format),
+ "\" is unknown", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "image file format \"",
+ Tcl_GetString(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);
+ format = options.format;
+ if (oldformat && format) {
+ format = (Tcl_Obj *) Tcl_GetString(options.format);
+ }
+ result = (*imageFormat->fileWriteProc)(interp,
+ Tcl_GetString(options.name), format, &block);
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ return result;
+ }
+
+ }
+ 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, -shrink,
+ * and -compositingrule.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Fields in *optPtr get filled in.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, objc, objv)
+ 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 objv; this variable is
+ * updated by this procedure. */
+ int objc; /* Number of arguments in objv[]. */
+ Tcl_Obj *CONST objv[]; /* Arguments to be parsed. */
+{
+ int index, c, bit, currentBit;
+ int length;
+ char *option, **listPtr;
+ int values[4];
+ int numValues, maxValues, argIndex;
+
+ for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) {
+ /*
+ * We can have one value specified without an option;
+ * it goes into optPtr->name.
+ */
+
+ option = Tcl_GetStringFromObj(objv[index], &length);
+ if (option[0] != '-') {
+ if (optPtr->name == NULL) {
+ optPtr->name = objv[index];
+ continue;
+ }
+ break;
+ }
+
+ /*
+ * Work out which option this is.
+ */
+
+ c = option[0];
+ bit = 0;
+ currentBit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((c == *listPtr[0])
+ && (strncmp(option, *listPtr, (size_t) 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 \"",
+ Tcl_GetString(objv[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 < objc) {
+ *optIndexPtr = ++index;
+ optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp),
+ Tk_GetUid(Tcl_GetString(objv[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. Note
+ * that parsing this is outside the scope of this
+ * function.
+ */
+
+ if (index + 1 < objc) {
+ *optIndexPtr = ++index;
+ optPtr->format = objv[index];
+ } else {
+ Tcl_AppendResult(interp, "the \"-format\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (bit == OPT_COMPOSITE) {
+ /*
+ * The -compositingrule option takes a single value from
+ * a well-known set.
+ */
+
+ if (index + 1 < objc) {
+ /*
+ * Note that these must match the TK_PHOTO_COMPOSITE_*
+ * constants.
+ */
+ static CONST char *compositingRules[] = {
+ "overlay", "set",
+ NULL
+ };
+
+ index++;
+ if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules,
+ "compositing rule", 0, &optPtr->compositingRule)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *optIndexPtr = index;
+ } else {
+ Tcl_AppendResult(interp, "the \"-compositingrule\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) {
+ char *val;
+ maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2;
+ argIndex = index + 1;
+ for (numValues = 0; numValues < maxValues; ++numValues) {
+ if (argIndex >= objc) {
+ break;
+ }
+ val = Tcl_GetString(objv[argIndex]);
+ if ((argIndex < objc) && (isdigit(UCHAR(val[0]))
+ || ((val[0] == '-') && isdigit(UCHAR(val[1]))))) {
+ if (Tcl_GetInt(interp, val, &values[numValues])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ break;
+ }
+ ++argIndex;
+ }
+
+ if (numValues == 0) {
+ Tcl_AppendResult(interp, "the \"", option, "\" 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 the masterPtr->interp's result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match
+ * the new configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoConfigureMaster(interp, masterPtr, objc, 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 objc; /* Number of entries in objv. */
+ 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;
+ CONST char *oldFileString, *oldPaletteString;
+ Tcl_Obj *oldData, *data = NULL, *oldFormat, *format = NULL;
+ int length, i, j;
+ double oldGamma;
+ int result;
+ Tcl_Channel chan;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight;
+ CONST char **args;
+ int oldformat;
+ Tcl_Obj *tempdata, *tempformat;
+
+ args = (CONST char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0, j = 0; i < objc; i++,j++) {
+ args[j] = Tcl_GetStringFromObj(objv[i], &length);
+ if ((length > 1) && (args[j][0] == '-')) {
+ if ((args[j][1] == 'd') &&
+ !strncmp(args[j],"-data", (size_t) length)) {
+ if (i < objc) {
+ data = objv[++i];
+ j--;
+ }
+ } else if ((args[j][1] == 'f') &&
+ !strncmp(args[j],"-format", (size_t) length)) {
+ if (i < objc) {
+ format = 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;
+ if (oldFileString == NULL) {
+ oldData = masterPtr->dataString;
+ if (oldData != NULL) {
+ Tcl_IncrRefCount(oldData);
+ }
+ } else {
+ oldData = NULL;
+ }
+ oldFormat = masterPtr->format;
+ if (oldFormat != NULL) {
+ Tcl_IncrRefCount(oldFormat);
+ }
+ oldPaletteString = masterPtr->palette;
+ oldGamma = masterPtr->gamma;
+
+ /*
+ * Process the configuration options specified.
+ */
+
+ if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs,
+ j, args, (char *) masterPtr, flags) != TCL_OK) {
+ ckfree((char *) args);
+ goto errorExit;
+ }
+ ckfree((char *) args);
+
+ /*
+ * 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 (data) {
+ if (data->length
+ || (data->typePtr == Tcl_GetObjType("bytearray")
+ && data->internalRep.otherValuePtr != NULL)) {
+ Tcl_IncrRefCount(data);
+ } else {
+ data = NULL;
+ }
+ if (masterPtr->dataString) {
+ Tcl_DecrRefCount(masterPtr->dataString);
+ }
+ masterPtr->dataString = data;
+ }
+ if (format) {
+ if (format->length) {
+ Tcl_IncrRefCount(format);
+ } else {
+ format = NULL;
+ }
+ if (masterPtr->format) {
+ Tcl_DecrRefCount(masterPtr->format);
+ }
+ masterPtr->format = format;
+ }
+ /*
+ * Set the image to the user-requested size, if any,
+ * and make sure storage is correctly allocated for this image.
+ */
+
+ if (ImgPhotoSetSize(masterPtr, masterPtr->width,
+ masterPtr->height) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ goto errorExit;
+ }
+
+ /*
+ * 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_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't get image from a file in a safe interpreter",
+ (char *) NULL);
+ goto errorExit;
+ }
+
+ chan = Tcl_OpenFileChannel(interp, masterPtr->fileString, "r", 0);
+ if (chan == NULL) {
+ goto errorExit;
+ }
+ /*
+ * -translation binary also sets -encoding binary
+ */
+ if ((Tcl_SetChannelOption(interp, chan,
+ "-translation", "binary") != TCL_OK) ||
+ (MatchFileFormat(interp, chan, masterPtr->fileString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) != TCL_OK)) {
+ Tcl_Close(NULL, chan);
+ goto errorExit;
+ }
+ result = ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ if (result != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ goto errorExit;
+ }
+ tempformat = masterPtr->format;
+ if (oldformat && tempformat) {
+ tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
+ }
+ result = (*imageFormat->fileReadProc)(interp, chan,
+ masterPtr->fileString, tempformat,
+ (Tk_PhotoHandle) masterPtr, 0, 0,
+ imageWidth, imageHeight, 0, 0);
+ Tcl_Close(NULL, chan);
+ if (result != TCL_OK) {
+ goto errorExit;
+ }
+
+ Tcl_ResetResult(interp);
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ if ((masterPtr->fileString == NULL) && (masterPtr->dataString != NULL)
+ && ((masterPtr->dataString != oldData)
+ || (masterPtr->format != oldFormat))) {
+
+ if (MatchStringFormat(interp, masterPtr->dataString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) != TCL_OK) {
+ goto errorExit;
+ }
+ if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, (char *) NULL);
+ goto errorExit;
+ }
+ tempformat = masterPtr->format;
+ tempdata = masterPtr->dataString;
+ if (oldformat) {
+ if (tempformat) {
+ tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
+ }
+ tempdata = (Tcl_Obj *) Tcl_GetString(tempdata);
+ }
+ if ((*imageFormat->stringReadProc)(interp, tempdata,
+ tempformat, (Tk_PhotoHandle) masterPtr,
+ 0, 0, imageWidth, imageHeight, 0, 0) != TCL_OK) {
+ goto errorExit;
+ }
+
+ Tcl_ResetResult(interp);
+ 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;
+
+ if (oldData != NULL) {
+ Tcl_DecrRefCount(oldData);
+ }
+ if (oldFormat != NULL) {
+ Tcl_DecrRefCount(oldFormat);
+ }
+ return TCL_OK;
+
+ errorExit:
+ if (oldData != NULL) {
+ Tcl_DecrRefCount(oldData);
+ }
+ if (oldFormat != NULL) {
+ Tcl_DecrRefCount(oldFormat);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Can't we use autoconf to figure this out?
+ */
+
+ 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;
+ char buf[TCL_INTEGER_SPACE * 3];
+ int numVisuals;
+ XColor *white, *black;
+ XGCValues gcValues;
+
+ /*
+ * Table of "best" choices for palette for PseudoColor displays
+ * with between 3 and 15 bits/pixel.
+ */
+
+ 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_GetGC(tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+
+ /*
+ * Set configuration options and finish the initialization of the instance.
+ * This will also dither the image if necessary.
+ */
+
+ 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);
+ }
+
+ 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->dataString != NULL) {
+ Tcl_DecrRefCount(masterPtr->dataString);
+ }
+ if (masterPtr->format != NULL) {
+ Tcl_DecrRefCount(masterPtr->format);
+ }
+ 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:
+ * TCL_OK if successful, TCL_ERROR if failure occurred (currently
+ * just with memory allocation.)
+ *
+ * Side effects:
+ * Storage gets reallocated, for the master and all its instances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoSetSize(masterPtr, width, height)
+ PhotoMaster *masterPtr;
+ int width, height;
+{
+ unsigned char *newPix24 = NULL;
+ 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;
+ }
+
+ pitch = width * 4;
+
+ /*
+ * Test if we're going to (re)allocate the main buffer now, so
+ * that any failures will leave the photo unchanged.
+ */
+ if ((width != masterPtr->width) || (height != masterPtr->height)
+ || (masterPtr->pix24 == NULL)) {
+ newPix24 = (unsigned char *)
+ attemptckalloc((unsigned) (height * pitch));
+ if (newPix24 == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * 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);
+ }
+
+ /*
+ * Use the reallocated storage (allocation above) for the 24-bit
+ * image and copy over valid regions. Note that this test is true
+ * precisely when the allocation has already been done.
+ */
+ if (newPix24 != NULL) {
+ /*
+ * 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);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ if (!newPixmap) {
+ panic("Fail to create pixmap with Tk_GetPixmap in ImgPhotoInstanceSetSize.\n");
+ return;
+ }
+
+ /*
+ * 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. */
+ CONST 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.
+ */
+
+ 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, formatObj, imageFormatPtr,
+ widthPtr, heightPtr, oldformat)
+ 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. */
+ Tcl_Obj *formatObj; /* 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 *oldformat;
+{
+ int matched;
+ int useoldformat = 0;
+ Tk_PhotoImageFormat *formatPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ char *formatString = NULL;
+
+ if (formatObj) {
+ formatString = Tcl_GetString(formatObj);
+ }
+
+ /*
+ * Scan through the table of file format handlers to find
+ * one which can handle the image.
+ */
+
+ matched = 0;
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != 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, Tcl_LongAsWide(0L), SEEK_SET);
+
+ if ((*formatPtr->fileMatchProc)(chan, fileName, formatObj,
+ widthPtr, heightPtr, interp)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+ if (formatPtr == NULL) {
+ useoldformat = 1;
+ for (formatPtr = tsdPtr->oldFormatList; 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, Tcl_LongAsWide(0L), SEEK_SET);
+ if ((*formatPtr->fileMatchProc)(chan, fileName, (Tcl_Obj *)
+ formatString, widthPtr, heightPtr, interp)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+ }
+
+ if (formatPtr == NULL) {
+ if ((formatObj != 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;
+ *oldformat = useoldformat;
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(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, data, formatObj, imageFormatPtr,
+ widthPtr, heightPtr, oldformat)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Obj *data; /* Object containing the image data. */
+ Tcl_Obj *formatObj; /* 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 *oldformat; /* returns 1 if the old image API is used */
+{
+ int matched;
+ int useoldformat = 0;
+ Tk_PhotoImageFormat *formatPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ char *formatString = NULL;
+
+ if (formatObj) {
+ formatString = Tcl_GetString(formatObj);
+ }
+
+ /*
+ * Scan through the table of file format handlers to find
+ * one which can handle the image.
+ */
+
+ matched = 0;
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != 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)(data, formatObj,
+ widthPtr, heightPtr, interp)) {
+ break;
+ }
+ }
+
+ if (formatPtr == NULL) {
+ useoldformat = 1;
+ for (formatPtr = tsdPtr->oldFormatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != 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)(
+ (Tcl_Obj *) Tcl_GetString(data),
+ (Tcl_Obj *) formatString,
+ widthPtr, heightPtr, interp)) {
+ break;
+ }
+ }
+ }
+ if (formatPtr == NULL) {
+ if ((formatObj != 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;
+ *oldformat = useoldformat;
+ 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. */
+ CONST 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, compRule)
+ 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 compRule; /* Compositing rule to use when processing
+ * transparent pixels. */
+{
+ 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)) {
+ if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ }
+
+ 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 = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
+ 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;
+
+ /*
+ * This test is probably too restrictive. We should also be able to
+ * do a memcpy if pixelSize == 3 and alphaOffset == 0. Maybe other cases
+ * too.
+ */
+ if ((blockPtr->pixelSize == 4)
+ && (greenOffset == 1) && (blueOffset == 2) && (alphaOffset == 3)
+ && (width <= blockPtr->width) && (height <= blockPtr->height)
+ && ((height == 1) || ((x == 0) && (width == masterPtr->width)
+ && (blockPtr->pitch == pitch)))
+ && (compRule == TK_PHOTO_COMPOSITE_SET)) {
+ memcpy((VOID *) destLinePtr,
+ (VOID *) (blockPtr->pixelPtr + blockPtr->offset[0]),
+ (size_t) (height * width * 4));
+ } else {
+ int alpha;
+ for (hLeft = height; hLeft > 0;) {
+ srcLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ hCopy = MIN(hLeft, blockPtr->height);
+ hLeft -= hCopy;
+ for (; hCopy > 0; --hCopy) {
+ if ((blockPtr->pixelSize == 4) && (greenOffset == 1)
+ && (blueOffset == 2) && (alphaOffset == 3)
+ && (width <= blockPtr->width)
+ && (compRule == TK_PHOTO_COMPOSITE_SET)) {
+ memcpy((VOID *) destLinePtr, (VOID *) srcLinePtr,
+ (size_t) (width * 4));
+ } else {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockPtr->width);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; --wCopy) {
+ alpha = srcPtr[alphaOffset];
+ /*
+ * In the easy case, we can just copy.
+ */
+ if (!alphaOffset || (alpha == 255)) {
+ /* new solid part of the image */
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = 255;
+ srcPtr += blockPtr->pixelSize;
+ continue;
+ }
+
+ /*
+ * Combine according to the compositing rule.
+ */
+ switch (compRule) {
+ case TK_PHOTO_COMPOSITE_SET:
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = alpha;
+ break;
+
+ case TK_PHOTO_COMPOSITE_OVERLAY:
+ if (!destPtr[3]) {
+ /*
+ * There must be a better way to select a
+ * background colour!
+ */
+ destPtr[0] = destPtr[1] = destPtr[2] = 0xd9;
+ }
+
+ if (alpha) {
+ destPtr[0] += (srcPtr[0] - destPtr[0]) * alpha / 255;
+ destPtr[1] += (srcPtr[greenOffset] - destPtr[1]) * alpha / 255;
+ destPtr[2] += (srcPtr[blueOffset] - destPtr[2]) * alpha / 255;
+ destPtr[3] += (255 - destPtr[3]) * alpha / 255;
+ }
+ /*
+ * else should be empty space
+ */
+ destPtr += 4;
+ break;
+
+ default:
+ panic("unknown compositing rule: %d", compRule);
+ }
+ srcPtr += blockPtr->pixelSize;
+ }
+ }
+ }
+ srcLinePtr += blockPtr->pitch;
+ destLinePtr += pitch;
+ }
+ }
+ }
+
+ /*
+ * Add this new block to the region which specifies which data is valid.
+ */
+
+ if (alphaOffset) {
+ int x1, y1, end;
+
+ /*
+ * This block is grossly inefficient. For each row in the image, it
+ * finds each continguous string of nontransparent pixels, then marks
+ * those areas as valid in the validRegion mask. This makes drawing
+ * very efficient, because of the way we use X: we just say, here's
+ * your mask, and here's your data. We need not worry about the
+ * current background color, etc. But this costs us a lot on the
+ * image setup. Still, image setup only happens once, whereas the
+ * drawing happens many times, so this might be the best way to go.
+ *
+ * An alternative might be to not set up this mask, and instead, at
+ * drawing time, for each transparent pixel, set its color to the
+ * color of the background behind that pixel. This is what I suspect
+ * most of programs do. However, they don't have to deal with the
+ * canvas, which could have many different background colors.
+ * Determining the correct bg color for a given pixel might be
+ * expensive.
+ */
+
+ if (compRule != TK_PHOTO_COMPOSITE_OVERLAY) {
+ /*
+ * Don't need this when using the OVERLAY compositing rule,
+ * which always strictly increases the valid region.
+ */
+ TkRegion workRgn = TkCreateRegion();
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, workRgn, workRgn);
+ TkSubtractRegion(masterPtr->validRegion, workRgn,
+ masterPtr->validRegion);
+ TkDestroyRegion(workRgn);
+ }
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4 + 3;
+ for (y1 = 0; y1 < height; y1++) {
+ x1 = 0;
+ destPtr = destLinePtr;
+ while (x1 < width) {
+ /* search for first non-transparent pixel */
+ while ((x1 < width) && !*destPtr) {
+ x1++;
+ destPtr += 4;
+ }
+ end = x1;
+ /* search for first transparent pixel */
+ while ((end < width) && *destPtr) {
+ end++;
+ destPtr += 4;
+ }
+ if (end > x1) {
+ rect.x = x + x1;
+ rect.y = y + y1;
+ rect.width = end - x1;
+ rect.height = 1;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+ x1 = end;
+ }
+ destLinePtr += masterPtr->width * 4;
+ }
+ } else {
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+
+ /*
+ * Update each instance.
+ */
+
+ Tk_DitherPhoto((Tk_PhotoHandle)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, compRule)
+ 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. */
+ int compRule; /* Compositing rule to use when processing
+ * transparent pixels. */
+{
+ 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, compRule);
+ 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);
+ if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ 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 = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
+ 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--) {
+ /*
+ * Common case (solid pixels) first
+ */
+ if (!alphaOffset || (srcPtr[alphaOffset] == 255)) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = 255;
+ continue;
+ }
+
+ switch (compRule) {
+ case TK_PHOTO_COMPOSITE_SET:
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = srcPtr[alphaOffset];
+ break;
+ case TK_PHOTO_COMPOSITE_OVERLAY:
+ if (!destPtr[3]) {
+ /*
+ * There must be a better way to select a
+ * background colour!
+ */
+ destPtr[0] = destPtr[1] = destPtr[2] = 0xd9;
+ }
+ if (srcPtr[alphaOffset]) {
+ destPtr[0] += (srcPtr[0] - destPtr[0]) * srcPtr[alphaOffset] / 255;
+ destPtr[1] += (srcPtr[greenOffset] - destPtr[1]) * srcPtr[alphaOffset] / 255;
+ destPtr[2] += (srcPtr[blueOffset] - destPtr[2]) * srcPtr[alphaOffset] / 255;
+ destPtr[3] += (255 - destPtr[3]) * srcPtr[alphaOffset] / 255;
+ }
+ destPtr += 4;
+ break;
+ default:
+ panic("unknown compositing rule: %d", compRule);
+ }
+ }
+ srcPtr += blockXSkip;
+ }
+ }
+ destLinePtr += pitch;
+ yRepeat--;
+ if (yRepeat <= 0) {
+ srcLinePtr += blockYSkip;
+ yRepeat = zoomY;
+ }
+ }
+ }
+
+ /*
+ * Recompute the region of data for which we have valid pixels to plot.
+ */
+
+ if (alphaOffset) {
+ int x1, y1, end;
+
+ if (compRule != TK_PHOTO_COMPOSITE_OVERLAY) {
+ /*
+ * Don't need this when using the OVERLAY compositing rule, which
+ * always strictly increases the valid region.
+ */
+ TkRegion workRgn = TkCreateRegion();
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = 1;
+ TkUnionRectWithRegion(&rect, workRgn, workRgn);
+ TkSubtractRegion(masterPtr->validRegion, workRgn,
+ masterPtr->validRegion);
+ TkDestroyRegion(workRgn);
+ }
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4 + 3;
+ for (y1 = 0; y1 < height; y1++) {
+ x1 = 0;
+ destPtr = destLinePtr;
+ while (x1 < width) {
+ /* search for first non-transparent pixel */
+ while ((x1 < width) && !*destPtr) {
+ x1++;
+ destPtr += 4;
+ }
+ end = x1;
+ /* search for first transparent pixel */
+ while ((end < width) && *destPtr) {
+ end++;
+ destPtr += 4;
+ }
+ if (end > x1) {
+ rect.x = x + x1;
+ rect.y = y + y1;
+ rect.width = end - x1;
+ rect.height = 1;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+ x1 = end;
+ }
+ destLinePtr += masterPtr->width * 4;
+ }
+ } else {
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+
+ /*
+ * Update each instance.
+ */
+
+ Tk_DitherPhoto((Tk_PhotoHandle)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_DitherPhoto --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DitherPhoto(photo, x, y, width, height)
+ Tk_PhotoHandle photo; /* 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. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) photo;
+ 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)) {
+ if (ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width),
+ MAX(height, masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ 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;
+ if (ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width),
+ ((height > 0) ? height: masterPtr->height)) == TCL_ERROR) {
+ panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetPhotoValidRegion --
+ *
+ * This procedure is called to get the part of the photo where
+ * there is valid data. Or, conversely, the part of the photo
+ * which is transparent.
+ *
+ * Results:
+ * A TkRegion value that indicates the current area of the photo
+ * that is valid. This value should not be used after any
+ * modification to the photo image.
+ *
+ * Side Effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkRegion
+TkPhotoGetValidRegion(handle)
+ Tk_PhotoHandle handle; /* Handle for the image whose valid region
+ * is to obtained. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ return masterPtr->validRegion;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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((unsigned int) (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, formatString, blockPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *formatString;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ int row,col;
+ char *line, *linePtr;
+ unsigned char *pixelPtr;
+ int greenOffset, blueOffset;
+ Tcl_DString data;
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ Tcl_DStringInit(&data);
+ if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
+ line = (char *) ckalloc((unsigned int) ((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(&data, line+1);
+ }
+ ckfree (line);
+ }
+ Tcl_DStringResult(interp, &data);
+ 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;
+ blockPtr->offset[3] = 3;
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PhotoOptionFind --
+ *
+ * Finds a specific Photo option.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * After commands are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef struct OptionAssocData {
+ struct OptionAssocData *nextPtr; /* pointer to next OptionAssocData */
+ Tcl_ObjCmdProc *command; /* command associated with this
+ * option */
+ char name[1]; /* name of option (remaining chars) */
+} OptionAssocData;
+
+static Tcl_ObjCmdProc *
+PhotoOptionFind(interp, obj)
+ Tcl_Interp *interp; /* Interpreter that is being deleted. */
+ Tcl_Obj *obj; /* Name of option to be found. */
+{
+ size_t length;
+ char *name = Tcl_GetStringFromObj(obj, (int *) &length);
+ OptionAssocData *list;
+ char *prevname = NULL;
+ Tcl_ObjCmdProc *proc = (Tcl_ObjCmdProc *) NULL;
+ list = (OptionAssocData *) Tcl_GetAssocData(interp, "photoOption",
+ (Tcl_InterpDeleteProc **) NULL);
+ while (list != (OptionAssocData *) NULL) {
+ if (strncmp(name, list->name, length) == 0) {
+ if (proc != (Tcl_ObjCmdProc *) NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "ambiguous option \"", name,
+ "\": must be ", prevname, (char *) NULL);
+ while (list->nextPtr != (OptionAssocData *) NULL) {
+ Tcl_AppendResult(interp, prevname, ", ",(char *) NULL);
+ list = list->nextPtr;
+ prevname = list->name;
+ }
+ Tcl_AppendResult(interp, ", or", prevname, (char *) NULL);
+ return (Tcl_ObjCmdProc *) NULL;
+ }
+ proc = list->command;
+ prevname = list->name;
+ }
+ list = list->nextPtr;
+ }
+ if (proc != (Tcl_ObjCmdProc *) NULL) {
+ Tcl_ResetResult(interp);
+ }
+ return proc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PhotoOptionCleanupProc --
+ *
+ * This procedure is invoked whenever an interpreter is deleted
+ * to cleanup the AssocData for "photoVisitor".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Photo Visitor options are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PhotoOptionCleanupProc(clientData, interp)
+ ClientData clientData; /* Points to "photoVisitor" AssocData
+ * for the interpreter. */
+ Tcl_Interp *interp; /* Interpreter that is being deleted. */
+{
+ OptionAssocData *list = (OptionAssocData *) clientData;
+ OptionAssocData *ptr;
+
+ while (list != NULL) {
+ list = (ptr = list)->nextPtr;
+ ckfree((char *) ptr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreatePhotoOption --
+ *
+ * This procedure may be invoked to add a new kind of photo
+ * option to the core photo command supported by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, the new option will be useable by the
+ * photo command.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreatePhotoOption(interp, name, proc)
+ Tcl_Interp *interp; /* interpreter */
+ CONST char *name; /* option name */
+ Tcl_ObjCmdProc *proc; /* proc to execute command */
+{
+ OptionAssocData *typePtr2, *prevPtr, *ptr;
+ OptionAssocData *list;
+
+ list = (OptionAssocData *) Tcl_GetAssocData(interp, "photoOption",
+ (Tcl_InterpDeleteProc **) NULL);
+
+ /*
+ * If there's already a photo option with the given name, remove it.
+ */
+
+ for (typePtr2 = list, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (strcmp(typePtr2->name, name) == 0) {
+ if (prevPtr == NULL) {
+ list = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ ckfree((char *) typePtr2);
+ break;
+ }
+ }
+ ptr = (OptionAssocData *) ckalloc(sizeof(OptionAssocData) + strlen(name));
+ strcpy(&(ptr->name[0]), name);
+ ptr->command = proc;
+ ptr->nextPtr = list;
+ Tcl_SetAssocData(interp, "photoOption", PhotoOptionCleanupProc,
+ (ClientData) ptr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostscriptPhoto --
+ *
+ * This procedure is called to output the contents of a
+ * photo image in Postscript by calling the Tk_PostscriptPhoto
+ * function.
+ *
+ * Results:
+ * Returns a standard Tcl return value.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+ImgPhotoPostscript(clientData, interp, tkwin, psInfo,
+ x, y, width, height, prepass)
+ ClientData clientData; /* Handle for the photo image */
+ Tcl_Interp *interp; /* Interpreter */
+ Tk_Window tkwin; /* (unused) */
+ Tk_PostscriptInfo psInfo; /* postscript info */
+ int x, y; /* First pixel to output */
+ int width, height; /* Width and height of area */
+ int prepass; /* (unused) */
+{
+ Tk_PhotoImageBlock block;
+
+ Tk_PhotoGetImage((Tk_PhotoHandle) clientData, &block);
+ block.pixelPtr += y * block.pitch + x * block.pixelSize;
+
+ return Tk_PostscriptPhoto(interp, &block, psInfo, width, height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutBlock_NoComposite, Tk_PhotoPutZoomedBlock_NoComposite --
+ *
+ * These backward-compatability functions just exist to fill slots in
+ * stubs table. For the behaviour of *_NoComposite, refer to the
+ * corresponding function without the extra suffix.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tk_PhotoPutBlock_NoComposite(handle, blockPtr, x, y, width, height)
+ Tk_PhotoHandle handle;
+ Tk_PhotoImageBlock *blockPtr;
+ int x, y, width, height;
+{
+ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height,
+ TK_PHOTO_COMPOSITE_OVERLAY);
+}
+
+void
+Tk_PhotoPutZoomedBlock_NoComposite(handle, blockPtr, x, y, width, height,
+ zoomX, zoomY, subsampleX, subsampleY)
+ Tk_PhotoHandle handle;
+ Tk_PhotoImageBlock *blockPtr;
+ int x, y, width, height, zoomX, zoomY, subsampleX, subsampleY;
+{
+ Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height,
+ zoomX, zoomY, subsampleX, subsampleY, TK_PHOTO_COMPOSITE_OVERLAY);
+}
diff --git a/tcl/generic/tkImgUtil.c b/tcl/generic/tkImgUtil.c
new file mode 100644
index 00000000000..b865c9ca18f
--- /dev/null
+++ b/tcl/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/tcl/generic/tkInitScript.h b/tcl/generic/tkInitScript.h
new file mode 100644
index 00000000000..e64c1436be3
--- /dev/null
+++ b/tcl/generic/tkInitScript.h
@@ -0,0 +1,58 @@
+/*
+ * tkInitScript.h --
+ *
+ * This file contains Unix & Windows common init script
+ * It is not used on the Mac. (the mac init script is in tkMacInit.c)
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+
+
+/*
+ * 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/tcl/generic/tkInt.decls b/tcl/generic/tkInt.decls
new file mode 100644
index 00000000000..9046efd34b8
--- /dev/null
+++ b/tcl/generic/tkInt.decls
@@ -0,0 +1,2234 @@
+ # tkInt.decls --
+#
+# This file contains the declarations for all unsupported
+# functions that are exported by the Tk library. This file
+# is used to generate the tkIntDecls.h, tkIntPlatDecls.h,
+# tkIntStub.c, and tkPlatStub.c files.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+library tk
+
+# Define the unsupported generic interfaces.
+
+interface tkInt
+
+# Declare each of the functions in the unsupported internal Tcl
+# interface. These interfaces are allowed to changed between versions.
+# Use at your own risk. Note that the position of functions should not
+# be changed between versions to avoid gratuitous incompatibilities.
+
+declare 0 generic {
+ TkWindow * TkAllocWindow (TkDisplay *dispPtr, int screenNum, \
+ TkWindow *parentPtr)
+}
+
+declare 1 generic {
+ void TkBezierPoints (double control[], int numSteps, double *coordPtr)
+}
+
+declare 2 generic {
+ void TkBezierScreenPoints (Tk_Canvas canvas, double control[], \
+ int numSteps, XPoint *xPointPtr)
+}
+
+declare 3 generic {
+ void TkBindDeadWindow (TkWindow *winPtr)
+}
+
+declare 4 generic {
+ void TkBindEventProc (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 5 generic {
+ void TkBindFree (TkMainInfo *mainPtr)
+}
+
+declare 6 generic {
+ void TkBindInit (TkMainInfo *mainPtr)
+}
+
+declare 7 generic {
+ void TkChangeEventWindow (XEvent *eventPtr, TkWindow *winPtr)
+}
+
+declare 8 generic {
+ int TkClipInit (Tcl_Interp *interp, TkDisplay *dispPtr)
+}
+
+declare 9 generic {
+ void TkComputeAnchor (Tk_Anchor anchor, Tk_Window tkwin, \
+ int padX, int padY, int innerWidth, int innerHeight, \
+ int *xPtr, int *yPtr)
+}
+
+declare 10 generic {
+ int TkCopyAndGlobalEval (Tcl_Interp *interp, char *script)
+}
+
+declare 11 generic {
+ unsigned long TkCreateBindingProcedure (Tcl_Interp *interp, \
+ Tk_BindingTable bindingTable, \
+ ClientData object, CONST char *eventString, \
+ TkBindEvalProc *evalProc, TkBindFreeProc *freeProc, \
+ ClientData clientData)
+}
+
+declare 12 generic {
+ TkCursor * TkCreateCursorFromData (Tk_Window tkwin, \
+ CONST char *source, CONST char *mask, int width, int height, \
+ int xHot, int yHot, XColor fg, XColor bg)
+}
+
+declare 13 generic {
+ int TkCreateFrame (ClientData clientData, \
+ Tcl_Interp *interp, int argc, char **argv, \
+ int toplevel, char *appName)
+}
+
+declare 14 generic {
+ Tk_Window TkCreateMainWindow (Tcl_Interp *interp, \
+ CONST char *screenName, char *baseName)
+}
+
+declare 15 generic {
+ Time TkCurrentTime (TkDisplay *dispPtr)
+}
+
+declare 16 generic {
+ void TkDeleteAllImages (TkMainInfo *mainPtr)
+}
+
+declare 17 generic {
+ void TkDoConfigureNotify (TkWindow *winPtr)
+}
+
+declare 18 generic {
+ void TkDrawInsetFocusHighlight (Tk_Window tkwin, GC gc, int width, \
+ Drawable drawable, int padding)
+}
+
+declare 19 generic {
+ void TkEventDeadWindow (TkWindow *winPtr)
+}
+
+declare 20 generic {
+ void TkFillPolygon (Tk_Canvas canvas, \
+ double *coordPtr, int numPoints, Display *display, \
+ Drawable drawable, GC gc, GC outlineGC)
+}
+
+declare 21 generic {
+ int TkFindStateNum (Tcl_Interp *interp, \
+ CONST char *option, CONST TkStateMap *mapPtr, \
+ CONST char *strKey)
+}
+
+declare 22 generic {
+ char * TkFindStateString (CONST TkStateMap *mapPtr, int numKey)
+}
+
+declare 23 generic {
+ void TkFocusDeadWindow (TkWindow *winPtr)
+}
+
+declare 24 generic {
+ int TkFocusFilterEvent (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 25 generic {
+ TkWindow * TkFocusKeyEvent (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 26 generic {
+ void TkFontPkgInit (TkMainInfo *mainPtr)
+}
+
+declare 27 generic {
+ void TkFontPkgFree (TkMainInfo *mainPtr)
+}
+
+declare 28 generic {
+ void TkFreeBindingTags (TkWindow *winPtr)
+}
+
+# Name change only, TkFreeCursor in Tcl 8.0.x now TkpFreeCursor
+declare 29 generic {
+ void TkpFreeCursor (TkCursor *cursorPtr)
+}
+
+declare 30 generic {
+ char * TkGetBitmapData (Tcl_Interp *interp, \
+ char *string, char *fileName, int *widthPtr, \
+ int *heightPtr, int *hotXPtr, int *hotYPtr)
+}
+
+declare 31 generic {
+ void TkGetButtPoints (double p1[], double p2[], \
+ double width, int project, double m1[], double m2[])
+}
+
+declare 32 generic {
+ TkCursor * TkGetCursorByName (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tk_Uid string)
+}
+
+declare 33 generic {
+ CONST84_RETURN char * TkGetDefaultScreenName (Tcl_Interp *interp, \
+ CONST char *screenName)
+}
+
+declare 34 generic {
+ TkDisplay * TkGetDisplay (Display *display)
+}
+
+declare 35 generic {
+ int TkGetDisplayOf (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \
+ Tk_Window *tkwinPtr)
+}
+
+declare 36 generic {
+ TkWindow * TkGetFocusWin (TkWindow *winPtr)
+}
+
+declare 37 generic {
+ int TkGetInterpNames (Tcl_Interp *interp, Tk_Window tkwin)
+}
+
+declare 38 generic {
+ int TkGetMiterPoints (double p1[], double p2[], double p3[], \
+ double width, double m1[],double m2[])
+}
+
+declare 39 generic {
+ void TkGetPointerCoords (Tk_Window tkwin, int *xPtr, int *yPtr)
+}
+
+declare 40 generic {
+ void TkGetServerInfo (Tcl_Interp *interp, Tk_Window tkwin)
+}
+
+declare 41 generic {
+ void TkGrabDeadWindow (TkWindow *winPtr)
+}
+
+declare 42 generic {
+ int TkGrabState (TkWindow *winPtr)
+}
+
+declare 43 generic {
+ void TkIncludePoint (Tk_Item *itemPtr, double *pointPtr)
+}
+
+declare 44 generic {
+ void TkInOutEvents (XEvent *eventPtr, TkWindow *sourcePtr, \
+ TkWindow *destPtr, int leaveType, int enterType, \
+ Tcl_QueuePosition position)
+}
+
+declare 45 generic {
+ void TkInstallFrameMenu (Tk_Window tkwin)
+}
+
+declare 46 generic {
+ char * TkKeysymToString (KeySym keysym)
+}
+
+declare 47 generic {
+ int TkLineToArea (double end1Ptr[], double end2Ptr[], double rectPtr[])
+}
+
+declare 48 generic {
+ double TkLineToPoint (double end1Ptr[], \
+ double end2Ptr[], double pointPtr[])
+}
+
+declare 49 generic {
+ int TkMakeBezierCurve (Tk_Canvas canvas, \
+ double *pointPtr, int numPoints, int numSteps, \
+ XPoint xPoints[], double dblPoints[])
+}
+
+declare 50 generic {
+ void TkMakeBezierPostscript (Tcl_Interp *interp, \
+ Tk_Canvas canvas, double *pointPtr, int numPoints)
+}
+
+declare 51 generic {
+ void TkOptionClassChanged (TkWindow *winPtr)
+}
+
+declare 52 generic {
+ void TkOptionDeadWindow (TkWindow *winPtr)
+}
+
+declare 53 generic {
+ int TkOvalToArea (double *ovalPtr, double *rectPtr)
+}
+
+declare 54 generic {
+ double TkOvalToPoint (double ovalPtr[], \
+ double width, int filled, double pointPtr[])
+}
+
+declare 55 generic {
+ int TkpChangeFocus (TkWindow *winPtr, int force)
+}
+
+declare 56 generic {
+ void TkpCloseDisplay (TkDisplay *dispPtr)
+}
+
+declare 57 generic {
+ void TkpClaimFocus (TkWindow *topLevelPtr, int force)
+}
+
+declare 58 generic {
+ void TkpDisplayWarning (CONST char *msg, CONST char *title)
+}
+
+declare 59 generic {
+ void TkpGetAppName (Tcl_Interp *interp, Tcl_DString *name)
+}
+
+declare 60 generic {
+ TkWindow * TkpGetOtherWindow (TkWindow *winPtr)
+}
+
+declare 61 generic {
+ TkWindow * TkpGetWrapperWindow (TkWindow *winPtr)
+}
+
+declare 62 generic {
+ int TkpInit (Tcl_Interp *interp)
+}
+
+declare 63 generic {
+ void TkpInitializeMenuBindings (Tcl_Interp *interp, \
+ Tk_BindingTable bindingTable)
+}
+
+declare 64 generic {
+ void TkpMakeContainer (Tk_Window tkwin)
+}
+
+declare 65 generic {
+ void TkpMakeMenuWindow (Tk_Window tkwin, int transient)
+}
+
+declare 66 generic {
+ Window TkpMakeWindow (TkWindow *winPtr, Window parent)
+}
+
+declare 67 generic {
+ void TkpMenuNotifyToplevelCreate (Tcl_Interp *interp1, char *menuName)
+}
+
+declare 68 generic {
+ TkDisplay * TkpOpenDisplay (CONST char *display_name)
+}
+
+declare 69 generic {
+ int TkPointerEvent (XEvent *eventPtr, TkWindow *winPtr)
+}
+
+declare 70 generic {
+ int TkPolygonToArea (double *polyPtr, int numPoints, double *rectPtr)
+}
+
+declare 71 generic {
+ double TkPolygonToPoint (double *polyPtr, int numPoints, double *pointPtr)
+}
+
+declare 72 generic {
+ int TkPositionInTree (TkWindow *winPtr, TkWindow *treePtr)
+}
+
+declare 73 generic {
+ void TkpRedirectKeyEvent (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 74 generic {
+ void TkpSetMainMenubar (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *menuName)
+}
+
+declare 75 generic {
+ int TkpUseWindow (Tcl_Interp *interp, Tk_Window tkwin, CONST char *string)
+}
+
+declare 76 generic {
+ int TkpWindowWasRecentlyDeleted (Window win, TkDisplay *dispPtr)
+}
+
+declare 77 generic {
+ void TkQueueEventForAllChildren (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 78 generic {
+ int TkReadBitmapFile (Display* display, Drawable d, CONST char* filename, \
+ unsigned int* width_return, unsigned int* height_return, \
+ Pixmap* bitmap_return, int* x_hot_return, int* y_hot_return)
+}
+
+declare 79 generic {
+ int TkScrollWindow (Tk_Window tkwin, GC gc, \
+ int x, int y, int width, int height, int dx, \
+ int dy, TkRegion damageRgn)
+}
+
+declare 80 generic {
+ void TkSelDeadWindow (TkWindow *winPtr)
+}
+
+declare 81 generic {
+ void TkSelEventProc (Tk_Window tkwin, XEvent *eventPtr)
+}
+
+declare 82 generic {
+ void TkSelInit (Tk_Window tkwin)
+}
+
+declare 83 generic {
+ void TkSelPropProc (XEvent *eventPtr)
+}
+
+# Exported publically as Tk_SetClassProcs in 8.4a2
+#declare 84 generic {
+# void TkSetClassProcs (Tk_Window tkwin, \
+# TkClassProcs *procs, ClientData instanceData)
+#}
+
+declare 85 generic {
+ void TkSetWindowMenuBar (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *oldMenuName, char *menuName)
+}
+
+declare 86 generic {
+ KeySym TkStringToKeysym (char *name)
+}
+
+declare 87 generic {
+ int TkThickPolyLineToArea (double *coordPtr, \
+ int numPoints, double width, int capStyle, \
+ int joinStyle, double *rectPtr)
+}
+
+declare 88 generic {
+ void TkWmAddToColormapWindows (TkWindow *winPtr)
+}
+
+declare 89 generic {
+ void TkWmDeadWindow (TkWindow *winPtr)
+}
+
+declare 90 generic {
+ TkWindow * TkWmFocusToplevel (TkWindow *winPtr)
+}
+
+declare 91 generic {
+ void TkWmMapWindow (TkWindow *winPtr)
+}
+
+declare 92 generic {
+ void TkWmNewWindow (TkWindow *winPtr)
+}
+
+declare 93 generic {
+ void TkWmProtocolEventProc (TkWindow *winPtr, XEvent *evenvPtr)
+}
+
+declare 94 generic {
+ void TkWmRemoveFromColormapWindows (TkWindow *winPtr)
+}
+
+declare 95 generic {
+ void TkWmRestackToplevel (TkWindow *winPtr, int aboveBelow, \
+ TkWindow *otherPtr)
+}
+
+declare 96 generic {
+ void TkWmSetClass (TkWindow *winPtr)
+}
+
+declare 97 generic {
+ void TkWmUnmapWindow (TkWindow *winPtr)
+}
+
+# new for 8.1
+
+declare 98 generic {
+ Tcl_Obj * TkDebugBitmap ( Tk_Window tkwin, char *name)
+}
+
+declare 99 generic {
+ Tcl_Obj * TkDebugBorder ( Tk_Window tkwin, char *name)
+}
+
+declare 100 generic {
+ Tcl_Obj * TkDebugCursor ( Tk_Window tkwin, char *name)
+}
+
+declare 101 generic {
+ Tcl_Obj * TkDebugColor ( Tk_Window tkwin, char *name)
+}
+
+declare 102 generic {
+ Tcl_Obj * TkDebugConfig (Tcl_Interp *interp, Tk_OptionTable table)
+}
+
+declare 103 generic {
+ Tcl_Obj * TkDebugFont ( Tk_Window tkwin, char *name)
+}
+
+declare 104 generic {
+ int TkFindStateNumObj (Tcl_Interp *interp, \
+ Tcl_Obj *optionPtr, CONST TkStateMap *mapPtr, \
+ Tcl_Obj *keyPtr)
+}
+
+declare 105 generic {
+ Tcl_HashTable * TkGetBitmapPredefTable (void)
+}
+
+declare 106 generic {
+ TkDisplay * TkGetDisplayList (void)
+}
+
+declare 107 generic {
+ TkMainInfo * TkGetMainInfoList (void)
+}
+
+declare 108 generic {
+ int TkGetWindowFromObj (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tcl_Obj *objPtr, \
+ Tk_Window *windowPtr)
+}
+
+declare 109 generic {
+ char * TkpGetString (TkWindow *winPtr, \
+ XEvent *eventPtr, Tcl_DString *dsPtr)
+}
+
+declare 110 generic {
+ void TkpGetSubFonts (Tcl_Interp *interp, Tk_Font tkfont)
+}
+
+declare 111 generic {
+ Tcl_Obj * TkpGetSystemDefault (Tk_Window tkwin, \
+ CONST char *dbName, CONST char *className)
+}
+
+declare 112 generic {
+ void TkpMenuThreadInit (void)
+}
+
+declare 113 {mac aqua win} {
+ void TkClipBox (TkRegion rgn, XRectangle* rect_return)
+}
+
+declare 114 {mac aqua win} {
+ TkRegion TkCreateRegion (void)
+}
+
+declare 115 {mac aqua win} {
+ void TkDestroyRegion (TkRegion rgn)
+}
+
+declare 116 {mac aqua win} {
+ void TkIntersectRegion (TkRegion sra, TkRegion srcb, TkRegion dr_return)
+}
+
+declare 117 {mac aqua win} {
+ int TkRectInRegion (TkRegion rgn, int x, int y, unsigned int width, \
+ unsigned int height)
+}
+
+declare 118 {mac aqua win} {
+ void TkSetRegion (Display* display, GC gc, TkRegion rgn)
+}
+
+declare 119 {mac aqua win} {
+ void TkUnionRectWithRegion (XRectangle* rect, \
+ TkRegion src, TkRegion dr_return)
+}
+
+# removed duplicate from tkIntPlat table
+#declare 120 mac {
+# void TkGenerateActivateEvents (TkWindow *winPtr, int active)
+#}
+
+declare 121 {mac aqua} {
+ Pixmap TkpCreateNativeBitmap (Display *display, CONST char * source)
+}
+
+declare 122 {mac aqua} {
+ void TkpDefineNativeBitmaps (void)
+}
+
+# removed duplicate from tkIntPlat table
+#declare 123 mac {
+# unsigned long TkpGetMS (void)
+#}
+
+declare 124 {mac aqua} {
+ Pixmap TkpGetNativeAppBitmap (Display *display, \
+ CONST char *name, int *width, int *height)
+}
+
+# removed duplicates from tkIntPlat table
+#declare 125 mac {
+# void TkPointerDeadWindow (TkWindow *winPtr)
+#}
+#
+#declare 126 mac {
+# void TkpSetCapture (TkWindow *winPtr)
+#}
+#
+#declare 127 mac {
+# void TkpSetCursor (TkpCursor cursor)
+#}
+#
+#declare 128 mac {
+# void TkpWmSetState (TkWindow *winPtr, int state)
+#}
+#
+#declare 130 mac {
+# Window TkGetTransientMaster (TkWindow *winPtr)
+#}
+#
+#declare 131 mac {
+# int TkGenerateButtonEvent (int x, int y, \
+# Window window, unsigned int state)
+#}
+#
+#declare 133 mac {
+# void TkGenWMDestroyEvent (Tk_Window tkwin)
+#}
+#
+#declare 134 mac {
+# void TkGenWMConfigureEvent (Tk_Window tkwin, int x, int y, \
+# int width, int height, int flags)
+#}
+
+declare 135 generic {
+ void TkpDrawHighlightBorder (Tk_Window tkwin, GC fgGC, GC bgGC, \
+ int highlightWidth, Drawable drawable)
+}
+
+declare 136 generic {
+ void TkSetFocusWin (TkWindow *winPtr, int force)
+}
+
+declare 137 generic {
+ void TkpSetKeycodeAndState (Tk_Window tkwin, KeySym keySym, \
+ XEvent *eventPtr)
+}
+
+declare 138 generic {
+ KeySym TkpGetKeySym (TkDisplay *dispPtr, XEvent *eventPtr)
+}
+
+declare 139 generic {
+ void TkpInitKeymapInfo (TkDisplay *dispPtr)
+}
+
+declare 140 generic {
+ TkRegion TkPhotoGetValidRegion (Tk_PhotoHandle handle)
+}
+
+declare 141 generic {
+ TkWindow ** TkWmStackorderToplevel(TkWindow *parentPtr)
+}
+
+declare 142 generic {
+ void TkFocusFree(TkMainInfo *mainPtr)
+}
+
+declare 143 generic {
+ void TkClipCleanup(TkDisplay *dispPtr)
+}
+
+declare 144 generic {
+ void TkGCCleanup(TkDisplay *dispPtr)
+}
+
+declare 145 {mac win aqua} {
+ void TkSubtractRegion (TkRegion sra, TkRegion srcb, TkRegion dr_return)
+}
+
+declare 146 generic {
+ void TkStylePkgInit (TkMainInfo *mainPtr)
+}
+declare 147 generic {
+ void TkStylePkgFree (TkMainInfo *mainPtr)
+}
+
+##############################################################################
+
+# Define the platform specific internal Tcl interface. These functions are
+# only available on the designated platform.
+
+interface tkIntPlat
+
+#########################
+# Unix specific functions
+
+declare 0 x11 {
+ void TkCreateXEventSource (void)
+}
+
+declare 1 x11 {
+ void TkFreeWindowId (TkDisplay *dispPtr, Window w)
+}
+
+declare 2 x11 {
+ void TkInitXId (TkDisplay *dispPtr)
+}
+
+declare 3 x11 {
+ int TkpCmapStressed (Tk_Window tkwin, Colormap colormap)
+}
+
+declare 4 x11 {
+ void TkpSync (Display *display)
+}
+
+declare 5 x11 {
+ Window TkUnixContainerId (TkWindow *winPtr)
+}
+
+declare 6 x11 {
+ int TkUnixDoOneXEvent (Tcl_Time *timePtr)
+}
+
+declare 7 x11 {
+ void TkUnixSetMenubar (Tk_Window tkwin, Tk_Window menubar)
+}
+
+declare 8 x11 {
+ int TkpScanWindowId (Tcl_Interp *interp, CONST char *string, Window *idPtr)
+}
+
+declare 9 x11 {
+ void TkWmCleanup (TkDisplay *dispPtr)
+}
+
+declare 10 x11 {
+ void TkSendCleanup (TkDisplay *dispPtr)
+}
+
+declare 11 x11 {
+ void TkFreeXId (TkDisplay *dispPtr)
+}
+
+declare 12 x11 {
+ int TkpWmSetState (TkWindow *winPtr, int state)
+}
+
+############################
+# Windows specific functions
+
+declare 0 win {
+ char * TkAlignImageData (XImage *image, int alignment, int bitOrder)
+}
+
+declare 2 win {
+ void TkGenerateActivateEvents (TkWindow *winPtr, int active)
+}
+
+declare 3 win {
+ unsigned long TkpGetMS (void)
+}
+
+declare 4 win {
+ void TkPointerDeadWindow (TkWindow *winPtr)
+}
+
+declare 5 win {
+ void TkpPrintWindowId (char *buf, Window window)
+}
+
+declare 6 win {
+ int TkpScanWindowId (Tcl_Interp *interp, CONST char *string, Window *idPtr)
+}
+
+declare 7 win {
+ void TkpSetCapture (TkWindow *winPtr)
+}
+
+declare 8 win {
+ void TkpSetCursor (TkpCursor cursor)
+}
+
+declare 9 win {
+ void TkpWmSetState (TkWindow *winPtr, int state)
+}
+
+declare 10 win {
+ void TkSetPixmapColormap (Pixmap pixmap, Colormap colormap)
+}
+
+declare 11 win {
+ void TkWinCancelMouseTimer (void)
+}
+
+declare 12 win {
+ void TkWinClipboardRender (TkDisplay *dispPtr, UINT format)
+}
+
+declare 13 win {
+ LRESULT TkWinEmbeddedEventProc (HWND hwnd, UINT message, \
+ WPARAM wParam, LPARAM lParam)
+}
+
+declare 14 win {
+ void TkWinFillRect (HDC dc, int x, int y, int width, int height, \
+ int pixel)
+}
+
+declare 15 win {
+ COLORREF TkWinGetBorderPixels (Tk_Window tkwin, Tk_3DBorder border, \
+ int which)
+}
+
+declare 16 win {
+ HDC TkWinGetDrawableDC (Display *display, Drawable d, TkWinDCState* state)
+}
+
+declare 17 win {
+ int TkWinGetModifierState (void)
+}
+
+declare 18 win {
+ HPALETTE TkWinGetSystemPalette (void)
+}
+
+declare 19 win {
+ HWND TkWinGetWrapperWindow (Tk_Window tkwin)
+}
+
+declare 20 win {
+ int TkWinHandleMenuEvent (HWND *phwnd, \
+ UINT *pMessage, WPARAM *pwParam, LPARAM *plParam, \
+ LRESULT *plResult)
+}
+
+declare 21 win {
+ int TkWinIndexOfColor (XColor *colorPtr)
+}
+
+declare 22 win {
+ void TkWinReleaseDrawableDC (Drawable d, HDC hdc, TkWinDCState* state)
+}
+
+declare 23 win {
+ LRESULT TkWinResendEvent (WNDPROC wndproc, HWND hwnd, XEvent *eventPtr)
+}
+
+declare 24 win {
+ HPALETTE TkWinSelectPalette (HDC dc, Colormap colormap)
+}
+
+declare 25 win {
+ void TkWinSetMenu (Tk_Window tkwin, HMENU hMenu)
+}
+
+declare 26 win {
+ void TkWinSetWindowPos (HWND hwnd, HWND siblingHwnd, int pos)
+}
+
+declare 27 win {
+ void TkWinWmCleanup (HINSTANCE hInstance)
+}
+
+declare 28 win {
+ void TkWinXCleanup (HINSTANCE hInstance)
+}
+
+declare 29 win {
+ void TkWinXInit (HINSTANCE hInstance)
+}
+
+# new for 8.1
+
+declare 30 win {
+ void TkWinSetForegroundWindow (TkWindow *winPtr)
+}
+
+declare 31 win {
+ void TkWinDialogDebug (int debug)
+}
+
+declare 32 win {
+ Tcl_Obj * TkWinGetMenuSystemDefault (Tk_Window tkwin, \
+ CONST char *dbName, CONST char *className)
+}
+
+declare 33 win {
+ int TkWinGetPlatformId(void)
+}
+
+########################
+# Mac specific functions
+
+declare 0 mac {
+ void TkGenerateActivateEvents (TkWindow *winPtr, int active)
+}
+
+# removed duplicates from tkInt table
+#declare 1 mac {
+# Pixmap TkpCreateNativeBitmap (Display *display, CONST char * source)
+#}
+#
+#declare 2 mac {
+# void TkpDefineNativeBitmaps (void)
+#}
+
+declare 3 mac {
+ unsigned long TkpGetMS (void)
+}
+
+declare 5 mac {
+ void TkPointerDeadWindow (TkWindow *winPtr)
+}
+
+declare 6 mac {
+ void TkpSetCapture (TkWindow *winPtr)
+}
+
+declare 7 mac {
+ void TkpSetCursor (TkpCursor cursor)
+}
+
+declare 8 mac {
+ void TkpWmSetState (TkWindow *winPtr, int state)
+}
+
+declare 10 mac {
+ void TkAboutDlg (void)
+}
+
+declare 13 mac {
+ Window TkGetTransientMaster (TkWindow *winPtr)
+}
+
+declare 14 mac {
+ int TkGenerateButtonEvent (int x, int y, \
+ Window window, unsigned int state)
+}
+
+declare 16 mac {
+ void TkGenWMDestroyEvent (Tk_Window tkwin)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 17 mac {
+# void TkGenWMConfigureEvent (Tk_Window tkwin, int x, int y, \
+# int width, int height, int flags)
+#}
+
+declare 18 mac {
+ unsigned int TkMacButtonKeyState (void)
+}
+
+declare 19 mac {
+ void TkMacClearMenubarActive (void)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 20 mac {
+# int TkMacConvertEvent (EventRecord *eventPtr)
+#}
+
+declare 21 mac {
+ int TkMacDispatchMenuEvent (int menuID, int index)
+}
+
+declare 22 mac {
+ void TkMacInstallCursor (int resizeOverride)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 23 mac {
+# int TkMacConvertTkEvent (EventRecord *eventPtr, Window window)
+#}
+
+declare 24 mac {
+ void TkMacHandleTearoffMenu (void)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 26 mac {
+# void TkMacInvalClipRgns (TkWindow *winPtr)
+#}
+
+declare 27 mac {
+ void TkMacDoHLEvent (EventRecord *theEvent)
+}
+
+declare 29 mac {
+ Time TkMacGenerateTime (void)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 30 mac {
+# GWorldPtr TkMacGetDrawablePort (Drawable drawable)
+#}
+
+declare 31 mac {
+ TkWindow * TkMacGetScrollbarGrowWindow (TkWindow *winPtr)
+}
+
+declare 32 mac {
+ Window TkMacGetXWindow (WindowRef macWinPtr)
+}
+
+declare 33 mac {
+ int TkMacGrowToplevel (WindowRef whichWindow, Point start)
+}
+
+declare 34 mac {
+ void TkMacHandleMenuSelect (long mResult, int optionKeyPressed)
+}
+
+# removed duplicates from tkPlat table (tk.decls)
+#declare 35 mac {
+# int TkMacHaveAppearance (void)
+#}
+#
+#declare 36 mac {
+# void TkMacInitAppleEvents (Tcl_Interp *interp)
+#}
+#
+#declare 37 mac {
+# void TkMacInitMenus (Tcl_Interp *interp)
+#}
+
+declare 38 mac {
+ void TkMacInvalidateWindow (MacDrawable *macWin, int flag)
+}
+
+declare 39 mac {
+ int TkMacIsCharacterMissing (Tk_Font tkfont, unsigned int searchChar)
+}
+
+declare 40 mac {
+ void TkMacMakeRealWindowExist (TkWindow *winPtr)
+}
+
+declare 41 mac {
+ BitMapPtr TkMacMakeStippleMap(Drawable d1, Drawable d2)
+}
+
+declare 42 mac {
+ void TkMacMenuClick (void)
+}
+
+declare 43 mac {
+ void TkMacRegisterOffScreenWindow (Window window, GWorldPtr portPtr)
+}
+
+declare 44 mac {
+ int TkMacResizable (TkWindow *winPtr)
+}
+
+declare 46 mac {
+ void TkMacSetHelpMenuItemCount (void)
+}
+
+declare 47 mac {
+ void TkMacSetScrollbarGrow (TkWindow *winPtr, int flag)
+}
+
+declare 48 mac {
+ void TkMacSetUpClippingRgn (Drawable drawable)
+}
+
+declare 49 mac {
+ void TkMacSetUpGraphicsPort (GC gc)
+}
+
+declare 50 mac {
+ void TkMacUpdateClipRgn (TkWindow *winPtr)
+}
+
+declare 51 mac {
+ void TkMacUnregisterMacWindow (GWorldPtr portPtr)
+}
+
+declare 52 mac {
+ int TkMacUseMenuID (short macID)
+}
+
+declare 53 mac {
+ RgnHandle TkMacVisableClipRgn (TkWindow *winPtr)
+}
+
+declare 54 mac {
+ void TkMacWinBounds (TkWindow *winPtr, Rect *geometry)
+}
+
+declare 55 mac {
+ void TkMacWindowOffset (WindowRef wRef, int *xOffset, int *yOffset)
+}
+
+declare 57 mac {
+ int TkSetMacColor (unsigned long pixel, RGBColor *macColor)
+}
+
+declare 58 mac {
+ void TkSetWMName (TkWindow *winPtr, Tk_Uid titleUid)
+}
+
+declare 59 mac {
+ void TkSuspendClipboard (void)
+}
+
+declare 61 mac {
+ int TkMacZoomToplevel (WindowPtr whichWindow, Point where, short zoomPart)
+}
+
+declare 62 mac {
+ Tk_Window Tk_TopCoordsToWindow (Tk_Window tkwin, \
+ int rootX, int rootY, int *newX, int *newY)
+}
+
+declare 63 mac {
+ MacDrawable * TkMacContainerId (TkWindow *winPtr)
+}
+
+declare 64 mac {
+ MacDrawable * TkMacGetHostToplevel (TkWindow *winPtr)
+}
+
+declare 65 mac {
+ void TkMacPreprocessMenu (void)
+}
+
+declare 66 mac {
+ int TkpIsWindowFloating (WindowRef window)
+}
+
+########################
+# Mac OS X specific functions
+
+declare 0 aqua {
+ void TkGenerateActivateEvents (TkWindow *winPtr, int active)
+}
+
+# removed duplicates from tkInt table
+#declare 1 aqua {
+# Pixmap TkpCreateNativeBitmap (Display *display, CONST char * source)
+#}
+#
+#declare 2 aqua {
+# void TkpDefineNativeBitmaps (void)
+#}
+
+declare 3 aqua {
+ void TkPointerDeadWindow (TkWindow *winPtr)
+}
+
+declare 4 aqua {
+ void TkpSetCapture (TkWindow *winPtr)
+}
+
+declare 5 aqua {
+ void TkpSetCursor (TkpCursor cursor)
+}
+
+declare 6 aqua {
+ void TkpWmSetState (TkWindow *winPtr, int state)
+}
+
+declare 7 aqua {
+ void TkAboutDlg (void)
+}
+
+declare 8 aqua {
+ unsigned int TkMacOSXButtonKeyState (void)
+}
+
+declare 9 aqua {
+ void TkMacOSXClearMenubarActive (void)
+}
+
+declare 10 aqua {
+ int TkMacOSXDispatchMenuEvent (int menuID, int index)
+}
+
+declare 11 aqua {
+ void TkMacOSXInstallCursor (int resizeOverride)
+}
+
+declare 12 aqua {
+ void TkMacOSXHandleTearoffMenu (void)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 13 aqua {
+# void TkMacOSXInvalClipRgns (TkWindow *winPtr)
+#}
+
+declare 14 aqua {
+ int TkMacOSXDoHLEvent (EventRecord *theEvent)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 15 aqua {
+# GWorldPtr TkMacOSXGetDrawablePort (Drawable drawable)
+#}
+
+declare 16 aqua {
+ Window TkMacOSXGetXWindow (WindowRef macWinPtr)
+}
+
+declare 17 aqua {
+ int TkMacOSXGrowToplevel (WindowRef whichWindow, Point start)
+}
+
+declare 18 aqua {
+ void TkMacOSXHandleMenuSelect (long mResult, int optionKeyPressed)
+}
+
+# removed duplicates from tkPlat table (tk.decls)
+#declare 19 aqua {
+# void TkMacOSXInitAppleEvents (Tcl_Interp *interp)
+#}
+#
+#declare 20 aqua {
+# void TkMacOSXInitMenus (Tcl_Interp *interp)
+#}
+
+declare 21 aqua {
+ void TkMacOSXInvalidateWindow (MacDrawable *macWin, int flag)
+}
+
+declare 22 aqua {
+ int TkMacOSXIsCharacterMissing (Tk_Font tkfont, unsigned int searchChar)
+}
+
+declare 23 aqua {
+ void TkMacOSXMakeRealWindowExist (TkWindow *winPtr)
+}
+
+declare 24 aqua {
+ BitMapPtr TkMacOSXMakeStippleMap(Drawable d1, Drawable d2)
+}
+
+declare 25 aqua {
+ void TkMacOSXMenuClick (void)
+}
+
+declare 26 aqua {
+ void TkMacOSXRegisterOffScreenWindow (Window window, GWorldPtr portPtr)
+}
+
+declare 27 aqua {
+ int TkMacOSXResizable (TkWindow *winPtr)
+}
+
+declare 28 aqua {
+ void TkMacOSXSetHelpMenuItemCount (void)
+}
+
+declare 29 aqua {
+ void TkMacOSXSetScrollbarGrow (TkWindow *winPtr, int flag)
+}
+
+declare 30 aqua {
+ void TkMacOSXSetUpClippingRgn (Drawable drawable)
+}
+
+declare 31 aqua {
+ void TkMacOSXSetUpGraphicsPort (GC gc, GWorldPtr destPort)
+}
+
+declare 32 aqua {
+ void TkMacOSXUpdateClipRgn (TkWindow *winPtr)
+}
+
+declare 33 aqua {
+ void TkMacOSXUnregisterMacWindow (WindowRef portPtr)
+}
+
+declare 34 aqua {
+ int TkMacOSXUseMenuID (short macID)
+}
+
+declare 35 aqua {
+ RgnHandle TkMacOSXVisableClipRgn (TkWindow *winPtr)
+}
+
+declare 36 aqua {
+ void TkMacOSXWinBounds (TkWindow *winPtr, Rect *geometry)
+}
+
+declare 37 aqua {
+ void TkMacOSXWindowOffset (WindowRef wRef, int *xOffset, int *yOffset)
+}
+
+declare 38 aqua {
+ int TkSetMacColor (unsigned long pixel, RGBColor *macColor)
+}
+
+declare 39 aqua {
+ void TkSetWMName (TkWindow *winPtr, Tk_Uid titleUid)
+}
+
+declare 40 aqua {
+ void TkSuspendClipboard (void)
+}
+
+declare 41 aqua {
+ int TkMacOSXZoomToplevel (WindowPtr whichWindow, Point where, short zoomPart)
+}
+
+declare 42 aqua {
+ Tk_Window Tk_TopCoordsToWindow (Tk_Window tkwin, \
+ int rootX, int rootY, int *newX, int *newY)
+}
+
+declare 43 aqua {
+ MacDrawable * TkMacOSXContainerId (TkWindow *winPtr)
+}
+
+declare 44 aqua {
+ MacDrawable * TkMacOSXGetHostToplevel (TkWindow *winPtr)
+}
+
+declare 45 aqua {
+ void TkMacOSXPreprocessMenu (void)
+}
+
+declare 46 aqua {
+ int TkpIsWindowFloating (WindowRef window)
+}
+
+declare 47 aqua {
+ Tk_Window TkMacOSXGetCapture (void)
+}
+
+declare 49 aqua {
+ Window TkGetTransientMaster (TkWindow *winPtr)
+}
+
+declare 50 aqua {
+ int TkGenerateButtonEvent (int x, int y, \
+ Window window, unsigned int state)
+}
+
+declare 51 aqua {
+ void TkGenWMDestroyEvent (Tk_Window tkwin)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 52 aqua {
+# void TkGenWMConfigureEvent (Tk_Window tkwin, int x, int y, \
+# int width, int height, int flags)
+#}
+
+declare 53 aqua {
+ unsigned long TkpGetMS (void)
+}
+
+##############################################################################
+
+# Define the platform specific internal Xlib interfaces. These functions are
+# only available on the designated platform.
+
+interface tkIntXlib
+
+# X functions for Windows
+
+declare 0 win {
+ void XSetDashes (Display* display, GC gc, int dash_offset,
+ _Xconst char* dash_list, int n)
+}
+
+declare 1 win {
+ XModifierKeymap* XGetModifierMapping (Display* d)
+}
+
+declare 2 win {
+ XImage * XCreateImage (Display* d, Visual* v, unsigned int ui1, int i1, \
+ int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, \
+ int i4)
+
+}
+
+declare 3 win {
+ XImage *XGetImage (Display* d, Drawable dr, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
+}
+
+declare 4 win {
+ char *XGetAtomName (Display* d,Atom a)
+
+}
+
+declare 5 win {
+ char *XKeysymToString (KeySym k)
+}
+
+declare 6 win {
+ Colormap XCreateColormap (Display* d, Window w, Visual* v, int i)
+
+}
+
+declare 7 win {
+ Cursor XCreatePixmapCursor (Display* d, Pixmap p1, Pixmap p2, \
+ XColor* x1, XColor* x2, \
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 8 win {
+ Cursor XCreateGlyphCursor (Display* d, Font f1, Font f2, \
+ unsigned int ui1, unsigned int ui2, XColor* x1, XColor* x2)
+}
+
+declare 9 win {
+ GContext XGContextFromGC (GC g)
+}
+
+declare 10 win {
+ XHostAddress *XListHosts (Display* d, int* i, Bool* b)
+}
+
+# second parameter was of type KeyCode
+declare 11 win {
+ KeySym XKeycodeToKeysym (Display* d, unsigned int k, int i)
+}
+
+declare 12 win {
+ KeySym XStringToKeysym (_Xconst char* c)
+}
+
+declare 13 win {
+ Window XRootWindow (Display* d, int i)
+}
+
+declare 14 win {
+ XErrorHandler XSetErrorHandler (XErrorHandler x)
+}
+
+declare 15 win {
+ Status XIconifyWindow (Display* d, Window w, int i)
+}
+
+declare 16 win {
+ Status XWithdrawWindow (Display* d, Window w, int i)
+}
+
+declare 17 win {
+ Status XGetWMColormapWindows (Display* d, Window w, Window** wpp, int* ip)
+}
+
+declare 18 win {
+ Status XAllocColor (Display* d, Colormap c, XColor* xp)
+}
+
+declare 19 win {
+ void XBell (Display* d, int i)
+}
+
+declare 20 win {
+ void XChangeProperty (Display* d, Window w, Atom a1, Atom a2, int i1, \
+ int i2, _Xconst unsigned char* c, int i3)
+}
+
+declare 21 win {
+ void XChangeWindowAttributes (Display* d, Window w, unsigned long ul, \
+ XSetWindowAttributes* x)
+}
+
+declare 22 win {
+ void XClearWindow (Display* d, Window w)
+}
+
+declare 23 win {
+ void XConfigureWindow (Display* d, Window w, unsigned int i, \
+ XWindowChanges* x)
+}
+
+declare 24 win {
+ void XCopyArea (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4)
+}
+
+declare 25 win {
+ void XCopyPlane (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4, unsigned long ul)
+}
+
+declare 26 win {
+ Pixmap XCreateBitmapFromData(Display* display, Drawable d, \
+ _Xconst char* data, unsigned int width,unsigned int height)
+}
+
+declare 27 win {
+ void XDefineCursor (Display* d, Window w, Cursor c)
+}
+
+declare 28 win {
+ void XDeleteProperty (Display* d, Window w, Atom a)
+}
+
+declare 29 win {
+ void XDestroyWindow (Display* d, Window w)
+}
+
+declare 30 win {
+ void XDrawArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 31 win {
+ void XDrawLines (Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)
+}
+
+declare 32 win {
+ void XDrawRectangle (Display* d, Drawable dr, GC g, int i1, int i2,\
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 33 win {
+ void XFillArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 34 win {
+ void XFillPolygon (Display* d, Drawable dr, GC g, XPoint* x, \
+ int i1, int i2, int i3)
+}
+
+declare 35 win {
+ void XFillRectangles (Display* d, Drawable dr, GC g, XRectangle* x, int i)
+}
+
+declare 36 win {
+ void XForceScreenSaver (Display* d, int i)
+}
+
+declare 37 win {
+ void XFreeColormap (Display* d, Colormap c)
+}
+
+declare 38 win {
+ void XFreeColors (Display* d, Colormap c, \
+ unsigned long* ulp, int i, unsigned long ul)
+}
+
+declare 39 win {
+ void XFreeCursor (Display* d, Cursor c)
+}
+
+declare 40 win {
+ void XFreeModifiermap (XModifierKeymap* x)
+}
+
+declare 41 win {
+ Status XGetGeometry (Display* d, Drawable dr, Window* w, int* i1, \
+ int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, \
+ unsigned int* ui4)
+}
+
+declare 42 win {
+ void XGetInputFocus (Display* d, Window* w, int* i)
+}
+
+declare 43 win {
+ int XGetWindowProperty (Display* d, Window w, Atom a1, long l1, long l2, \
+ Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, \
+ unsigned long* ulp2, unsigned char** cpp)
+}
+
+declare 44 win {
+ Status XGetWindowAttributes (Display* d, Window w, XWindowAttributes* x)
+}
+
+declare 45 win {
+ int XGrabKeyboard (Display* d, Window w, Bool b, int i1, int i2, Time t)
+}
+
+declare 46 win {
+ int XGrabPointer (Display* d, Window w1, Bool b, unsigned int ui, \
+ int i1, int i2, Window w2, Cursor c, Time t)
+}
+
+declare 47 win {
+ KeyCode XKeysymToKeycode (Display* d, KeySym k)
+}
+
+declare 48 win {
+ Status XLookupColor (Display* d, Colormap c1, _Xconst char* c2, \
+ XColor* x1, XColor* x2)
+}
+
+declare 49 win {
+ void XMapWindow (Display* d, Window w)
+}
+
+declare 50 win {
+ void XMoveResizeWindow (Display* d, Window w, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 51 win {
+ void XMoveWindow (Display* d, Window w, int i1, int i2)
+}
+
+declare 52 win {
+ void XNextEvent (Display* d, XEvent* x)
+}
+
+declare 53 win {
+ void XPutBackEvent (Display* d, XEvent* x)
+}
+
+declare 54 win {
+ void XQueryColors (Display* d, Colormap c, XColor* x, int i)
+}
+
+declare 55 win {
+ Bool XQueryPointer (Display* d, Window w1, Window* w2, Window* w3, \
+ int* i1, int* i2, int* i3, int* i4, unsigned int* ui)
+}
+
+declare 56 win {
+ Status XQueryTree (Display* d, Window w1, Window* w2, Window* w3, \
+ Window** w4, unsigned int* ui)
+}
+
+declare 57 win {
+ void XRaiseWindow (Display* d, Window w)
+}
+
+declare 58 win {
+ void XRefreshKeyboardMapping (XMappingEvent* x)
+}
+
+declare 59 win {
+ void XResizeWindow (Display* d, Window w, unsigned int ui1, \
+ unsigned int ui2)
+}
+
+declare 60 win {
+ void XSelectInput (Display* d, Window w, long l)
+}
+
+declare 61 win {
+ Status XSendEvent (Display* d, Window w, Bool b, long l, XEvent* x)
+}
+
+declare 62 win {
+ void XSetCommand (Display* d, Window w, CONST char** c, int i)
+}
+
+declare 63 win {
+ void XSetIconName (Display* d, Window w, _Xconst char* c)
+}
+
+declare 64 win {
+ void XSetInputFocus (Display* d, Window w, int i, Time t)
+}
+
+declare 65 win {
+ void XSetSelectionOwner (Display* d, Atom a, Window w, Time t)
+}
+
+declare 66 win {
+ void XSetWindowBackground (Display* d, Window w, unsigned long ul)
+}
+
+declare 67 win {
+ void XSetWindowBackgroundPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 68 win {
+ void XSetWindowBorder (Display* d, Window w, unsigned long ul)
+}
+
+declare 69 win {
+ void XSetWindowBorderPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 70 win {
+ void XSetWindowBorderWidth (Display* d, Window w, unsigned int ui)
+}
+
+declare 71 win {
+ void XSetWindowColormap (Display* d, Window w, Colormap c)
+}
+
+declare 72 win {
+ Bool XTranslateCoordinates (Display* d, Window w1, Window w2, int i1,\
+ int i2, int* i3, int* i4, Window* w3)
+}
+
+declare 73 win {
+ void XUngrabKeyboard (Display* d, Time t)
+}
+
+declare 74 win {
+ void XUngrabPointer (Display* d, Time t)
+}
+
+declare 75 win {
+ void XUnmapWindow (Display* d, Window w)
+}
+
+declare 76 win {
+ void XWindowEvent (Display* d, Window w, long l, XEvent* x)
+}
+
+declare 77 win {
+ void XDestroyIC (XIC x)
+}
+
+declare 78 win {
+ Bool XFilterEvent (XEvent* x, Window w)
+}
+
+declare 79 win {
+ int XmbLookupString (XIC xi, XKeyPressedEvent* xk, \
+ char* c, int i, KeySym* k, Status* s)
+}
+
+declare 80 win {
+ void TkPutImage (unsigned long *colors, \
+ int ncolors, Display* display, Drawable d, \
+ GC gc, XImage* image, int src_x, int src_y, \
+ int dest_x, int dest_y, unsigned int width, \
+ unsigned int height)
+}
+# This slot is reserved for use by the clipping rectangle patch:
+# declare 81 win {
+# XSetClipRectangles(Display *display, GC gc, int clip_x_origin, \
+# int clip_y_origin, XRectangle rectangles[], int n, int ordering)
+# }
+
+declare 82 win {
+ Status XParseColor (Display *display, Colormap map, \
+ _Xconst char* spec, XColor *colorPtr)
+}
+
+declare 83 win {
+ GC XCreateGC(Display* display, Drawable d, \
+ unsigned long valuemask, XGCValues* values)
+}
+
+declare 84 win {
+ void XFreeGC(Display* display, GC gc)
+}
+
+declare 85 win {
+ Atom XInternAtom(Display* display,_Xconst char* atom_name, \
+ Bool only_if_exists)
+}
+
+declare 86 win {
+ void XSetBackground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 87 win {
+ void XSetForeground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 88 win {
+ void XSetClipMask(Display* display, GC gc, Pixmap pixmap)
+}
+
+declare 89 win {
+ void XSetClipOrigin(Display* display, GC gc, \
+ int clip_x_origin, int clip_y_origin)
+}
+
+declare 90 win {
+ void XSetTSOrigin(Display* display, GC gc, \
+ int ts_x_origin, int ts_y_origin)
+}
+
+declare 91 win {
+ void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values)
+}
+
+declare 92 win {
+ void XSetFont(Display *display, GC gc, Font font)
+}
+
+declare 93 win {
+ void XSetArcMode(Display *display, GC gc, int arc_mode)
+}
+
+declare 94 win {
+ void XSetStipple(Display *display, GC gc, Pixmap stipple)
+}
+
+declare 95 win {
+ void XSetFillRule(Display *display, GC gc, int fill_rule)
+}
+
+declare 96 win {
+ void XSetFillStyle(Display *display, GC gc, int fill_style)
+}
+
+declare 97 win {
+ void XSetFunction(Display *display, GC gc, int function)
+}
+
+declare 98 win {
+ void XSetLineAttributes(Display *display, GC gc, \
+ unsigned int line_width, int line_style, \
+ int cap_style, int join_style)
+}
+
+declare 99 win {
+ int _XInitImageFuncPtrs(XImage *image)
+}
+
+declare 100 win {
+ XIC XCreateIC(void)
+}
+
+declare 101 win {
+ XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \
+ XVisualInfo* vinfo_template, int* nitems_return)
+}
+
+declare 102 win {
+ void XSetWMClientMachine(Display* display, Window w, XTextProperty* text_prop)
+}
+
+declare 103 win {
+ Status XStringListToTextProperty(char** list, int count, \
+ XTextProperty* text_prop_return)
+}
+declare 104 win {
+ void XDrawLine (Display* d, Drawable dr, GC g, int x1, int y1, \
+ int x2, int y2)
+}
+declare 106 win {
+ void XFillRectangle (Display* display, Drawable d, GC gc, \
+ int x, int y, unsigned int width, unsigned int height)
+}
+declare 105 win {
+ void XWarpPointer (Display* d, Window s, Window dw, int sx, int sy, \
+ unsigned int sw, unsigned int sh, int dx, int dy)
+}
+
+# X functions for Mac and Aqua
+
+declare 0 {mac aqua} {
+ void XSetDashes (Display* display, GC gc, int dash_offset,
+ _Xconst char* dash_list, int n)
+}
+
+declare 1 {mac aqua} {
+ XModifierKeymap* XGetModifierMapping (Display* d)
+}
+
+declare 2 {mac aqua} {
+ XImage * XCreateImage (Display* d, Visual* v, unsigned int ui1, int i1, \
+ int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, \
+ int i4)
+
+}
+
+declare 3 {mac aqua} {
+ XImage *XGetImage (Display* d, Drawable dr, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
+}
+
+declare 4 {mac aqua} {
+ char *XGetAtomName (Display* d,Atom a)
+
+}
+
+declare 5 {mac aqua} {
+ char *XKeysymToString (KeySym k)
+}
+
+declare 6 {mac aqua} {
+ Colormap XCreateColormap (Display* d, Window w, Visual* v, int i)
+
+}
+
+declare 7 {mac aqua} {
+ GContext XGContextFromGC (GC g)
+}
+
+declare 8 {mac aqua} {
+ KeySym XKeycodeToKeysym (Display* d, KeyCode k, int i)
+}
+
+declare 9 {mac aqua} {
+ KeySym XStringToKeysym (_Xconst char* c)
+}
+
+declare 10 {mac aqua} {
+ Window XRootWindow (Display* d, int i)
+}
+
+declare 11 {mac aqua} {
+ XErrorHandler XSetErrorHandler (XErrorHandler x)
+}
+
+declare 12 {mac aqua} {
+ Status XAllocColor (Display* d, Colormap c, XColor* xp)
+}
+
+declare 13 {mac aqua} {
+ void XBell (Display* d, int i)
+}
+
+declare 14 {mac aqua} {
+ void XChangeProperty (Display* d, Window w, Atom a1, Atom a2, int i1, \
+ int i2, _Xconst unsigned char* c, int i3)
+}
+
+declare 15 {mac aqua} {
+ void XChangeWindowAttributes (Display* d, Window w, unsigned long ul, \
+ XSetWindowAttributes* x)
+}
+
+declare 16 {mac aqua} {
+ void XConfigureWindow (Display* d, Window w, unsigned int i, \
+ XWindowChanges* x)
+}
+
+declare 17 {mac aqua} {
+ void XCopyArea (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4)
+}
+
+declare 18 {mac aqua} {
+ void XCopyPlane (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4, unsigned long ul)
+}
+
+declare 19 {mac aqua} {
+ Pixmap XCreateBitmapFromData(Display* display, Drawable d, \
+ _Xconst char* data, unsigned int width,unsigned int height)
+}
+
+declare 20 {mac aqua} {
+ void XDefineCursor (Display* d, Window w, Cursor c)
+}
+
+declare 21 {mac aqua} {
+ void XDestroyWindow (Display* d, Window w)
+}
+
+declare 22 {mac aqua} {
+ void XDrawArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 23 {mac aqua} {
+ void XDrawLines (Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)
+}
+
+declare 24 {mac aqua} {
+ void XDrawRectangle (Display* d, Drawable dr, GC g, int i1, int i2,\
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 25 {mac aqua} {
+ void XFillArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 26 {mac aqua} {
+ void XFillPolygon (Display* d, Drawable dr, GC g, XPoint* x, \
+ int i1, int i2, int i3)
+}
+
+declare 27 {mac aqua} {
+ void XFillRectangles (Display* d, Drawable dr, GC g, XRectangle* x, int i)
+}
+
+declare 28 {mac aqua} {
+ void XFreeColormap (Display* d, Colormap c)
+}
+
+declare 29 {mac aqua} {
+ void XFreeColors (Display* d, Colormap c, \
+ unsigned long* ulp, int i, unsigned long ul)
+}
+
+declare 30 {mac aqua} {
+ void XFreeModifiermap (XModifierKeymap* x)
+}
+
+declare 31 {mac aqua} {
+ Status XGetGeometry (Display* d, Drawable dr, Window* w, int* i1, \
+ int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, \
+ unsigned int* ui4)
+}
+
+declare 32 {mac aqua} {
+ int XGetWindowProperty (Display* d, Window w, Atom a1, long l1, long l2, \
+ Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, \
+ unsigned long* ulp2, unsigned char** cpp)
+}
+
+declare 33 {mac aqua} {
+ int XGrabKeyboard (Display* d, Window w, Bool b, int i1, int i2, Time t)
+}
+
+declare 34 {mac aqua} {
+ int XGrabPointer (Display* d, Window w1, Bool b, unsigned int ui, \
+ int i1, int i2, Window w2, Cursor c, Time t)
+}
+
+declare 35 {mac aqua} {
+ KeyCode XKeysymToKeycode (Display* d, KeySym k)
+}
+
+declare 36 {mac aqua} {
+ void XMapWindow (Display* d, Window w)
+}
+
+declare 37 {mac aqua} {
+ void XMoveResizeWindow (Display* d, Window w, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 38 {mac aqua} {
+ void XMoveWindow (Display* d, Window w, int i1, int i2)
+}
+
+declare 39 {mac aqua} {
+ Bool XQueryPointer (Display* d, Window w1, Window* w2, Window* w3, \
+ int* i1, int* i2, int* i3, int* i4, unsigned int* ui)
+}
+
+declare 40 {mac aqua} {
+ void XRaiseWindow (Display* d, Window w)
+}
+
+declare 41 {mac aqua} {
+ void XRefreshKeyboardMapping (XMappingEvent* x)
+}
+
+declare 42 {mac aqua} {
+ void XResizeWindow (Display* d, Window w, unsigned int ui1, \
+ unsigned int ui2)
+}
+
+declare 43 {mac aqua} {
+ void XSelectInput (Display* d, Window w, long l)
+}
+
+declare 44 {mac aqua} {
+ Status XSendEvent (Display* d, Window w, Bool b, long l, XEvent* x)
+}
+
+declare 45 {mac aqua} {
+ void XSetIconName (Display* d, Window w, _Xconst char* c)
+}
+
+declare 46 {mac aqua} {
+ void XSetInputFocus (Display* d, Window w, int i, Time t)
+}
+
+declare 47 {mac aqua} {
+ void XSetSelectionOwner (Display* d, Atom a, Window w, Time t)
+}
+
+declare 48 {mac aqua} {
+ void XSetWindowBackground (Display* d, Window w, unsigned long ul)
+}
+
+declare 49 {mac aqua} {
+ void XSetWindowBackgroundPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 50 {mac aqua} {
+ void XSetWindowBorder (Display* d, Window w, unsigned long ul)
+}
+
+declare 51 {mac aqua} {
+ void XSetWindowBorderPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 52 {mac aqua} {
+ void XSetWindowBorderWidth (Display* d, Window w, unsigned int ui)
+}
+
+declare 53 {mac aqua} {
+ void XSetWindowColormap (Display* d, Window w, Colormap c)
+}
+
+declare 54 {mac aqua} {
+ void XUngrabKeyboard (Display* d, Time t)
+}
+
+declare 55 {mac aqua} {
+ void XUngrabPointer (Display* d, Time t)
+}
+
+declare 56 {mac aqua} {
+ void XUnmapWindow (Display* d, Window w)
+}
+
+declare 57 {mac aqua} {
+ void TkPutImage (unsigned long *colors, \
+ int ncolors, Display* display, Drawable d, \
+ GC gc, XImage* image, int src_x, int src_y, \
+ int dest_x, int dest_y, unsigned int width, \
+ unsigned int height)
+}
+declare 58 {mac aqua} {
+ Status XParseColor (Display *display, Colormap map, \
+ _Xconst char* spec, XColor *colorPtr)
+}
+
+declare 59 {mac aqua} {
+ GC XCreateGC(Display* display, Drawable d, \
+ unsigned long valuemask, XGCValues* values)
+}
+
+declare 60 {mac aqua} {
+ void XFreeGC(Display* display, GC gc)
+}
+
+declare 61 {mac aqua} {
+ Atom XInternAtom(Display* display,_Xconst char* atom_name, \
+ Bool only_if_exists)
+}
+
+declare 62 {mac aqua} {
+ void XSetBackground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 63 {mac aqua} {
+ void XSetForeground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 64 {mac aqua} {
+ void XSetClipMask(Display* display, GC gc, Pixmap pixmap)
+}
+
+declare 65 {mac aqua} {
+ void XSetClipOrigin(Display* display, GC gc, \
+ int clip_x_origin, int clip_y_origin)
+}
+
+declare 66 {mac aqua} {
+ void XSetTSOrigin(Display* display, GC gc, \
+ int ts_x_origin, int ts_y_origin)
+}
+
+declare 67 {mac aqua} {
+ void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values)
+}
+
+declare 68 {mac aqua} {
+ void XSetFont(Display *display, GC gc, Font font)
+}
+
+declare 69 {mac aqua} {
+ void XSetArcMode(Display *display, GC gc, int arc_mode)
+}
+
+declare 70 {mac aqua} {
+ void XSetStipple(Display *display, GC gc, Pixmap stipple)
+}
+
+declare 71 {mac aqua} {
+ void XSetFillRule(Display *display, GC gc, int fill_rule)
+}
+
+declare 72 {mac aqua} {
+ void XSetFillStyle(Display *display, GC gc, int fill_style)
+}
+
+declare 73 {mac aqua} {
+ void XSetFunction(Display *display, GC gc, int function)
+}
+
+declare 74 {mac aqua} {
+ void XSetLineAttributes(Display *display, GC gc, \
+ unsigned int line_width, int line_style, \
+ int cap_style, int join_style)
+}
+
+declare 75 {mac aqua} {
+ int _XInitImageFuncPtrs(XImage *image)
+}
+
+declare 76 {mac aqua} {
+ XIC XCreateIC(void)
+}
+
+declare 77 {mac aqua} {
+ XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \
+ XVisualInfo* vinfo_template, int* nitems_return)
+}
+
+declare 78 {mac aqua} {
+ void XSetWMClientMachine(Display* display, Window w, \
+ XTextProperty* text_prop)
+}
+
+declare 79 {mac aqua} {
+ Status XStringListToTextProperty(char** list, int count, \
+ XTextProperty* text_prop_return)
+}
+declare 80 {mac aqua} {
+ void XDrawSegments(Display *display, Drawable d, GC gc, \
+ XSegment *segments, int nsegments)
+}
+declare 81 {mac aqua} {
+ void XForceScreenSaver(Display* display, int mode)
+}
+declare 82 {mac aqua} {
+ void XDrawLine (Display* d, Drawable dr, GC g, int x1, int y1, \
+ int x2, int y2)
+}
+declare 83 {mac aqua} {
+ void XFillRectangle (Display* display, Drawable d, GC gc, \
+ int x, int y, unsigned int width, unsigned int height)
+}
+declare 84 {mac aqua} {
+ void XClearWindow (Display* d, Window w)
+}
+
+declare 85 {mac aqua} {
+ void XDrawPoint (Display* display, Drawable d, GC gc, int x, int y)
+}
+
+declare 86 {mac aqua} {
+ void XDrawPoints (Display* display, Drawable d, GC gc, XPoint *points, \
+ int npoints, int mode)
+}
+
+declare 87 {mac aqua} {
+ void XWarpPointer (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)
+}
+
+declare 88 {mac aqua} {
+ void XQueryColor (Display *display, Colormap colormap, XColor *def_in_out)
+}
+
+declare 89 {mac aqua} {
+ void XQueryColors (Display *display, Colormap colormap, \
+ XColor *defs_in_out, int ncolors)
+}
diff --git a/tcl/generic/tkInt.h b/tcl/generic/tkInt.h
new file mode 100644
index 00000000000..f51496483ec
--- /dev/null
+++ b/tcl/generic/tkInt.h
@@ -0,0 +1,1177 @@
+/*
+ * 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
+
+/*
+ * Opaque type declarations:
+ */
+
+typedef struct TkColormap TkColormap;
+typedef struct TkGrabEvent TkGrabEvent;
+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));
+
+/*
+ * One of the following structures is maintained for each cursor in
+ * use in the system. This structure is used by tkCursor.c and the
+ * various system specific cursor files.
+ */
+
+typedef struct TkCursor {
+ Tk_Cursor cursor; /* System specific identifier for cursor. */
+ Display *display; /* Display containing cursor. Needed for
+ * disposal and retrieval of cursors. */
+ int resourceRefCount; /* Number of active uses of this cursor (each
+ * active use corresponds to a call to
+ * Tk_AllocPreserveFromObj or Tk_Preserve).
+ * If this count is 0, then this structure
+ * is no longer valid and it isn't present
+ * in a hash table: it is being kept around
+ * only because there are objects referring
+ * to it. The structure is freed when
+ * resourceRefCount and objRefCount are
+ * both 0. */
+ int objRefCount; /* Number of Tcl objects that reference
+ * this structure.. */
+ Tcl_HashTable *otherTable; /* Second table (other than idTable) used
+ * to index this entry. */
+ Tcl_HashEntry *hashPtr; /* Entry in otherTable for this structure
+ * (needed when deleting). */
+ Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure
+ * (needed when deleting). */
+ struct TkCursor *nextPtr; /* Points to the next TkCursor structure with
+ * the same name. Cursors with the same
+ * name but different displays are chained
+ * together off a single hash table entry. */
+} TkCursor;
+
+/*
+ * This defines whether we should try to use XIM over-the-spot style
+ * input. Allow users to override it. It is a much more elegant use
+ * of XIM, but uses a bit more memory.
+ */
+
+#ifndef TK_XIM_SPOT
+# define TK_XIM_SPOT 1
+#endif
+
+/*
+ * The following structure is kept one-per-TkDisplay to maintain information
+ * about the caret (cursor location) on this display. This is used to
+ * dictate global focus location (Windows Accessibility guidelines) and to
+ * position the IME or XIM over-the-spot window.
+ */
+
+typedef struct TkCaret {
+ struct TkWindow *winPtr; /* the window on which we requested caret
+ * placement */
+ int x; /* relative x coord of the caret */
+ int y; /* relative y coord of the caret */
+ int height; /* specified height of the window */
+} TkCaret;
+
+/*
+ * One of the following structures is maintained for each display
+ * containing a window managed by Tk. In part, the structure is
+ * used to store thread-specific data, since each thread will have
+ * its own TkDisplay structure.
+ */
+
+typedef struct TkDisplay {
+ Display *display; /* Xlib's info about display. */
+ struct TkDisplay *nextPtr; /* Next in list of all displays. */
+ char *name; /* Name of display (with any screen
+ * identifier removed). Malloc-ed. */
+ Time lastEventTime; /* Time of last event received for this
+ * display. */
+
+ /*
+ * Information used primarily by tk3d.c:
+ */
+
+ int borderInit; /* 0 means borderTable needs initializing. */
+ Tcl_HashTable borderTable; /* Maps from color name to TkBorder
+ * structure. */
+
+ /*
+ * Information used by tkAtom.c only:
+ */
+
+ int atomInit; /* 0 means stuff below hasn't been
+ * initialized yet. */
+ Tcl_HashTable nameTable; /* Maps from names to Atom's. */
+ Tcl_HashTable atomTable; /* Maps from Atom's back to names. */
+
+ /*
+ * Information used primarily by tkBind.c:
+ */
+
+ int bindInfoStale; /* Non-zero means the variables in this
+ * part of the structure are potentially
+ * incorrect and should be recomputed. */
+ 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 tkBitmap.c only:
+ */
+
+ int bitmapInit; /* 0 means tables above need initializing. */
+ int bitmapAutoNumber; /* Used to number bitmaps. */
+ Tcl_HashTable bitmapNameTable;
+ /* Maps from name of bitmap to the first
+ * TkBitmap record for that name. */
+ Tcl_HashTable bitmapIdTable;/* Maps from bitmap id to the TkBitmap
+ * structure for the bitmap. */
+ Tcl_HashTable bitmapDataTable;
+ /* Used by Tk_GetBitmapFromData to map from
+ * a collection of in-core data about a
+ * bitmap to a reference giving an auto-
+ * matically-generated name for the bitmap. */
+
+ /*
+ * Information used by tkCanvas.c only:
+ */
+
+ int numIdSearches;
+ int numSlowSearches;
+
+ /*
+ * Used by tkColor.c only:
+ */
+
+ int colorInit; /* 0 means color module needs initializing. */
+ TkStressedCmap *stressPtr; /* First in list of colormaps that have
+ * filled up, so we have to pick an
+ * approximate color. */
+ Tcl_HashTable colorNameTable;
+ /* Maps from color name to TkColor structure
+ * for that color. */
+ Tcl_HashTable colorValueTable;
+ /* Maps from integer RGB values to TkColor
+ * structures. */
+
+ /*
+ * Used by tkCursor.c only:
+ */
+
+ int cursorInit; /* 0 means cursor module need initializing. */
+ Tcl_HashTable cursorNameTable;
+ /* Maps from a string name to a cursor to the
+ * TkCursor record for the cursor. */
+ Tcl_HashTable cursorDataTable;
+ /* Maps from a collection of in-core data
+ * about a cursor to a TkCursor structure. */
+ Tcl_HashTable cursorIdTable;
+ /* Maps from a cursor id to the TkCursor
+ * structure for the cursor. */
+ char cursorString[20]; /* Used to store a cursor id string. */
+ Font cursorFont; /* Font to use for standard cursors.
+ * None means font not loaded yet. */
+
+ /*
+ * Information used by tkError.c only:
+ */
+
+ struct TkErrorHandler *errorPtr;
+ /* First in list of error handlers
+ * for this display. NULL means
+ * no handlers exist at present. */
+ int deleteCount; /* Counts # of handlers deleted since
+ * last time inactive handlers were
+ * garbage-collected. When this number
+ * gets big, handlers get cleaned up. */
+
+ /*
+ * Used by tkEvent.c only:
+ */
+
+ struct TkWindowEvent *delayedMotionPtr;
+ /* Points to a malloc-ed motion event
+ * whose processing has been delayed in
+ * the hopes that another motion event
+ * will come along right away and we can
+ * merge the two of them together. NULL
+ * means that there is no delayed motion
+ * event. */
+
+ /*
+ * Information used by tkFocus.c only:
+ */
+
+ int focusDebug; /* 1 means collect focus debugging
+ * statistics. */
+ struct TkWindow *implicitWinPtr;
+ /* If the focus arrived at a toplevel window
+ * implicitly via an Enter event (rather
+ * than via a FocusIn event), this points
+ * to the toplevel window. Otherwise it is
+ * NULL. */
+ struct TkWindow *focusPtr; /* Points to the window on this display that
+ * should be receiving keyboard events. When
+ * multiple applications on the display have
+ * the focus, this will refer to the
+ * innermost window in the innermost
+ * application. This information isn't used
+ * under Unix or Windows, but it's needed on
+ * the Macintosh. */
+
+ /*
+ * Information used by tkGC.c only:
+ */
+
+ Tcl_HashTable gcValueTable; /* Maps from a GC's values to a TkGC structure
+ * describing a GC with those values. */
+ Tcl_HashTable gcIdTable; /* Maps from a GC to a TkGC. */
+ int gcInit; /* 0 means the tables below need
+ * initializing. */
+
+ /*
+ * Information used by tkGeometry.c only:
+ */
+
+ Tcl_HashTable maintainHashTable;
+ /* Hash table that maps from a master's
+ * Tk_Window token to a list of slaves
+ * managed by that master. */
+ int geomInit;
+
+ /*
+ * Information used by tkGet.c only:
+ */
+
+ Tcl_HashTable uidTable; /* Stores all Tk_Uid used in a thread. */
+ int uidInit; /* 0 means uidTable needs initializing. */
+
+ /*
+ * Information used by tkGrab.c only:
+ */
+
+ struct TkWindow *grabWinPtr;
+ /* Window in which the pointer is currently
+ * 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 tkGrid.c only:
+ */
+
+ int gridInit; /* 0 means table below needs initializing. */
+ Tcl_HashTable gridHashTable;/* Maps from Tk_Window tokens to
+ * corresponding Grid structures. */
+
+ /*
+ * Information used by tkImage.c only:
+ */
+
+ int imageId; /* Value used to number image ids. */
+
+ /*
+ * Information used by tkMacWinMenu.c only:
+ */
+
+ int postCommandGeneration;
+
+ /*
+ * Information used by tkOption.c only.
+ */
+
+
+
+ /*
+ * Information used by tkPack.c only.
+ */
+
+ int packInit; /* 0 means table below needs initializing. */
+ Tcl_HashTable packerHashTable;
+ /* Maps from Tk_Window tokens to
+ * corresponding Packer structures. */
+
+
+ /*
+ * Information used by tkPlace.c only.
+ */
+
+ int placeInit; /* 0 means tables below need initializing. */
+ Tcl_HashTable masterTable; /* Maps from Tk_Window toke to the Master
+ * structure for the window, if it exists. */
+ Tcl_HashTable slaveTable; /* Maps from Tk_Window toke to the Slave
+ * structure for the window, if it exists. */
+
+ /*
+ * Information used by tkSelect.c and tkClipboard.c only:
+ */
+
+ struct TkSelectionInfo *selectionInfoPtr;
+ /* First in list of selection information
+ * records. Each entry contains information
+ * about the current owner of a particular
+ * selection on this display. */
+ Atom multipleAtom; /* Atom for MULTIPLE. None means
+ * selection stuff isn't initialized. */
+ Atom incrAtom; /* Atom for INCR. */
+ Atom targetsAtom; /* Atom for TARGETS. */
+ Atom timestampAtom; /* Atom for TIMESTAMP. */
+ Atom textAtom; /* Atom for TEXT. */
+ Atom compoundTextAtom; /* Atom for COMPOUND_TEXT. */
+ Atom applicationAtom; /* Atom for TK_APPLICATION. */
+ Atom windowAtom; /* Atom for TK_WINDOW. */
+ Atom clipboardAtom; /* Atom for CLIPBOARD. */
+ Atom utf8Atom; /* Atom for UTF8_STRING. */
+
+ Tk_Window clipWindow; /* Window used for clipboard ownership and to
+ * retrieve selections between processes. NULL
+ * means clipboard info hasn't been
+ * initialized. */
+ int clipboardActive; /* 1 means we currently own the clipboard
+ * selection, 0 means we don't. */
+ struct TkMainInfo *clipboardAppPtr;
+ /* Last application that owned clipboard. */
+ struct TkClipboardTarget *clipTargetPtr;
+ /* First in list of clipboard type information
+ * records. Each entry contains information
+ * about the buffers for a given selection
+ * target. */
+
+ /*
+ * Information used by tkSend.c only:
+ */
+
+ Tk_Window commTkwin; /* Window used for communication
+ * between interpreters during "send"
+ * commands. NULL means send info hasn't
+ * been initialized yet. */
+ Atom commProperty; /* X's name for comm property. */
+ Atom registryProperty; /* X's name for property containing
+ * registry of interpreter names. */
+ Atom appNameProperty; /* X's name for property used to hold the
+ * application name on each comm window. */
+
+ /*
+ * Information used by tkXId.c only:
+ */
+
+ struct TkIdStack *idStackPtr;
+ /* First in list of chunks of free resource
+ * identifiers, or NULL if there are no free
+ * resources. */
+ XID (*defaultAllocProc) _ANSI_ARGS_((Display *display));
+ /* Default resource allocator for display. */
+ struct TkIdStack *windowStackPtr;
+ /* First in list of chunks of window
+ * identifers that can't be reused right
+ * now. */
+ Tcl_TimerToken idCleanupScheduled;
+ /* If set, it means a call to WindowIdCleanup
+ * has already been scheduled, 0 means it
+ * hasn't. */
+
+ /*
+ * Information used by tkUnixWm.c and tkWinWm.c only:
+ */
+
+ struct TkWmInfo *firstWmPtr; /* Points to first top-level window. */
+ struct TkWmInfo *foregroundWmPtr;
+ /* Points to the foreground window. */
+
+ /*
+ * Information maintained by tkWindow.c for use later on by tkXId.c:
+ */
+
+
+ int destroyCount; /* Number of Tk_DestroyWindow operations
+ * in progress. */
+ unsigned long lastDestroyRequest;
+ /* Id of most recent XDestroyWindow request;
+ * can re-use ids in windowStackPtr when
+ * server has seen this request and event
+ * queue is empty. */
+
+ /*
+ * Information used by tkVisual.c only:
+ */
+
+ TkColormap *cmapPtr; /* First in list of all non-default colormaps
+ * allocated for this display. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+#ifdef TK_USE_INPUT_METHODS
+ XIM inputMethod; /* Input method for this display */
+#if TK_XIM_SPOT
+ XFontSet inputXfs; /* XFontSet cached for over-the-spot XIM. */
+#endif
+#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.
+ */
+ /*
+ * The following field were all added for Tk8.3
+ */
+ int mouseButtonState; /* current mouse button state for this
+ * display */
+ Window warpWindow;
+ int warpX;
+ int warpY;
+
+ /*
+ * The following field(s) were all added for Tk8.4
+ */
+ long deletionEpoch; /* Incremented by window deletions */
+ unsigned int flags; /* Various flag values: these are all
+ * defined in below. */
+ TkCaret caret; /* information about the caret for this
+ * display. This is not a pointer. */
+} TkDisplay;
+
+/*
+ * Flag values for TkDisplay flags.
+ * TK_DISPLAY_COLLAPSE_MOTION_EVENTS: (default on)
+ * Indicates that we should collapse motion events on this display
+ * TK_DISPLAY_USE_IM: (default on, set via tk.tcl)
+ * Whether to use input methods for this display
+ * TK_DISPLAY_XIM_SPOT: (default off)
+ * Indicates that we should use over-the-spot XIM on this display
+ * TK_DISPLAY_WM_TRACING: (default off)
+ * Whether we should do wm tracing on this display.
+ * TK_DISPLAY_IN_WARP: (default off)
+ * Indicates that we are in a pointer warp
+ */
+
+#define TK_DISPLAY_COLLAPSE_MOTION_EVENTS (1 << 0)
+#define TK_DISPLAY_USE_IM (1 << 1)
+#define TK_DISPLAY_XIM_SPOT (1 << 2)
+#define TK_DISPLAY_WM_TRACING (1 << 3)
+#define TK_DISPLAY_IN_WARP (1 << 4)
+
+/*
+ * 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 TkCreateMainWindow). 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
+ * application basis. */
+ struct TkFontInfo *fontInfoPtr;
+ /* Information used by tkFont.c on a per
+ * application basis. */
+
+ /*
+ * Information used only by tkFocus.c and tk*Embed.c:
+ */
+
+ struct TkToplevelFocusInfo *tlFocusPtr;
+ /* First in list of records containing focus
+ * 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 {
+ CONST 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; /* XIM input context. */
+#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 internalBorderLeft; /* Width of internal border of window
+ * (0 means no internal border). Geometry
+ * managers should not normally place children
+ * on top of the border.
+ * Fields for the other three sides are found
+ * below. */
+
+ /*
+ * 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.
+ */
+
+ Tk_ClassProcs *classProcsPtr;
+ ClientData instanceData;
+
+ /*
+ * Platform specific information private to each port.
+ */
+
+ struct TkWindowPrivate *privatePtr;
+
+ /*
+ * More information used by tkGeometry.c for geometry management.
+ */
+
+ /* The remaining fields of internal border. */
+ int internalBorderRight;
+ int internalBorderTop;
+ int internalBorderBottom;
+
+ int minReqWidth; /* Minimum requested width. */
+ int minReqHeight; /* Minimum requested height. */
+} 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)
+
+/*
+ * 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)
+
+/*
+ * Object types not declared in tkObj.c need to be mentioned here so
+ * they can be properly registered with Tcl:
+ */
+
+extern Tcl_ObjType tkBorderObjType;
+extern Tcl_ObjType tkBitmapObjType;
+extern Tcl_ObjType tkColorObjType;
+extern Tcl_ObjType tkCursorObjType;
+extern Tcl_ObjType tkFontObjType;
+extern Tcl_ObjType tkOptionObjType;
+extern Tcl_ObjType tkStateKeyObjType;
+
+/*
+ * Miscellaneous variables shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+extern Tk_SmoothMethod tkBezierSmoothMethod;
+extern Tk_ImageType tkBitmapImageType;
+extern Tk_PhotoImageFormat tkImgFmtGIF;
+extern void (*tkHandleEventProc) _ANSI_ARGS_((
+ XEvent* eventPtr));
+extern Tk_PhotoImageFormat tkImgFmtPPM;
+extern TkMainInfo *tkMainWindowList;
+extern Tk_ImageType tkPhotoImageType;
+extern Tcl_HashTable tkPredefBitmapTable;
+extern int tkSendSerial;
+
+#include "tkIntDecls.h"
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Internal procedures shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+EXTERN int Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_BindObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_BindtagsObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ButtonObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_CanvasObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_CheckbuttonObjCmd _ANSI_ARGS_((
+ ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ClipboardObjCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ChooseColorObjCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ChooseDirectoryObjCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ChooseFontObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_DestroyObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_EntryObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_EventObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_FileeventCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_FrameObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_FocusObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_GetOpenFileObjCmd _ANSI_ARGS_((
+ ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_GetSaveFileObjCmd _ANSI_ARGS_((
+ ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_GrabObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_GridObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ImageObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_LabelObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_LabelframeObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ListboxObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_LowerObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_MenubuttonObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_MessageBoxObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_MessageObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_PanedWindowObjCmd _ANSI_ARGS_((
+ ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_OptionObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_PackObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_PlaceObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_RadiobuttonObjCmd _ANSI_ARGS_((
+ ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_RaiseObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ScaleObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int Tk_SelectionObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_SendCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_SpinboxObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_TkwaitObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ToplevelObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_UpdateObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_WmObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+
+EXTERN void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
+ int devId, CONST char *buffer, long size));
+
+EXTERN void TkEventInit _ANSI_ARGS_((void));
+
+EXTERN void TkRegisterObjTypes _ANSI_ARGS_((void));
+
+EXTERN int TkCreateMenuCmd _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int TkDeadAppCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+
+EXTERN int TkpTestembedCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int TkCanvasGetCoordObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tcl_Obj *obj,
+ double *doublePtr));
+EXTERN int TkCanvasDashParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value, char *widgRec,
+ int offset));
+EXTERN char * TkCanvasDashPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+EXTERN int TkGetDoublePixels _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *string,
+ double *doublePtr));
+EXTERN CONST Tk_OptionSpec *
+ TkGetOptionSpec _ANSI_ARGS_((CONST char *name,
+ Tk_OptionTable optionTable));
+EXTERN int TkOffsetParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value, char *widgRec,
+ int offset));
+EXTERN char * TkOffsetPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+EXTERN int TkOrientParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value,
+ char *widgRec, int offset));
+EXTERN char * TkOrientPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+EXTERN int TkPixelParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value, char *widgRec,
+ int offset));
+EXTERN char * TkPixelPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+EXTERN int TkPostscriptImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_PostscriptInfo psInfo,
+ XImage *ximage, int x, int y, int width,
+ int height));
+EXTERN int TkSmoothParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST char *value, char *recordPtr, int offset));
+EXTERN char * TkSmoothPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr));
+EXTERN int TkStateParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value,
+ char *widgRec, int offset));
+EXTERN char * TkStatePrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+EXTERN int TkTileParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *value, char *widgRec,
+ int offset));
+EXTERN char * TkTilePrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+/*
+ * Unsupported commands.
+ */
+EXTERN int TkUnsupported1Cmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKINT */
diff --git a/tcl/generic/tkIntDecls.h b/tcl/generic/tkIntDecls.h
new file mode 100644
index 00000000000..51c14910512
--- /dev/null
+++ b/tcl/generic/tkIntDecls.h
@@ -0,0 +1,1547 @@
+/*
+ * tkIntDecls.h --
+ *
+ * This file contains the declarations for all unsupported
+ * functions that are exported by the Tk library. These
+ * interfaces are not guaranteed to remain the same between
+ * versions. Use at your own risk.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKINTDECLS
+#define _TKINTDECLS
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tkInt.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+EXTERN TkWindow * TkAllocWindow _ANSI_ARGS_((TkDisplay * dispPtr,
+ int screenNum, TkWindow * parentPtr));
+/* 1 */
+EXTERN void TkBezierPoints _ANSI_ARGS_((double control[],
+ int numSteps, double * coordPtr));
+/* 2 */
+EXTERN void TkBezierScreenPoints _ANSI_ARGS_((Tk_Canvas canvas,
+ double control[], int numSteps,
+ XPoint * xPointPtr));
+/* 3 */
+EXTERN void TkBindDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 4 */
+EXTERN void TkBindEventProc _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr));
+/* 5 */
+EXTERN void TkBindFree _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 6 */
+EXTERN void TkBindInit _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 7 */
+EXTERN void TkChangeEventWindow _ANSI_ARGS_((XEvent * eventPtr,
+ TkWindow * winPtr));
+/* 8 */
+EXTERN int TkClipInit _ANSI_ARGS_((Tcl_Interp * interp,
+ TkDisplay * dispPtr));
+/* 9 */
+EXTERN void TkComputeAnchor _ANSI_ARGS_((Tk_Anchor anchor,
+ Tk_Window tkwin, int padX, int padY,
+ int innerWidth, int innerHeight, int * xPtr,
+ int * yPtr));
+/* 10 */
+EXTERN int TkCopyAndGlobalEval _ANSI_ARGS_((Tcl_Interp * interp,
+ char * script));
+/* 11 */
+EXTERN unsigned long TkCreateBindingProcedure _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, CONST char * eventString,
+ TkBindEvalProc * evalProc,
+ TkBindFreeProc * freeProc,
+ ClientData clientData));
+/* 12 */
+EXTERN TkCursor * TkCreateCursorFromData _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char * source, CONST char * mask,
+ int width, int height, int xHot, int yHot,
+ XColor fg, XColor bg));
+/* 13 */
+EXTERN int TkCreateFrame _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp, int argc, char ** argv,
+ int toplevel, char * appName));
+/* 14 */
+EXTERN Tk_Window TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * screenName, char * baseName));
+/* 15 */
+EXTERN Time TkCurrentTime _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 16 */
+EXTERN void TkDeleteAllImages _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 17 */
+EXTERN void TkDoConfigureNotify _ANSI_ARGS_((TkWindow * winPtr));
+/* 18 */
+EXTERN void TkDrawInsetFocusHighlight _ANSI_ARGS_((
+ Tk_Window tkwin, GC gc, int width,
+ Drawable drawable, int padding));
+/* 19 */
+EXTERN void TkEventDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 20 */
+EXTERN void TkFillPolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ double * coordPtr, int numPoints,
+ Display * display, Drawable drawable, GC gc,
+ GC outlineGC));
+/* 21 */
+EXTERN int TkFindStateNum _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * option,
+ CONST TkStateMap * mapPtr,
+ CONST char * strKey));
+/* 22 */
+EXTERN char * TkFindStateString _ANSI_ARGS_((
+ CONST TkStateMap * mapPtr, int numKey));
+/* 23 */
+EXTERN void TkFocusDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 24 */
+EXTERN int TkFocusFilterEvent _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr));
+/* 25 */
+EXTERN TkWindow * TkFocusKeyEvent _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr));
+/* 26 */
+EXTERN void TkFontPkgInit _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 27 */
+EXTERN void TkFontPkgFree _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 28 */
+EXTERN void TkFreeBindingTags _ANSI_ARGS_((TkWindow * winPtr));
+/* 29 */
+EXTERN void TkpFreeCursor _ANSI_ARGS_((TkCursor * cursorPtr));
+/* 30 */
+EXTERN char * TkGetBitmapData _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, char * fileName,
+ int * widthPtr, int * heightPtr,
+ int * hotXPtr, int * hotYPtr));
+/* 31 */
+EXTERN void TkGetButtPoints _ANSI_ARGS_((double p1[],
+ double p2[], double width, int project,
+ double m1[], double m2[]));
+/* 32 */
+EXTERN TkCursor * TkGetCursorByName _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid string));
+/* 33 */
+EXTERN CONST84_RETURN char * TkGetDefaultScreenName _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * screenName));
+/* 34 */
+EXTERN TkDisplay * TkGetDisplay _ANSI_ARGS_((Display * display));
+/* 35 */
+EXTERN int TkGetDisplayOf _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[],
+ Tk_Window * tkwinPtr));
+/* 36 */
+EXTERN TkWindow * TkGetFocusWin _ANSI_ARGS_((TkWindow * winPtr));
+/* 37 */
+EXTERN int TkGetInterpNames _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin));
+/* 38 */
+EXTERN int TkGetMiterPoints _ANSI_ARGS_((double p1[],
+ double p2[], double p3[], double width,
+ double m1[], double m2[]));
+/* 39 */
+EXTERN void TkGetPointerCoords _ANSI_ARGS_((Tk_Window tkwin,
+ int * xPtr, int * yPtr));
+/* 40 */
+EXTERN void TkGetServerInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin));
+/* 41 */
+EXTERN void TkGrabDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 42 */
+EXTERN int TkGrabState _ANSI_ARGS_((TkWindow * winPtr));
+/* 43 */
+EXTERN void TkIncludePoint _ANSI_ARGS_((Tk_Item * itemPtr,
+ double * pointPtr));
+/* 44 */
+EXTERN void TkInOutEvents _ANSI_ARGS_((XEvent * eventPtr,
+ TkWindow * sourcePtr, TkWindow * destPtr,
+ int leaveType, int enterType,
+ Tcl_QueuePosition position));
+/* 45 */
+EXTERN void TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin));
+/* 46 */
+EXTERN char * TkKeysymToString _ANSI_ARGS_((KeySym keysym));
+/* 47 */
+EXTERN int TkLineToArea _ANSI_ARGS_((double end1Ptr[],
+ double end2Ptr[], double rectPtr[]));
+/* 48 */
+EXTERN double TkLineToPoint _ANSI_ARGS_((double end1Ptr[],
+ double end2Ptr[], double pointPtr[]));
+/* 49 */
+EXTERN int TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas,
+ double * pointPtr, int numPoints,
+ int numSteps, XPoint xPoints[],
+ double dblPoints[]));
+/* 50 */
+EXTERN void TkMakeBezierPostscript _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Canvas canvas,
+ double * pointPtr, int numPoints));
+/* 51 */
+EXTERN void TkOptionClassChanged _ANSI_ARGS_((TkWindow * winPtr));
+/* 52 */
+EXTERN void TkOptionDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 53 */
+EXTERN int TkOvalToArea _ANSI_ARGS_((double * ovalPtr,
+ double * rectPtr));
+/* 54 */
+EXTERN double TkOvalToPoint _ANSI_ARGS_((double ovalPtr[],
+ double width, int filled, double pointPtr[]));
+/* 55 */
+EXTERN int TkpChangeFocus _ANSI_ARGS_((TkWindow * winPtr,
+ int force));
+/* 56 */
+EXTERN void TkpCloseDisplay _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 57 */
+EXTERN void TkpClaimFocus _ANSI_ARGS_((TkWindow * topLevelPtr,
+ int force));
+/* 58 */
+EXTERN void TkpDisplayWarning _ANSI_ARGS_((CONST char * msg,
+ CONST char * title));
+/* 59 */
+EXTERN void TkpGetAppName _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_DString * name));
+/* 60 */
+EXTERN TkWindow * TkpGetOtherWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 61 */
+EXTERN TkWindow * TkpGetWrapperWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 62 */
+EXTERN int TkpInit _ANSI_ARGS_((Tcl_Interp * interp));
+/* 63 */
+EXTERN void TkpInitializeMenuBindings _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ Tk_BindingTable bindingTable));
+/* 64 */
+EXTERN void TkpMakeContainer _ANSI_ARGS_((Tk_Window tkwin));
+/* 65 */
+EXTERN void TkpMakeMenuWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int transient));
+/* 66 */
+EXTERN Window TkpMakeWindow _ANSI_ARGS_((TkWindow * winPtr,
+ Window parent));
+/* 67 */
+EXTERN void TkpMenuNotifyToplevelCreate _ANSI_ARGS_((
+ Tcl_Interp * interp1, char * menuName));
+/* 68 */
+EXTERN TkDisplay * TkpOpenDisplay _ANSI_ARGS_((
+ CONST char * display_name));
+/* 69 */
+EXTERN int TkPointerEvent _ANSI_ARGS_((XEvent * eventPtr,
+ TkWindow * winPtr));
+/* 70 */
+EXTERN int TkPolygonToArea _ANSI_ARGS_((double * polyPtr,
+ int numPoints, double * rectPtr));
+/* 71 */
+EXTERN double TkPolygonToPoint _ANSI_ARGS_((double * polyPtr,
+ int numPoints, double * pointPtr));
+/* 72 */
+EXTERN int TkPositionInTree _ANSI_ARGS_((TkWindow * winPtr,
+ TkWindow * treePtr));
+/* 73 */
+EXTERN void TkpRedirectKeyEvent _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr));
+/* 74 */
+EXTERN void TkpSetMainMenubar _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * menuName));
+/* 75 */
+EXTERN int TkpUseWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * string));
+/* 76 */
+EXTERN int TkpWindowWasRecentlyDeleted _ANSI_ARGS_((Window win,
+ TkDisplay * dispPtr));
+/* 77 */
+EXTERN void TkQueueEventForAllChildren _ANSI_ARGS_((
+ TkWindow * winPtr, XEvent * eventPtr));
+/* 78 */
+EXTERN int TkReadBitmapFile _ANSI_ARGS_((Display* display,
+ Drawable d, CONST char* filename,
+ unsigned int* width_return,
+ unsigned int* height_return,
+ Pixmap* bitmap_return, int* x_hot_return,
+ int* y_hot_return));
+/* 79 */
+EXTERN int TkScrollWindow _ANSI_ARGS_((Tk_Window tkwin, GC gc,
+ int x, int y, int width, int height, int dx,
+ int dy, TkRegion damageRgn));
+/* 80 */
+EXTERN void TkSelDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 81 */
+EXTERN void TkSelEventProc _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent * eventPtr));
+/* 82 */
+EXTERN void TkSelInit _ANSI_ARGS_((Tk_Window tkwin));
+/* 83 */
+EXTERN void TkSelPropProc _ANSI_ARGS_((XEvent * eventPtr));
+/* Slot 84 is reserved */
+/* 85 */
+EXTERN void TkSetWindowMenuBar _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * oldMenuName,
+ char * menuName));
+/* 86 */
+EXTERN KeySym TkStringToKeysym _ANSI_ARGS_((char * name));
+/* 87 */
+EXTERN int TkThickPolyLineToArea _ANSI_ARGS_((double * coordPtr,
+ int numPoints, double width, int capStyle,
+ int joinStyle, double * rectPtr));
+/* 88 */
+EXTERN void TkWmAddToColormapWindows _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 89 */
+EXTERN void TkWmDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 90 */
+EXTERN TkWindow * TkWmFocusToplevel _ANSI_ARGS_((TkWindow * winPtr));
+/* 91 */
+EXTERN void TkWmMapWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 92 */
+EXTERN void TkWmNewWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 93 */
+EXTERN void TkWmProtocolEventProc _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * evenvPtr));
+/* 94 */
+EXTERN void TkWmRemoveFromColormapWindows _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 95 */
+EXTERN void TkWmRestackToplevel _ANSI_ARGS_((TkWindow * winPtr,
+ int aboveBelow, TkWindow * otherPtr));
+/* 96 */
+EXTERN void TkWmSetClass _ANSI_ARGS_((TkWindow * winPtr));
+/* 97 */
+EXTERN void TkWmUnmapWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 98 */
+EXTERN Tcl_Obj * TkDebugBitmap _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 99 */
+EXTERN Tcl_Obj * TkDebugBorder _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 100 */
+EXTERN Tcl_Obj * TkDebugCursor _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 101 */
+EXTERN Tcl_Obj * TkDebugColor _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 102 */
+EXTERN Tcl_Obj * TkDebugConfig _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_OptionTable table));
+/* 103 */
+EXTERN Tcl_Obj * TkDebugFont _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 104 */
+EXTERN int TkFindStateNumObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * optionPtr,
+ CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr));
+/* 105 */
+EXTERN Tcl_HashTable * TkGetBitmapPredefTable _ANSI_ARGS_((void));
+/* 106 */
+EXTERN TkDisplay * TkGetDisplayList _ANSI_ARGS_((void));
+/* 107 */
+EXTERN TkMainInfo * TkGetMainInfoList _ANSI_ARGS_((void));
+/* 108 */
+EXTERN int TkGetWindowFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr,
+ Tk_Window * windowPtr));
+/* 109 */
+EXTERN char * TkpGetString _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr, Tcl_DString * dsPtr));
+/* 110 */
+EXTERN void TkpGetSubFonts _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Font tkfont));
+/* 111 */
+EXTERN Tcl_Obj * TkpGetSystemDefault _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char * dbName, CONST char * className));
+/* 112 */
+EXTERN void TkpMenuThreadInit _ANSI_ARGS_((void));
+#ifdef __WIN32__
+/* 113 */
+EXTERN void TkClipBox _ANSI_ARGS_((TkRegion rgn,
+ XRectangle* rect_return));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 113 */
+EXTERN void TkClipBox _ANSI_ARGS_((TkRegion rgn,
+ XRectangle* rect_return));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 113 */
+EXTERN void TkClipBox _ANSI_ARGS_((TkRegion rgn,
+ XRectangle* rect_return));
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+/* 114 */
+EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 114 */
+EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 114 */
+EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void));
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+/* 115 */
+EXTERN void TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 115 */
+EXTERN void TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 115 */
+EXTERN void TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+/* 116 */
+EXTERN void TkIntersectRegion _ANSI_ARGS_((TkRegion sra,
+ TkRegion srcb, TkRegion dr_return));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 116 */
+EXTERN void TkIntersectRegion _ANSI_ARGS_((TkRegion sra,
+ TkRegion srcb, TkRegion dr_return));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 116 */
+EXTERN void TkIntersectRegion _ANSI_ARGS_((TkRegion sra,
+ TkRegion srcb, TkRegion dr_return));
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+/* 117 */
+EXTERN int TkRectInRegion _ANSI_ARGS_((TkRegion rgn, int x,
+ int y, unsigned int width,
+ unsigned int height));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 117 */
+EXTERN int TkRectInRegion _ANSI_ARGS_((TkRegion rgn, int x,
+ int y, unsigned int width,
+ unsigned int height));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 117 */
+EXTERN int TkRectInRegion _ANSI_ARGS_((TkRegion rgn, int x,
+ int y, unsigned int width,
+ unsigned int height));
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+/* 118 */
+EXTERN void TkSetRegion _ANSI_ARGS_((Display* display, GC gc,
+ TkRegion rgn));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 118 */
+EXTERN void TkSetRegion _ANSI_ARGS_((Display* display, GC gc,
+ TkRegion rgn));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 118 */
+EXTERN void TkSetRegion _ANSI_ARGS_((Display* display, GC gc,
+ TkRegion rgn));
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+/* 119 */
+EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect,
+ TkRegion src, TkRegion dr_return));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 119 */
+EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect,
+ TkRegion src, TkRegion dr_return));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 119 */
+EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect,
+ TkRegion src, TkRegion dr_return));
+#endif /* MAC_OSX_TK */
+/* Slot 120 is reserved */
+#ifdef MAC_TCL
+/* 121 */
+EXTERN Pixmap TkpCreateNativeBitmap _ANSI_ARGS_((Display * display,
+ CONST char * source));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 121 */
+EXTERN Pixmap TkpCreateNativeBitmap _ANSI_ARGS_((Display * display,
+ CONST char * source));
+#endif /* MAC_OSX_TK */
+#ifdef MAC_TCL
+/* 122 */
+EXTERN void TkpDefineNativeBitmaps _ANSI_ARGS_((void));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 122 */
+EXTERN void TkpDefineNativeBitmaps _ANSI_ARGS_((void));
+#endif /* MAC_OSX_TK */
+/* Slot 123 is reserved */
+#ifdef MAC_TCL
+/* 124 */
+EXTERN Pixmap TkpGetNativeAppBitmap _ANSI_ARGS_((Display * display,
+ CONST char * name, int * width, int * height));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 124 */
+EXTERN Pixmap TkpGetNativeAppBitmap _ANSI_ARGS_((Display * display,
+ CONST char * name, int * width, int * height));
+#endif /* MAC_OSX_TK */
+/* Slot 125 is reserved */
+/* Slot 126 is reserved */
+/* Slot 127 is reserved */
+/* Slot 128 is reserved */
+/* Slot 129 is reserved */
+/* Slot 130 is reserved */
+/* Slot 131 is reserved */
+/* Slot 132 is reserved */
+/* Slot 133 is reserved */
+/* Slot 134 is reserved */
+/* 135 */
+EXTERN void TkpDrawHighlightBorder _ANSI_ARGS_((Tk_Window tkwin,
+ GC fgGC, GC bgGC, int highlightWidth,
+ Drawable drawable));
+/* 136 */
+EXTERN void TkSetFocusWin _ANSI_ARGS_((TkWindow * winPtr,
+ int force));
+/* 137 */
+EXTERN void TkpSetKeycodeAndState _ANSI_ARGS_((Tk_Window tkwin,
+ KeySym keySym, XEvent * eventPtr));
+/* 138 */
+EXTERN KeySym TkpGetKeySym _ANSI_ARGS_((TkDisplay * dispPtr,
+ XEvent * eventPtr));
+/* 139 */
+EXTERN void TkpInitKeymapInfo _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 140 */
+EXTERN TkRegion TkPhotoGetValidRegion _ANSI_ARGS_((
+ Tk_PhotoHandle handle));
+/* 141 */
+EXTERN TkWindow ** TkWmStackorderToplevel _ANSI_ARGS_((
+ TkWindow * parentPtr));
+/* 142 */
+EXTERN void TkFocusFree _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 143 */
+EXTERN void TkClipCleanup _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 144 */
+EXTERN void TkGCCleanup _ANSI_ARGS_((TkDisplay * dispPtr));
+#ifdef __WIN32__
+/* 145 */
+EXTERN void TkSubtractRegion _ANSI_ARGS_((TkRegion sra,
+ TkRegion srcb, TkRegion dr_return));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 145 */
+EXTERN void TkSubtractRegion _ANSI_ARGS_((TkRegion sra,
+ TkRegion srcb, TkRegion dr_return));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 145 */
+EXTERN void TkSubtractRegion _ANSI_ARGS_((TkRegion sra,
+ TkRegion srcb, TkRegion dr_return));
+#endif /* MAC_OSX_TK */
+/* 146 */
+EXTERN void TkStylePkgInit _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 147 */
+EXTERN void TkStylePkgFree _ANSI_ARGS_((TkMainInfo * mainPtr));
+
+typedef struct TkIntStubs {
+ int magic;
+ struct TkIntStubHooks *hooks;
+
+ TkWindow * (*tkAllocWindow) _ANSI_ARGS_((TkDisplay * dispPtr, int screenNum, TkWindow * parentPtr)); /* 0 */
+ void (*tkBezierPoints) _ANSI_ARGS_((double control[], int numSteps, double * coordPtr)); /* 1 */
+ void (*tkBezierScreenPoints) _ANSI_ARGS_((Tk_Canvas canvas, double control[], int numSteps, XPoint * xPointPtr)); /* 2 */
+ void (*tkBindDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 3 */
+ void (*tkBindEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 4 */
+ void (*tkBindFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 5 */
+ void (*tkBindInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 6 */
+ void (*tkChangeEventWindow) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 7 */
+ int (*tkClipInit) _ANSI_ARGS_((Tcl_Interp * interp, TkDisplay * dispPtr)); /* 8 */
+ void (*tkComputeAnchor) _ANSI_ARGS_((Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int * xPtr, int * yPtr)); /* 9 */
+ int (*tkCopyAndGlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * script)); /* 10 */
+ unsigned long (*tkCreateBindingProcedure) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, CONST char * eventString, TkBindEvalProc * evalProc, TkBindFreeProc * freeProc, ClientData clientData)); /* 11 */
+ TkCursor * (*tkCreateCursorFromData) _ANSI_ARGS_((Tk_Window tkwin, CONST char * source, CONST char * mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg)); /* 12 */
+ int (*tkCreateFrame) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv, int toplevel, char * appName)); /* 13 */
+ Tk_Window (*tkCreateMainWindow) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * screenName, char * baseName)); /* 14 */
+ Time (*tkCurrentTime) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 15 */
+ void (*tkDeleteAllImages) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 16 */
+ void (*tkDoConfigureNotify) _ANSI_ARGS_((TkWindow * winPtr)); /* 17 */
+ void (*tkDrawInsetFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable, int padding)); /* 18 */
+ void (*tkEventDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 19 */
+ void (*tkFillPolygon) _ANSI_ARGS_((Tk_Canvas canvas, double * coordPtr, int numPoints, Display * display, Drawable drawable, GC gc, GC outlineGC)); /* 20 */
+ int (*tkFindStateNum) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * option, CONST TkStateMap * mapPtr, CONST char * strKey)); /* 21 */
+ char * (*tkFindStateString) _ANSI_ARGS_((CONST TkStateMap * mapPtr, int numKey)); /* 22 */
+ void (*tkFocusDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 23 */
+ int (*tkFocusFilterEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 24 */
+ TkWindow * (*tkFocusKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 25 */
+ void (*tkFontPkgInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 26 */
+ void (*tkFontPkgFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 27 */
+ void (*tkFreeBindingTags) _ANSI_ARGS_((TkWindow * winPtr)); /* 28 */
+ void (*tkpFreeCursor) _ANSI_ARGS_((TkCursor * cursorPtr)); /* 29 */
+ char * (*tkGetBitmapData) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * fileName, int * widthPtr, int * heightPtr, int * hotXPtr, int * hotYPtr)); /* 30 */
+ void (*tkGetButtPoints) _ANSI_ARGS_((double p1[], double p2[], double width, int project, double m1[], double m2[])); /* 31 */
+ TkCursor * (*tkGetCursorByName) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid string)); /* 32 */
+ CONST84_RETURN char * (*tkGetDefaultScreenName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * screenName)); /* 33 */
+ TkDisplay * (*tkGetDisplay) _ANSI_ARGS_((Display * display)); /* 34 */
+ int (*tkGetDisplayOf) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], Tk_Window * tkwinPtr)); /* 35 */
+ TkWindow * (*tkGetFocusWin) _ANSI_ARGS_((TkWindow * winPtr)); /* 36 */
+ int (*tkGetInterpNames) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 37 */
+ int (*tkGetMiterPoints) _ANSI_ARGS_((double p1[], double p2[], double p3[], double width, double m1[], double m2[])); /* 38 */
+ void (*tkGetPointerCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 39 */
+ void (*tkGetServerInfo) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 40 */
+ void (*tkGrabDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 41 */
+ int (*tkGrabState) _ANSI_ARGS_((TkWindow * winPtr)); /* 42 */
+ void (*tkIncludePoint) _ANSI_ARGS_((Tk_Item * itemPtr, double * pointPtr)); /* 43 */
+ void (*tkInOutEvents) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * sourcePtr, TkWindow * destPtr, int leaveType, int enterType, Tcl_QueuePosition position)); /* 44 */
+ void (*tkInstallFrameMenu) _ANSI_ARGS_((Tk_Window tkwin)); /* 45 */
+ char * (*tkKeysymToString) _ANSI_ARGS_((KeySym keysym)); /* 46 */
+ int (*tkLineToArea) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double rectPtr[])); /* 47 */
+ double (*tkLineToPoint) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double pointPtr[])); /* 48 */
+ int (*tkMakeBezierCurve) _ANSI_ARGS_((Tk_Canvas canvas, double * pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[])); /* 49 */
+ void (*tkMakeBezierPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * pointPtr, int numPoints)); /* 50 */
+ void (*tkOptionClassChanged) _ANSI_ARGS_((TkWindow * winPtr)); /* 51 */
+ void (*tkOptionDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 52 */
+ int (*tkOvalToArea) _ANSI_ARGS_((double * ovalPtr, double * rectPtr)); /* 53 */
+ double (*tkOvalToPoint) _ANSI_ARGS_((double ovalPtr[], double width, int filled, double pointPtr[])); /* 54 */
+ int (*tkpChangeFocus) _ANSI_ARGS_((TkWindow * winPtr, int force)); /* 55 */
+ void (*tkpCloseDisplay) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 56 */
+ void (*tkpClaimFocus) _ANSI_ARGS_((TkWindow * topLevelPtr, int force)); /* 57 */
+ void (*tkpDisplayWarning) _ANSI_ARGS_((CONST char * msg, CONST char * title)); /* 58 */
+ void (*tkpGetAppName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * name)); /* 59 */
+ TkWindow * (*tkpGetOtherWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 60 */
+ TkWindow * (*tkpGetWrapperWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 61 */
+ int (*tkpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 62 */
+ void (*tkpInitializeMenuBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable)); /* 63 */
+ void (*tkpMakeContainer) _ANSI_ARGS_((Tk_Window tkwin)); /* 64 */
+ void (*tkpMakeMenuWindow) _ANSI_ARGS_((Tk_Window tkwin, int transient)); /* 65 */
+ Window (*tkpMakeWindow) _ANSI_ARGS_((TkWindow * winPtr, Window parent)); /* 66 */
+ void (*tkpMenuNotifyToplevelCreate) _ANSI_ARGS_((Tcl_Interp * interp1, char * menuName)); /* 67 */
+ TkDisplay * (*tkpOpenDisplay) _ANSI_ARGS_((CONST char * display_name)); /* 68 */
+ int (*tkPointerEvent) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 69 */
+ int (*tkPolygonToArea) _ANSI_ARGS_((double * polyPtr, int numPoints, double * rectPtr)); /* 70 */
+ double (*tkPolygonToPoint) _ANSI_ARGS_((double * polyPtr, int numPoints, double * pointPtr)); /* 71 */
+ int (*tkPositionInTree) _ANSI_ARGS_((TkWindow * winPtr, TkWindow * treePtr)); /* 72 */
+ void (*tkpRedirectKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 73 */
+ void (*tkpSetMainMenubar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * menuName)); /* 74 */
+ int (*tkpUseWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * string)); /* 75 */
+ int (*tkpWindowWasRecentlyDeleted) _ANSI_ARGS_((Window win, TkDisplay * dispPtr)); /* 76 */
+ void (*tkQueueEventForAllChildren) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 77 */
+ int (*tkReadBitmapFile) _ANSI_ARGS_((Display* display, Drawable d, CONST char* filename, unsigned int* width_return, unsigned int* height_return, Pixmap* bitmap_return, int* x_hot_return, int* y_hot_return)); /* 78 */
+ int (*tkScrollWindow) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int x, int y, int width, int height, int dx, int dy, TkRegion damageRgn)); /* 79 */
+ void (*tkSelDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 80 */
+ void (*tkSelEventProc) _ANSI_ARGS_((Tk_Window tkwin, XEvent * eventPtr)); /* 81 */
+ void (*tkSelInit) _ANSI_ARGS_((Tk_Window tkwin)); /* 82 */
+ void (*tkSelPropProc) _ANSI_ARGS_((XEvent * eventPtr)); /* 83 */
+ void *reserved84;
+ void (*tkSetWindowMenuBar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * oldMenuName, char * menuName)); /* 85 */
+ KeySym (*tkStringToKeysym) _ANSI_ARGS_((char * name)); /* 86 */
+ int (*tkThickPolyLineToArea) _ANSI_ARGS_((double * coordPtr, int numPoints, double width, int capStyle, int joinStyle, double * rectPtr)); /* 87 */
+ void (*tkWmAddToColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 88 */
+ void (*tkWmDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 89 */
+ TkWindow * (*tkWmFocusToplevel) _ANSI_ARGS_((TkWindow * winPtr)); /* 90 */
+ void (*tkWmMapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 91 */
+ void (*tkWmNewWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 92 */
+ void (*tkWmProtocolEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * evenvPtr)); /* 93 */
+ void (*tkWmRemoveFromColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 94 */
+ void (*tkWmRestackToplevel) _ANSI_ARGS_((TkWindow * winPtr, int aboveBelow, TkWindow * otherPtr)); /* 95 */
+ void (*tkWmSetClass) _ANSI_ARGS_((TkWindow * winPtr)); /* 96 */
+ void (*tkWmUnmapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 97 */
+ Tcl_Obj * (*tkDebugBitmap) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 98 */
+ Tcl_Obj * (*tkDebugBorder) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 99 */
+ Tcl_Obj * (*tkDebugCursor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 100 */
+ Tcl_Obj * (*tkDebugColor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 101 */
+ Tcl_Obj * (*tkDebugConfig) _ANSI_ARGS_((Tcl_Interp * interp, Tk_OptionTable table)); /* 102 */
+ Tcl_Obj * (*tkDebugFont) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 103 */
+ int (*tkFindStateNumObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * optionPtr, CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr)); /* 104 */
+ Tcl_HashTable * (*tkGetBitmapPredefTable) _ANSI_ARGS_((void)); /* 105 */
+ TkDisplay * (*tkGetDisplayList) _ANSI_ARGS_((void)); /* 106 */
+ TkMainInfo * (*tkGetMainInfoList) _ANSI_ARGS_((void)); /* 107 */
+ int (*tkGetWindowFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, Tk_Window * windowPtr)); /* 108 */
+ char * (*tkpGetString) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr, Tcl_DString * dsPtr)); /* 109 */
+ void (*tkpGetSubFonts) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Font tkfont)); /* 110 */
+ Tcl_Obj * (*tkpGetSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, CONST char * dbName, CONST char * className)); /* 111 */
+ void (*tkpMenuThreadInit) _ANSI_ARGS_((void)); /* 112 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved113;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 113 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 113 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 113 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved114;
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkRegion (*tkCreateRegion) _ANSI_ARGS_((void)); /* 114 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkRegion (*tkCreateRegion) _ANSI_ARGS_((void)); /* 114 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkRegion (*tkCreateRegion) _ANSI_ARGS_((void)); /* 114 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved115;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tkDestroyRegion) _ANSI_ARGS_((TkRegion rgn)); /* 115 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkDestroyRegion) _ANSI_ARGS_((TkRegion rgn)); /* 115 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkDestroyRegion) _ANSI_ARGS_((TkRegion rgn)); /* 115 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved116;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tkIntersectRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 116 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkIntersectRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 116 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkIntersectRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 116 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved117;
+#endif /* UNIX */
+#ifdef __WIN32__
+ int (*tkRectInRegion) _ANSI_ARGS_((TkRegion rgn, int x, int y, unsigned int width, unsigned int height)); /* 117 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ int (*tkRectInRegion) _ANSI_ARGS_((TkRegion rgn, int x, int y, unsigned int width, unsigned int height)); /* 117 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ int (*tkRectInRegion) _ANSI_ARGS_((TkRegion rgn, int x, int y, unsigned int width, unsigned int height)); /* 117 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved118;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tkSetRegion) _ANSI_ARGS_((Display* display, GC gc, TkRegion rgn)); /* 118 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkSetRegion) _ANSI_ARGS_((Display* display, GC gc, TkRegion rgn)); /* 118 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkSetRegion) _ANSI_ARGS_((Display* display, GC gc, TkRegion rgn)); /* 118 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved119;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tkUnionRectWithRegion) _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); /* 119 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkUnionRectWithRegion) _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); /* 119 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkUnionRectWithRegion) _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); /* 119 */
+#endif /* MAC_OSX_TK */
+ void *reserved120;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved121;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved121;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ Pixmap (*tkpCreateNativeBitmap) _ANSI_ARGS_((Display * display, CONST char * source)); /* 121 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ Pixmap (*tkpCreateNativeBitmap) _ANSI_ARGS_((Display * display, CONST char * source)); /* 121 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved122;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved122;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkpDefineNativeBitmaps) _ANSI_ARGS_((void)); /* 122 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkpDefineNativeBitmaps) _ANSI_ARGS_((void)); /* 122 */
+#endif /* MAC_OSX_TK */
+ void *reserved123;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved124;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved124;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ Pixmap (*tkpGetNativeAppBitmap) _ANSI_ARGS_((Display * display, CONST char * name, int * width, int * height)); /* 124 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ Pixmap (*tkpGetNativeAppBitmap) _ANSI_ARGS_((Display * display, CONST char * name, int * width, int * height)); /* 124 */
+#endif /* MAC_OSX_TK */
+ void *reserved125;
+ void *reserved126;
+ void *reserved127;
+ void *reserved128;
+ void *reserved129;
+ void *reserved130;
+ void *reserved131;
+ void *reserved132;
+ void *reserved133;
+ void *reserved134;
+ void (*tkpDrawHighlightBorder) _ANSI_ARGS_((Tk_Window tkwin, GC fgGC, GC bgGC, int highlightWidth, Drawable drawable)); /* 135 */
+ void (*tkSetFocusWin) _ANSI_ARGS_((TkWindow * winPtr, int force)); /* 136 */
+ void (*tkpSetKeycodeAndState) _ANSI_ARGS_((Tk_Window tkwin, KeySym keySym, XEvent * eventPtr)); /* 137 */
+ KeySym (*tkpGetKeySym) _ANSI_ARGS_((TkDisplay * dispPtr, XEvent * eventPtr)); /* 138 */
+ void (*tkpInitKeymapInfo) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 139 */
+ TkRegion (*tkPhotoGetValidRegion) _ANSI_ARGS_((Tk_PhotoHandle handle)); /* 140 */
+ TkWindow ** (*tkWmStackorderToplevel) _ANSI_ARGS_((TkWindow * parentPtr)); /* 141 */
+ void (*tkFocusFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 142 */
+ void (*tkClipCleanup) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 143 */
+ void (*tkGCCleanup) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 144 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved145;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tkSubtractRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 145 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkSubtractRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 145 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkSubtractRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 145 */
+#endif /* MAC_OSX_TK */
+ void (*tkStylePkgInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 146 */
+ void (*tkStylePkgFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 147 */
+} TkIntStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TkIntStubs *tkIntStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef TkAllocWindow
+#define TkAllocWindow \
+ (tkIntStubsPtr->tkAllocWindow) /* 0 */
+#endif
+#ifndef TkBezierPoints
+#define TkBezierPoints \
+ (tkIntStubsPtr->tkBezierPoints) /* 1 */
+#endif
+#ifndef TkBezierScreenPoints
+#define TkBezierScreenPoints \
+ (tkIntStubsPtr->tkBezierScreenPoints) /* 2 */
+#endif
+#ifndef TkBindDeadWindow
+#define TkBindDeadWindow \
+ (tkIntStubsPtr->tkBindDeadWindow) /* 3 */
+#endif
+#ifndef TkBindEventProc
+#define TkBindEventProc \
+ (tkIntStubsPtr->tkBindEventProc) /* 4 */
+#endif
+#ifndef TkBindFree
+#define TkBindFree \
+ (tkIntStubsPtr->tkBindFree) /* 5 */
+#endif
+#ifndef TkBindInit
+#define TkBindInit \
+ (tkIntStubsPtr->tkBindInit) /* 6 */
+#endif
+#ifndef TkChangeEventWindow
+#define TkChangeEventWindow \
+ (tkIntStubsPtr->tkChangeEventWindow) /* 7 */
+#endif
+#ifndef TkClipInit
+#define TkClipInit \
+ (tkIntStubsPtr->tkClipInit) /* 8 */
+#endif
+#ifndef TkComputeAnchor
+#define TkComputeAnchor \
+ (tkIntStubsPtr->tkComputeAnchor) /* 9 */
+#endif
+#ifndef TkCopyAndGlobalEval
+#define TkCopyAndGlobalEval \
+ (tkIntStubsPtr->tkCopyAndGlobalEval) /* 10 */
+#endif
+#ifndef TkCreateBindingProcedure
+#define TkCreateBindingProcedure \
+ (tkIntStubsPtr->tkCreateBindingProcedure) /* 11 */
+#endif
+#ifndef TkCreateCursorFromData
+#define TkCreateCursorFromData \
+ (tkIntStubsPtr->tkCreateCursorFromData) /* 12 */
+#endif
+#ifndef TkCreateFrame
+#define TkCreateFrame \
+ (tkIntStubsPtr->tkCreateFrame) /* 13 */
+#endif
+#ifndef TkCreateMainWindow
+#define TkCreateMainWindow \
+ (tkIntStubsPtr->tkCreateMainWindow) /* 14 */
+#endif
+#ifndef TkCurrentTime
+#define TkCurrentTime \
+ (tkIntStubsPtr->tkCurrentTime) /* 15 */
+#endif
+#ifndef TkDeleteAllImages
+#define TkDeleteAllImages \
+ (tkIntStubsPtr->tkDeleteAllImages) /* 16 */
+#endif
+#ifndef TkDoConfigureNotify
+#define TkDoConfigureNotify \
+ (tkIntStubsPtr->tkDoConfigureNotify) /* 17 */
+#endif
+#ifndef TkDrawInsetFocusHighlight
+#define TkDrawInsetFocusHighlight \
+ (tkIntStubsPtr->tkDrawInsetFocusHighlight) /* 18 */
+#endif
+#ifndef TkEventDeadWindow
+#define TkEventDeadWindow \
+ (tkIntStubsPtr->tkEventDeadWindow) /* 19 */
+#endif
+#ifndef TkFillPolygon
+#define TkFillPolygon \
+ (tkIntStubsPtr->tkFillPolygon) /* 20 */
+#endif
+#ifndef TkFindStateNum
+#define TkFindStateNum \
+ (tkIntStubsPtr->tkFindStateNum) /* 21 */
+#endif
+#ifndef TkFindStateString
+#define TkFindStateString \
+ (tkIntStubsPtr->tkFindStateString) /* 22 */
+#endif
+#ifndef TkFocusDeadWindow
+#define TkFocusDeadWindow \
+ (tkIntStubsPtr->tkFocusDeadWindow) /* 23 */
+#endif
+#ifndef TkFocusFilterEvent
+#define TkFocusFilterEvent \
+ (tkIntStubsPtr->tkFocusFilterEvent) /* 24 */
+#endif
+#ifndef TkFocusKeyEvent
+#define TkFocusKeyEvent \
+ (tkIntStubsPtr->tkFocusKeyEvent) /* 25 */
+#endif
+#ifndef TkFontPkgInit
+#define TkFontPkgInit \
+ (tkIntStubsPtr->tkFontPkgInit) /* 26 */
+#endif
+#ifndef TkFontPkgFree
+#define TkFontPkgFree \
+ (tkIntStubsPtr->tkFontPkgFree) /* 27 */
+#endif
+#ifndef TkFreeBindingTags
+#define TkFreeBindingTags \
+ (tkIntStubsPtr->tkFreeBindingTags) /* 28 */
+#endif
+#ifndef TkpFreeCursor
+#define TkpFreeCursor \
+ (tkIntStubsPtr->tkpFreeCursor) /* 29 */
+#endif
+#ifndef TkGetBitmapData
+#define TkGetBitmapData \
+ (tkIntStubsPtr->tkGetBitmapData) /* 30 */
+#endif
+#ifndef TkGetButtPoints
+#define TkGetButtPoints \
+ (tkIntStubsPtr->tkGetButtPoints) /* 31 */
+#endif
+#ifndef TkGetCursorByName
+#define TkGetCursorByName \
+ (tkIntStubsPtr->tkGetCursorByName) /* 32 */
+#endif
+#ifndef TkGetDefaultScreenName
+#define TkGetDefaultScreenName \
+ (tkIntStubsPtr->tkGetDefaultScreenName) /* 33 */
+#endif
+#ifndef TkGetDisplay
+#define TkGetDisplay \
+ (tkIntStubsPtr->tkGetDisplay) /* 34 */
+#endif
+#ifndef TkGetDisplayOf
+#define TkGetDisplayOf \
+ (tkIntStubsPtr->tkGetDisplayOf) /* 35 */
+#endif
+#ifndef TkGetFocusWin
+#define TkGetFocusWin \
+ (tkIntStubsPtr->tkGetFocusWin) /* 36 */
+#endif
+#ifndef TkGetInterpNames
+#define TkGetInterpNames \
+ (tkIntStubsPtr->tkGetInterpNames) /* 37 */
+#endif
+#ifndef TkGetMiterPoints
+#define TkGetMiterPoints \
+ (tkIntStubsPtr->tkGetMiterPoints) /* 38 */
+#endif
+#ifndef TkGetPointerCoords
+#define TkGetPointerCoords \
+ (tkIntStubsPtr->tkGetPointerCoords) /* 39 */
+#endif
+#ifndef TkGetServerInfo
+#define TkGetServerInfo \
+ (tkIntStubsPtr->tkGetServerInfo) /* 40 */
+#endif
+#ifndef TkGrabDeadWindow
+#define TkGrabDeadWindow \
+ (tkIntStubsPtr->tkGrabDeadWindow) /* 41 */
+#endif
+#ifndef TkGrabState
+#define TkGrabState \
+ (tkIntStubsPtr->tkGrabState) /* 42 */
+#endif
+#ifndef TkIncludePoint
+#define TkIncludePoint \
+ (tkIntStubsPtr->tkIncludePoint) /* 43 */
+#endif
+#ifndef TkInOutEvents
+#define TkInOutEvents \
+ (tkIntStubsPtr->tkInOutEvents) /* 44 */
+#endif
+#ifndef TkInstallFrameMenu
+#define TkInstallFrameMenu \
+ (tkIntStubsPtr->tkInstallFrameMenu) /* 45 */
+#endif
+#ifndef TkKeysymToString
+#define TkKeysymToString \
+ (tkIntStubsPtr->tkKeysymToString) /* 46 */
+#endif
+#ifndef TkLineToArea
+#define TkLineToArea \
+ (tkIntStubsPtr->tkLineToArea) /* 47 */
+#endif
+#ifndef TkLineToPoint
+#define TkLineToPoint \
+ (tkIntStubsPtr->tkLineToPoint) /* 48 */
+#endif
+#ifndef TkMakeBezierCurve
+#define TkMakeBezierCurve \
+ (tkIntStubsPtr->tkMakeBezierCurve) /* 49 */
+#endif
+#ifndef TkMakeBezierPostscript
+#define TkMakeBezierPostscript \
+ (tkIntStubsPtr->tkMakeBezierPostscript) /* 50 */
+#endif
+#ifndef TkOptionClassChanged
+#define TkOptionClassChanged \
+ (tkIntStubsPtr->tkOptionClassChanged) /* 51 */
+#endif
+#ifndef TkOptionDeadWindow
+#define TkOptionDeadWindow \
+ (tkIntStubsPtr->tkOptionDeadWindow) /* 52 */
+#endif
+#ifndef TkOvalToArea
+#define TkOvalToArea \
+ (tkIntStubsPtr->tkOvalToArea) /* 53 */
+#endif
+#ifndef TkOvalToPoint
+#define TkOvalToPoint \
+ (tkIntStubsPtr->tkOvalToPoint) /* 54 */
+#endif
+#ifndef TkpChangeFocus
+#define TkpChangeFocus \
+ (tkIntStubsPtr->tkpChangeFocus) /* 55 */
+#endif
+#ifndef TkpCloseDisplay
+#define TkpCloseDisplay \
+ (tkIntStubsPtr->tkpCloseDisplay) /* 56 */
+#endif
+#ifndef TkpClaimFocus
+#define TkpClaimFocus \
+ (tkIntStubsPtr->tkpClaimFocus) /* 57 */
+#endif
+#ifndef TkpDisplayWarning
+#define TkpDisplayWarning \
+ (tkIntStubsPtr->tkpDisplayWarning) /* 58 */
+#endif
+#ifndef TkpGetAppName
+#define TkpGetAppName \
+ (tkIntStubsPtr->tkpGetAppName) /* 59 */
+#endif
+#ifndef TkpGetOtherWindow
+#define TkpGetOtherWindow \
+ (tkIntStubsPtr->tkpGetOtherWindow) /* 60 */
+#endif
+#ifndef TkpGetWrapperWindow
+#define TkpGetWrapperWindow \
+ (tkIntStubsPtr->tkpGetWrapperWindow) /* 61 */
+#endif
+#ifndef TkpInit
+#define TkpInit \
+ (tkIntStubsPtr->tkpInit) /* 62 */
+#endif
+#ifndef TkpInitializeMenuBindings
+#define TkpInitializeMenuBindings \
+ (tkIntStubsPtr->tkpInitializeMenuBindings) /* 63 */
+#endif
+#ifndef TkpMakeContainer
+#define TkpMakeContainer \
+ (tkIntStubsPtr->tkpMakeContainer) /* 64 */
+#endif
+#ifndef TkpMakeMenuWindow
+#define TkpMakeMenuWindow \
+ (tkIntStubsPtr->tkpMakeMenuWindow) /* 65 */
+#endif
+#ifndef TkpMakeWindow
+#define TkpMakeWindow \
+ (tkIntStubsPtr->tkpMakeWindow) /* 66 */
+#endif
+#ifndef TkpMenuNotifyToplevelCreate
+#define TkpMenuNotifyToplevelCreate \
+ (tkIntStubsPtr->tkpMenuNotifyToplevelCreate) /* 67 */
+#endif
+#ifndef TkpOpenDisplay
+#define TkpOpenDisplay \
+ (tkIntStubsPtr->tkpOpenDisplay) /* 68 */
+#endif
+#ifndef TkPointerEvent
+#define TkPointerEvent \
+ (tkIntStubsPtr->tkPointerEvent) /* 69 */
+#endif
+#ifndef TkPolygonToArea
+#define TkPolygonToArea \
+ (tkIntStubsPtr->tkPolygonToArea) /* 70 */
+#endif
+#ifndef TkPolygonToPoint
+#define TkPolygonToPoint \
+ (tkIntStubsPtr->tkPolygonToPoint) /* 71 */
+#endif
+#ifndef TkPositionInTree
+#define TkPositionInTree \
+ (tkIntStubsPtr->tkPositionInTree) /* 72 */
+#endif
+#ifndef TkpRedirectKeyEvent
+#define TkpRedirectKeyEvent \
+ (tkIntStubsPtr->tkpRedirectKeyEvent) /* 73 */
+#endif
+#ifndef TkpSetMainMenubar
+#define TkpSetMainMenubar \
+ (tkIntStubsPtr->tkpSetMainMenubar) /* 74 */
+#endif
+#ifndef TkpUseWindow
+#define TkpUseWindow \
+ (tkIntStubsPtr->tkpUseWindow) /* 75 */
+#endif
+#ifndef TkpWindowWasRecentlyDeleted
+#define TkpWindowWasRecentlyDeleted \
+ (tkIntStubsPtr->tkpWindowWasRecentlyDeleted) /* 76 */
+#endif
+#ifndef TkQueueEventForAllChildren
+#define TkQueueEventForAllChildren \
+ (tkIntStubsPtr->tkQueueEventForAllChildren) /* 77 */
+#endif
+#ifndef TkReadBitmapFile
+#define TkReadBitmapFile \
+ (tkIntStubsPtr->tkReadBitmapFile) /* 78 */
+#endif
+#ifndef TkScrollWindow
+#define TkScrollWindow \
+ (tkIntStubsPtr->tkScrollWindow) /* 79 */
+#endif
+#ifndef TkSelDeadWindow
+#define TkSelDeadWindow \
+ (tkIntStubsPtr->tkSelDeadWindow) /* 80 */
+#endif
+#ifndef TkSelEventProc
+#define TkSelEventProc \
+ (tkIntStubsPtr->tkSelEventProc) /* 81 */
+#endif
+#ifndef TkSelInit
+#define TkSelInit \
+ (tkIntStubsPtr->tkSelInit) /* 82 */
+#endif
+#ifndef TkSelPropProc
+#define TkSelPropProc \
+ (tkIntStubsPtr->tkSelPropProc) /* 83 */
+#endif
+/* Slot 84 is reserved */
+#ifndef TkSetWindowMenuBar
+#define TkSetWindowMenuBar \
+ (tkIntStubsPtr->tkSetWindowMenuBar) /* 85 */
+#endif
+#ifndef TkStringToKeysym
+#define TkStringToKeysym \
+ (tkIntStubsPtr->tkStringToKeysym) /* 86 */
+#endif
+#ifndef TkThickPolyLineToArea
+#define TkThickPolyLineToArea \
+ (tkIntStubsPtr->tkThickPolyLineToArea) /* 87 */
+#endif
+#ifndef TkWmAddToColormapWindows
+#define TkWmAddToColormapWindows \
+ (tkIntStubsPtr->tkWmAddToColormapWindows) /* 88 */
+#endif
+#ifndef TkWmDeadWindow
+#define TkWmDeadWindow \
+ (tkIntStubsPtr->tkWmDeadWindow) /* 89 */
+#endif
+#ifndef TkWmFocusToplevel
+#define TkWmFocusToplevel \
+ (tkIntStubsPtr->tkWmFocusToplevel) /* 90 */
+#endif
+#ifndef TkWmMapWindow
+#define TkWmMapWindow \
+ (tkIntStubsPtr->tkWmMapWindow) /* 91 */
+#endif
+#ifndef TkWmNewWindow
+#define TkWmNewWindow \
+ (tkIntStubsPtr->tkWmNewWindow) /* 92 */
+#endif
+#ifndef TkWmProtocolEventProc
+#define TkWmProtocolEventProc \
+ (tkIntStubsPtr->tkWmProtocolEventProc) /* 93 */
+#endif
+#ifndef TkWmRemoveFromColormapWindows
+#define TkWmRemoveFromColormapWindows \
+ (tkIntStubsPtr->tkWmRemoveFromColormapWindows) /* 94 */
+#endif
+#ifndef TkWmRestackToplevel
+#define TkWmRestackToplevel \
+ (tkIntStubsPtr->tkWmRestackToplevel) /* 95 */
+#endif
+#ifndef TkWmSetClass
+#define TkWmSetClass \
+ (tkIntStubsPtr->tkWmSetClass) /* 96 */
+#endif
+#ifndef TkWmUnmapWindow
+#define TkWmUnmapWindow \
+ (tkIntStubsPtr->tkWmUnmapWindow) /* 97 */
+#endif
+#ifndef TkDebugBitmap
+#define TkDebugBitmap \
+ (tkIntStubsPtr->tkDebugBitmap) /* 98 */
+#endif
+#ifndef TkDebugBorder
+#define TkDebugBorder \
+ (tkIntStubsPtr->tkDebugBorder) /* 99 */
+#endif
+#ifndef TkDebugCursor
+#define TkDebugCursor \
+ (tkIntStubsPtr->tkDebugCursor) /* 100 */
+#endif
+#ifndef TkDebugColor
+#define TkDebugColor \
+ (tkIntStubsPtr->tkDebugColor) /* 101 */
+#endif
+#ifndef TkDebugConfig
+#define TkDebugConfig \
+ (tkIntStubsPtr->tkDebugConfig) /* 102 */
+#endif
+#ifndef TkDebugFont
+#define TkDebugFont \
+ (tkIntStubsPtr->tkDebugFont) /* 103 */
+#endif
+#ifndef TkFindStateNumObj
+#define TkFindStateNumObj \
+ (tkIntStubsPtr->tkFindStateNumObj) /* 104 */
+#endif
+#ifndef TkGetBitmapPredefTable
+#define TkGetBitmapPredefTable \
+ (tkIntStubsPtr->tkGetBitmapPredefTable) /* 105 */
+#endif
+#ifndef TkGetDisplayList
+#define TkGetDisplayList \
+ (tkIntStubsPtr->tkGetDisplayList) /* 106 */
+#endif
+#ifndef TkGetMainInfoList
+#define TkGetMainInfoList \
+ (tkIntStubsPtr->tkGetMainInfoList) /* 107 */
+#endif
+#ifndef TkGetWindowFromObj
+#define TkGetWindowFromObj \
+ (tkIntStubsPtr->tkGetWindowFromObj) /* 108 */
+#endif
+#ifndef TkpGetString
+#define TkpGetString \
+ (tkIntStubsPtr->tkpGetString) /* 109 */
+#endif
+#ifndef TkpGetSubFonts
+#define TkpGetSubFonts \
+ (tkIntStubsPtr->tkpGetSubFonts) /* 110 */
+#endif
+#ifndef TkpGetSystemDefault
+#define TkpGetSystemDefault \
+ (tkIntStubsPtr->tkpGetSystemDefault) /* 111 */
+#endif
+#ifndef TkpMenuThreadInit
+#define TkpMenuThreadInit \
+ (tkIntStubsPtr->tkpMenuThreadInit) /* 112 */
+#endif
+#ifdef __WIN32__
+#ifndef TkClipBox
+#define TkClipBox \
+ (tkIntStubsPtr->tkClipBox) /* 113 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkClipBox
+#define TkClipBox \
+ (tkIntStubsPtr->tkClipBox) /* 113 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkClipBox
+#define TkClipBox \
+ (tkIntStubsPtr->tkClipBox) /* 113 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+#ifndef TkCreateRegion
+#define TkCreateRegion \
+ (tkIntStubsPtr->tkCreateRegion) /* 114 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkCreateRegion
+#define TkCreateRegion \
+ (tkIntStubsPtr->tkCreateRegion) /* 114 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkCreateRegion
+#define TkCreateRegion \
+ (tkIntStubsPtr->tkCreateRegion) /* 114 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+#ifndef TkDestroyRegion
+#define TkDestroyRegion \
+ (tkIntStubsPtr->tkDestroyRegion) /* 115 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkDestroyRegion
+#define TkDestroyRegion \
+ (tkIntStubsPtr->tkDestroyRegion) /* 115 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkDestroyRegion
+#define TkDestroyRegion \
+ (tkIntStubsPtr->tkDestroyRegion) /* 115 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+#ifndef TkIntersectRegion
+#define TkIntersectRegion \
+ (tkIntStubsPtr->tkIntersectRegion) /* 116 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkIntersectRegion
+#define TkIntersectRegion \
+ (tkIntStubsPtr->tkIntersectRegion) /* 116 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkIntersectRegion
+#define TkIntersectRegion \
+ (tkIntStubsPtr->tkIntersectRegion) /* 116 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+#ifndef TkRectInRegion
+#define TkRectInRegion \
+ (tkIntStubsPtr->tkRectInRegion) /* 117 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkRectInRegion
+#define TkRectInRegion \
+ (tkIntStubsPtr->tkRectInRegion) /* 117 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkRectInRegion
+#define TkRectInRegion \
+ (tkIntStubsPtr->tkRectInRegion) /* 117 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+#ifndef TkSetRegion
+#define TkSetRegion \
+ (tkIntStubsPtr->tkSetRegion) /* 118 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkSetRegion
+#define TkSetRegion \
+ (tkIntStubsPtr->tkSetRegion) /* 118 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkSetRegion
+#define TkSetRegion \
+ (tkIntStubsPtr->tkSetRegion) /* 118 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifdef __WIN32__
+#ifndef TkUnionRectWithRegion
+#define TkUnionRectWithRegion \
+ (tkIntStubsPtr->tkUnionRectWithRegion) /* 119 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkUnionRectWithRegion
+#define TkUnionRectWithRegion \
+ (tkIntStubsPtr->tkUnionRectWithRegion) /* 119 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkUnionRectWithRegion
+#define TkUnionRectWithRegion \
+ (tkIntStubsPtr->tkUnionRectWithRegion) /* 119 */
+#endif
+#endif /* MAC_OSX_TK */
+/* Slot 120 is reserved */
+#ifdef MAC_TCL
+#ifndef TkpCreateNativeBitmap
+#define TkpCreateNativeBitmap \
+ (tkIntStubsPtr->tkpCreateNativeBitmap) /* 121 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkpCreateNativeBitmap
+#define TkpCreateNativeBitmap \
+ (tkIntStubsPtr->tkpCreateNativeBitmap) /* 121 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifdef MAC_TCL
+#ifndef TkpDefineNativeBitmaps
+#define TkpDefineNativeBitmaps \
+ (tkIntStubsPtr->tkpDefineNativeBitmaps) /* 122 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkpDefineNativeBitmaps
+#define TkpDefineNativeBitmaps \
+ (tkIntStubsPtr->tkpDefineNativeBitmaps) /* 122 */
+#endif
+#endif /* MAC_OSX_TK */
+/* Slot 123 is reserved */
+#ifdef MAC_TCL
+#ifndef TkpGetNativeAppBitmap
+#define TkpGetNativeAppBitmap \
+ (tkIntStubsPtr->tkpGetNativeAppBitmap) /* 124 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkpGetNativeAppBitmap
+#define TkpGetNativeAppBitmap \
+ (tkIntStubsPtr->tkpGetNativeAppBitmap) /* 124 */
+#endif
+#endif /* MAC_OSX_TK */
+/* Slot 125 is reserved */
+/* Slot 126 is reserved */
+/* Slot 127 is reserved */
+/* Slot 128 is reserved */
+/* Slot 129 is reserved */
+/* Slot 130 is reserved */
+/* Slot 131 is reserved */
+/* Slot 132 is reserved */
+/* Slot 133 is reserved */
+/* Slot 134 is reserved */
+#ifndef TkpDrawHighlightBorder
+#define TkpDrawHighlightBorder \
+ (tkIntStubsPtr->tkpDrawHighlightBorder) /* 135 */
+#endif
+#ifndef TkSetFocusWin
+#define TkSetFocusWin \
+ (tkIntStubsPtr->tkSetFocusWin) /* 136 */
+#endif
+#ifndef TkpSetKeycodeAndState
+#define TkpSetKeycodeAndState \
+ (tkIntStubsPtr->tkpSetKeycodeAndState) /* 137 */
+#endif
+#ifndef TkpGetKeySym
+#define TkpGetKeySym \
+ (tkIntStubsPtr->tkpGetKeySym) /* 138 */
+#endif
+#ifndef TkpInitKeymapInfo
+#define TkpInitKeymapInfo \
+ (tkIntStubsPtr->tkpInitKeymapInfo) /* 139 */
+#endif
+#ifndef TkPhotoGetValidRegion
+#define TkPhotoGetValidRegion \
+ (tkIntStubsPtr->tkPhotoGetValidRegion) /* 140 */
+#endif
+#ifndef TkWmStackorderToplevel
+#define TkWmStackorderToplevel \
+ (tkIntStubsPtr->tkWmStackorderToplevel) /* 141 */
+#endif
+#ifndef TkFocusFree
+#define TkFocusFree \
+ (tkIntStubsPtr->tkFocusFree) /* 142 */
+#endif
+#ifndef TkClipCleanup
+#define TkClipCleanup \
+ (tkIntStubsPtr->tkClipCleanup) /* 143 */
+#endif
+#ifndef TkGCCleanup
+#define TkGCCleanup \
+ (tkIntStubsPtr->tkGCCleanup) /* 144 */
+#endif
+#ifdef __WIN32__
+#ifndef TkSubtractRegion
+#define TkSubtractRegion \
+ (tkIntStubsPtr->tkSubtractRegion) /* 145 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkSubtractRegion
+#define TkSubtractRegion \
+ (tkIntStubsPtr->tkSubtractRegion) /* 145 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkSubtractRegion
+#define TkSubtractRegion \
+ (tkIntStubsPtr->tkSubtractRegion) /* 145 */
+#endif
+#endif /* MAC_OSX_TK */
+#ifndef TkStylePkgInit
+#define TkStylePkgInit \
+ (tkIntStubsPtr->tkStylePkgInit) /* 146 */
+#endif
+#ifndef TkStylePkgFree
+#define TkStylePkgFree \
+ (tkIntStubsPtr->tkStylePkgFree) /* 147 */
+#endif
+
+#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKINTDECLS */
+
diff --git a/tcl/generic/tkIntPlatDecls.h b/tcl/generic/tkIntPlatDecls.h
new file mode 100644
index 00000000000..0dbb21c8b8e
--- /dev/null
+++ b/tcl/generic/tkIntPlatDecls.h
@@ -0,0 +1,1220 @@
+/*
+ * tkIntPlatDecls.h --
+ *
+ * This file contains the declarations for all platform dependent
+ * unsupported functions that are exported by the Tk library. These
+ * interfaces are not guaranteed to remain the same between
+ * versions. Use at your own risk.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKINTPLATDECLS
+#define _TKINTPLATDECLS
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tkInt.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+#ifdef __WIN32__
+/* 0 */
+EXTERN char * TkAlignImageData _ANSI_ARGS_((XImage * image,
+ int alignment, int bitOrder));
+/* Slot 1 is reserved */
+/* 2 */
+EXTERN void TkGenerateActivateEvents _ANSI_ARGS_((
+ TkWindow * winPtr, int active));
+/* 3 */
+EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void));
+/* 4 */
+EXTERN void TkPointerDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 5 */
+EXTERN void TkpPrintWindowId _ANSI_ARGS_((char * buf,
+ Window window));
+/* 6 */
+EXTERN int TkpScanWindowId _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * string, Window * idPtr));
+/* 7 */
+EXTERN void TkpSetCapture _ANSI_ARGS_((TkWindow * winPtr));
+/* 8 */
+EXTERN void TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
+/* 9 */
+EXTERN void TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr,
+ int state));
+/* 10 */
+EXTERN void TkSetPixmapColormap _ANSI_ARGS_((Pixmap pixmap,
+ Colormap colormap));
+/* 11 */
+EXTERN void TkWinCancelMouseTimer _ANSI_ARGS_((void));
+/* 12 */
+EXTERN void TkWinClipboardRender _ANSI_ARGS_((
+ TkDisplay * dispPtr, UINT format));
+/* 13 */
+EXTERN LRESULT TkWinEmbeddedEventProc _ANSI_ARGS_((HWND hwnd,
+ UINT message, WPARAM wParam, LPARAM lParam));
+/* 14 */
+EXTERN void TkWinFillRect _ANSI_ARGS_((HDC dc, int x, int y,
+ int width, int height, int pixel));
+/* 15 */
+EXTERN COLORREF TkWinGetBorderPixels _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_3DBorder border, int which));
+/* 16 */
+EXTERN HDC TkWinGetDrawableDC _ANSI_ARGS_((Display * display,
+ Drawable d, TkWinDCState* state));
+/* 17 */
+EXTERN int TkWinGetModifierState _ANSI_ARGS_((void));
+/* 18 */
+EXTERN HPALETTE TkWinGetSystemPalette _ANSI_ARGS_((void));
+/* 19 */
+EXTERN HWND TkWinGetWrapperWindow _ANSI_ARGS_((Tk_Window tkwin));
+/* 20 */
+EXTERN int TkWinHandleMenuEvent _ANSI_ARGS_((HWND * phwnd,
+ UINT * pMessage, WPARAM * pwParam,
+ LPARAM * plParam, LRESULT * plResult));
+/* 21 */
+EXTERN int TkWinIndexOfColor _ANSI_ARGS_((XColor * colorPtr));
+/* 22 */
+EXTERN void TkWinReleaseDrawableDC _ANSI_ARGS_((Drawable d,
+ HDC hdc, TkWinDCState* state));
+/* 23 */
+EXTERN LRESULT TkWinResendEvent _ANSI_ARGS_((WNDPROC wndproc,
+ HWND hwnd, XEvent * eventPtr));
+/* 24 */
+EXTERN HPALETTE TkWinSelectPalette _ANSI_ARGS_((HDC dc,
+ Colormap colormap));
+/* 25 */
+EXTERN void TkWinSetMenu _ANSI_ARGS_((Tk_Window tkwin,
+ HMENU hMenu));
+/* 26 */
+EXTERN void TkWinSetWindowPos _ANSI_ARGS_((HWND hwnd,
+ HWND siblingHwnd, int pos));
+/* 27 */
+EXTERN void TkWinWmCleanup _ANSI_ARGS_((HINSTANCE hInstance));
+/* 28 */
+EXTERN void TkWinXCleanup _ANSI_ARGS_((HINSTANCE hInstance));
+/* 29 */
+EXTERN void TkWinXInit _ANSI_ARGS_((HINSTANCE hInstance));
+/* 30 */
+EXTERN void TkWinSetForegroundWindow _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 31 */
+EXTERN void TkWinDialogDebug _ANSI_ARGS_((int debug));
+/* 32 */
+EXTERN Tcl_Obj * TkWinGetMenuSystemDefault _ANSI_ARGS_((
+ Tk_Window tkwin, CONST char * dbName,
+ CONST char * className));
+/* 33 */
+EXTERN int TkWinGetPlatformId _ANSI_ARGS_((void));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 0 */
+EXTERN void TkGenerateActivateEvents _ANSI_ARGS_((
+ TkWindow * winPtr, int active));
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+/* 3 */
+EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void));
+/* Slot 4 is reserved */
+/* 5 */
+EXTERN void TkPointerDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 6 */
+EXTERN void TkpSetCapture _ANSI_ARGS_((TkWindow * winPtr));
+/* 7 */
+EXTERN void TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
+/* 8 */
+EXTERN void TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr,
+ int state));
+/* Slot 9 is reserved */
+/* 10 */
+EXTERN void TkAboutDlg _ANSI_ARGS_((void));
+/* Slot 11 is reserved */
+/* Slot 12 is reserved */
+/* 13 */
+EXTERN Window TkGetTransientMaster _ANSI_ARGS_((TkWindow * winPtr));
+/* 14 */
+EXTERN int TkGenerateButtonEvent _ANSI_ARGS_((int x, int y,
+ Window window, unsigned int state));
+/* Slot 15 is reserved */
+/* 16 */
+EXTERN void TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin));
+/* Slot 17 is reserved */
+/* 18 */
+EXTERN unsigned int TkMacButtonKeyState _ANSI_ARGS_((void));
+/* 19 */
+EXTERN void TkMacClearMenubarActive _ANSI_ARGS_((void));
+/* Slot 20 is reserved */
+/* 21 */
+EXTERN int TkMacDispatchMenuEvent _ANSI_ARGS_((int menuID,
+ int index));
+/* 22 */
+EXTERN void TkMacInstallCursor _ANSI_ARGS_((int resizeOverride));
+/* Slot 23 is reserved */
+/* 24 */
+EXTERN void TkMacHandleTearoffMenu _ANSI_ARGS_((void));
+/* Slot 25 is reserved */
+/* Slot 26 is reserved */
+/* 27 */
+EXTERN void TkMacDoHLEvent _ANSI_ARGS_((EventRecord * theEvent));
+/* Slot 28 is reserved */
+/* 29 */
+EXTERN Time TkMacGenerateTime _ANSI_ARGS_((void));
+/* Slot 30 is reserved */
+/* 31 */
+EXTERN TkWindow * TkMacGetScrollbarGrowWindow _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 32 */
+EXTERN Window TkMacGetXWindow _ANSI_ARGS_((WindowRef macWinPtr));
+/* 33 */
+EXTERN int TkMacGrowToplevel _ANSI_ARGS_((WindowRef whichWindow,
+ Point start));
+/* 34 */
+EXTERN void TkMacHandleMenuSelect _ANSI_ARGS_((long mResult,
+ int optionKeyPressed));
+/* Slot 35 is reserved */
+/* Slot 36 is reserved */
+/* Slot 37 is reserved */
+/* 38 */
+EXTERN void TkMacInvalidateWindow _ANSI_ARGS_((
+ MacDrawable * macWin, int flag));
+/* 39 */
+EXTERN int TkMacIsCharacterMissing _ANSI_ARGS_((Tk_Font tkfont,
+ unsigned int searchChar));
+/* 40 */
+EXTERN void TkMacMakeRealWindowExist _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 41 */
+EXTERN BitMapPtr TkMacMakeStippleMap _ANSI_ARGS_((Drawable d1,
+ Drawable d2));
+/* 42 */
+EXTERN void TkMacMenuClick _ANSI_ARGS_((void));
+/* 43 */
+EXTERN void TkMacRegisterOffScreenWindow _ANSI_ARGS_((
+ Window window, GWorldPtr portPtr));
+/* 44 */
+EXTERN int TkMacResizable _ANSI_ARGS_((TkWindow * winPtr));
+/* Slot 45 is reserved */
+/* 46 */
+EXTERN void TkMacSetHelpMenuItemCount _ANSI_ARGS_((void));
+/* 47 */
+EXTERN void TkMacSetScrollbarGrow _ANSI_ARGS_((TkWindow * winPtr,
+ int flag));
+/* 48 */
+EXTERN void TkMacSetUpClippingRgn _ANSI_ARGS_((Drawable drawable));
+/* 49 */
+EXTERN void TkMacSetUpGraphicsPort _ANSI_ARGS_((GC gc));
+/* 50 */
+EXTERN void TkMacUpdateClipRgn _ANSI_ARGS_((TkWindow * winPtr));
+/* 51 */
+EXTERN void TkMacUnregisterMacWindow _ANSI_ARGS_((
+ GWorldPtr portPtr));
+/* 52 */
+EXTERN int TkMacUseMenuID _ANSI_ARGS_((short macID));
+/* 53 */
+EXTERN RgnHandle TkMacVisableClipRgn _ANSI_ARGS_((TkWindow * winPtr));
+/* 54 */
+EXTERN void TkMacWinBounds _ANSI_ARGS_((TkWindow * winPtr,
+ Rect * geometry));
+/* 55 */
+EXTERN void TkMacWindowOffset _ANSI_ARGS_((WindowRef wRef,
+ int * xOffset, int * yOffset));
+/* Slot 56 is reserved */
+/* 57 */
+EXTERN int TkSetMacColor _ANSI_ARGS_((unsigned long pixel,
+ RGBColor * macColor));
+/* 58 */
+EXTERN void TkSetWMName _ANSI_ARGS_((TkWindow * winPtr,
+ Tk_Uid titleUid));
+/* 59 */
+EXTERN void TkSuspendClipboard _ANSI_ARGS_((void));
+/* Slot 60 is reserved */
+/* 61 */
+EXTERN int TkMacZoomToplevel _ANSI_ARGS_((WindowPtr whichWindow,
+ Point where, short zoomPart));
+/* 62 */
+EXTERN Tk_Window Tk_TopCoordsToWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int rootX, int rootY, int * newX, int * newY));
+/* 63 */
+EXTERN MacDrawable * TkMacContainerId _ANSI_ARGS_((TkWindow * winPtr));
+/* 64 */
+EXTERN MacDrawable * TkMacGetHostToplevel _ANSI_ARGS_((TkWindow * winPtr));
+/* 65 */
+EXTERN void TkMacPreprocessMenu _ANSI_ARGS_((void));
+/* 66 */
+EXTERN int TkpIsWindowFloating _ANSI_ARGS_((WindowRef window));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 0 */
+EXTERN void TkGenerateActivateEvents _ANSI_ARGS_((
+ TkWindow * winPtr, int active));
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+/* 3 */
+EXTERN void TkPointerDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 4 */
+EXTERN void TkpSetCapture _ANSI_ARGS_((TkWindow * winPtr));
+/* 5 */
+EXTERN void TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
+/* 6 */
+EXTERN void TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr,
+ int state));
+/* 7 */
+EXTERN void TkAboutDlg _ANSI_ARGS_((void));
+/* 8 */
+EXTERN unsigned int TkMacOSXButtonKeyState _ANSI_ARGS_((void));
+/* 9 */
+EXTERN void TkMacOSXClearMenubarActive _ANSI_ARGS_((void));
+/* 10 */
+EXTERN int TkMacOSXDispatchMenuEvent _ANSI_ARGS_((int menuID,
+ int index));
+/* 11 */
+EXTERN void TkMacOSXInstallCursor _ANSI_ARGS_((
+ int resizeOverride));
+/* 12 */
+EXTERN void TkMacOSXHandleTearoffMenu _ANSI_ARGS_((void));
+/* Slot 13 is reserved */
+/* 14 */
+EXTERN int TkMacOSXDoHLEvent _ANSI_ARGS_((
+ EventRecord * theEvent));
+/* Slot 15 is reserved */
+/* 16 */
+EXTERN Window TkMacOSXGetXWindow _ANSI_ARGS_((WindowRef macWinPtr));
+/* 17 */
+EXTERN int TkMacOSXGrowToplevel _ANSI_ARGS_((
+ WindowRef whichWindow, Point start));
+/* 18 */
+EXTERN void TkMacOSXHandleMenuSelect _ANSI_ARGS_((long mResult,
+ int optionKeyPressed));
+/* Slot 19 is reserved */
+/* Slot 20 is reserved */
+/* 21 */
+EXTERN void TkMacOSXInvalidateWindow _ANSI_ARGS_((
+ MacDrawable * macWin, int flag));
+/* 22 */
+EXTERN int TkMacOSXIsCharacterMissing _ANSI_ARGS_((
+ Tk_Font tkfont, unsigned int searchChar));
+/* 23 */
+EXTERN void TkMacOSXMakeRealWindowExist _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 24 */
+EXTERN BitMapPtr TkMacOSXMakeStippleMap _ANSI_ARGS_((Drawable d1,
+ Drawable d2));
+/* 25 */
+EXTERN void TkMacOSXMenuClick _ANSI_ARGS_((void));
+/* 26 */
+EXTERN void TkMacOSXRegisterOffScreenWindow _ANSI_ARGS_((
+ Window window, GWorldPtr portPtr));
+/* 27 */
+EXTERN int TkMacOSXResizable _ANSI_ARGS_((TkWindow * winPtr));
+/* 28 */
+EXTERN void TkMacOSXSetHelpMenuItemCount _ANSI_ARGS_((void));
+/* 29 */
+EXTERN void TkMacOSXSetScrollbarGrow _ANSI_ARGS_((
+ TkWindow * winPtr, int flag));
+/* 30 */
+EXTERN void TkMacOSXSetUpClippingRgn _ANSI_ARGS_((
+ Drawable drawable));
+/* 31 */
+EXTERN void TkMacOSXSetUpGraphicsPort _ANSI_ARGS_((GC gc,
+ GWorldPtr destPort));
+/* 32 */
+EXTERN void TkMacOSXUpdateClipRgn _ANSI_ARGS_((TkWindow * winPtr));
+/* 33 */
+EXTERN void TkMacOSXUnregisterMacWindow _ANSI_ARGS_((
+ WindowRef portPtr));
+/* 34 */
+EXTERN int TkMacOSXUseMenuID _ANSI_ARGS_((short macID));
+/* 35 */
+EXTERN RgnHandle TkMacOSXVisableClipRgn _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 36 */
+EXTERN void TkMacOSXWinBounds _ANSI_ARGS_((TkWindow * winPtr,
+ Rect * geometry));
+/* 37 */
+EXTERN void TkMacOSXWindowOffset _ANSI_ARGS_((WindowRef wRef,
+ int * xOffset, int * yOffset));
+/* 38 */
+EXTERN int TkSetMacColor _ANSI_ARGS_((unsigned long pixel,
+ RGBColor * macColor));
+/* 39 */
+EXTERN void TkSetWMName _ANSI_ARGS_((TkWindow * winPtr,
+ Tk_Uid titleUid));
+/* 40 */
+EXTERN void TkSuspendClipboard _ANSI_ARGS_((void));
+/* 41 */
+EXTERN int TkMacOSXZoomToplevel _ANSI_ARGS_((
+ WindowPtr whichWindow, Point where,
+ short zoomPart));
+/* 42 */
+EXTERN Tk_Window Tk_TopCoordsToWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int rootX, int rootY, int * newX, int * newY));
+/* 43 */
+EXTERN MacDrawable * TkMacOSXContainerId _ANSI_ARGS_((TkWindow * winPtr));
+/* 44 */
+EXTERN MacDrawable * TkMacOSXGetHostToplevel _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 45 */
+EXTERN void TkMacOSXPreprocessMenu _ANSI_ARGS_((void));
+/* 46 */
+EXTERN int TkpIsWindowFloating _ANSI_ARGS_((WindowRef window));
+/* 47 */
+EXTERN Tk_Window TkMacOSXGetCapture _ANSI_ARGS_((void));
+/* Slot 48 is reserved */
+/* 49 */
+EXTERN Window TkGetTransientMaster _ANSI_ARGS_((TkWindow * winPtr));
+/* 50 */
+EXTERN int TkGenerateButtonEvent _ANSI_ARGS_((int x, int y,
+ Window window, unsigned int state));
+/* 51 */
+EXTERN void TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin));
+/* Slot 52 is reserved */
+/* 53 */
+EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void));
+#endif /* MAC_OSX_TK */
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */
+/* 0 */
+EXTERN void TkCreateXEventSource _ANSI_ARGS_((void));
+/* 1 */
+EXTERN void TkFreeWindowId _ANSI_ARGS_((TkDisplay * dispPtr,
+ Window w));
+/* 2 */
+EXTERN void TkInitXId _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 3 */
+EXTERN int TkpCmapStressed _ANSI_ARGS_((Tk_Window tkwin,
+ Colormap colormap));
+/* 4 */
+EXTERN void TkpSync _ANSI_ARGS_((Display * display));
+/* 5 */
+EXTERN Window TkUnixContainerId _ANSI_ARGS_((TkWindow * winPtr));
+/* 6 */
+EXTERN int TkUnixDoOneXEvent _ANSI_ARGS_((Tcl_Time * timePtr));
+/* 7 */
+EXTERN void TkUnixSetMenubar _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_Window menubar));
+/* 8 */
+EXTERN int TkpScanWindowId _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * string, Window * idPtr));
+/* 9 */
+EXTERN void TkWmCleanup _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 10 */
+EXTERN void TkSendCleanup _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 11 */
+EXTERN void TkFreeXId _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 12 */
+EXTERN int TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr,
+ int state));
+#endif /* X11 */
+
+typedef struct TkIntPlatStubs {
+ int magic;
+ struct TkIntPlatStubHooks *hooks;
+
+#ifdef __WIN32__
+ char * (*tkAlignImageData) _ANSI_ARGS_((XImage * image, int alignment, int bitOrder)); /* 0 */
+ void *reserved1;
+ void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 2 */
+ unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 3 */
+ void (*tkPointerDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 4 */
+ void (*tkpPrintWindowId) _ANSI_ARGS_((char * buf, Window window)); /* 5 */
+ int (*tkpScanWindowId) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, Window * idPtr)); /* 6 */
+ void (*tkpSetCapture) _ANSI_ARGS_((TkWindow * winPtr)); /* 7 */
+ void (*tkpSetCursor) _ANSI_ARGS_((TkpCursor cursor)); /* 8 */
+ void (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 9 */
+ void (*tkSetPixmapColormap) _ANSI_ARGS_((Pixmap pixmap, Colormap colormap)); /* 10 */
+ void (*tkWinCancelMouseTimer) _ANSI_ARGS_((void)); /* 11 */
+ void (*tkWinClipboardRender) _ANSI_ARGS_((TkDisplay * dispPtr, UINT format)); /* 12 */
+ LRESULT (*tkWinEmbeddedEventProc) _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); /* 13 */
+ void (*tkWinFillRect) _ANSI_ARGS_((HDC dc, int x, int y, int width, int height, int pixel)); /* 14 */
+ COLORREF (*tkWinGetBorderPixels) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border, int which)); /* 15 */
+ HDC (*tkWinGetDrawableDC) _ANSI_ARGS_((Display * display, Drawable d, TkWinDCState* state)); /* 16 */
+ int (*tkWinGetModifierState) _ANSI_ARGS_((void)); /* 17 */
+ HPALETTE (*tkWinGetSystemPalette) _ANSI_ARGS_((void)); /* 18 */
+ HWND (*tkWinGetWrapperWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 19 */
+ int (*tkWinHandleMenuEvent) _ANSI_ARGS_((HWND * phwnd, UINT * pMessage, WPARAM * pwParam, LPARAM * plParam, LRESULT * plResult)); /* 20 */
+ int (*tkWinIndexOfColor) _ANSI_ARGS_((XColor * colorPtr)); /* 21 */
+ void (*tkWinReleaseDrawableDC) _ANSI_ARGS_((Drawable d, HDC hdc, TkWinDCState* state)); /* 22 */
+ LRESULT (*tkWinResendEvent) _ANSI_ARGS_((WNDPROC wndproc, HWND hwnd, XEvent * eventPtr)); /* 23 */
+ HPALETTE (*tkWinSelectPalette) _ANSI_ARGS_((HDC dc, Colormap colormap)); /* 24 */
+ void (*tkWinSetMenu) _ANSI_ARGS_((Tk_Window tkwin, HMENU hMenu)); /* 25 */
+ void (*tkWinSetWindowPos) _ANSI_ARGS_((HWND hwnd, HWND siblingHwnd, int pos)); /* 26 */
+ void (*tkWinWmCleanup) _ANSI_ARGS_((HINSTANCE hInstance)); /* 27 */
+ void (*tkWinXCleanup) _ANSI_ARGS_((HINSTANCE hInstance)); /* 28 */
+ void (*tkWinXInit) _ANSI_ARGS_((HINSTANCE hInstance)); /* 29 */
+ void (*tkWinSetForegroundWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 30 */
+ void (*tkWinDialogDebug) _ANSI_ARGS_((int debug)); /* 31 */
+ Tcl_Obj * (*tkWinGetMenuSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, CONST char * dbName, CONST char * className)); /* 32 */
+ int (*tkWinGetPlatformId) _ANSI_ARGS_((void)); /* 33 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 0 */
+ void *reserved1;
+ void *reserved2;
+ unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 3 */
+ void *reserved4;
+ void (*tkPointerDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 5 */
+ void (*tkpSetCapture) _ANSI_ARGS_((TkWindow * winPtr)); /* 6 */
+ void (*tkpSetCursor) _ANSI_ARGS_((TkpCursor cursor)); /* 7 */
+ void (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 8 */
+ void *reserved9;
+ void (*tkAboutDlg) _ANSI_ARGS_((void)); /* 10 */
+ void *reserved11;
+ void *reserved12;
+ Window (*tkGetTransientMaster) _ANSI_ARGS_((TkWindow * winPtr)); /* 13 */
+ int (*tkGenerateButtonEvent) _ANSI_ARGS_((int x, int y, Window window, unsigned int state)); /* 14 */
+ void *reserved15;
+ void (*tkGenWMDestroyEvent) _ANSI_ARGS_((Tk_Window tkwin)); /* 16 */
+ void *reserved17;
+ unsigned int (*tkMacButtonKeyState) _ANSI_ARGS_((void)); /* 18 */
+ void (*tkMacClearMenubarActive) _ANSI_ARGS_((void)); /* 19 */
+ void *reserved20;
+ int (*tkMacDispatchMenuEvent) _ANSI_ARGS_((int menuID, int index)); /* 21 */
+ void (*tkMacInstallCursor) _ANSI_ARGS_((int resizeOverride)); /* 22 */
+ void *reserved23;
+ void (*tkMacHandleTearoffMenu) _ANSI_ARGS_((void)); /* 24 */
+ void *reserved25;
+ void *reserved26;
+ void (*tkMacDoHLEvent) _ANSI_ARGS_((EventRecord * theEvent)); /* 27 */
+ void *reserved28;
+ Time (*tkMacGenerateTime) _ANSI_ARGS_((void)); /* 29 */
+ void *reserved30;
+ TkWindow * (*tkMacGetScrollbarGrowWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 31 */
+ Window (*tkMacGetXWindow) _ANSI_ARGS_((WindowRef macWinPtr)); /* 32 */
+ int (*tkMacGrowToplevel) _ANSI_ARGS_((WindowRef whichWindow, Point start)); /* 33 */
+ void (*tkMacHandleMenuSelect) _ANSI_ARGS_((long mResult, int optionKeyPressed)); /* 34 */
+ void *reserved35;
+ void *reserved36;
+ void *reserved37;
+ void (*tkMacInvalidateWindow) _ANSI_ARGS_((MacDrawable * macWin, int flag)); /* 38 */
+ int (*tkMacIsCharacterMissing) _ANSI_ARGS_((Tk_Font tkfont, unsigned int searchChar)); /* 39 */
+ void (*tkMacMakeRealWindowExist) _ANSI_ARGS_((TkWindow * winPtr)); /* 40 */
+ BitMapPtr (*tkMacMakeStippleMap) _ANSI_ARGS_((Drawable d1, Drawable d2)); /* 41 */
+ void (*tkMacMenuClick) _ANSI_ARGS_((void)); /* 42 */
+ void (*tkMacRegisterOffScreenWindow) _ANSI_ARGS_((Window window, GWorldPtr portPtr)); /* 43 */
+ int (*tkMacResizable) _ANSI_ARGS_((TkWindow * winPtr)); /* 44 */
+ void *reserved45;
+ void (*tkMacSetHelpMenuItemCount) _ANSI_ARGS_((void)); /* 46 */
+ void (*tkMacSetScrollbarGrow) _ANSI_ARGS_((TkWindow * winPtr, int flag)); /* 47 */
+ void (*tkMacSetUpClippingRgn) _ANSI_ARGS_((Drawable drawable)); /* 48 */
+ void (*tkMacSetUpGraphicsPort) _ANSI_ARGS_((GC gc)); /* 49 */
+ void (*tkMacUpdateClipRgn) _ANSI_ARGS_((TkWindow * winPtr)); /* 50 */
+ void (*tkMacUnregisterMacWindow) _ANSI_ARGS_((GWorldPtr portPtr)); /* 51 */
+ int (*tkMacUseMenuID) _ANSI_ARGS_((short macID)); /* 52 */
+ RgnHandle (*tkMacVisableClipRgn) _ANSI_ARGS_((TkWindow * winPtr)); /* 53 */
+ void (*tkMacWinBounds) _ANSI_ARGS_((TkWindow * winPtr, Rect * geometry)); /* 54 */
+ void (*tkMacWindowOffset) _ANSI_ARGS_((WindowRef wRef, int * xOffset, int * yOffset)); /* 55 */
+ void *reserved56;
+ int (*tkSetMacColor) _ANSI_ARGS_((unsigned long pixel, RGBColor * macColor)); /* 57 */
+ void (*tkSetWMName) _ANSI_ARGS_((TkWindow * winPtr, Tk_Uid titleUid)); /* 58 */
+ void (*tkSuspendClipboard) _ANSI_ARGS_((void)); /* 59 */
+ void *reserved60;
+ int (*tkMacZoomToplevel) _ANSI_ARGS_((WindowPtr whichWindow, Point where, short zoomPart)); /* 61 */
+ Tk_Window (*tk_TopCoordsToWindow) _ANSI_ARGS_((Tk_Window tkwin, int rootX, int rootY, int * newX, int * newY)); /* 62 */
+ MacDrawable * (*tkMacContainerId) _ANSI_ARGS_((TkWindow * winPtr)); /* 63 */
+ MacDrawable * (*tkMacGetHostToplevel) _ANSI_ARGS_((TkWindow * winPtr)); /* 64 */
+ void (*tkMacPreprocessMenu) _ANSI_ARGS_((void)); /* 65 */
+ int (*tkpIsWindowFloating) _ANSI_ARGS_((WindowRef window)); /* 66 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 0 */
+ void *reserved1;
+ void *reserved2;
+ void (*tkPointerDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 3 */
+ void (*tkpSetCapture) _ANSI_ARGS_((TkWindow * winPtr)); /* 4 */
+ void (*tkpSetCursor) _ANSI_ARGS_((TkpCursor cursor)); /* 5 */
+ void (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 6 */
+ void (*tkAboutDlg) _ANSI_ARGS_((void)); /* 7 */
+ unsigned int (*tkMacOSXButtonKeyState) _ANSI_ARGS_((void)); /* 8 */
+ void (*tkMacOSXClearMenubarActive) _ANSI_ARGS_((void)); /* 9 */
+ int (*tkMacOSXDispatchMenuEvent) _ANSI_ARGS_((int menuID, int index)); /* 10 */
+ void (*tkMacOSXInstallCursor) _ANSI_ARGS_((int resizeOverride)); /* 11 */
+ void (*tkMacOSXHandleTearoffMenu) _ANSI_ARGS_((void)); /* 12 */
+ void *reserved13;
+ int (*tkMacOSXDoHLEvent) _ANSI_ARGS_((EventRecord * theEvent)); /* 14 */
+ void *reserved15;
+ Window (*tkMacOSXGetXWindow) _ANSI_ARGS_((WindowRef macWinPtr)); /* 16 */
+ int (*tkMacOSXGrowToplevel) _ANSI_ARGS_((WindowRef whichWindow, Point start)); /* 17 */
+ void (*tkMacOSXHandleMenuSelect) _ANSI_ARGS_((long mResult, int optionKeyPressed)); /* 18 */
+ void *reserved19;
+ void *reserved20;
+ void (*tkMacOSXInvalidateWindow) _ANSI_ARGS_((MacDrawable * macWin, int flag)); /* 21 */
+ int (*tkMacOSXIsCharacterMissing) _ANSI_ARGS_((Tk_Font tkfont, unsigned int searchChar)); /* 22 */
+ void (*tkMacOSXMakeRealWindowExist) _ANSI_ARGS_((TkWindow * winPtr)); /* 23 */
+ BitMapPtr (*tkMacOSXMakeStippleMap) _ANSI_ARGS_((Drawable d1, Drawable d2)); /* 24 */
+ void (*tkMacOSXMenuClick) _ANSI_ARGS_((void)); /* 25 */
+ void (*tkMacOSXRegisterOffScreenWindow) _ANSI_ARGS_((Window window, GWorldPtr portPtr)); /* 26 */
+ int (*tkMacOSXResizable) _ANSI_ARGS_((TkWindow * winPtr)); /* 27 */
+ void (*tkMacOSXSetHelpMenuItemCount) _ANSI_ARGS_((void)); /* 28 */
+ void (*tkMacOSXSetScrollbarGrow) _ANSI_ARGS_((TkWindow * winPtr, int flag)); /* 29 */
+ void (*tkMacOSXSetUpClippingRgn) _ANSI_ARGS_((Drawable drawable)); /* 30 */
+ void (*tkMacOSXSetUpGraphicsPort) _ANSI_ARGS_((GC gc, GWorldPtr destPort)); /* 31 */
+ void (*tkMacOSXUpdateClipRgn) _ANSI_ARGS_((TkWindow * winPtr)); /* 32 */
+ void (*tkMacOSXUnregisterMacWindow) _ANSI_ARGS_((WindowRef portPtr)); /* 33 */
+ int (*tkMacOSXUseMenuID) _ANSI_ARGS_((short macID)); /* 34 */
+ RgnHandle (*tkMacOSXVisableClipRgn) _ANSI_ARGS_((TkWindow * winPtr)); /* 35 */
+ void (*tkMacOSXWinBounds) _ANSI_ARGS_((TkWindow * winPtr, Rect * geometry)); /* 36 */
+ void (*tkMacOSXWindowOffset) _ANSI_ARGS_((WindowRef wRef, int * xOffset, int * yOffset)); /* 37 */
+ int (*tkSetMacColor) _ANSI_ARGS_((unsigned long pixel, RGBColor * macColor)); /* 38 */
+ void (*tkSetWMName) _ANSI_ARGS_((TkWindow * winPtr, Tk_Uid titleUid)); /* 39 */
+ void (*tkSuspendClipboard) _ANSI_ARGS_((void)); /* 40 */
+ int (*tkMacOSXZoomToplevel) _ANSI_ARGS_((WindowPtr whichWindow, Point where, short zoomPart)); /* 41 */
+ Tk_Window (*tk_TopCoordsToWindow) _ANSI_ARGS_((Tk_Window tkwin, int rootX, int rootY, int * newX, int * newY)); /* 42 */
+ MacDrawable * (*tkMacOSXContainerId) _ANSI_ARGS_((TkWindow * winPtr)); /* 43 */
+ MacDrawable * (*tkMacOSXGetHostToplevel) _ANSI_ARGS_((TkWindow * winPtr)); /* 44 */
+ void (*tkMacOSXPreprocessMenu) _ANSI_ARGS_((void)); /* 45 */
+ int (*tkpIsWindowFloating) _ANSI_ARGS_((WindowRef window)); /* 46 */
+ Tk_Window (*tkMacOSXGetCapture) _ANSI_ARGS_((void)); /* 47 */
+ void *reserved48;
+ Window (*tkGetTransientMaster) _ANSI_ARGS_((TkWindow * winPtr)); /* 49 */
+ int (*tkGenerateButtonEvent) _ANSI_ARGS_((int x, int y, Window window, unsigned int state)); /* 50 */
+ void (*tkGenWMDestroyEvent) _ANSI_ARGS_((Tk_Window tkwin)); /* 51 */
+ void *reserved52;
+ unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 53 */
+#endif /* MAC_OSX_TK */
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */
+ void (*tkCreateXEventSource) _ANSI_ARGS_((void)); /* 0 */
+ void (*tkFreeWindowId) _ANSI_ARGS_((TkDisplay * dispPtr, Window w)); /* 1 */
+ void (*tkInitXId) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 2 */
+ int (*tkpCmapStressed) _ANSI_ARGS_((Tk_Window tkwin, Colormap colormap)); /* 3 */
+ void (*tkpSync) _ANSI_ARGS_((Display * display)); /* 4 */
+ Window (*tkUnixContainerId) _ANSI_ARGS_((TkWindow * winPtr)); /* 5 */
+ int (*tkUnixDoOneXEvent) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 6 */
+ void (*tkUnixSetMenubar) _ANSI_ARGS_((Tk_Window tkwin, Tk_Window menubar)); /* 7 */
+ int (*tkpScanWindowId) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, Window * idPtr)); /* 8 */
+ void (*tkWmCleanup) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 9 */
+ void (*tkSendCleanup) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 10 */
+ void (*tkFreeXId) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 11 */
+ int (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 12 */
+#endif /* X11 */
+} TkIntPlatStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TkIntPlatStubs *tkIntPlatStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifdef __WIN32__
+#ifndef TkAlignImageData
+#define TkAlignImageData \
+ (tkIntPlatStubsPtr->tkAlignImageData) /* 0 */
+#endif
+/* Slot 1 is reserved */
+#ifndef TkGenerateActivateEvents
+#define TkGenerateActivateEvents \
+ (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 2 */
+#endif
+#ifndef TkpGetMS
+#define TkpGetMS \
+ (tkIntPlatStubsPtr->tkpGetMS) /* 3 */
+#endif
+#ifndef TkPointerDeadWindow
+#define TkPointerDeadWindow \
+ (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 4 */
+#endif
+#ifndef TkpPrintWindowId
+#define TkpPrintWindowId \
+ (tkIntPlatStubsPtr->tkpPrintWindowId) /* 5 */
+#endif
+#ifndef TkpScanWindowId
+#define TkpScanWindowId \
+ (tkIntPlatStubsPtr->tkpScanWindowId) /* 6 */
+#endif
+#ifndef TkpSetCapture
+#define TkpSetCapture \
+ (tkIntPlatStubsPtr->tkpSetCapture) /* 7 */
+#endif
+#ifndef TkpSetCursor
+#define TkpSetCursor \
+ (tkIntPlatStubsPtr->tkpSetCursor) /* 8 */
+#endif
+#ifndef TkpWmSetState
+#define TkpWmSetState \
+ (tkIntPlatStubsPtr->tkpWmSetState) /* 9 */
+#endif
+#ifndef TkSetPixmapColormap
+#define TkSetPixmapColormap \
+ (tkIntPlatStubsPtr->tkSetPixmapColormap) /* 10 */
+#endif
+#ifndef TkWinCancelMouseTimer
+#define TkWinCancelMouseTimer \
+ (tkIntPlatStubsPtr->tkWinCancelMouseTimer) /* 11 */
+#endif
+#ifndef TkWinClipboardRender
+#define TkWinClipboardRender \
+ (tkIntPlatStubsPtr->tkWinClipboardRender) /* 12 */
+#endif
+#ifndef TkWinEmbeddedEventProc
+#define TkWinEmbeddedEventProc \
+ (tkIntPlatStubsPtr->tkWinEmbeddedEventProc) /* 13 */
+#endif
+#ifndef TkWinFillRect
+#define TkWinFillRect \
+ (tkIntPlatStubsPtr->tkWinFillRect) /* 14 */
+#endif
+#ifndef TkWinGetBorderPixels
+#define TkWinGetBorderPixels \
+ (tkIntPlatStubsPtr->tkWinGetBorderPixels) /* 15 */
+#endif
+#ifndef TkWinGetDrawableDC
+#define TkWinGetDrawableDC \
+ (tkIntPlatStubsPtr->tkWinGetDrawableDC) /* 16 */
+#endif
+#ifndef TkWinGetModifierState
+#define TkWinGetModifierState \
+ (tkIntPlatStubsPtr->tkWinGetModifierState) /* 17 */
+#endif
+#ifndef TkWinGetSystemPalette
+#define TkWinGetSystemPalette \
+ (tkIntPlatStubsPtr->tkWinGetSystemPalette) /* 18 */
+#endif
+#ifndef TkWinGetWrapperWindow
+#define TkWinGetWrapperWindow \
+ (tkIntPlatStubsPtr->tkWinGetWrapperWindow) /* 19 */
+#endif
+#ifndef TkWinHandleMenuEvent
+#define TkWinHandleMenuEvent \
+ (tkIntPlatStubsPtr->tkWinHandleMenuEvent) /* 20 */
+#endif
+#ifndef TkWinIndexOfColor
+#define TkWinIndexOfColor \
+ (tkIntPlatStubsPtr->tkWinIndexOfColor) /* 21 */
+#endif
+#ifndef TkWinReleaseDrawableDC
+#define TkWinReleaseDrawableDC \
+ (tkIntPlatStubsPtr->tkWinReleaseDrawableDC) /* 22 */
+#endif
+#ifndef TkWinResendEvent
+#define TkWinResendEvent \
+ (tkIntPlatStubsPtr->tkWinResendEvent) /* 23 */
+#endif
+#ifndef TkWinSelectPalette
+#define TkWinSelectPalette \
+ (tkIntPlatStubsPtr->tkWinSelectPalette) /* 24 */
+#endif
+#ifndef TkWinSetMenu
+#define TkWinSetMenu \
+ (tkIntPlatStubsPtr->tkWinSetMenu) /* 25 */
+#endif
+#ifndef TkWinSetWindowPos
+#define TkWinSetWindowPos \
+ (tkIntPlatStubsPtr->tkWinSetWindowPos) /* 26 */
+#endif
+#ifndef TkWinWmCleanup
+#define TkWinWmCleanup \
+ (tkIntPlatStubsPtr->tkWinWmCleanup) /* 27 */
+#endif
+#ifndef TkWinXCleanup
+#define TkWinXCleanup \
+ (tkIntPlatStubsPtr->tkWinXCleanup) /* 28 */
+#endif
+#ifndef TkWinXInit
+#define TkWinXInit \
+ (tkIntPlatStubsPtr->tkWinXInit) /* 29 */
+#endif
+#ifndef TkWinSetForegroundWindow
+#define TkWinSetForegroundWindow \
+ (tkIntPlatStubsPtr->tkWinSetForegroundWindow) /* 30 */
+#endif
+#ifndef TkWinDialogDebug
+#define TkWinDialogDebug \
+ (tkIntPlatStubsPtr->tkWinDialogDebug) /* 31 */
+#endif
+#ifndef TkWinGetMenuSystemDefault
+#define TkWinGetMenuSystemDefault \
+ (tkIntPlatStubsPtr->tkWinGetMenuSystemDefault) /* 32 */
+#endif
+#ifndef TkWinGetPlatformId
+#define TkWinGetPlatformId \
+ (tkIntPlatStubsPtr->tkWinGetPlatformId) /* 33 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TkGenerateActivateEvents
+#define TkGenerateActivateEvents \
+ (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 0 */
+#endif
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+#ifndef TkpGetMS
+#define TkpGetMS \
+ (tkIntPlatStubsPtr->tkpGetMS) /* 3 */
+#endif
+/* Slot 4 is reserved */
+#ifndef TkPointerDeadWindow
+#define TkPointerDeadWindow \
+ (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 5 */
+#endif
+#ifndef TkpSetCapture
+#define TkpSetCapture \
+ (tkIntPlatStubsPtr->tkpSetCapture) /* 6 */
+#endif
+#ifndef TkpSetCursor
+#define TkpSetCursor \
+ (tkIntPlatStubsPtr->tkpSetCursor) /* 7 */
+#endif
+#ifndef TkpWmSetState
+#define TkpWmSetState \
+ (tkIntPlatStubsPtr->tkpWmSetState) /* 8 */
+#endif
+/* Slot 9 is reserved */
+#ifndef TkAboutDlg
+#define TkAboutDlg \
+ (tkIntPlatStubsPtr->tkAboutDlg) /* 10 */
+#endif
+/* Slot 11 is reserved */
+/* Slot 12 is reserved */
+#ifndef TkGetTransientMaster
+#define TkGetTransientMaster \
+ (tkIntPlatStubsPtr->tkGetTransientMaster) /* 13 */
+#endif
+#ifndef TkGenerateButtonEvent
+#define TkGenerateButtonEvent \
+ (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 14 */
+#endif
+/* Slot 15 is reserved */
+#ifndef TkGenWMDestroyEvent
+#define TkGenWMDestroyEvent \
+ (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 16 */
+#endif
+/* Slot 17 is reserved */
+#ifndef TkMacButtonKeyState
+#define TkMacButtonKeyState \
+ (tkIntPlatStubsPtr->tkMacButtonKeyState) /* 18 */
+#endif
+#ifndef TkMacClearMenubarActive
+#define TkMacClearMenubarActive \
+ (tkIntPlatStubsPtr->tkMacClearMenubarActive) /* 19 */
+#endif
+/* Slot 20 is reserved */
+#ifndef TkMacDispatchMenuEvent
+#define TkMacDispatchMenuEvent \
+ (tkIntPlatStubsPtr->tkMacDispatchMenuEvent) /* 21 */
+#endif
+#ifndef TkMacInstallCursor
+#define TkMacInstallCursor \
+ (tkIntPlatStubsPtr->tkMacInstallCursor) /* 22 */
+#endif
+/* Slot 23 is reserved */
+#ifndef TkMacHandleTearoffMenu
+#define TkMacHandleTearoffMenu \
+ (tkIntPlatStubsPtr->tkMacHandleTearoffMenu) /* 24 */
+#endif
+/* Slot 25 is reserved */
+/* Slot 26 is reserved */
+#ifndef TkMacDoHLEvent
+#define TkMacDoHLEvent \
+ (tkIntPlatStubsPtr->tkMacDoHLEvent) /* 27 */
+#endif
+/* Slot 28 is reserved */
+#ifndef TkMacGenerateTime
+#define TkMacGenerateTime \
+ (tkIntPlatStubsPtr->tkMacGenerateTime) /* 29 */
+#endif
+/* Slot 30 is reserved */
+#ifndef TkMacGetScrollbarGrowWindow
+#define TkMacGetScrollbarGrowWindow \
+ (tkIntPlatStubsPtr->tkMacGetScrollbarGrowWindow) /* 31 */
+#endif
+#ifndef TkMacGetXWindow
+#define TkMacGetXWindow \
+ (tkIntPlatStubsPtr->tkMacGetXWindow) /* 32 */
+#endif
+#ifndef TkMacGrowToplevel
+#define TkMacGrowToplevel \
+ (tkIntPlatStubsPtr->tkMacGrowToplevel) /* 33 */
+#endif
+#ifndef TkMacHandleMenuSelect
+#define TkMacHandleMenuSelect \
+ (tkIntPlatStubsPtr->tkMacHandleMenuSelect) /* 34 */
+#endif
+/* Slot 35 is reserved */
+/* Slot 36 is reserved */
+/* Slot 37 is reserved */
+#ifndef TkMacInvalidateWindow
+#define TkMacInvalidateWindow \
+ (tkIntPlatStubsPtr->tkMacInvalidateWindow) /* 38 */
+#endif
+#ifndef TkMacIsCharacterMissing
+#define TkMacIsCharacterMissing \
+ (tkIntPlatStubsPtr->tkMacIsCharacterMissing) /* 39 */
+#endif
+#ifndef TkMacMakeRealWindowExist
+#define TkMacMakeRealWindowExist \
+ (tkIntPlatStubsPtr->tkMacMakeRealWindowExist) /* 40 */
+#endif
+#ifndef TkMacMakeStippleMap
+#define TkMacMakeStippleMap \
+ (tkIntPlatStubsPtr->tkMacMakeStippleMap) /* 41 */
+#endif
+#ifndef TkMacMenuClick
+#define TkMacMenuClick \
+ (tkIntPlatStubsPtr->tkMacMenuClick) /* 42 */
+#endif
+#ifndef TkMacRegisterOffScreenWindow
+#define TkMacRegisterOffScreenWindow \
+ (tkIntPlatStubsPtr->tkMacRegisterOffScreenWindow) /* 43 */
+#endif
+#ifndef TkMacResizable
+#define TkMacResizable \
+ (tkIntPlatStubsPtr->tkMacResizable) /* 44 */
+#endif
+/* Slot 45 is reserved */
+#ifndef TkMacSetHelpMenuItemCount
+#define TkMacSetHelpMenuItemCount \
+ (tkIntPlatStubsPtr->tkMacSetHelpMenuItemCount) /* 46 */
+#endif
+#ifndef TkMacSetScrollbarGrow
+#define TkMacSetScrollbarGrow \
+ (tkIntPlatStubsPtr->tkMacSetScrollbarGrow) /* 47 */
+#endif
+#ifndef TkMacSetUpClippingRgn
+#define TkMacSetUpClippingRgn \
+ (tkIntPlatStubsPtr->tkMacSetUpClippingRgn) /* 48 */
+#endif
+#ifndef TkMacSetUpGraphicsPort
+#define TkMacSetUpGraphicsPort \
+ (tkIntPlatStubsPtr->tkMacSetUpGraphicsPort) /* 49 */
+#endif
+#ifndef TkMacUpdateClipRgn
+#define TkMacUpdateClipRgn \
+ (tkIntPlatStubsPtr->tkMacUpdateClipRgn) /* 50 */
+#endif
+#ifndef TkMacUnregisterMacWindow
+#define TkMacUnregisterMacWindow \
+ (tkIntPlatStubsPtr->tkMacUnregisterMacWindow) /* 51 */
+#endif
+#ifndef TkMacUseMenuID
+#define TkMacUseMenuID \
+ (tkIntPlatStubsPtr->tkMacUseMenuID) /* 52 */
+#endif
+#ifndef TkMacVisableClipRgn
+#define TkMacVisableClipRgn \
+ (tkIntPlatStubsPtr->tkMacVisableClipRgn) /* 53 */
+#endif
+#ifndef TkMacWinBounds
+#define TkMacWinBounds \
+ (tkIntPlatStubsPtr->tkMacWinBounds) /* 54 */
+#endif
+#ifndef TkMacWindowOffset
+#define TkMacWindowOffset \
+ (tkIntPlatStubsPtr->tkMacWindowOffset) /* 55 */
+#endif
+/* Slot 56 is reserved */
+#ifndef TkSetMacColor
+#define TkSetMacColor \
+ (tkIntPlatStubsPtr->tkSetMacColor) /* 57 */
+#endif
+#ifndef TkSetWMName
+#define TkSetWMName \
+ (tkIntPlatStubsPtr->tkSetWMName) /* 58 */
+#endif
+#ifndef TkSuspendClipboard
+#define TkSuspendClipboard \
+ (tkIntPlatStubsPtr->tkSuspendClipboard) /* 59 */
+#endif
+/* Slot 60 is reserved */
+#ifndef TkMacZoomToplevel
+#define TkMacZoomToplevel \
+ (tkIntPlatStubsPtr->tkMacZoomToplevel) /* 61 */
+#endif
+#ifndef Tk_TopCoordsToWindow
+#define Tk_TopCoordsToWindow \
+ (tkIntPlatStubsPtr->tk_TopCoordsToWindow) /* 62 */
+#endif
+#ifndef TkMacContainerId
+#define TkMacContainerId \
+ (tkIntPlatStubsPtr->tkMacContainerId) /* 63 */
+#endif
+#ifndef TkMacGetHostToplevel
+#define TkMacGetHostToplevel \
+ (tkIntPlatStubsPtr->tkMacGetHostToplevel) /* 64 */
+#endif
+#ifndef TkMacPreprocessMenu
+#define TkMacPreprocessMenu \
+ (tkIntPlatStubsPtr->tkMacPreprocessMenu) /* 65 */
+#endif
+#ifndef TkpIsWindowFloating
+#define TkpIsWindowFloating \
+ (tkIntPlatStubsPtr->tkpIsWindowFloating) /* 66 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef TkGenerateActivateEvents
+#define TkGenerateActivateEvents \
+ (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 0 */
+#endif
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+#ifndef TkPointerDeadWindow
+#define TkPointerDeadWindow \
+ (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 3 */
+#endif
+#ifndef TkpSetCapture
+#define TkpSetCapture \
+ (tkIntPlatStubsPtr->tkpSetCapture) /* 4 */
+#endif
+#ifndef TkpSetCursor
+#define TkpSetCursor \
+ (tkIntPlatStubsPtr->tkpSetCursor) /* 5 */
+#endif
+#ifndef TkpWmSetState
+#define TkpWmSetState \
+ (tkIntPlatStubsPtr->tkpWmSetState) /* 6 */
+#endif
+#ifndef TkAboutDlg
+#define TkAboutDlg \
+ (tkIntPlatStubsPtr->tkAboutDlg) /* 7 */
+#endif
+#ifndef TkMacOSXButtonKeyState
+#define TkMacOSXButtonKeyState \
+ (tkIntPlatStubsPtr->tkMacOSXButtonKeyState) /* 8 */
+#endif
+#ifndef TkMacOSXClearMenubarActive
+#define TkMacOSXClearMenubarActive \
+ (tkIntPlatStubsPtr->tkMacOSXClearMenubarActive) /* 9 */
+#endif
+#ifndef TkMacOSXDispatchMenuEvent
+#define TkMacOSXDispatchMenuEvent \
+ (tkIntPlatStubsPtr->tkMacOSXDispatchMenuEvent) /* 10 */
+#endif
+#ifndef TkMacOSXInstallCursor
+#define TkMacOSXInstallCursor \
+ (tkIntPlatStubsPtr->tkMacOSXInstallCursor) /* 11 */
+#endif
+#ifndef TkMacOSXHandleTearoffMenu
+#define TkMacOSXHandleTearoffMenu \
+ (tkIntPlatStubsPtr->tkMacOSXHandleTearoffMenu) /* 12 */
+#endif
+/* Slot 13 is reserved */
+#ifndef TkMacOSXDoHLEvent
+#define TkMacOSXDoHLEvent \
+ (tkIntPlatStubsPtr->tkMacOSXDoHLEvent) /* 14 */
+#endif
+/* Slot 15 is reserved */
+#ifndef TkMacOSXGetXWindow
+#define TkMacOSXGetXWindow \
+ (tkIntPlatStubsPtr->tkMacOSXGetXWindow) /* 16 */
+#endif
+#ifndef TkMacOSXGrowToplevel
+#define TkMacOSXGrowToplevel \
+ (tkIntPlatStubsPtr->tkMacOSXGrowToplevel) /* 17 */
+#endif
+#ifndef TkMacOSXHandleMenuSelect
+#define TkMacOSXHandleMenuSelect \
+ (tkIntPlatStubsPtr->tkMacOSXHandleMenuSelect) /* 18 */
+#endif
+/* Slot 19 is reserved */
+/* Slot 20 is reserved */
+#ifndef TkMacOSXInvalidateWindow
+#define TkMacOSXInvalidateWindow \
+ (tkIntPlatStubsPtr->tkMacOSXInvalidateWindow) /* 21 */
+#endif
+#ifndef TkMacOSXIsCharacterMissing
+#define TkMacOSXIsCharacterMissing \
+ (tkIntPlatStubsPtr->tkMacOSXIsCharacterMissing) /* 22 */
+#endif
+#ifndef TkMacOSXMakeRealWindowExist
+#define TkMacOSXMakeRealWindowExist \
+ (tkIntPlatStubsPtr->tkMacOSXMakeRealWindowExist) /* 23 */
+#endif
+#ifndef TkMacOSXMakeStippleMap
+#define TkMacOSXMakeStippleMap \
+ (tkIntPlatStubsPtr->tkMacOSXMakeStippleMap) /* 24 */
+#endif
+#ifndef TkMacOSXMenuClick
+#define TkMacOSXMenuClick \
+ (tkIntPlatStubsPtr->tkMacOSXMenuClick) /* 25 */
+#endif
+#ifndef TkMacOSXRegisterOffScreenWindow
+#define TkMacOSXRegisterOffScreenWindow \
+ (tkIntPlatStubsPtr->tkMacOSXRegisterOffScreenWindow) /* 26 */
+#endif
+#ifndef TkMacOSXResizable
+#define TkMacOSXResizable \
+ (tkIntPlatStubsPtr->tkMacOSXResizable) /* 27 */
+#endif
+#ifndef TkMacOSXSetHelpMenuItemCount
+#define TkMacOSXSetHelpMenuItemCount \
+ (tkIntPlatStubsPtr->tkMacOSXSetHelpMenuItemCount) /* 28 */
+#endif
+#ifndef TkMacOSXSetScrollbarGrow
+#define TkMacOSXSetScrollbarGrow \
+ (tkIntPlatStubsPtr->tkMacOSXSetScrollbarGrow) /* 29 */
+#endif
+#ifndef TkMacOSXSetUpClippingRgn
+#define TkMacOSXSetUpClippingRgn \
+ (tkIntPlatStubsPtr->tkMacOSXSetUpClippingRgn) /* 30 */
+#endif
+#ifndef TkMacOSXSetUpGraphicsPort
+#define TkMacOSXSetUpGraphicsPort \
+ (tkIntPlatStubsPtr->tkMacOSXSetUpGraphicsPort) /* 31 */
+#endif
+#ifndef TkMacOSXUpdateClipRgn
+#define TkMacOSXUpdateClipRgn \
+ (tkIntPlatStubsPtr->tkMacOSXUpdateClipRgn) /* 32 */
+#endif
+#ifndef TkMacOSXUnregisterMacWindow
+#define TkMacOSXUnregisterMacWindow \
+ (tkIntPlatStubsPtr->tkMacOSXUnregisterMacWindow) /* 33 */
+#endif
+#ifndef TkMacOSXUseMenuID
+#define TkMacOSXUseMenuID \
+ (tkIntPlatStubsPtr->tkMacOSXUseMenuID) /* 34 */
+#endif
+#ifndef TkMacOSXVisableClipRgn
+#define TkMacOSXVisableClipRgn \
+ (tkIntPlatStubsPtr->tkMacOSXVisableClipRgn) /* 35 */
+#endif
+#ifndef TkMacOSXWinBounds
+#define TkMacOSXWinBounds \
+ (tkIntPlatStubsPtr->tkMacOSXWinBounds) /* 36 */
+#endif
+#ifndef TkMacOSXWindowOffset
+#define TkMacOSXWindowOffset \
+ (tkIntPlatStubsPtr->tkMacOSXWindowOffset) /* 37 */
+#endif
+#ifndef TkSetMacColor
+#define TkSetMacColor \
+ (tkIntPlatStubsPtr->tkSetMacColor) /* 38 */
+#endif
+#ifndef TkSetWMName
+#define TkSetWMName \
+ (tkIntPlatStubsPtr->tkSetWMName) /* 39 */
+#endif
+#ifndef TkSuspendClipboard
+#define TkSuspendClipboard \
+ (tkIntPlatStubsPtr->tkSuspendClipboard) /* 40 */
+#endif
+#ifndef TkMacOSXZoomToplevel
+#define TkMacOSXZoomToplevel \
+ (tkIntPlatStubsPtr->tkMacOSXZoomToplevel) /* 41 */
+#endif
+#ifndef Tk_TopCoordsToWindow
+#define Tk_TopCoordsToWindow \
+ (tkIntPlatStubsPtr->tk_TopCoordsToWindow) /* 42 */
+#endif
+#ifndef TkMacOSXContainerId
+#define TkMacOSXContainerId \
+ (tkIntPlatStubsPtr->tkMacOSXContainerId) /* 43 */
+#endif
+#ifndef TkMacOSXGetHostToplevel
+#define TkMacOSXGetHostToplevel \
+ (tkIntPlatStubsPtr->tkMacOSXGetHostToplevel) /* 44 */
+#endif
+#ifndef TkMacOSXPreprocessMenu
+#define TkMacOSXPreprocessMenu \
+ (tkIntPlatStubsPtr->tkMacOSXPreprocessMenu) /* 45 */
+#endif
+#ifndef TkpIsWindowFloating
+#define TkpIsWindowFloating \
+ (tkIntPlatStubsPtr->tkpIsWindowFloating) /* 46 */
+#endif
+#ifndef TkMacOSXGetCapture
+#define TkMacOSXGetCapture \
+ (tkIntPlatStubsPtr->tkMacOSXGetCapture) /* 47 */
+#endif
+/* Slot 48 is reserved */
+#ifndef TkGetTransientMaster
+#define TkGetTransientMaster \
+ (tkIntPlatStubsPtr->tkGetTransientMaster) /* 49 */
+#endif
+#ifndef TkGenerateButtonEvent
+#define TkGenerateButtonEvent \
+ (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 50 */
+#endif
+#ifndef TkGenWMDestroyEvent
+#define TkGenWMDestroyEvent \
+ (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 51 */
+#endif
+/* Slot 52 is reserved */
+#ifndef TkpGetMS
+#define TkpGetMS \
+ (tkIntPlatStubsPtr->tkpGetMS) /* 53 */
+#endif
+#endif /* MAC_OSX_TK */
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */
+#ifndef TkCreateXEventSource
+#define TkCreateXEventSource \
+ (tkIntPlatStubsPtr->tkCreateXEventSource) /* 0 */
+#endif
+#ifndef TkFreeWindowId
+#define TkFreeWindowId \
+ (tkIntPlatStubsPtr->tkFreeWindowId) /* 1 */
+#endif
+#ifndef TkInitXId
+#define TkInitXId \
+ (tkIntPlatStubsPtr->tkInitXId) /* 2 */
+#endif
+#ifndef TkpCmapStressed
+#define TkpCmapStressed \
+ (tkIntPlatStubsPtr->tkpCmapStressed) /* 3 */
+#endif
+#ifndef TkpSync
+#define TkpSync \
+ (tkIntPlatStubsPtr->tkpSync) /* 4 */
+#endif
+#ifndef TkUnixContainerId
+#define TkUnixContainerId \
+ (tkIntPlatStubsPtr->tkUnixContainerId) /* 5 */
+#endif
+#ifndef TkUnixDoOneXEvent
+#define TkUnixDoOneXEvent \
+ (tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 6 */
+#endif
+#ifndef TkUnixSetMenubar
+#define TkUnixSetMenubar \
+ (tkIntPlatStubsPtr->tkUnixSetMenubar) /* 7 */
+#endif
+#ifndef TkpScanWindowId
+#define TkpScanWindowId \
+ (tkIntPlatStubsPtr->tkpScanWindowId) /* 8 */
+#endif
+#ifndef TkWmCleanup
+#define TkWmCleanup \
+ (tkIntPlatStubsPtr->tkWmCleanup) /* 9 */
+#endif
+#ifndef TkSendCleanup
+#define TkSendCleanup \
+ (tkIntPlatStubsPtr->tkSendCleanup) /* 10 */
+#endif
+#ifndef TkFreeXId
+#define TkFreeXId \
+ (tkIntPlatStubsPtr->tkFreeXId) /* 11 */
+#endif
+#ifndef TkpWmSetState
+#define TkpWmSetState \
+ (tkIntPlatStubsPtr->tkpWmSetState) /* 12 */
+#endif
+#endif /* X11 */
+
+#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKINTPLATDECLS */
diff --git a/tcl/generic/tkIntXlibDecls.h b/tcl/generic/tkIntXlibDecls.h
new file mode 100644
index 00000000000..9f9e00e7e89
--- /dev/null
+++ b/tcl/generic/tkIntXlibDecls.h
@@ -0,0 +1,2414 @@
+/*
+ * tkIntXlibDecls.h --
+ *
+ * This file contains the declarations for all platform dependent
+ * unsupported functions that are exported by the Tk library. These
+ * interfaces are not guaranteed to remain the same between
+ * versions. Use at your own risk.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKINTXLIBDECLS
+#define _TKINTXLIBDECLS
+
+#ifdef MAC_TCL
+#include "Xutil.h"
+#else
+#include "X11/Xutil.h"
+#endif
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tkInt.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+#ifdef __WIN32__
+/* 0 */
+EXTERN void XSetDashes _ANSI_ARGS_((Display* display, GC gc,
+ int dash_offset, _Xconst char* dash_list,
+ int n));
+/* 1 */
+EXTERN XModifierKeymap* XGetModifierMapping _ANSI_ARGS_((Display* d));
+/* 2 */
+EXTERN XImage * XCreateImage _ANSI_ARGS_((Display* d, Visual* v,
+ unsigned int ui1, int i1, int i2, char* cp,
+ unsigned int ui2, unsigned int ui3, int i3,
+ int i4));
+/* 3 */
+EXTERN XImage * XGetImage _ANSI_ARGS_((Display* d, Drawable dr,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, unsigned long ul, int i3));
+/* 4 */
+EXTERN char * XGetAtomName _ANSI_ARGS_((Display* d, Atom a));
+/* 5 */
+EXTERN char * XKeysymToString _ANSI_ARGS_((KeySym k));
+/* 6 */
+EXTERN Colormap XCreateColormap _ANSI_ARGS_((Display* d, Window w,
+ Visual* v, int i));
+/* 7 */
+EXTERN Cursor XCreatePixmapCursor _ANSI_ARGS_((Display* d,
+ Pixmap p1, Pixmap p2, XColor* x1, XColor* x2,
+ unsigned int ui1, unsigned int ui2));
+/* 8 */
+EXTERN Cursor XCreateGlyphCursor _ANSI_ARGS_((Display* d, Font f1,
+ Font f2, unsigned int ui1, unsigned int ui2,
+ XColor* x1, XColor* x2));
+/* 9 */
+EXTERN GContext XGContextFromGC _ANSI_ARGS_((GC g));
+/* 10 */
+EXTERN XHostAddress * XListHosts _ANSI_ARGS_((Display* d, int* i, Bool* b));
+/* 11 */
+EXTERN KeySym XKeycodeToKeysym _ANSI_ARGS_((Display* d,
+ unsigned int k, int i));
+/* 12 */
+EXTERN KeySym XStringToKeysym _ANSI_ARGS_((_Xconst char* c));
+/* 13 */
+EXTERN Window XRootWindow _ANSI_ARGS_((Display* d, int i));
+/* 14 */
+EXTERN XErrorHandler XSetErrorHandler _ANSI_ARGS_((XErrorHandler x));
+/* 15 */
+EXTERN Status XIconifyWindow _ANSI_ARGS_((Display* d, Window w,
+ int i));
+/* 16 */
+EXTERN Status XWithdrawWindow _ANSI_ARGS_((Display* d, Window w,
+ int i));
+/* 17 */
+EXTERN Status XGetWMColormapWindows _ANSI_ARGS_((Display* d,
+ Window w, Window** wpp, int* ip));
+/* 18 */
+EXTERN Status XAllocColor _ANSI_ARGS_((Display* d, Colormap c,
+ XColor* xp));
+/* 19 */
+EXTERN void XBell _ANSI_ARGS_((Display* d, int i));
+/* 20 */
+EXTERN void XChangeProperty _ANSI_ARGS_((Display* d, Window w,
+ Atom a1, Atom a2, int i1, int i2,
+ _Xconst unsigned char* c, int i3));
+/* 21 */
+EXTERN void XChangeWindowAttributes _ANSI_ARGS_((Display* d,
+ Window w, unsigned long ul,
+ XSetWindowAttributes* x));
+/* 22 */
+EXTERN void XClearWindow _ANSI_ARGS_((Display* d, Window w));
+/* 23 */
+EXTERN void XConfigureWindow _ANSI_ARGS_((Display* d, Window w,
+ unsigned int i, XWindowChanges* x));
+/* 24 */
+EXTERN void XCopyArea _ANSI_ARGS_((Display* d, Drawable dr1,
+ Drawable dr2, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3,
+ int i4));
+/* 25 */
+EXTERN void XCopyPlane _ANSI_ARGS_((Display* d, Drawable dr1,
+ Drawable dr2, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3,
+ int i4, unsigned long ul));
+/* 26 */
+EXTERN Pixmap XCreateBitmapFromData _ANSI_ARGS_((Display* display,
+ Drawable d, _Xconst char* data,
+ unsigned int width, unsigned int height));
+/* 27 */
+EXTERN void XDefineCursor _ANSI_ARGS_((Display* d, Window w,
+ Cursor c));
+/* 28 */
+EXTERN void XDeleteProperty _ANSI_ARGS_((Display* d, Window w,
+ Atom a));
+/* 29 */
+EXTERN void XDestroyWindow _ANSI_ARGS_((Display* d, Window w));
+/* 30 */
+EXTERN void XDrawArc _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4));
+/* 31 */
+EXTERN void XDrawLines _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XPoint* x, int i1, int i2));
+/* 32 */
+EXTERN void XDrawRectangle _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, int i1, int i2, unsigned int ui1,
+ unsigned int ui2));
+/* 33 */
+EXTERN void XFillArc _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4));
+/* 34 */
+EXTERN void XFillPolygon _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XPoint* x, int i1, int i2, int i3));
+/* 35 */
+EXTERN void XFillRectangles _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XRectangle* x, int i));
+/* 36 */
+EXTERN void XForceScreenSaver _ANSI_ARGS_((Display* d, int i));
+/* 37 */
+EXTERN void XFreeColormap _ANSI_ARGS_((Display* d, Colormap c));
+/* 38 */
+EXTERN void XFreeColors _ANSI_ARGS_((Display* d, Colormap c,
+ unsigned long* ulp, int i, unsigned long ul));
+/* 39 */
+EXTERN void XFreeCursor _ANSI_ARGS_((Display* d, Cursor c));
+/* 40 */
+EXTERN void XFreeModifiermap _ANSI_ARGS_((XModifierKeymap* x));
+/* 41 */
+EXTERN Status XGetGeometry _ANSI_ARGS_((Display* d, Drawable dr,
+ Window* w, int* i1, int* i2,
+ unsigned int* ui1, unsigned int* ui2,
+ unsigned int* ui3, unsigned int* ui4));
+/* 42 */
+EXTERN void XGetInputFocus _ANSI_ARGS_((Display* d, Window* w,
+ int* i));
+/* 43 */
+EXTERN int XGetWindowProperty _ANSI_ARGS_((Display* d, Window w,
+ Atom a1, long l1, long l2, Bool b, Atom a2,
+ Atom* ap, int* ip, unsigned long* ulp1,
+ unsigned long* ulp2, unsigned char** cpp));
+/* 44 */
+EXTERN Status XGetWindowAttributes _ANSI_ARGS_((Display* d,
+ Window w, XWindowAttributes* x));
+/* 45 */
+EXTERN int XGrabKeyboard _ANSI_ARGS_((Display* d, Window w,
+ Bool b, int i1, int i2, Time t));
+/* 46 */
+EXTERN int XGrabPointer _ANSI_ARGS_((Display* d, Window w1,
+ Bool b, unsigned int ui, int i1, int i2,
+ Window w2, Cursor c, Time t));
+/* 47 */
+EXTERN KeyCode XKeysymToKeycode _ANSI_ARGS_((Display* d, KeySym k));
+/* 48 */
+EXTERN Status XLookupColor _ANSI_ARGS_((Display* d, Colormap c1,
+ _Xconst char* c2, XColor* x1, XColor* x2));
+/* 49 */
+EXTERN void XMapWindow _ANSI_ARGS_((Display* d, Window w));
+/* 50 */
+EXTERN void XMoveResizeWindow _ANSI_ARGS_((Display* d, Window w,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2));
+/* 51 */
+EXTERN void XMoveWindow _ANSI_ARGS_((Display* d, Window w,
+ int i1, int i2));
+/* 52 */
+EXTERN void XNextEvent _ANSI_ARGS_((Display* d, XEvent* x));
+/* 53 */
+EXTERN void XPutBackEvent _ANSI_ARGS_((Display* d, XEvent* x));
+/* 54 */
+EXTERN void XQueryColors _ANSI_ARGS_((Display* d, Colormap c,
+ XColor* x, int i));
+/* 55 */
+EXTERN Bool XQueryPointer _ANSI_ARGS_((Display* d, Window w1,
+ Window* w2, Window* w3, int* i1, int* i2,
+ int* i3, int* i4, unsigned int* ui));
+/* 56 */
+EXTERN Status XQueryTree _ANSI_ARGS_((Display* d, Window w1,
+ Window* w2, Window* w3, Window** w4,
+ unsigned int* ui));
+/* 57 */
+EXTERN void XRaiseWindow _ANSI_ARGS_((Display* d, Window w));
+/* 58 */
+EXTERN void XRefreshKeyboardMapping _ANSI_ARGS_((
+ XMappingEvent* x));
+/* 59 */
+EXTERN void XResizeWindow _ANSI_ARGS_((Display* d, Window w,
+ unsigned int ui1, unsigned int ui2));
+/* 60 */
+EXTERN void XSelectInput _ANSI_ARGS_((Display* d, Window w,
+ long l));
+/* 61 */
+EXTERN Status XSendEvent _ANSI_ARGS_((Display* d, Window w, Bool b,
+ long l, XEvent* x));
+/* 62 */
+EXTERN void XSetCommand _ANSI_ARGS_((Display* d, Window w,
+ CONST char** c, int i));
+/* 63 */
+EXTERN void XSetIconName _ANSI_ARGS_((Display* d, Window w,
+ _Xconst char* c));
+/* 64 */
+EXTERN void XSetInputFocus _ANSI_ARGS_((Display* d, Window w,
+ int i, Time t));
+/* 65 */
+EXTERN void XSetSelectionOwner _ANSI_ARGS_((Display* d, Atom a,
+ Window w, Time t));
+/* 66 */
+EXTERN void XSetWindowBackground _ANSI_ARGS_((Display* d,
+ Window w, unsigned long ul));
+/* 67 */
+EXTERN void XSetWindowBackgroundPixmap _ANSI_ARGS_((Display* d,
+ Window w, Pixmap p));
+/* 68 */
+EXTERN void XSetWindowBorder _ANSI_ARGS_((Display* d, Window w,
+ unsigned long ul));
+/* 69 */
+EXTERN void XSetWindowBorderPixmap _ANSI_ARGS_((Display* d,
+ Window w, Pixmap p));
+/* 70 */
+EXTERN void XSetWindowBorderWidth _ANSI_ARGS_((Display* d,
+ Window w, unsigned int ui));
+/* 71 */
+EXTERN void XSetWindowColormap _ANSI_ARGS_((Display* d, Window w,
+ Colormap c));
+/* 72 */
+EXTERN Bool XTranslateCoordinates _ANSI_ARGS_((Display* d,
+ Window w1, Window w2, int i1, int i2,
+ int* i3, int* i4, Window* w3));
+/* 73 */
+EXTERN void XUngrabKeyboard _ANSI_ARGS_((Display* d, Time t));
+/* 74 */
+EXTERN void XUngrabPointer _ANSI_ARGS_((Display* d, Time t));
+/* 75 */
+EXTERN void XUnmapWindow _ANSI_ARGS_((Display* d, Window w));
+/* 76 */
+EXTERN void XWindowEvent _ANSI_ARGS_((Display* d, Window w,
+ long l, XEvent* x));
+/* 77 */
+EXTERN void XDestroyIC _ANSI_ARGS_((XIC x));
+/* 78 */
+EXTERN Bool XFilterEvent _ANSI_ARGS_((XEvent* x, Window w));
+/* 79 */
+EXTERN int XmbLookupString _ANSI_ARGS_((XIC xi,
+ XKeyPressedEvent* xk, char* c, int i,
+ KeySym* k, Status* s));
+/* 80 */
+EXTERN void TkPutImage _ANSI_ARGS_((unsigned long * colors,
+ int ncolors, Display* display, Drawable d,
+ GC gc, XImage* image, int src_x, int src_y,
+ int dest_x, int dest_y, unsigned int width,
+ unsigned int height));
+/* Slot 81 is reserved */
+/* 82 */
+EXTERN Status XParseColor _ANSI_ARGS_((Display * display,
+ Colormap map, _Xconst char* spec,
+ XColor * colorPtr));
+/* 83 */
+EXTERN GC XCreateGC _ANSI_ARGS_((Display* display, Drawable d,
+ unsigned long valuemask, XGCValues* values));
+/* 84 */
+EXTERN void XFreeGC _ANSI_ARGS_((Display* display, GC gc));
+/* 85 */
+EXTERN Atom XInternAtom _ANSI_ARGS_((Display* display,
+ _Xconst char* atom_name, Bool only_if_exists));
+/* 86 */
+EXTERN void XSetBackground _ANSI_ARGS_((Display* display, GC gc,
+ unsigned long foreground));
+/* 87 */
+EXTERN void XSetForeground _ANSI_ARGS_((Display* display, GC gc,
+ unsigned long foreground));
+/* 88 */
+EXTERN void XSetClipMask _ANSI_ARGS_((Display* display, GC gc,
+ Pixmap pixmap));
+/* 89 */
+EXTERN void XSetClipOrigin _ANSI_ARGS_((Display* display, GC gc,
+ int clip_x_origin, int clip_y_origin));
+/* 90 */
+EXTERN void XSetTSOrigin _ANSI_ARGS_((Display* display, GC gc,
+ int ts_x_origin, int ts_y_origin));
+/* 91 */
+EXTERN void XChangeGC _ANSI_ARGS_((Display * d, GC gc,
+ unsigned long mask, XGCValues * values));
+/* 92 */
+EXTERN void XSetFont _ANSI_ARGS_((Display * display, GC gc,
+ Font font));
+/* 93 */
+EXTERN void XSetArcMode _ANSI_ARGS_((Display * display, GC gc,
+ int arc_mode));
+/* 94 */
+EXTERN void XSetStipple _ANSI_ARGS_((Display * display, GC gc,
+ Pixmap stipple));
+/* 95 */
+EXTERN void XSetFillRule _ANSI_ARGS_((Display * display, GC gc,
+ int fill_rule));
+/* 96 */
+EXTERN void XSetFillStyle _ANSI_ARGS_((Display * display, GC gc,
+ int fill_style));
+/* 97 */
+EXTERN void XSetFunction _ANSI_ARGS_((Display * display, GC gc,
+ int function));
+/* 98 */
+EXTERN void XSetLineAttributes _ANSI_ARGS_((Display * display,
+ GC gc, unsigned int line_width,
+ int line_style, int cap_style,
+ int join_style));
+/* 99 */
+EXTERN int _XInitImageFuncPtrs _ANSI_ARGS_((XImage * image));
+/* 100 */
+EXTERN XIC XCreateIC _ANSI_ARGS_((void));
+/* 101 */
+EXTERN XVisualInfo * XGetVisualInfo _ANSI_ARGS_((Display* display,
+ long vinfo_mask, XVisualInfo* vinfo_template,
+ int* nitems_return));
+/* 102 */
+EXTERN void XSetWMClientMachine _ANSI_ARGS_((Display* display,
+ Window w, XTextProperty* text_prop));
+/* 103 */
+EXTERN Status XStringListToTextProperty _ANSI_ARGS_((char** list,
+ int count, XTextProperty* text_prop_return));
+/* 104 */
+EXTERN void XDrawLine _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int x1, int y1, int x2, int y2));
+/* 105 */
+EXTERN void XWarpPointer _ANSI_ARGS_((Display* d, Window s,
+ Window dw, int sx, int sy, unsigned int sw,
+ unsigned int sh, int dx, int dy));
+/* 106 */
+EXTERN void XFillRectangle _ANSI_ARGS_((Display* display,
+ Drawable d, GC gc, int x, int y,
+ unsigned int width, unsigned int height));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 0 */
+EXTERN void XSetDashes _ANSI_ARGS_((Display* display, GC gc,
+ int dash_offset, _Xconst char* dash_list,
+ int n));
+/* 1 */
+EXTERN XModifierKeymap* XGetModifierMapping _ANSI_ARGS_((Display* d));
+/* 2 */
+EXTERN XImage * XCreateImage _ANSI_ARGS_((Display* d, Visual* v,
+ unsigned int ui1, int i1, int i2, char* cp,
+ unsigned int ui2, unsigned int ui3, int i3,
+ int i4));
+/* 3 */
+EXTERN XImage * XGetImage _ANSI_ARGS_((Display* d, Drawable dr,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, unsigned long ul, int i3));
+/* 4 */
+EXTERN char * XGetAtomName _ANSI_ARGS_((Display* d, Atom a));
+/* 5 */
+EXTERN char * XKeysymToString _ANSI_ARGS_((KeySym k));
+/* 6 */
+EXTERN Colormap XCreateColormap _ANSI_ARGS_((Display* d, Window w,
+ Visual* v, int i));
+/* 7 */
+EXTERN GContext XGContextFromGC _ANSI_ARGS_((GC g));
+/* 8 */
+EXTERN KeySym XKeycodeToKeysym _ANSI_ARGS_((Display* d, KeyCode k,
+ int i));
+/* 9 */
+EXTERN KeySym XStringToKeysym _ANSI_ARGS_((_Xconst char* c));
+/* 10 */
+EXTERN Window XRootWindow _ANSI_ARGS_((Display* d, int i));
+/* 11 */
+EXTERN XErrorHandler XSetErrorHandler _ANSI_ARGS_((XErrorHandler x));
+/* 12 */
+EXTERN Status XAllocColor _ANSI_ARGS_((Display* d, Colormap c,
+ XColor* xp));
+/* 13 */
+EXTERN void XBell _ANSI_ARGS_((Display* d, int i));
+/* 14 */
+EXTERN void XChangeProperty _ANSI_ARGS_((Display* d, Window w,
+ Atom a1, Atom a2, int i1, int i2,
+ _Xconst unsigned char* c, int i3));
+/* 15 */
+EXTERN void XChangeWindowAttributes _ANSI_ARGS_((Display* d,
+ Window w, unsigned long ul,
+ XSetWindowAttributes* x));
+/* 16 */
+EXTERN void XConfigureWindow _ANSI_ARGS_((Display* d, Window w,
+ unsigned int i, XWindowChanges* x));
+/* 17 */
+EXTERN void XCopyArea _ANSI_ARGS_((Display* d, Drawable dr1,
+ Drawable dr2, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3,
+ int i4));
+/* 18 */
+EXTERN void XCopyPlane _ANSI_ARGS_((Display* d, Drawable dr1,
+ Drawable dr2, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3,
+ int i4, unsigned long ul));
+/* 19 */
+EXTERN Pixmap XCreateBitmapFromData _ANSI_ARGS_((Display* display,
+ Drawable d, _Xconst char* data,
+ unsigned int width, unsigned int height));
+/* 20 */
+EXTERN void XDefineCursor _ANSI_ARGS_((Display* d, Window w,
+ Cursor c));
+/* 21 */
+EXTERN void XDestroyWindow _ANSI_ARGS_((Display* d, Window w));
+/* 22 */
+EXTERN void XDrawArc _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4));
+/* 23 */
+EXTERN void XDrawLines _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XPoint* x, int i1, int i2));
+/* 24 */
+EXTERN void XDrawRectangle _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, int i1, int i2, unsigned int ui1,
+ unsigned int ui2));
+/* 25 */
+EXTERN void XFillArc _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4));
+/* 26 */
+EXTERN void XFillPolygon _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XPoint* x, int i1, int i2, int i3));
+/* 27 */
+EXTERN void XFillRectangles _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XRectangle* x, int i));
+/* 28 */
+EXTERN void XFreeColormap _ANSI_ARGS_((Display* d, Colormap c));
+/* 29 */
+EXTERN void XFreeColors _ANSI_ARGS_((Display* d, Colormap c,
+ unsigned long* ulp, int i, unsigned long ul));
+/* 30 */
+EXTERN void XFreeModifiermap _ANSI_ARGS_((XModifierKeymap* x));
+/* 31 */
+EXTERN Status XGetGeometry _ANSI_ARGS_((Display* d, Drawable dr,
+ Window* w, int* i1, int* i2,
+ unsigned int* ui1, unsigned int* ui2,
+ unsigned int* ui3, unsigned int* ui4));
+/* 32 */
+EXTERN int XGetWindowProperty _ANSI_ARGS_((Display* d, Window w,
+ Atom a1, long l1, long l2, Bool b, Atom a2,
+ Atom* ap, int* ip, unsigned long* ulp1,
+ unsigned long* ulp2, unsigned char** cpp));
+/* 33 */
+EXTERN int XGrabKeyboard _ANSI_ARGS_((Display* d, Window w,
+ Bool b, int i1, int i2, Time t));
+/* 34 */
+EXTERN int XGrabPointer _ANSI_ARGS_((Display* d, Window w1,
+ Bool b, unsigned int ui, int i1, int i2,
+ Window w2, Cursor c, Time t));
+/* 35 */
+EXTERN KeyCode XKeysymToKeycode _ANSI_ARGS_((Display* d, KeySym k));
+/* 36 */
+EXTERN void XMapWindow _ANSI_ARGS_((Display* d, Window w));
+/* 37 */
+EXTERN void XMoveResizeWindow _ANSI_ARGS_((Display* d, Window w,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2));
+/* 38 */
+EXTERN void XMoveWindow _ANSI_ARGS_((Display* d, Window w,
+ int i1, int i2));
+/* 39 */
+EXTERN Bool XQueryPointer _ANSI_ARGS_((Display* d, Window w1,
+ Window* w2, Window* w3, int* i1, int* i2,
+ int* i3, int* i4, unsigned int* ui));
+/* 40 */
+EXTERN void XRaiseWindow _ANSI_ARGS_((Display* d, Window w));
+/* 41 */
+EXTERN void XRefreshKeyboardMapping _ANSI_ARGS_((
+ XMappingEvent* x));
+/* 42 */
+EXTERN void XResizeWindow _ANSI_ARGS_((Display* d, Window w,
+ unsigned int ui1, unsigned int ui2));
+/* 43 */
+EXTERN void XSelectInput _ANSI_ARGS_((Display* d, Window w,
+ long l));
+/* 44 */
+EXTERN Status XSendEvent _ANSI_ARGS_((Display* d, Window w, Bool b,
+ long l, XEvent* x));
+/* 45 */
+EXTERN void XSetIconName _ANSI_ARGS_((Display* d, Window w,
+ _Xconst char* c));
+/* 46 */
+EXTERN void XSetInputFocus _ANSI_ARGS_((Display* d, Window w,
+ int i, Time t));
+/* 47 */
+EXTERN void XSetSelectionOwner _ANSI_ARGS_((Display* d, Atom a,
+ Window w, Time t));
+/* 48 */
+EXTERN void XSetWindowBackground _ANSI_ARGS_((Display* d,
+ Window w, unsigned long ul));
+/* 49 */
+EXTERN void XSetWindowBackgroundPixmap _ANSI_ARGS_((Display* d,
+ Window w, Pixmap p));
+/* 50 */
+EXTERN void XSetWindowBorder _ANSI_ARGS_((Display* d, Window w,
+ unsigned long ul));
+/* 51 */
+EXTERN void XSetWindowBorderPixmap _ANSI_ARGS_((Display* d,
+ Window w, Pixmap p));
+/* 52 */
+EXTERN void XSetWindowBorderWidth _ANSI_ARGS_((Display* d,
+ Window w, unsigned int ui));
+/* 53 */
+EXTERN void XSetWindowColormap _ANSI_ARGS_((Display* d, Window w,
+ Colormap c));
+/* 54 */
+EXTERN void XUngrabKeyboard _ANSI_ARGS_((Display* d, Time t));
+/* 55 */
+EXTERN void XUngrabPointer _ANSI_ARGS_((Display* d, Time t));
+/* 56 */
+EXTERN void XUnmapWindow _ANSI_ARGS_((Display* d, Window w));
+/* 57 */
+EXTERN void TkPutImage _ANSI_ARGS_((unsigned long * colors,
+ int ncolors, Display* display, Drawable d,
+ GC gc, XImage* image, int src_x, int src_y,
+ int dest_x, int dest_y, unsigned int width,
+ unsigned int height));
+/* 58 */
+EXTERN Status XParseColor _ANSI_ARGS_((Display * display,
+ Colormap map, _Xconst char* spec,
+ XColor * colorPtr));
+/* 59 */
+EXTERN GC XCreateGC _ANSI_ARGS_((Display* display, Drawable d,
+ unsigned long valuemask, XGCValues* values));
+/* 60 */
+EXTERN void XFreeGC _ANSI_ARGS_((Display* display, GC gc));
+/* 61 */
+EXTERN Atom XInternAtom _ANSI_ARGS_((Display* display,
+ _Xconst char* atom_name, Bool only_if_exists));
+/* 62 */
+EXTERN void XSetBackground _ANSI_ARGS_((Display* display, GC gc,
+ unsigned long foreground));
+/* 63 */
+EXTERN void XSetForeground _ANSI_ARGS_((Display* display, GC gc,
+ unsigned long foreground));
+/* 64 */
+EXTERN void XSetClipMask _ANSI_ARGS_((Display* display, GC gc,
+ Pixmap pixmap));
+/* 65 */
+EXTERN void XSetClipOrigin _ANSI_ARGS_((Display* display, GC gc,
+ int clip_x_origin, int clip_y_origin));
+/* 66 */
+EXTERN void XSetTSOrigin _ANSI_ARGS_((Display* display, GC gc,
+ int ts_x_origin, int ts_y_origin));
+/* 67 */
+EXTERN void XChangeGC _ANSI_ARGS_((Display * d, GC gc,
+ unsigned long mask, XGCValues * values));
+/* 68 */
+EXTERN void XSetFont _ANSI_ARGS_((Display * display, GC gc,
+ Font font));
+/* 69 */
+EXTERN void XSetArcMode _ANSI_ARGS_((Display * display, GC gc,
+ int arc_mode));
+/* 70 */
+EXTERN void XSetStipple _ANSI_ARGS_((Display * display, GC gc,
+ Pixmap stipple));
+/* 71 */
+EXTERN void XSetFillRule _ANSI_ARGS_((Display * display, GC gc,
+ int fill_rule));
+/* 72 */
+EXTERN void XSetFillStyle _ANSI_ARGS_((Display * display, GC gc,
+ int fill_style));
+/* 73 */
+EXTERN void XSetFunction _ANSI_ARGS_((Display * display, GC gc,
+ int function));
+/* 74 */
+EXTERN void XSetLineAttributes _ANSI_ARGS_((Display * display,
+ GC gc, unsigned int line_width,
+ int line_style, int cap_style,
+ int join_style));
+/* 75 */
+EXTERN int _XInitImageFuncPtrs _ANSI_ARGS_((XImage * image));
+/* 76 */
+EXTERN XIC XCreateIC _ANSI_ARGS_((void));
+/* 77 */
+EXTERN XVisualInfo * XGetVisualInfo _ANSI_ARGS_((Display* display,
+ long vinfo_mask, XVisualInfo* vinfo_template,
+ int* nitems_return));
+/* 78 */
+EXTERN void XSetWMClientMachine _ANSI_ARGS_((Display* display,
+ Window w, XTextProperty* text_prop));
+/* 79 */
+EXTERN Status XStringListToTextProperty _ANSI_ARGS_((char** list,
+ int count, XTextProperty* text_prop_return));
+/* 80 */
+EXTERN void XDrawSegments _ANSI_ARGS_((Display * display,
+ Drawable d, GC gc, XSegment * segments,
+ int nsegments));
+/* 81 */
+EXTERN void XForceScreenSaver _ANSI_ARGS_((Display* display,
+ int mode));
+/* 82 */
+EXTERN void XDrawLine _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int x1, int y1, int x2, int y2));
+/* 83 */
+EXTERN void XFillRectangle _ANSI_ARGS_((Display* display,
+ Drawable d, GC gc, int x, int y,
+ unsigned int width, unsigned int height));
+/* 84 */
+EXTERN void XClearWindow _ANSI_ARGS_((Display* d, Window w));
+/* 85 */
+EXTERN void XDrawPoint _ANSI_ARGS_((Display* display, Drawable d,
+ GC gc, int x, int y));
+/* 86 */
+EXTERN void XDrawPoints _ANSI_ARGS_((Display* display,
+ Drawable d, GC gc, XPoint * points,
+ int npoints, int mode));
+/* 87 */
+EXTERN void XWarpPointer _ANSI_ARGS_((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));
+/* 88 */
+EXTERN void XQueryColor _ANSI_ARGS_((Display * display,
+ Colormap colormap, XColor * def_in_out));
+/* 89 */
+EXTERN void XQueryColors _ANSI_ARGS_((Display * display,
+ Colormap colormap, XColor * defs_in_out,
+ int ncolors));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 0 */
+EXTERN void XSetDashes _ANSI_ARGS_((Display* display, GC gc,
+ int dash_offset, _Xconst char* dash_list,
+ int n));
+/* 1 */
+EXTERN XModifierKeymap* XGetModifierMapping _ANSI_ARGS_((Display* d));
+/* 2 */
+EXTERN XImage * XCreateImage _ANSI_ARGS_((Display* d, Visual* v,
+ unsigned int ui1, int i1, int i2, char* cp,
+ unsigned int ui2, unsigned int ui3, int i3,
+ int i4));
+/* 3 */
+EXTERN XImage * XGetImage _ANSI_ARGS_((Display* d, Drawable dr,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, unsigned long ul, int i3));
+/* 4 */
+EXTERN char * XGetAtomName _ANSI_ARGS_((Display* d, Atom a));
+/* 5 */
+EXTERN char * XKeysymToString _ANSI_ARGS_((KeySym k));
+/* 6 */
+EXTERN Colormap XCreateColormap _ANSI_ARGS_((Display* d, Window w,
+ Visual* v, int i));
+/* 7 */
+EXTERN GContext XGContextFromGC _ANSI_ARGS_((GC g));
+/* 8 */
+EXTERN KeySym XKeycodeToKeysym _ANSI_ARGS_((Display* d, KeyCode k,
+ int i));
+/* 9 */
+EXTERN KeySym XStringToKeysym _ANSI_ARGS_((_Xconst char* c));
+/* 10 */
+EXTERN Window XRootWindow _ANSI_ARGS_((Display* d, int i));
+/* 11 */
+EXTERN XErrorHandler XSetErrorHandler _ANSI_ARGS_((XErrorHandler x));
+/* 12 */
+EXTERN Status XAllocColor _ANSI_ARGS_((Display* d, Colormap c,
+ XColor* xp));
+/* 13 */
+EXTERN void XBell _ANSI_ARGS_((Display* d, int i));
+/* 14 */
+EXTERN void XChangeProperty _ANSI_ARGS_((Display* d, Window w,
+ Atom a1, Atom a2, int i1, int i2,
+ _Xconst unsigned char* c, int i3));
+/* 15 */
+EXTERN void XChangeWindowAttributes _ANSI_ARGS_((Display* d,
+ Window w, unsigned long ul,
+ XSetWindowAttributes* x));
+/* 16 */
+EXTERN void XConfigureWindow _ANSI_ARGS_((Display* d, Window w,
+ unsigned int i, XWindowChanges* x));
+/* 17 */
+EXTERN void XCopyArea _ANSI_ARGS_((Display* d, Drawable dr1,
+ Drawable dr2, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3,
+ int i4));
+/* 18 */
+EXTERN void XCopyPlane _ANSI_ARGS_((Display* d, Drawable dr1,
+ Drawable dr2, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3,
+ int i4, unsigned long ul));
+/* 19 */
+EXTERN Pixmap XCreateBitmapFromData _ANSI_ARGS_((Display* display,
+ Drawable d, _Xconst char* data,
+ unsigned int width, unsigned int height));
+/* 20 */
+EXTERN void XDefineCursor _ANSI_ARGS_((Display* d, Window w,
+ Cursor c));
+/* 21 */
+EXTERN void XDestroyWindow _ANSI_ARGS_((Display* d, Window w));
+/* 22 */
+EXTERN void XDrawArc _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4));
+/* 23 */
+EXTERN void XDrawLines _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XPoint* x, int i1, int i2));
+/* 24 */
+EXTERN void XDrawRectangle _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, int i1, int i2, unsigned int ui1,
+ unsigned int ui2));
+/* 25 */
+EXTERN void XFillArc _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4));
+/* 26 */
+EXTERN void XFillPolygon _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XPoint* x, int i1, int i2, int i3));
+/* 27 */
+EXTERN void XFillRectangles _ANSI_ARGS_((Display* d, Drawable dr,
+ GC g, XRectangle* x, int i));
+/* 28 */
+EXTERN void XFreeColormap _ANSI_ARGS_((Display* d, Colormap c));
+/* 29 */
+EXTERN void XFreeColors _ANSI_ARGS_((Display* d, Colormap c,
+ unsigned long* ulp, int i, unsigned long ul));
+/* 30 */
+EXTERN void XFreeModifiermap _ANSI_ARGS_((XModifierKeymap* x));
+/* 31 */
+EXTERN Status XGetGeometry _ANSI_ARGS_((Display* d, Drawable dr,
+ Window* w, int* i1, int* i2,
+ unsigned int* ui1, unsigned int* ui2,
+ unsigned int* ui3, unsigned int* ui4));
+/* 32 */
+EXTERN int XGetWindowProperty _ANSI_ARGS_((Display* d, Window w,
+ Atom a1, long l1, long l2, Bool b, Atom a2,
+ Atom* ap, int* ip, unsigned long* ulp1,
+ unsigned long* ulp2, unsigned char** cpp));
+/* 33 */
+EXTERN int XGrabKeyboard _ANSI_ARGS_((Display* d, Window w,
+ Bool b, int i1, int i2, Time t));
+/* 34 */
+EXTERN int XGrabPointer _ANSI_ARGS_((Display* d, Window w1,
+ Bool b, unsigned int ui, int i1, int i2,
+ Window w2, Cursor c, Time t));
+/* 35 */
+EXTERN KeyCode XKeysymToKeycode _ANSI_ARGS_((Display* d, KeySym k));
+/* 36 */
+EXTERN void XMapWindow _ANSI_ARGS_((Display* d, Window w));
+/* 37 */
+EXTERN void XMoveResizeWindow _ANSI_ARGS_((Display* d, Window w,
+ int i1, int i2, unsigned int ui1,
+ unsigned int ui2));
+/* 38 */
+EXTERN void XMoveWindow _ANSI_ARGS_((Display* d, Window w,
+ int i1, int i2));
+/* 39 */
+EXTERN Bool XQueryPointer _ANSI_ARGS_((Display* d, Window w1,
+ Window* w2, Window* w3, int* i1, int* i2,
+ int* i3, int* i4, unsigned int* ui));
+/* 40 */
+EXTERN void XRaiseWindow _ANSI_ARGS_((Display* d, Window w));
+/* 41 */
+EXTERN void XRefreshKeyboardMapping _ANSI_ARGS_((
+ XMappingEvent* x));
+/* 42 */
+EXTERN void XResizeWindow _ANSI_ARGS_((Display* d, Window w,
+ unsigned int ui1, unsigned int ui2));
+/* 43 */
+EXTERN void XSelectInput _ANSI_ARGS_((Display* d, Window w,
+ long l));
+/* 44 */
+EXTERN Status XSendEvent _ANSI_ARGS_((Display* d, Window w, Bool b,
+ long l, XEvent* x));
+/* 45 */
+EXTERN void XSetIconName _ANSI_ARGS_((Display* d, Window w,
+ _Xconst char* c));
+/* 46 */
+EXTERN void XSetInputFocus _ANSI_ARGS_((Display* d, Window w,
+ int i, Time t));
+/* 47 */
+EXTERN void XSetSelectionOwner _ANSI_ARGS_((Display* d, Atom a,
+ Window w, Time t));
+/* 48 */
+EXTERN void XSetWindowBackground _ANSI_ARGS_((Display* d,
+ Window w, unsigned long ul));
+/* 49 */
+EXTERN void XSetWindowBackgroundPixmap _ANSI_ARGS_((Display* d,
+ Window w, Pixmap p));
+/* 50 */
+EXTERN void XSetWindowBorder _ANSI_ARGS_((Display* d, Window w,
+ unsigned long ul));
+/* 51 */
+EXTERN void XSetWindowBorderPixmap _ANSI_ARGS_((Display* d,
+ Window w, Pixmap p));
+/* 52 */
+EXTERN void XSetWindowBorderWidth _ANSI_ARGS_((Display* d,
+ Window w, unsigned int ui));
+/* 53 */
+EXTERN void XSetWindowColormap _ANSI_ARGS_((Display* d, Window w,
+ Colormap c));
+/* 54 */
+EXTERN void XUngrabKeyboard _ANSI_ARGS_((Display* d, Time t));
+/* 55 */
+EXTERN void XUngrabPointer _ANSI_ARGS_((Display* d, Time t));
+/* 56 */
+EXTERN void XUnmapWindow _ANSI_ARGS_((Display* d, Window w));
+/* 57 */
+EXTERN void TkPutImage _ANSI_ARGS_((unsigned long * colors,
+ int ncolors, Display* display, Drawable d,
+ GC gc, XImage* image, int src_x, int src_y,
+ int dest_x, int dest_y, unsigned int width,
+ unsigned int height));
+/* 58 */
+EXTERN Status XParseColor _ANSI_ARGS_((Display * display,
+ Colormap map, _Xconst char* spec,
+ XColor * colorPtr));
+/* 59 */
+EXTERN GC XCreateGC _ANSI_ARGS_((Display* display, Drawable d,
+ unsigned long valuemask, XGCValues* values));
+/* 60 */
+EXTERN void XFreeGC _ANSI_ARGS_((Display* display, GC gc));
+/* 61 */
+EXTERN Atom XInternAtom _ANSI_ARGS_((Display* display,
+ _Xconst char* atom_name, Bool only_if_exists));
+/* 62 */
+EXTERN void XSetBackground _ANSI_ARGS_((Display* display, GC gc,
+ unsigned long foreground));
+/* 63 */
+EXTERN void XSetForeground _ANSI_ARGS_((Display* display, GC gc,
+ unsigned long foreground));
+/* 64 */
+EXTERN void XSetClipMask _ANSI_ARGS_((Display* display, GC gc,
+ Pixmap pixmap));
+/* 65 */
+EXTERN void XSetClipOrigin _ANSI_ARGS_((Display* display, GC gc,
+ int clip_x_origin, int clip_y_origin));
+/* 66 */
+EXTERN void XSetTSOrigin _ANSI_ARGS_((Display* display, GC gc,
+ int ts_x_origin, int ts_y_origin));
+/* 67 */
+EXTERN void XChangeGC _ANSI_ARGS_((Display * d, GC gc,
+ unsigned long mask, XGCValues * values));
+/* 68 */
+EXTERN void XSetFont _ANSI_ARGS_((Display * display, GC gc,
+ Font font));
+/* 69 */
+EXTERN void XSetArcMode _ANSI_ARGS_((Display * display, GC gc,
+ int arc_mode));
+/* 70 */
+EXTERN void XSetStipple _ANSI_ARGS_((Display * display, GC gc,
+ Pixmap stipple));
+/* 71 */
+EXTERN void XSetFillRule _ANSI_ARGS_((Display * display, GC gc,
+ int fill_rule));
+/* 72 */
+EXTERN void XSetFillStyle _ANSI_ARGS_((Display * display, GC gc,
+ int fill_style));
+/* 73 */
+EXTERN void XSetFunction _ANSI_ARGS_((Display * display, GC gc,
+ int function));
+/* 74 */
+EXTERN void XSetLineAttributes _ANSI_ARGS_((Display * display,
+ GC gc, unsigned int line_width,
+ int line_style, int cap_style,
+ int join_style));
+/* 75 */
+EXTERN int _XInitImageFuncPtrs _ANSI_ARGS_((XImage * image));
+/* 76 */
+EXTERN XIC XCreateIC _ANSI_ARGS_((void));
+/* 77 */
+EXTERN XVisualInfo * XGetVisualInfo _ANSI_ARGS_((Display* display,
+ long vinfo_mask, XVisualInfo* vinfo_template,
+ int* nitems_return));
+/* 78 */
+EXTERN void XSetWMClientMachine _ANSI_ARGS_((Display* display,
+ Window w, XTextProperty* text_prop));
+/* 79 */
+EXTERN Status XStringListToTextProperty _ANSI_ARGS_((char** list,
+ int count, XTextProperty* text_prop_return));
+/* 80 */
+EXTERN void XDrawSegments _ANSI_ARGS_((Display * display,
+ Drawable d, GC gc, XSegment * segments,
+ int nsegments));
+/* 81 */
+EXTERN void XForceScreenSaver _ANSI_ARGS_((Display* display,
+ int mode));
+/* 82 */
+EXTERN void XDrawLine _ANSI_ARGS_((Display* d, Drawable dr, GC g,
+ int x1, int y1, int x2, int y2));
+/* 83 */
+EXTERN void XFillRectangle _ANSI_ARGS_((Display* display,
+ Drawable d, GC gc, int x, int y,
+ unsigned int width, unsigned int height));
+/* 84 */
+EXTERN void XClearWindow _ANSI_ARGS_((Display* d, Window w));
+/* 85 */
+EXTERN void XDrawPoint _ANSI_ARGS_((Display* display, Drawable d,
+ GC gc, int x, int y));
+/* 86 */
+EXTERN void XDrawPoints _ANSI_ARGS_((Display* display,
+ Drawable d, GC gc, XPoint * points,
+ int npoints, int mode));
+/* 87 */
+EXTERN void XWarpPointer _ANSI_ARGS_((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));
+/* 88 */
+EXTERN void XQueryColor _ANSI_ARGS_((Display * display,
+ Colormap colormap, XColor * def_in_out));
+/* 89 */
+EXTERN void XQueryColors _ANSI_ARGS_((Display * display,
+ Colormap colormap, XColor * defs_in_out,
+ int ncolors));
+#endif /* MAC_OSX_TK */
+
+typedef struct TkIntXlibStubs {
+ int magic;
+ struct TkIntXlibStubHooks *hooks;
+
+#ifdef __WIN32__
+ void (*xSetDashes) _ANSI_ARGS_((Display* display, GC gc, int dash_offset, _Xconst char* dash_list, int n)); /* 0 */
+ XModifierKeymap* (*xGetModifierMapping) _ANSI_ARGS_((Display* d)); /* 1 */
+ XImage * (*xCreateImage) _ANSI_ARGS_((Display* d, Visual* v, unsigned int ui1, int i1, int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, int i4)); /* 2 */
+ XImage * (*xGetImage) _ANSI_ARGS_((Display* d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)); /* 3 */
+ char * (*xGetAtomName) _ANSI_ARGS_((Display* d, Atom a)); /* 4 */
+ char * (*xKeysymToString) _ANSI_ARGS_((KeySym k)); /* 5 */
+ Colormap (*xCreateColormap) _ANSI_ARGS_((Display* d, Window w, Visual* v, int i)); /* 6 */
+ Cursor (*xCreatePixmapCursor) _ANSI_ARGS_((Display* d, Pixmap p1, Pixmap p2, XColor* x1, XColor* x2, unsigned int ui1, unsigned int ui2)); /* 7 */
+ Cursor (*xCreateGlyphCursor) _ANSI_ARGS_((Display* d, Font f1, Font f2, unsigned int ui1, unsigned int ui2, XColor* x1, XColor* x2)); /* 8 */
+ GContext (*xGContextFromGC) _ANSI_ARGS_((GC g)); /* 9 */
+ XHostAddress * (*xListHosts) _ANSI_ARGS_((Display* d, int* i, Bool* b)); /* 10 */
+ KeySym (*xKeycodeToKeysym) _ANSI_ARGS_((Display* d, unsigned int k, int i)); /* 11 */
+ KeySym (*xStringToKeysym) _ANSI_ARGS_((_Xconst char* c)); /* 12 */
+ Window (*xRootWindow) _ANSI_ARGS_((Display* d, int i)); /* 13 */
+ XErrorHandler (*xSetErrorHandler) _ANSI_ARGS_((XErrorHandler x)); /* 14 */
+ Status (*xIconifyWindow) _ANSI_ARGS_((Display* d, Window w, int i)); /* 15 */
+ Status (*xWithdrawWindow) _ANSI_ARGS_((Display* d, Window w, int i)); /* 16 */
+ Status (*xGetWMColormapWindows) _ANSI_ARGS_((Display* d, Window w, Window** wpp, int* ip)); /* 17 */
+ Status (*xAllocColor) _ANSI_ARGS_((Display* d, Colormap c, XColor* xp)); /* 18 */
+ void (*xBell) _ANSI_ARGS_((Display* d, int i)); /* 19 */
+ void (*xChangeProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char* c, int i3)); /* 20 */
+ void (*xChangeWindowAttributes) _ANSI_ARGS_((Display* d, Window w, unsigned long ul, XSetWindowAttributes* x)); /* 21 */
+ void (*xClearWindow) _ANSI_ARGS_((Display* d, Window w)); /* 22 */
+ void (*xConfigureWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int i, XWindowChanges* x)); /* 23 */
+ void (*xCopyArea) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 24 */
+ void (*xCopyPlane) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4, unsigned long ul)); /* 25 */
+ Pixmap (*xCreateBitmapFromData) _ANSI_ARGS_((Display* display, Drawable d, _Xconst char* data, unsigned int width, unsigned int height)); /* 26 */
+ void (*xDefineCursor) _ANSI_ARGS_((Display* d, Window w, Cursor c)); /* 27 */
+ void (*xDeleteProperty) _ANSI_ARGS_((Display* d, Window w, Atom a)); /* 28 */
+ void (*xDestroyWindow) _ANSI_ARGS_((Display* d, Window w)); /* 29 */
+ void (*xDrawArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 30 */
+ void (*xDrawLines) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)); /* 31 */
+ void (*xDrawRectangle) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 32 */
+ void (*xFillArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 33 */
+ void (*xFillPolygon) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2, int i3)); /* 34 */
+ void (*xFillRectangles) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XRectangle* x, int i)); /* 35 */
+ void (*xForceScreenSaver) _ANSI_ARGS_((Display* d, int i)); /* 36 */
+ void (*xFreeColormap) _ANSI_ARGS_((Display* d, Colormap c)); /* 37 */
+ void (*xFreeColors) _ANSI_ARGS_((Display* d, Colormap c, unsigned long* ulp, int i, unsigned long ul)); /* 38 */
+ void (*xFreeCursor) _ANSI_ARGS_((Display* d, Cursor c)); /* 39 */
+ void (*xFreeModifiermap) _ANSI_ARGS_((XModifierKeymap* x)); /* 40 */
+ Status (*xGetGeometry) _ANSI_ARGS_((Display* d, Drawable dr, Window* w, int* i1, int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, unsigned int* ui4)); /* 41 */
+ void (*xGetInputFocus) _ANSI_ARGS_((Display* d, Window* w, int* i)); /* 42 */
+ int (*xGetWindowProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, long l1, long l2, Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, unsigned long* ulp2, unsigned char** cpp)); /* 43 */
+ Status (*xGetWindowAttributes) _ANSI_ARGS_((Display* d, Window w, XWindowAttributes* x)); /* 44 */
+ int (*xGrabKeyboard) _ANSI_ARGS_((Display* d, Window w, Bool b, int i1, int i2, Time t)); /* 45 */
+ int (*xGrabPointer) _ANSI_ARGS_((Display* d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t)); /* 46 */
+ KeyCode (*xKeysymToKeycode) _ANSI_ARGS_((Display* d, KeySym k)); /* 47 */
+ Status (*xLookupColor) _ANSI_ARGS_((Display* d, Colormap c1, _Xconst char* c2, XColor* x1, XColor* x2)); /* 48 */
+ void (*xMapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 49 */
+ void (*xMoveResizeWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 50 */
+ void (*xMoveWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2)); /* 51 */
+ void (*xNextEvent) _ANSI_ARGS_((Display* d, XEvent* x)); /* 52 */
+ void (*xPutBackEvent) _ANSI_ARGS_((Display* d, XEvent* x)); /* 53 */
+ void (*xQueryColors) _ANSI_ARGS_((Display* d, Colormap c, XColor* x, int i)); /* 54 */
+ Bool (*xQueryPointer) _ANSI_ARGS_((Display* d, Window w1, Window* w2, Window* w3, int* i1, int* i2, int* i3, int* i4, unsigned int* ui)); /* 55 */
+ Status (*xQueryTree) _ANSI_ARGS_((Display* d, Window w1, Window* w2, Window* w3, Window** w4, unsigned int* ui)); /* 56 */
+ void (*xRaiseWindow) _ANSI_ARGS_((Display* d, Window w)); /* 57 */
+ void (*xRefreshKeyboardMapping) _ANSI_ARGS_((XMappingEvent* x)); /* 58 */
+ void (*xResizeWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int ui1, unsigned int ui2)); /* 59 */
+ void (*xSelectInput) _ANSI_ARGS_((Display* d, Window w, long l)); /* 60 */
+ Status (*xSendEvent) _ANSI_ARGS_((Display* d, Window w, Bool b, long l, XEvent* x)); /* 61 */
+ void (*xSetCommand) _ANSI_ARGS_((Display* d, Window w, CONST char** c, int i)); /* 62 */
+ void (*xSetIconName) _ANSI_ARGS_((Display* d, Window w, _Xconst char* c)); /* 63 */
+ void (*xSetInputFocus) _ANSI_ARGS_((Display* d, Window w, int i, Time t)); /* 64 */
+ void (*xSetSelectionOwner) _ANSI_ARGS_((Display* d, Atom a, Window w, Time t)); /* 65 */
+ void (*xSetWindowBackground) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 66 */
+ void (*xSetWindowBackgroundPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 67 */
+ void (*xSetWindowBorder) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 68 */
+ void (*xSetWindowBorderPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 69 */
+ void (*xSetWindowBorderWidth) _ANSI_ARGS_((Display* d, Window w, unsigned int ui)); /* 70 */
+ void (*xSetWindowColormap) _ANSI_ARGS_((Display* d, Window w, Colormap c)); /* 71 */
+ Bool (*xTranslateCoordinates) _ANSI_ARGS_((Display* d, Window w1, Window w2, int i1, int i2, int* i3, int* i4, Window* w3)); /* 72 */
+ void (*xUngrabKeyboard) _ANSI_ARGS_((Display* d, Time t)); /* 73 */
+ void (*xUngrabPointer) _ANSI_ARGS_((Display* d, Time t)); /* 74 */
+ void (*xUnmapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 75 */
+ void (*xWindowEvent) _ANSI_ARGS_((Display* d, Window w, long l, XEvent* x)); /* 76 */
+ void (*xDestroyIC) _ANSI_ARGS_((XIC x)); /* 77 */
+ Bool (*xFilterEvent) _ANSI_ARGS_((XEvent* x, Window w)); /* 78 */
+ int (*xmbLookupString) _ANSI_ARGS_((XIC xi, XKeyPressedEvent* xk, char* c, int i, KeySym* k, Status* s)); /* 79 */
+ void (*tkPutImage) _ANSI_ARGS_((unsigned long * colors, int ncolors, Display* display, Drawable d, GC gc, XImage* image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height)); /* 80 */
+ void *reserved81;
+ Status (*xParseColor) _ANSI_ARGS_((Display * display, Colormap map, _Xconst char* spec, XColor * colorPtr)); /* 82 */
+ GC (*xCreateGC) _ANSI_ARGS_((Display* display, Drawable d, unsigned long valuemask, XGCValues* values)); /* 83 */
+ void (*xFreeGC) _ANSI_ARGS_((Display* display, GC gc)); /* 84 */
+ Atom (*xInternAtom) _ANSI_ARGS_((Display* display, _Xconst char* atom_name, Bool only_if_exists)); /* 85 */
+ void (*xSetBackground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 86 */
+ void (*xSetForeground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 87 */
+ void (*xSetClipMask) _ANSI_ARGS_((Display* display, GC gc, Pixmap pixmap)); /* 88 */
+ void (*xSetClipOrigin) _ANSI_ARGS_((Display* display, GC gc, int clip_x_origin, int clip_y_origin)); /* 89 */
+ void (*xSetTSOrigin) _ANSI_ARGS_((Display* display, GC gc, int ts_x_origin, int ts_y_origin)); /* 90 */
+ void (*xChangeGC) _ANSI_ARGS_((Display * d, GC gc, unsigned long mask, XGCValues * values)); /* 91 */
+ void (*xSetFont) _ANSI_ARGS_((Display * display, GC gc, Font font)); /* 92 */
+ void (*xSetArcMode) _ANSI_ARGS_((Display * display, GC gc, int arc_mode)); /* 93 */
+ void (*xSetStipple) _ANSI_ARGS_((Display * display, GC gc, Pixmap stipple)); /* 94 */
+ void (*xSetFillRule) _ANSI_ARGS_((Display * display, GC gc, int fill_rule)); /* 95 */
+ void (*xSetFillStyle) _ANSI_ARGS_((Display * display, GC gc, int fill_style)); /* 96 */
+ void (*xSetFunction) _ANSI_ARGS_((Display * display, GC gc, int function)); /* 97 */
+ void (*xSetLineAttributes) _ANSI_ARGS_((Display * display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style)); /* 98 */
+ int (*_XInitImageFuncPtrs) _ANSI_ARGS_((XImage * image)); /* 99 */
+ XIC (*xCreateIC) _ANSI_ARGS_((void)); /* 100 */
+ XVisualInfo * (*xGetVisualInfo) _ANSI_ARGS_((Display* display, long vinfo_mask, XVisualInfo* vinfo_template, int* nitems_return)); /* 101 */
+ void (*xSetWMClientMachine) _ANSI_ARGS_((Display* display, Window w, XTextProperty* text_prop)); /* 102 */
+ Status (*xStringListToTextProperty) _ANSI_ARGS_((char** list, int count, XTextProperty* text_prop_return)); /* 103 */
+ void (*xDrawLine) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int x1, int y1, int x2, int y2)); /* 104 */
+ void (*xWarpPointer) _ANSI_ARGS_((Display* d, Window s, Window dw, int sx, int sy, unsigned int sw, unsigned int sh, int dx, int dy)); /* 105 */
+ void (*xFillRectangle) _ANSI_ARGS_((Display* display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height)); /* 106 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*xSetDashes) _ANSI_ARGS_((Display* display, GC gc, int dash_offset, _Xconst char* dash_list, int n)); /* 0 */
+ XModifierKeymap* (*xGetModifierMapping) _ANSI_ARGS_((Display* d)); /* 1 */
+ XImage * (*xCreateImage) _ANSI_ARGS_((Display* d, Visual* v, unsigned int ui1, int i1, int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, int i4)); /* 2 */
+ XImage * (*xGetImage) _ANSI_ARGS_((Display* d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)); /* 3 */
+ char * (*xGetAtomName) _ANSI_ARGS_((Display* d, Atom a)); /* 4 */
+ char * (*xKeysymToString) _ANSI_ARGS_((KeySym k)); /* 5 */
+ Colormap (*xCreateColormap) _ANSI_ARGS_((Display* d, Window w, Visual* v, int i)); /* 6 */
+ GContext (*xGContextFromGC) _ANSI_ARGS_((GC g)); /* 7 */
+ KeySym (*xKeycodeToKeysym) _ANSI_ARGS_((Display* d, KeyCode k, int i)); /* 8 */
+ KeySym (*xStringToKeysym) _ANSI_ARGS_((_Xconst char* c)); /* 9 */
+ Window (*xRootWindow) _ANSI_ARGS_((Display* d, int i)); /* 10 */
+ XErrorHandler (*xSetErrorHandler) _ANSI_ARGS_((XErrorHandler x)); /* 11 */
+ Status (*xAllocColor) _ANSI_ARGS_((Display* d, Colormap c, XColor* xp)); /* 12 */
+ void (*xBell) _ANSI_ARGS_((Display* d, int i)); /* 13 */
+ void (*xChangeProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char* c, int i3)); /* 14 */
+ void (*xChangeWindowAttributes) _ANSI_ARGS_((Display* d, Window w, unsigned long ul, XSetWindowAttributes* x)); /* 15 */
+ void (*xConfigureWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int i, XWindowChanges* x)); /* 16 */
+ void (*xCopyArea) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 17 */
+ void (*xCopyPlane) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4, unsigned long ul)); /* 18 */
+ Pixmap (*xCreateBitmapFromData) _ANSI_ARGS_((Display* display, Drawable d, _Xconst char* data, unsigned int width, unsigned int height)); /* 19 */
+ void (*xDefineCursor) _ANSI_ARGS_((Display* d, Window w, Cursor c)); /* 20 */
+ void (*xDestroyWindow) _ANSI_ARGS_((Display* d, Window w)); /* 21 */
+ void (*xDrawArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 22 */
+ void (*xDrawLines) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)); /* 23 */
+ void (*xDrawRectangle) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 24 */
+ void (*xFillArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 25 */
+ void (*xFillPolygon) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2, int i3)); /* 26 */
+ void (*xFillRectangles) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XRectangle* x, int i)); /* 27 */
+ void (*xFreeColormap) _ANSI_ARGS_((Display* d, Colormap c)); /* 28 */
+ void (*xFreeColors) _ANSI_ARGS_((Display* d, Colormap c, unsigned long* ulp, int i, unsigned long ul)); /* 29 */
+ void (*xFreeModifiermap) _ANSI_ARGS_((XModifierKeymap* x)); /* 30 */
+ Status (*xGetGeometry) _ANSI_ARGS_((Display* d, Drawable dr, Window* w, int* i1, int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, unsigned int* ui4)); /* 31 */
+ int (*xGetWindowProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, long l1, long l2, Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, unsigned long* ulp2, unsigned char** cpp)); /* 32 */
+ int (*xGrabKeyboard) _ANSI_ARGS_((Display* d, Window w, Bool b, int i1, int i2, Time t)); /* 33 */
+ int (*xGrabPointer) _ANSI_ARGS_((Display* d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t)); /* 34 */
+ KeyCode (*xKeysymToKeycode) _ANSI_ARGS_((Display* d, KeySym k)); /* 35 */
+ void (*xMapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 36 */
+ void (*xMoveResizeWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 37 */
+ void (*xMoveWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2)); /* 38 */
+ Bool (*xQueryPointer) _ANSI_ARGS_((Display* d, Window w1, Window* w2, Window* w3, int* i1, int* i2, int* i3, int* i4, unsigned int* ui)); /* 39 */
+ void (*xRaiseWindow) _ANSI_ARGS_((Display* d, Window w)); /* 40 */
+ void (*xRefreshKeyboardMapping) _ANSI_ARGS_((XMappingEvent* x)); /* 41 */
+ void (*xResizeWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int ui1, unsigned int ui2)); /* 42 */
+ void (*xSelectInput) _ANSI_ARGS_((Display* d, Window w, long l)); /* 43 */
+ Status (*xSendEvent) _ANSI_ARGS_((Display* d, Window w, Bool b, long l, XEvent* x)); /* 44 */
+ void (*xSetIconName) _ANSI_ARGS_((Display* d, Window w, _Xconst char* c)); /* 45 */
+ void (*xSetInputFocus) _ANSI_ARGS_((Display* d, Window w, int i, Time t)); /* 46 */
+ void (*xSetSelectionOwner) _ANSI_ARGS_((Display* d, Atom a, Window w, Time t)); /* 47 */
+ void (*xSetWindowBackground) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 48 */
+ void (*xSetWindowBackgroundPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 49 */
+ void (*xSetWindowBorder) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 50 */
+ void (*xSetWindowBorderPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 51 */
+ void (*xSetWindowBorderWidth) _ANSI_ARGS_((Display* d, Window w, unsigned int ui)); /* 52 */
+ void (*xSetWindowColormap) _ANSI_ARGS_((Display* d, Window w, Colormap c)); /* 53 */
+ void (*xUngrabKeyboard) _ANSI_ARGS_((Display* d, Time t)); /* 54 */
+ void (*xUngrabPointer) _ANSI_ARGS_((Display* d, Time t)); /* 55 */
+ void (*xUnmapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 56 */
+ void (*tkPutImage) _ANSI_ARGS_((unsigned long * colors, int ncolors, Display* display, Drawable d, GC gc, XImage* image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height)); /* 57 */
+ Status (*xParseColor) _ANSI_ARGS_((Display * display, Colormap map, _Xconst char* spec, XColor * colorPtr)); /* 58 */
+ GC (*xCreateGC) _ANSI_ARGS_((Display* display, Drawable d, unsigned long valuemask, XGCValues* values)); /* 59 */
+ void (*xFreeGC) _ANSI_ARGS_((Display* display, GC gc)); /* 60 */
+ Atom (*xInternAtom) _ANSI_ARGS_((Display* display, _Xconst char* atom_name, Bool only_if_exists)); /* 61 */
+ void (*xSetBackground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 62 */
+ void (*xSetForeground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 63 */
+ void (*xSetClipMask) _ANSI_ARGS_((Display* display, GC gc, Pixmap pixmap)); /* 64 */
+ void (*xSetClipOrigin) _ANSI_ARGS_((Display* display, GC gc, int clip_x_origin, int clip_y_origin)); /* 65 */
+ void (*xSetTSOrigin) _ANSI_ARGS_((Display* display, GC gc, int ts_x_origin, int ts_y_origin)); /* 66 */
+ void (*xChangeGC) _ANSI_ARGS_((Display * d, GC gc, unsigned long mask, XGCValues * values)); /* 67 */
+ void (*xSetFont) _ANSI_ARGS_((Display * display, GC gc, Font font)); /* 68 */
+ void (*xSetArcMode) _ANSI_ARGS_((Display * display, GC gc, int arc_mode)); /* 69 */
+ void (*xSetStipple) _ANSI_ARGS_((Display * display, GC gc, Pixmap stipple)); /* 70 */
+ void (*xSetFillRule) _ANSI_ARGS_((Display * display, GC gc, int fill_rule)); /* 71 */
+ void (*xSetFillStyle) _ANSI_ARGS_((Display * display, GC gc, int fill_style)); /* 72 */
+ void (*xSetFunction) _ANSI_ARGS_((Display * display, GC gc, int function)); /* 73 */
+ void (*xSetLineAttributes) _ANSI_ARGS_((Display * display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style)); /* 74 */
+ int (*_XInitImageFuncPtrs) _ANSI_ARGS_((XImage * image)); /* 75 */
+ XIC (*xCreateIC) _ANSI_ARGS_((void)); /* 76 */
+ XVisualInfo * (*xGetVisualInfo) _ANSI_ARGS_((Display* display, long vinfo_mask, XVisualInfo* vinfo_template, int* nitems_return)); /* 77 */
+ void (*xSetWMClientMachine) _ANSI_ARGS_((Display* display, Window w, XTextProperty* text_prop)); /* 78 */
+ Status (*xStringListToTextProperty) _ANSI_ARGS_((char** list, int count, XTextProperty* text_prop_return)); /* 79 */
+ void (*xDrawSegments) _ANSI_ARGS_((Display * display, Drawable d, GC gc, XSegment * segments, int nsegments)); /* 80 */
+ void (*xForceScreenSaver) _ANSI_ARGS_((Display* display, int mode)); /* 81 */
+ void (*xDrawLine) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int x1, int y1, int x2, int y2)); /* 82 */
+ void (*xFillRectangle) _ANSI_ARGS_((Display* display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height)); /* 83 */
+ void (*xClearWindow) _ANSI_ARGS_((Display* d, Window w)); /* 84 */
+ void (*xDrawPoint) _ANSI_ARGS_((Display* display, Drawable d, GC gc, int x, int y)); /* 85 */
+ void (*xDrawPoints) _ANSI_ARGS_((Display* display, Drawable d, GC gc, XPoint * points, int npoints, int mode)); /* 86 */
+ void (*xWarpPointer) _ANSI_ARGS_((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)); /* 87 */
+ void (*xQueryColor) _ANSI_ARGS_((Display * display, Colormap colormap, XColor * def_in_out)); /* 88 */
+ void (*xQueryColors) _ANSI_ARGS_((Display * display, Colormap colormap, XColor * defs_in_out, int ncolors)); /* 89 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*xSetDashes) _ANSI_ARGS_((Display* display, GC gc, int dash_offset, _Xconst char* dash_list, int n)); /* 0 */
+ XModifierKeymap* (*xGetModifierMapping) _ANSI_ARGS_((Display* d)); /* 1 */
+ XImage * (*xCreateImage) _ANSI_ARGS_((Display* d, Visual* v, unsigned int ui1, int i1, int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, int i4)); /* 2 */
+ XImage * (*xGetImage) _ANSI_ARGS_((Display* d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)); /* 3 */
+ char * (*xGetAtomName) _ANSI_ARGS_((Display* d, Atom a)); /* 4 */
+ char * (*xKeysymToString) _ANSI_ARGS_((KeySym k)); /* 5 */
+ Colormap (*xCreateColormap) _ANSI_ARGS_((Display* d, Window w, Visual* v, int i)); /* 6 */
+ GContext (*xGContextFromGC) _ANSI_ARGS_((GC g)); /* 7 */
+ KeySym (*xKeycodeToKeysym) _ANSI_ARGS_((Display* d, KeyCode k, int i)); /* 8 */
+ KeySym (*xStringToKeysym) _ANSI_ARGS_((_Xconst char* c)); /* 9 */
+ Window (*xRootWindow) _ANSI_ARGS_((Display* d, int i)); /* 10 */
+ XErrorHandler (*xSetErrorHandler) _ANSI_ARGS_((XErrorHandler x)); /* 11 */
+ Status (*xAllocColor) _ANSI_ARGS_((Display* d, Colormap c, XColor* xp)); /* 12 */
+ void (*xBell) _ANSI_ARGS_((Display* d, int i)); /* 13 */
+ void (*xChangeProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char* c, int i3)); /* 14 */
+ void (*xChangeWindowAttributes) _ANSI_ARGS_((Display* d, Window w, unsigned long ul, XSetWindowAttributes* x)); /* 15 */
+ void (*xConfigureWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int i, XWindowChanges* x)); /* 16 */
+ void (*xCopyArea) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 17 */
+ void (*xCopyPlane) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4, unsigned long ul)); /* 18 */
+ Pixmap (*xCreateBitmapFromData) _ANSI_ARGS_((Display* display, Drawable d, _Xconst char* data, unsigned int width, unsigned int height)); /* 19 */
+ void (*xDefineCursor) _ANSI_ARGS_((Display* d, Window w, Cursor c)); /* 20 */
+ void (*xDestroyWindow) _ANSI_ARGS_((Display* d, Window w)); /* 21 */
+ void (*xDrawArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 22 */
+ void (*xDrawLines) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)); /* 23 */
+ void (*xDrawRectangle) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 24 */
+ void (*xFillArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 25 */
+ void (*xFillPolygon) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2, int i3)); /* 26 */
+ void (*xFillRectangles) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XRectangle* x, int i)); /* 27 */
+ void (*xFreeColormap) _ANSI_ARGS_((Display* d, Colormap c)); /* 28 */
+ void (*xFreeColors) _ANSI_ARGS_((Display* d, Colormap c, unsigned long* ulp, int i, unsigned long ul)); /* 29 */
+ void (*xFreeModifiermap) _ANSI_ARGS_((XModifierKeymap* x)); /* 30 */
+ Status (*xGetGeometry) _ANSI_ARGS_((Display* d, Drawable dr, Window* w, int* i1, int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, unsigned int* ui4)); /* 31 */
+ int (*xGetWindowProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, long l1, long l2, Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, unsigned long* ulp2, unsigned char** cpp)); /* 32 */
+ int (*xGrabKeyboard) _ANSI_ARGS_((Display* d, Window w, Bool b, int i1, int i2, Time t)); /* 33 */
+ int (*xGrabPointer) _ANSI_ARGS_((Display* d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t)); /* 34 */
+ KeyCode (*xKeysymToKeycode) _ANSI_ARGS_((Display* d, KeySym k)); /* 35 */
+ void (*xMapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 36 */
+ void (*xMoveResizeWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 37 */
+ void (*xMoveWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2)); /* 38 */
+ Bool (*xQueryPointer) _ANSI_ARGS_((Display* d, Window w1, Window* w2, Window* w3, int* i1, int* i2, int* i3, int* i4, unsigned int* ui)); /* 39 */
+ void (*xRaiseWindow) _ANSI_ARGS_((Display* d, Window w)); /* 40 */
+ void (*xRefreshKeyboardMapping) _ANSI_ARGS_((XMappingEvent* x)); /* 41 */
+ void (*xResizeWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int ui1, unsigned int ui2)); /* 42 */
+ void (*xSelectInput) _ANSI_ARGS_((Display* d, Window w, long l)); /* 43 */
+ Status (*xSendEvent) _ANSI_ARGS_((Display* d, Window w, Bool b, long l, XEvent* x)); /* 44 */
+ void (*xSetIconName) _ANSI_ARGS_((Display* d, Window w, _Xconst char* c)); /* 45 */
+ void (*xSetInputFocus) _ANSI_ARGS_((Display* d, Window w, int i, Time t)); /* 46 */
+ void (*xSetSelectionOwner) _ANSI_ARGS_((Display* d, Atom a, Window w, Time t)); /* 47 */
+ void (*xSetWindowBackground) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 48 */
+ void (*xSetWindowBackgroundPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 49 */
+ void (*xSetWindowBorder) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 50 */
+ void (*xSetWindowBorderPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 51 */
+ void (*xSetWindowBorderWidth) _ANSI_ARGS_((Display* d, Window w, unsigned int ui)); /* 52 */
+ void (*xSetWindowColormap) _ANSI_ARGS_((Display* d, Window w, Colormap c)); /* 53 */
+ void (*xUngrabKeyboard) _ANSI_ARGS_((Display* d, Time t)); /* 54 */
+ void (*xUngrabPointer) _ANSI_ARGS_((Display* d, Time t)); /* 55 */
+ void (*xUnmapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 56 */
+ void (*tkPutImage) _ANSI_ARGS_((unsigned long * colors, int ncolors, Display* display, Drawable d, GC gc, XImage* image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height)); /* 57 */
+ Status (*xParseColor) _ANSI_ARGS_((Display * display, Colormap map, _Xconst char* spec, XColor * colorPtr)); /* 58 */
+ GC (*xCreateGC) _ANSI_ARGS_((Display* display, Drawable d, unsigned long valuemask, XGCValues* values)); /* 59 */
+ void (*xFreeGC) _ANSI_ARGS_((Display* display, GC gc)); /* 60 */
+ Atom (*xInternAtom) _ANSI_ARGS_((Display* display, _Xconst char* atom_name, Bool only_if_exists)); /* 61 */
+ void (*xSetBackground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 62 */
+ void (*xSetForeground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 63 */
+ void (*xSetClipMask) _ANSI_ARGS_((Display* display, GC gc, Pixmap pixmap)); /* 64 */
+ void (*xSetClipOrigin) _ANSI_ARGS_((Display* display, GC gc, int clip_x_origin, int clip_y_origin)); /* 65 */
+ void (*xSetTSOrigin) _ANSI_ARGS_((Display* display, GC gc, int ts_x_origin, int ts_y_origin)); /* 66 */
+ void (*xChangeGC) _ANSI_ARGS_((Display * d, GC gc, unsigned long mask, XGCValues * values)); /* 67 */
+ void (*xSetFont) _ANSI_ARGS_((Display * display, GC gc, Font font)); /* 68 */
+ void (*xSetArcMode) _ANSI_ARGS_((Display * display, GC gc, int arc_mode)); /* 69 */
+ void (*xSetStipple) _ANSI_ARGS_((Display * display, GC gc, Pixmap stipple)); /* 70 */
+ void (*xSetFillRule) _ANSI_ARGS_((Display * display, GC gc, int fill_rule)); /* 71 */
+ void (*xSetFillStyle) _ANSI_ARGS_((Display * display, GC gc, int fill_style)); /* 72 */
+ void (*xSetFunction) _ANSI_ARGS_((Display * display, GC gc, int function)); /* 73 */
+ void (*xSetLineAttributes) _ANSI_ARGS_((Display * display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style)); /* 74 */
+ int (*_XInitImageFuncPtrs) _ANSI_ARGS_((XImage * image)); /* 75 */
+ XIC (*xCreateIC) _ANSI_ARGS_((void)); /* 76 */
+ XVisualInfo * (*xGetVisualInfo) _ANSI_ARGS_((Display* display, long vinfo_mask, XVisualInfo* vinfo_template, int* nitems_return)); /* 77 */
+ void (*xSetWMClientMachine) _ANSI_ARGS_((Display* display, Window w, XTextProperty* text_prop)); /* 78 */
+ Status (*xStringListToTextProperty) _ANSI_ARGS_((char** list, int count, XTextProperty* text_prop_return)); /* 79 */
+ void (*xDrawSegments) _ANSI_ARGS_((Display * display, Drawable d, GC gc, XSegment * segments, int nsegments)); /* 80 */
+ void (*xForceScreenSaver) _ANSI_ARGS_((Display* display, int mode)); /* 81 */
+ void (*xDrawLine) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int x1, int y1, int x2, int y2)); /* 82 */
+ void (*xFillRectangle) _ANSI_ARGS_((Display* display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height)); /* 83 */
+ void (*xClearWindow) _ANSI_ARGS_((Display* d, Window w)); /* 84 */
+ void (*xDrawPoint) _ANSI_ARGS_((Display* display, Drawable d, GC gc, int x, int y)); /* 85 */
+ void (*xDrawPoints) _ANSI_ARGS_((Display* display, Drawable d, GC gc, XPoint * points, int npoints, int mode)); /* 86 */
+ void (*xWarpPointer) _ANSI_ARGS_((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)); /* 87 */
+ void (*xQueryColor) _ANSI_ARGS_((Display * display, Colormap colormap, XColor * def_in_out)); /* 88 */
+ void (*xQueryColors) _ANSI_ARGS_((Display * display, Colormap colormap, XColor * defs_in_out, int ncolors)); /* 89 */
+#endif /* MAC_OSX_TK */
+} TkIntXlibStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TkIntXlibStubs *tkIntXlibStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifdef __WIN32__
+#ifndef XSetDashes
+#define XSetDashes \
+ (tkIntXlibStubsPtr->xSetDashes) /* 0 */
+#endif
+#ifndef XGetModifierMapping
+#define XGetModifierMapping \
+ (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */
+#endif
+#ifndef XCreateImage
+#define XCreateImage \
+ (tkIntXlibStubsPtr->xCreateImage) /* 2 */
+#endif
+#ifndef XGetImage
+#define XGetImage \
+ (tkIntXlibStubsPtr->xGetImage) /* 3 */
+#endif
+#ifndef XGetAtomName
+#define XGetAtomName \
+ (tkIntXlibStubsPtr->xGetAtomName) /* 4 */
+#endif
+#ifndef XKeysymToString
+#define XKeysymToString \
+ (tkIntXlibStubsPtr->xKeysymToString) /* 5 */
+#endif
+#ifndef XCreateColormap
+#define XCreateColormap \
+ (tkIntXlibStubsPtr->xCreateColormap) /* 6 */
+#endif
+#ifndef XCreatePixmapCursor
+#define XCreatePixmapCursor \
+ (tkIntXlibStubsPtr->xCreatePixmapCursor) /* 7 */
+#endif
+#ifndef XCreateGlyphCursor
+#define XCreateGlyphCursor \
+ (tkIntXlibStubsPtr->xCreateGlyphCursor) /* 8 */
+#endif
+#ifndef XGContextFromGC
+#define XGContextFromGC \
+ (tkIntXlibStubsPtr->xGContextFromGC) /* 9 */
+#endif
+#ifndef XListHosts
+#define XListHosts \
+ (tkIntXlibStubsPtr->xListHosts) /* 10 */
+#endif
+#ifndef XKeycodeToKeysym
+#define XKeycodeToKeysym \
+ (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 11 */
+#endif
+#ifndef XStringToKeysym
+#define XStringToKeysym \
+ (tkIntXlibStubsPtr->xStringToKeysym) /* 12 */
+#endif
+#ifndef XRootWindow
+#define XRootWindow \
+ (tkIntXlibStubsPtr->xRootWindow) /* 13 */
+#endif
+#ifndef XSetErrorHandler
+#define XSetErrorHandler \
+ (tkIntXlibStubsPtr->xSetErrorHandler) /* 14 */
+#endif
+#ifndef XIconifyWindow
+#define XIconifyWindow \
+ (tkIntXlibStubsPtr->xIconifyWindow) /* 15 */
+#endif
+#ifndef XWithdrawWindow
+#define XWithdrawWindow \
+ (tkIntXlibStubsPtr->xWithdrawWindow) /* 16 */
+#endif
+#ifndef XGetWMColormapWindows
+#define XGetWMColormapWindows \
+ (tkIntXlibStubsPtr->xGetWMColormapWindows) /* 17 */
+#endif
+#ifndef XAllocColor
+#define XAllocColor \
+ (tkIntXlibStubsPtr->xAllocColor) /* 18 */
+#endif
+#ifndef XBell
+#define XBell \
+ (tkIntXlibStubsPtr->xBell) /* 19 */
+#endif
+#ifndef XChangeProperty
+#define XChangeProperty \
+ (tkIntXlibStubsPtr->xChangeProperty) /* 20 */
+#endif
+#ifndef XChangeWindowAttributes
+#define XChangeWindowAttributes \
+ (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 21 */
+#endif
+#ifndef XClearWindow
+#define XClearWindow \
+ (tkIntXlibStubsPtr->xClearWindow) /* 22 */
+#endif
+#ifndef XConfigureWindow
+#define XConfigureWindow \
+ (tkIntXlibStubsPtr->xConfigureWindow) /* 23 */
+#endif
+#ifndef XCopyArea
+#define XCopyArea \
+ (tkIntXlibStubsPtr->xCopyArea) /* 24 */
+#endif
+#ifndef XCopyPlane
+#define XCopyPlane \
+ (tkIntXlibStubsPtr->xCopyPlane) /* 25 */
+#endif
+#ifndef XCreateBitmapFromData
+#define XCreateBitmapFromData \
+ (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 26 */
+#endif
+#ifndef XDefineCursor
+#define XDefineCursor \
+ (tkIntXlibStubsPtr->xDefineCursor) /* 27 */
+#endif
+#ifndef XDeleteProperty
+#define XDeleteProperty \
+ (tkIntXlibStubsPtr->xDeleteProperty) /* 28 */
+#endif
+#ifndef XDestroyWindow
+#define XDestroyWindow \
+ (tkIntXlibStubsPtr->xDestroyWindow) /* 29 */
+#endif
+#ifndef XDrawArc
+#define XDrawArc \
+ (tkIntXlibStubsPtr->xDrawArc) /* 30 */
+#endif
+#ifndef XDrawLines
+#define XDrawLines \
+ (tkIntXlibStubsPtr->xDrawLines) /* 31 */
+#endif
+#ifndef XDrawRectangle
+#define XDrawRectangle \
+ (tkIntXlibStubsPtr->xDrawRectangle) /* 32 */
+#endif
+#ifndef XFillArc
+#define XFillArc \
+ (tkIntXlibStubsPtr->xFillArc) /* 33 */
+#endif
+#ifndef XFillPolygon
+#define XFillPolygon \
+ (tkIntXlibStubsPtr->xFillPolygon) /* 34 */
+#endif
+#ifndef XFillRectangles
+#define XFillRectangles \
+ (tkIntXlibStubsPtr->xFillRectangles) /* 35 */
+#endif
+#ifndef XForceScreenSaver
+#define XForceScreenSaver \
+ (tkIntXlibStubsPtr->xForceScreenSaver) /* 36 */
+#endif
+#ifndef XFreeColormap
+#define XFreeColormap \
+ (tkIntXlibStubsPtr->xFreeColormap) /* 37 */
+#endif
+#ifndef XFreeColors
+#define XFreeColors \
+ (tkIntXlibStubsPtr->xFreeColors) /* 38 */
+#endif
+#ifndef XFreeCursor
+#define XFreeCursor \
+ (tkIntXlibStubsPtr->xFreeCursor) /* 39 */
+#endif
+#ifndef XFreeModifiermap
+#define XFreeModifiermap \
+ (tkIntXlibStubsPtr->xFreeModifiermap) /* 40 */
+#endif
+#ifndef XGetGeometry
+#define XGetGeometry \
+ (tkIntXlibStubsPtr->xGetGeometry) /* 41 */
+#endif
+#ifndef XGetInputFocus
+#define XGetInputFocus \
+ (tkIntXlibStubsPtr->xGetInputFocus) /* 42 */
+#endif
+#ifndef XGetWindowProperty
+#define XGetWindowProperty \
+ (tkIntXlibStubsPtr->xGetWindowProperty) /* 43 */
+#endif
+#ifndef XGetWindowAttributes
+#define XGetWindowAttributes \
+ (tkIntXlibStubsPtr->xGetWindowAttributes) /* 44 */
+#endif
+#ifndef XGrabKeyboard
+#define XGrabKeyboard \
+ (tkIntXlibStubsPtr->xGrabKeyboard) /* 45 */
+#endif
+#ifndef XGrabPointer
+#define XGrabPointer \
+ (tkIntXlibStubsPtr->xGrabPointer) /* 46 */
+#endif
+#ifndef XKeysymToKeycode
+#define XKeysymToKeycode \
+ (tkIntXlibStubsPtr->xKeysymToKeycode) /* 47 */
+#endif
+#ifndef XLookupColor
+#define XLookupColor \
+ (tkIntXlibStubsPtr->xLookupColor) /* 48 */
+#endif
+#ifndef XMapWindow
+#define XMapWindow \
+ (tkIntXlibStubsPtr->xMapWindow) /* 49 */
+#endif
+#ifndef XMoveResizeWindow
+#define XMoveResizeWindow \
+ (tkIntXlibStubsPtr->xMoveResizeWindow) /* 50 */
+#endif
+#ifndef XMoveWindow
+#define XMoveWindow \
+ (tkIntXlibStubsPtr->xMoveWindow) /* 51 */
+#endif
+#ifndef XNextEvent
+#define XNextEvent \
+ (tkIntXlibStubsPtr->xNextEvent) /* 52 */
+#endif
+#ifndef XPutBackEvent
+#define XPutBackEvent \
+ (tkIntXlibStubsPtr->xPutBackEvent) /* 53 */
+#endif
+#ifndef XQueryColors
+#define XQueryColors \
+ (tkIntXlibStubsPtr->xQueryColors) /* 54 */
+#endif
+#ifndef XQueryPointer
+#define XQueryPointer \
+ (tkIntXlibStubsPtr->xQueryPointer) /* 55 */
+#endif
+#ifndef XQueryTree
+#define XQueryTree \
+ (tkIntXlibStubsPtr->xQueryTree) /* 56 */
+#endif
+#ifndef XRaiseWindow
+#define XRaiseWindow \
+ (tkIntXlibStubsPtr->xRaiseWindow) /* 57 */
+#endif
+#ifndef XRefreshKeyboardMapping
+#define XRefreshKeyboardMapping \
+ (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 58 */
+#endif
+#ifndef XResizeWindow
+#define XResizeWindow \
+ (tkIntXlibStubsPtr->xResizeWindow) /* 59 */
+#endif
+#ifndef XSelectInput
+#define XSelectInput \
+ (tkIntXlibStubsPtr->xSelectInput) /* 60 */
+#endif
+#ifndef XSendEvent
+#define XSendEvent \
+ (tkIntXlibStubsPtr->xSendEvent) /* 61 */
+#endif
+#ifndef XSetCommand
+#define XSetCommand \
+ (tkIntXlibStubsPtr->xSetCommand) /* 62 */
+#endif
+#ifndef XSetIconName
+#define XSetIconName \
+ (tkIntXlibStubsPtr->xSetIconName) /* 63 */
+#endif
+#ifndef XSetInputFocus
+#define XSetInputFocus \
+ (tkIntXlibStubsPtr->xSetInputFocus) /* 64 */
+#endif
+#ifndef XSetSelectionOwner
+#define XSetSelectionOwner \
+ (tkIntXlibStubsPtr->xSetSelectionOwner) /* 65 */
+#endif
+#ifndef XSetWindowBackground
+#define XSetWindowBackground \
+ (tkIntXlibStubsPtr->xSetWindowBackground) /* 66 */
+#endif
+#ifndef XSetWindowBackgroundPixmap
+#define XSetWindowBackgroundPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 67 */
+#endif
+#ifndef XSetWindowBorder
+#define XSetWindowBorder \
+ (tkIntXlibStubsPtr->xSetWindowBorder) /* 68 */
+#endif
+#ifndef XSetWindowBorderPixmap
+#define XSetWindowBorderPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 69 */
+#endif
+#ifndef XSetWindowBorderWidth
+#define XSetWindowBorderWidth \
+ (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 70 */
+#endif
+#ifndef XSetWindowColormap
+#define XSetWindowColormap \
+ (tkIntXlibStubsPtr->xSetWindowColormap) /* 71 */
+#endif
+#ifndef XTranslateCoordinates
+#define XTranslateCoordinates \
+ (tkIntXlibStubsPtr->xTranslateCoordinates) /* 72 */
+#endif
+#ifndef XUngrabKeyboard
+#define XUngrabKeyboard \
+ (tkIntXlibStubsPtr->xUngrabKeyboard) /* 73 */
+#endif
+#ifndef XUngrabPointer
+#define XUngrabPointer \
+ (tkIntXlibStubsPtr->xUngrabPointer) /* 74 */
+#endif
+#ifndef XUnmapWindow
+#define XUnmapWindow \
+ (tkIntXlibStubsPtr->xUnmapWindow) /* 75 */
+#endif
+#ifndef XWindowEvent
+#define XWindowEvent \
+ (tkIntXlibStubsPtr->xWindowEvent) /* 76 */
+#endif
+#ifndef XDestroyIC
+#define XDestroyIC \
+ (tkIntXlibStubsPtr->xDestroyIC) /* 77 */
+#endif
+#ifndef XFilterEvent
+#define XFilterEvent \
+ (tkIntXlibStubsPtr->xFilterEvent) /* 78 */
+#endif
+#ifndef XmbLookupString
+#define XmbLookupString \
+ (tkIntXlibStubsPtr->xmbLookupString) /* 79 */
+#endif
+#ifndef TkPutImage
+#define TkPutImage \
+ (tkIntXlibStubsPtr->tkPutImage) /* 80 */
+#endif
+/* Slot 81 is reserved */
+#ifndef XParseColor
+#define XParseColor \
+ (tkIntXlibStubsPtr->xParseColor) /* 82 */
+#endif
+#ifndef XCreateGC
+#define XCreateGC \
+ (tkIntXlibStubsPtr->xCreateGC) /* 83 */
+#endif
+#ifndef XFreeGC
+#define XFreeGC \
+ (tkIntXlibStubsPtr->xFreeGC) /* 84 */
+#endif
+#ifndef XInternAtom
+#define XInternAtom \
+ (tkIntXlibStubsPtr->xInternAtom) /* 85 */
+#endif
+#ifndef XSetBackground
+#define XSetBackground \
+ (tkIntXlibStubsPtr->xSetBackground) /* 86 */
+#endif
+#ifndef XSetForeground
+#define XSetForeground \
+ (tkIntXlibStubsPtr->xSetForeground) /* 87 */
+#endif
+#ifndef XSetClipMask
+#define XSetClipMask \
+ (tkIntXlibStubsPtr->xSetClipMask) /* 88 */
+#endif
+#ifndef XSetClipOrigin
+#define XSetClipOrigin \
+ (tkIntXlibStubsPtr->xSetClipOrigin) /* 89 */
+#endif
+#ifndef XSetTSOrigin
+#define XSetTSOrigin \
+ (tkIntXlibStubsPtr->xSetTSOrigin) /* 90 */
+#endif
+#ifndef XChangeGC
+#define XChangeGC \
+ (tkIntXlibStubsPtr->xChangeGC) /* 91 */
+#endif
+#ifndef XSetFont
+#define XSetFont \
+ (tkIntXlibStubsPtr->xSetFont) /* 92 */
+#endif
+#ifndef XSetArcMode
+#define XSetArcMode \
+ (tkIntXlibStubsPtr->xSetArcMode) /* 93 */
+#endif
+#ifndef XSetStipple
+#define XSetStipple \
+ (tkIntXlibStubsPtr->xSetStipple) /* 94 */
+#endif
+#ifndef XSetFillRule
+#define XSetFillRule \
+ (tkIntXlibStubsPtr->xSetFillRule) /* 95 */
+#endif
+#ifndef XSetFillStyle
+#define XSetFillStyle \
+ (tkIntXlibStubsPtr->xSetFillStyle) /* 96 */
+#endif
+#ifndef XSetFunction
+#define XSetFunction \
+ (tkIntXlibStubsPtr->xSetFunction) /* 97 */
+#endif
+#ifndef XSetLineAttributes
+#define XSetLineAttributes \
+ (tkIntXlibStubsPtr->xSetLineAttributes) /* 98 */
+#endif
+#ifndef _XInitImageFuncPtrs
+#define _XInitImageFuncPtrs \
+ (tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 99 */
+#endif
+#ifndef XCreateIC
+#define XCreateIC \
+ (tkIntXlibStubsPtr->xCreateIC) /* 100 */
+#endif
+#ifndef XGetVisualInfo
+#define XGetVisualInfo \
+ (tkIntXlibStubsPtr->xGetVisualInfo) /* 101 */
+#endif
+#ifndef XSetWMClientMachine
+#define XSetWMClientMachine \
+ (tkIntXlibStubsPtr->xSetWMClientMachine) /* 102 */
+#endif
+#ifndef XStringListToTextProperty
+#define XStringListToTextProperty \
+ (tkIntXlibStubsPtr->xStringListToTextProperty) /* 103 */
+#endif
+#ifndef XDrawLine
+#define XDrawLine \
+ (tkIntXlibStubsPtr->xDrawLine) /* 104 */
+#endif
+#ifndef XWarpPointer
+#define XWarpPointer \
+ (tkIntXlibStubsPtr->xWarpPointer) /* 105 */
+#endif
+#ifndef XFillRectangle
+#define XFillRectangle \
+ (tkIntXlibStubsPtr->xFillRectangle) /* 106 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef XSetDashes
+#define XSetDashes \
+ (tkIntXlibStubsPtr->xSetDashes) /* 0 */
+#endif
+#ifndef XGetModifierMapping
+#define XGetModifierMapping \
+ (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */
+#endif
+#ifndef XCreateImage
+#define XCreateImage \
+ (tkIntXlibStubsPtr->xCreateImage) /* 2 */
+#endif
+#ifndef XGetImage
+#define XGetImage \
+ (tkIntXlibStubsPtr->xGetImage) /* 3 */
+#endif
+#ifndef XGetAtomName
+#define XGetAtomName \
+ (tkIntXlibStubsPtr->xGetAtomName) /* 4 */
+#endif
+#ifndef XKeysymToString
+#define XKeysymToString \
+ (tkIntXlibStubsPtr->xKeysymToString) /* 5 */
+#endif
+#ifndef XCreateColormap
+#define XCreateColormap \
+ (tkIntXlibStubsPtr->xCreateColormap) /* 6 */
+#endif
+#ifndef XGContextFromGC
+#define XGContextFromGC \
+ (tkIntXlibStubsPtr->xGContextFromGC) /* 7 */
+#endif
+#ifndef XKeycodeToKeysym
+#define XKeycodeToKeysym \
+ (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 8 */
+#endif
+#ifndef XStringToKeysym
+#define XStringToKeysym \
+ (tkIntXlibStubsPtr->xStringToKeysym) /* 9 */
+#endif
+#ifndef XRootWindow
+#define XRootWindow \
+ (tkIntXlibStubsPtr->xRootWindow) /* 10 */
+#endif
+#ifndef XSetErrorHandler
+#define XSetErrorHandler \
+ (tkIntXlibStubsPtr->xSetErrorHandler) /* 11 */
+#endif
+#ifndef XAllocColor
+#define XAllocColor \
+ (tkIntXlibStubsPtr->xAllocColor) /* 12 */
+#endif
+#ifndef XBell
+#define XBell \
+ (tkIntXlibStubsPtr->xBell) /* 13 */
+#endif
+#ifndef XChangeProperty
+#define XChangeProperty \
+ (tkIntXlibStubsPtr->xChangeProperty) /* 14 */
+#endif
+#ifndef XChangeWindowAttributes
+#define XChangeWindowAttributes \
+ (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 15 */
+#endif
+#ifndef XConfigureWindow
+#define XConfigureWindow \
+ (tkIntXlibStubsPtr->xConfigureWindow) /* 16 */
+#endif
+#ifndef XCopyArea
+#define XCopyArea \
+ (tkIntXlibStubsPtr->xCopyArea) /* 17 */
+#endif
+#ifndef XCopyPlane
+#define XCopyPlane \
+ (tkIntXlibStubsPtr->xCopyPlane) /* 18 */
+#endif
+#ifndef XCreateBitmapFromData
+#define XCreateBitmapFromData \
+ (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 19 */
+#endif
+#ifndef XDefineCursor
+#define XDefineCursor \
+ (tkIntXlibStubsPtr->xDefineCursor) /* 20 */
+#endif
+#ifndef XDestroyWindow
+#define XDestroyWindow \
+ (tkIntXlibStubsPtr->xDestroyWindow) /* 21 */
+#endif
+#ifndef XDrawArc
+#define XDrawArc \
+ (tkIntXlibStubsPtr->xDrawArc) /* 22 */
+#endif
+#ifndef XDrawLines
+#define XDrawLines \
+ (tkIntXlibStubsPtr->xDrawLines) /* 23 */
+#endif
+#ifndef XDrawRectangle
+#define XDrawRectangle \
+ (tkIntXlibStubsPtr->xDrawRectangle) /* 24 */
+#endif
+#ifndef XFillArc
+#define XFillArc \
+ (tkIntXlibStubsPtr->xFillArc) /* 25 */
+#endif
+#ifndef XFillPolygon
+#define XFillPolygon \
+ (tkIntXlibStubsPtr->xFillPolygon) /* 26 */
+#endif
+#ifndef XFillRectangles
+#define XFillRectangles \
+ (tkIntXlibStubsPtr->xFillRectangles) /* 27 */
+#endif
+#ifndef XFreeColormap
+#define XFreeColormap \
+ (tkIntXlibStubsPtr->xFreeColormap) /* 28 */
+#endif
+#ifndef XFreeColors
+#define XFreeColors \
+ (tkIntXlibStubsPtr->xFreeColors) /* 29 */
+#endif
+#ifndef XFreeModifiermap
+#define XFreeModifiermap \
+ (tkIntXlibStubsPtr->xFreeModifiermap) /* 30 */
+#endif
+#ifndef XGetGeometry
+#define XGetGeometry \
+ (tkIntXlibStubsPtr->xGetGeometry) /* 31 */
+#endif
+#ifndef XGetWindowProperty
+#define XGetWindowProperty \
+ (tkIntXlibStubsPtr->xGetWindowProperty) /* 32 */
+#endif
+#ifndef XGrabKeyboard
+#define XGrabKeyboard \
+ (tkIntXlibStubsPtr->xGrabKeyboard) /* 33 */
+#endif
+#ifndef XGrabPointer
+#define XGrabPointer \
+ (tkIntXlibStubsPtr->xGrabPointer) /* 34 */
+#endif
+#ifndef XKeysymToKeycode
+#define XKeysymToKeycode \
+ (tkIntXlibStubsPtr->xKeysymToKeycode) /* 35 */
+#endif
+#ifndef XMapWindow
+#define XMapWindow \
+ (tkIntXlibStubsPtr->xMapWindow) /* 36 */
+#endif
+#ifndef XMoveResizeWindow
+#define XMoveResizeWindow \
+ (tkIntXlibStubsPtr->xMoveResizeWindow) /* 37 */
+#endif
+#ifndef XMoveWindow
+#define XMoveWindow \
+ (tkIntXlibStubsPtr->xMoveWindow) /* 38 */
+#endif
+#ifndef XQueryPointer
+#define XQueryPointer \
+ (tkIntXlibStubsPtr->xQueryPointer) /* 39 */
+#endif
+#ifndef XRaiseWindow
+#define XRaiseWindow \
+ (tkIntXlibStubsPtr->xRaiseWindow) /* 40 */
+#endif
+#ifndef XRefreshKeyboardMapping
+#define XRefreshKeyboardMapping \
+ (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 41 */
+#endif
+#ifndef XResizeWindow
+#define XResizeWindow \
+ (tkIntXlibStubsPtr->xResizeWindow) /* 42 */
+#endif
+#ifndef XSelectInput
+#define XSelectInput \
+ (tkIntXlibStubsPtr->xSelectInput) /* 43 */
+#endif
+#ifndef XSendEvent
+#define XSendEvent \
+ (tkIntXlibStubsPtr->xSendEvent) /* 44 */
+#endif
+#ifndef XSetIconName
+#define XSetIconName \
+ (tkIntXlibStubsPtr->xSetIconName) /* 45 */
+#endif
+#ifndef XSetInputFocus
+#define XSetInputFocus \
+ (tkIntXlibStubsPtr->xSetInputFocus) /* 46 */
+#endif
+#ifndef XSetSelectionOwner
+#define XSetSelectionOwner \
+ (tkIntXlibStubsPtr->xSetSelectionOwner) /* 47 */
+#endif
+#ifndef XSetWindowBackground
+#define XSetWindowBackground \
+ (tkIntXlibStubsPtr->xSetWindowBackground) /* 48 */
+#endif
+#ifndef XSetWindowBackgroundPixmap
+#define XSetWindowBackgroundPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 49 */
+#endif
+#ifndef XSetWindowBorder
+#define XSetWindowBorder \
+ (tkIntXlibStubsPtr->xSetWindowBorder) /* 50 */
+#endif
+#ifndef XSetWindowBorderPixmap
+#define XSetWindowBorderPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 51 */
+#endif
+#ifndef XSetWindowBorderWidth
+#define XSetWindowBorderWidth \
+ (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 52 */
+#endif
+#ifndef XSetWindowColormap
+#define XSetWindowColormap \
+ (tkIntXlibStubsPtr->xSetWindowColormap) /* 53 */
+#endif
+#ifndef XUngrabKeyboard
+#define XUngrabKeyboard \
+ (tkIntXlibStubsPtr->xUngrabKeyboard) /* 54 */
+#endif
+#ifndef XUngrabPointer
+#define XUngrabPointer \
+ (tkIntXlibStubsPtr->xUngrabPointer) /* 55 */
+#endif
+#ifndef XUnmapWindow
+#define XUnmapWindow \
+ (tkIntXlibStubsPtr->xUnmapWindow) /* 56 */
+#endif
+#ifndef TkPutImage
+#define TkPutImage \
+ (tkIntXlibStubsPtr->tkPutImage) /* 57 */
+#endif
+#ifndef XParseColor
+#define XParseColor \
+ (tkIntXlibStubsPtr->xParseColor) /* 58 */
+#endif
+#ifndef XCreateGC
+#define XCreateGC \
+ (tkIntXlibStubsPtr->xCreateGC) /* 59 */
+#endif
+#ifndef XFreeGC
+#define XFreeGC \
+ (tkIntXlibStubsPtr->xFreeGC) /* 60 */
+#endif
+#ifndef XInternAtom
+#define XInternAtom \
+ (tkIntXlibStubsPtr->xInternAtom) /* 61 */
+#endif
+#ifndef XSetBackground
+#define XSetBackground \
+ (tkIntXlibStubsPtr->xSetBackground) /* 62 */
+#endif
+#ifndef XSetForeground
+#define XSetForeground \
+ (tkIntXlibStubsPtr->xSetForeground) /* 63 */
+#endif
+#ifndef XSetClipMask
+#define XSetClipMask \
+ (tkIntXlibStubsPtr->xSetClipMask) /* 64 */
+#endif
+#ifndef XSetClipOrigin
+#define XSetClipOrigin \
+ (tkIntXlibStubsPtr->xSetClipOrigin) /* 65 */
+#endif
+#ifndef XSetTSOrigin
+#define XSetTSOrigin \
+ (tkIntXlibStubsPtr->xSetTSOrigin) /* 66 */
+#endif
+#ifndef XChangeGC
+#define XChangeGC \
+ (tkIntXlibStubsPtr->xChangeGC) /* 67 */
+#endif
+#ifndef XSetFont
+#define XSetFont \
+ (tkIntXlibStubsPtr->xSetFont) /* 68 */
+#endif
+#ifndef XSetArcMode
+#define XSetArcMode \
+ (tkIntXlibStubsPtr->xSetArcMode) /* 69 */
+#endif
+#ifndef XSetStipple
+#define XSetStipple \
+ (tkIntXlibStubsPtr->xSetStipple) /* 70 */
+#endif
+#ifndef XSetFillRule
+#define XSetFillRule \
+ (tkIntXlibStubsPtr->xSetFillRule) /* 71 */
+#endif
+#ifndef XSetFillStyle
+#define XSetFillStyle \
+ (tkIntXlibStubsPtr->xSetFillStyle) /* 72 */
+#endif
+#ifndef XSetFunction
+#define XSetFunction \
+ (tkIntXlibStubsPtr->xSetFunction) /* 73 */
+#endif
+#ifndef XSetLineAttributes
+#define XSetLineAttributes \
+ (tkIntXlibStubsPtr->xSetLineAttributes) /* 74 */
+#endif
+#ifndef _XInitImageFuncPtrs
+#define _XInitImageFuncPtrs \
+ (tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 75 */
+#endif
+#ifndef XCreateIC
+#define XCreateIC \
+ (tkIntXlibStubsPtr->xCreateIC) /* 76 */
+#endif
+#ifndef XGetVisualInfo
+#define XGetVisualInfo \
+ (tkIntXlibStubsPtr->xGetVisualInfo) /* 77 */
+#endif
+#ifndef XSetWMClientMachine
+#define XSetWMClientMachine \
+ (tkIntXlibStubsPtr->xSetWMClientMachine) /* 78 */
+#endif
+#ifndef XStringListToTextProperty
+#define XStringListToTextProperty \
+ (tkIntXlibStubsPtr->xStringListToTextProperty) /* 79 */
+#endif
+#ifndef XDrawSegments
+#define XDrawSegments \
+ (tkIntXlibStubsPtr->xDrawSegments) /* 80 */
+#endif
+#ifndef XForceScreenSaver
+#define XForceScreenSaver \
+ (tkIntXlibStubsPtr->xForceScreenSaver) /* 81 */
+#endif
+#ifndef XDrawLine
+#define XDrawLine \
+ (tkIntXlibStubsPtr->xDrawLine) /* 82 */
+#endif
+#ifndef XFillRectangle
+#define XFillRectangle \
+ (tkIntXlibStubsPtr->xFillRectangle) /* 83 */
+#endif
+#ifndef XClearWindow
+#define XClearWindow \
+ (tkIntXlibStubsPtr->xClearWindow) /* 84 */
+#endif
+#ifndef XDrawPoint
+#define XDrawPoint \
+ (tkIntXlibStubsPtr->xDrawPoint) /* 85 */
+#endif
+#ifndef XDrawPoints
+#define XDrawPoints \
+ (tkIntXlibStubsPtr->xDrawPoints) /* 86 */
+#endif
+#ifndef XWarpPointer
+#define XWarpPointer \
+ (tkIntXlibStubsPtr->xWarpPointer) /* 87 */
+#endif
+#ifndef XQueryColor
+#define XQueryColor \
+ (tkIntXlibStubsPtr->xQueryColor) /* 88 */
+#endif
+#ifndef XQueryColors
+#define XQueryColors \
+ (tkIntXlibStubsPtr->xQueryColors) /* 89 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef XSetDashes
+#define XSetDashes \
+ (tkIntXlibStubsPtr->xSetDashes) /* 0 */
+#endif
+#ifndef XGetModifierMapping
+#define XGetModifierMapping \
+ (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */
+#endif
+#ifndef XCreateImage
+#define XCreateImage \
+ (tkIntXlibStubsPtr->xCreateImage) /* 2 */
+#endif
+#ifndef XGetImage
+#define XGetImage \
+ (tkIntXlibStubsPtr->xGetImage) /* 3 */
+#endif
+#ifndef XGetAtomName
+#define XGetAtomName \
+ (tkIntXlibStubsPtr->xGetAtomName) /* 4 */
+#endif
+#ifndef XKeysymToString
+#define XKeysymToString \
+ (tkIntXlibStubsPtr->xKeysymToString) /* 5 */
+#endif
+#ifndef XCreateColormap
+#define XCreateColormap \
+ (tkIntXlibStubsPtr->xCreateColormap) /* 6 */
+#endif
+#ifndef XGContextFromGC
+#define XGContextFromGC \
+ (tkIntXlibStubsPtr->xGContextFromGC) /* 7 */
+#endif
+#ifndef XKeycodeToKeysym
+#define XKeycodeToKeysym \
+ (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 8 */
+#endif
+#ifndef XStringToKeysym
+#define XStringToKeysym \
+ (tkIntXlibStubsPtr->xStringToKeysym) /* 9 */
+#endif
+#ifndef XRootWindow
+#define XRootWindow \
+ (tkIntXlibStubsPtr->xRootWindow) /* 10 */
+#endif
+#ifndef XSetErrorHandler
+#define XSetErrorHandler \
+ (tkIntXlibStubsPtr->xSetErrorHandler) /* 11 */
+#endif
+#ifndef XAllocColor
+#define XAllocColor \
+ (tkIntXlibStubsPtr->xAllocColor) /* 12 */
+#endif
+#ifndef XBell
+#define XBell \
+ (tkIntXlibStubsPtr->xBell) /* 13 */
+#endif
+#ifndef XChangeProperty
+#define XChangeProperty \
+ (tkIntXlibStubsPtr->xChangeProperty) /* 14 */
+#endif
+#ifndef XChangeWindowAttributes
+#define XChangeWindowAttributes \
+ (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 15 */
+#endif
+#ifndef XConfigureWindow
+#define XConfigureWindow \
+ (tkIntXlibStubsPtr->xConfigureWindow) /* 16 */
+#endif
+#ifndef XCopyArea
+#define XCopyArea \
+ (tkIntXlibStubsPtr->xCopyArea) /* 17 */
+#endif
+#ifndef XCopyPlane
+#define XCopyPlane \
+ (tkIntXlibStubsPtr->xCopyPlane) /* 18 */
+#endif
+#ifndef XCreateBitmapFromData
+#define XCreateBitmapFromData \
+ (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 19 */
+#endif
+#ifndef XDefineCursor
+#define XDefineCursor \
+ (tkIntXlibStubsPtr->xDefineCursor) /* 20 */
+#endif
+#ifndef XDestroyWindow
+#define XDestroyWindow \
+ (tkIntXlibStubsPtr->xDestroyWindow) /* 21 */
+#endif
+#ifndef XDrawArc
+#define XDrawArc \
+ (tkIntXlibStubsPtr->xDrawArc) /* 22 */
+#endif
+#ifndef XDrawLines
+#define XDrawLines \
+ (tkIntXlibStubsPtr->xDrawLines) /* 23 */
+#endif
+#ifndef XDrawRectangle
+#define XDrawRectangle \
+ (tkIntXlibStubsPtr->xDrawRectangle) /* 24 */
+#endif
+#ifndef XFillArc
+#define XFillArc \
+ (tkIntXlibStubsPtr->xFillArc) /* 25 */
+#endif
+#ifndef XFillPolygon
+#define XFillPolygon \
+ (tkIntXlibStubsPtr->xFillPolygon) /* 26 */
+#endif
+#ifndef XFillRectangles
+#define XFillRectangles \
+ (tkIntXlibStubsPtr->xFillRectangles) /* 27 */
+#endif
+#ifndef XFreeColormap
+#define XFreeColormap \
+ (tkIntXlibStubsPtr->xFreeColormap) /* 28 */
+#endif
+#ifndef XFreeColors
+#define XFreeColors \
+ (tkIntXlibStubsPtr->xFreeColors) /* 29 */
+#endif
+#ifndef XFreeModifiermap
+#define XFreeModifiermap \
+ (tkIntXlibStubsPtr->xFreeModifiermap) /* 30 */
+#endif
+#ifndef XGetGeometry
+#define XGetGeometry \
+ (tkIntXlibStubsPtr->xGetGeometry) /* 31 */
+#endif
+#ifndef XGetWindowProperty
+#define XGetWindowProperty \
+ (tkIntXlibStubsPtr->xGetWindowProperty) /* 32 */
+#endif
+#ifndef XGrabKeyboard
+#define XGrabKeyboard \
+ (tkIntXlibStubsPtr->xGrabKeyboard) /* 33 */
+#endif
+#ifndef XGrabPointer
+#define XGrabPointer \
+ (tkIntXlibStubsPtr->xGrabPointer) /* 34 */
+#endif
+#ifndef XKeysymToKeycode
+#define XKeysymToKeycode \
+ (tkIntXlibStubsPtr->xKeysymToKeycode) /* 35 */
+#endif
+#ifndef XMapWindow
+#define XMapWindow \
+ (tkIntXlibStubsPtr->xMapWindow) /* 36 */
+#endif
+#ifndef XMoveResizeWindow
+#define XMoveResizeWindow \
+ (tkIntXlibStubsPtr->xMoveResizeWindow) /* 37 */
+#endif
+#ifndef XMoveWindow
+#define XMoveWindow \
+ (tkIntXlibStubsPtr->xMoveWindow) /* 38 */
+#endif
+#ifndef XQueryPointer
+#define XQueryPointer \
+ (tkIntXlibStubsPtr->xQueryPointer) /* 39 */
+#endif
+#ifndef XRaiseWindow
+#define XRaiseWindow \
+ (tkIntXlibStubsPtr->xRaiseWindow) /* 40 */
+#endif
+#ifndef XRefreshKeyboardMapping
+#define XRefreshKeyboardMapping \
+ (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 41 */
+#endif
+#ifndef XResizeWindow
+#define XResizeWindow \
+ (tkIntXlibStubsPtr->xResizeWindow) /* 42 */
+#endif
+#ifndef XSelectInput
+#define XSelectInput \
+ (tkIntXlibStubsPtr->xSelectInput) /* 43 */
+#endif
+#ifndef XSendEvent
+#define XSendEvent \
+ (tkIntXlibStubsPtr->xSendEvent) /* 44 */
+#endif
+#ifndef XSetIconName
+#define XSetIconName \
+ (tkIntXlibStubsPtr->xSetIconName) /* 45 */
+#endif
+#ifndef XSetInputFocus
+#define XSetInputFocus \
+ (tkIntXlibStubsPtr->xSetInputFocus) /* 46 */
+#endif
+#ifndef XSetSelectionOwner
+#define XSetSelectionOwner \
+ (tkIntXlibStubsPtr->xSetSelectionOwner) /* 47 */
+#endif
+#ifndef XSetWindowBackground
+#define XSetWindowBackground \
+ (tkIntXlibStubsPtr->xSetWindowBackground) /* 48 */
+#endif
+#ifndef XSetWindowBackgroundPixmap
+#define XSetWindowBackgroundPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 49 */
+#endif
+#ifndef XSetWindowBorder
+#define XSetWindowBorder \
+ (tkIntXlibStubsPtr->xSetWindowBorder) /* 50 */
+#endif
+#ifndef XSetWindowBorderPixmap
+#define XSetWindowBorderPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 51 */
+#endif
+#ifndef XSetWindowBorderWidth
+#define XSetWindowBorderWidth \
+ (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 52 */
+#endif
+#ifndef XSetWindowColormap
+#define XSetWindowColormap \
+ (tkIntXlibStubsPtr->xSetWindowColormap) /* 53 */
+#endif
+#ifndef XUngrabKeyboard
+#define XUngrabKeyboard \
+ (tkIntXlibStubsPtr->xUngrabKeyboard) /* 54 */
+#endif
+#ifndef XUngrabPointer
+#define XUngrabPointer \
+ (tkIntXlibStubsPtr->xUngrabPointer) /* 55 */
+#endif
+#ifndef XUnmapWindow
+#define XUnmapWindow \
+ (tkIntXlibStubsPtr->xUnmapWindow) /* 56 */
+#endif
+#ifndef TkPutImage
+#define TkPutImage \
+ (tkIntXlibStubsPtr->tkPutImage) /* 57 */
+#endif
+#ifndef XParseColor
+#define XParseColor \
+ (tkIntXlibStubsPtr->xParseColor) /* 58 */
+#endif
+#ifndef XCreateGC
+#define XCreateGC \
+ (tkIntXlibStubsPtr->xCreateGC) /* 59 */
+#endif
+#ifndef XFreeGC
+#define XFreeGC \
+ (tkIntXlibStubsPtr->xFreeGC) /* 60 */
+#endif
+#ifndef XInternAtom
+#define XInternAtom \
+ (tkIntXlibStubsPtr->xInternAtom) /* 61 */
+#endif
+#ifndef XSetBackground
+#define XSetBackground \
+ (tkIntXlibStubsPtr->xSetBackground) /* 62 */
+#endif
+#ifndef XSetForeground
+#define XSetForeground \
+ (tkIntXlibStubsPtr->xSetForeground) /* 63 */
+#endif
+#ifndef XSetClipMask
+#define XSetClipMask \
+ (tkIntXlibStubsPtr->xSetClipMask) /* 64 */
+#endif
+#ifndef XSetClipOrigin
+#define XSetClipOrigin \
+ (tkIntXlibStubsPtr->xSetClipOrigin) /* 65 */
+#endif
+#ifndef XSetTSOrigin
+#define XSetTSOrigin \
+ (tkIntXlibStubsPtr->xSetTSOrigin) /* 66 */
+#endif
+#ifndef XChangeGC
+#define XChangeGC \
+ (tkIntXlibStubsPtr->xChangeGC) /* 67 */
+#endif
+#ifndef XSetFont
+#define XSetFont \
+ (tkIntXlibStubsPtr->xSetFont) /* 68 */
+#endif
+#ifndef XSetArcMode
+#define XSetArcMode \
+ (tkIntXlibStubsPtr->xSetArcMode) /* 69 */
+#endif
+#ifndef XSetStipple
+#define XSetStipple \
+ (tkIntXlibStubsPtr->xSetStipple) /* 70 */
+#endif
+#ifndef XSetFillRule
+#define XSetFillRule \
+ (tkIntXlibStubsPtr->xSetFillRule) /* 71 */
+#endif
+#ifndef XSetFillStyle
+#define XSetFillStyle \
+ (tkIntXlibStubsPtr->xSetFillStyle) /* 72 */
+#endif
+#ifndef XSetFunction
+#define XSetFunction \
+ (tkIntXlibStubsPtr->xSetFunction) /* 73 */
+#endif
+#ifndef XSetLineAttributes
+#define XSetLineAttributes \
+ (tkIntXlibStubsPtr->xSetLineAttributes) /* 74 */
+#endif
+#ifndef _XInitImageFuncPtrs
+#define _XInitImageFuncPtrs \
+ (tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 75 */
+#endif
+#ifndef XCreateIC
+#define XCreateIC \
+ (tkIntXlibStubsPtr->xCreateIC) /* 76 */
+#endif
+#ifndef XGetVisualInfo
+#define XGetVisualInfo \
+ (tkIntXlibStubsPtr->xGetVisualInfo) /* 77 */
+#endif
+#ifndef XSetWMClientMachine
+#define XSetWMClientMachine \
+ (tkIntXlibStubsPtr->xSetWMClientMachine) /* 78 */
+#endif
+#ifndef XStringListToTextProperty
+#define XStringListToTextProperty \
+ (tkIntXlibStubsPtr->xStringListToTextProperty) /* 79 */
+#endif
+#ifndef XDrawSegments
+#define XDrawSegments \
+ (tkIntXlibStubsPtr->xDrawSegments) /* 80 */
+#endif
+#ifndef XForceScreenSaver
+#define XForceScreenSaver \
+ (tkIntXlibStubsPtr->xForceScreenSaver) /* 81 */
+#endif
+#ifndef XDrawLine
+#define XDrawLine \
+ (tkIntXlibStubsPtr->xDrawLine) /* 82 */
+#endif
+#ifndef XFillRectangle
+#define XFillRectangle \
+ (tkIntXlibStubsPtr->xFillRectangle) /* 83 */
+#endif
+#ifndef XClearWindow
+#define XClearWindow \
+ (tkIntXlibStubsPtr->xClearWindow) /* 84 */
+#endif
+#ifndef XDrawPoint
+#define XDrawPoint \
+ (tkIntXlibStubsPtr->xDrawPoint) /* 85 */
+#endif
+#ifndef XDrawPoints
+#define XDrawPoints \
+ (tkIntXlibStubsPtr->xDrawPoints) /* 86 */
+#endif
+#ifndef XWarpPointer
+#define XWarpPointer \
+ (tkIntXlibStubsPtr->xWarpPointer) /* 87 */
+#endif
+#ifndef XQueryColor
+#define XQueryColor \
+ (tkIntXlibStubsPtr->xQueryColor) /* 88 */
+#endif
+#ifndef XQueryColors
+#define XQueryColors \
+ (tkIntXlibStubsPtr->xQueryColors) /* 89 */
+#endif
+#endif /* MAC_OSX_TK */
+
+#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKINTXLIBDECLS */
diff --git a/tcl/generic/tkListbox.c b/tcl/generic/tkListbox.c
new file mode 100644
index 00000000000..7cfc23bed7f
--- /dev/null
+++ b/tcl/generic/tkListbox.c
@@ -0,0 +1,3453 @@
+/*
+ * 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"
+
+#ifdef WIN32
+#include "tkWinInt.h"
+#endif
+
+typedef struct {
+ Tk_OptionTable listboxOptionTable; /* Table defining configuration options
+ * available for the listbox */
+ Tk_OptionTable itemAttrOptionTable; /* Table definining configuration
+ * options available for listbox
+ * items */
+} ListboxOptionTables;
+
+/*
+ * 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. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ Tk_OptionTable itemAttrOptionTable; /* Table that defines configuration
+ * options available for listbox
+ * items */
+ char *listVarName; /* List variable name */
+ Tcl_Obj *listObj; /* Pointer to the list object being used */
+ int nElements; /* Holds the current count of elements */
+ Tcl_HashTable *selection; /* Tracks selection */
+ Tcl_HashTable *itemAttrTable; /* Tracks item attributes */
+
+ /*
+ * 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. */
+ XColor *dfgColorPtr; /* Text color in disabled 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. */
+ int activeStyle; /* style in which to draw the active element.
+ * One of: underline, none, dotbox */
+
+ /*
+ * 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 state; /* Listbox state. */
+ Pixmap gray; /* Pixmap for displaying disabled text. */
+ int flags; /* Various flag bits: see below for
+ * definitions. */
+} Listbox;
+
+/*
+ * ItemAttr structures are used to store item configuration information for
+ * the items in a listbox
+ */
+typedef struct {
+ Tk_3DBorder border; /* Used for drawing background around text */
+ Tk_3DBorder selBorder; /* Used for selected text */
+ XColor *fgColor; /* Text color in normal mode. */
+ XColor *selFgColor; /* Text color in selected mode. */
+} ItemAttr;
+
+/*
+ * 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.
+ * MAXWIDTH_IS_STALE: Stored maxWidth may be out-of-date
+ * LISTBOX_DELETED: This listbox has been effectively destroyed.
+ */
+
+#define REDRAW_PENDING 1
+#define UPDATE_V_SCROLLBAR 2
+#define UPDATE_H_SCROLLBAR 4
+#define GOT_FOCUS 8
+#define MAXWIDTH_IS_STALE 16
+#define LISTBOX_DELETED 32
+
+/*
+ * The following enum is used to define a type for the -state option
+ * of the Entry widget. These values are used as indices into the
+ * string table below.
+ */
+
+enum state {
+ STATE_DISABLED, STATE_NORMAL
+};
+
+static char *stateStrings[] = {
+ "disabled", "normal", (char *) NULL
+};
+
+enum activeStyle {
+ ACTIVE_STYLE_DOTBOX, ACTIVE_STYLE_NONE, ACTIVE_STYLE_UNDERLINE
+};
+
+static char *activeStyleStrings[] = {
+ "dotbox", "none", "underline", (char *) NULL
+};
+
+/*
+ * The optionSpecs table defines the valid configuration options for the
+ * listbox widget
+ */
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_STRING_TABLE, "-activestyle", "activeStyle", "ActiveStyle",
+ DEF_LISTBOX_ACTIVE_STYLE, -1, Tk_Offset(Listbox, activeStyle),
+ 0, (ClientData) activeStyleStrings, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_LISTBOX_BG_COLOR, -1, Tk_Offset(Listbox, normalBorder),
+ 0, (ClientData) DEF_LISTBOX_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_LISTBOX_BORDER_WIDTH, -1, Tk_Offset(Listbox, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_LISTBOX_CURSOR, -1, Tk_Offset(Listbox, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_LISTBOX_DISABLED_FG, -1,
+ Tk_Offset(Listbox, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION, -1,
+ Tk_Offset(Listbox, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_LISTBOX_FONT, -1, Tk_Offset(Listbox, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_LISTBOX_FG, -1, Tk_Offset(Listbox, fgColorPtr), 0, 0, 0},
+ {TK_OPTION_INT, "-height", "height", "Height",
+ DEF_LISTBOX_HEIGHT, -1, Tk_Offset(Listbox, height), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG, -1,
+ Tk_Offset(Listbox, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_LISTBOX_HIGHLIGHT, -1, Tk_Offset(Listbox, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_LISTBOX_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Listbox, highlightWidth), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LISTBOX_RELIEF, -1, Tk_Offset(Listbox, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_LISTBOX_SELECT_COLOR, -1, Tk_Offset(Listbox, selBorder),
+ 0, (ClientData) DEF_LISTBOX_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_LISTBOX_SELECT_BD, -1,
+ Tk_Offset(Listbox, selBorderWidth), 0, 0, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_LISTBOX_SELECT_FG_COLOR, -1, Tk_Offset(Listbox, selFgColorPtr),
+ 0, (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode",
+ DEF_LISTBOX_SELECT_MODE, -1, Tk_Offset(Listbox, selectMode),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_LISTBOX_SET_GRID, -1, Tk_Offset(Listbox, setGrid), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_LISTBOX_STATE, -1, Tk_Offset(Listbox, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(Listbox, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_LISTBOX_WIDTH, -1, Tk_Offset(Listbox, width), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, xScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, yScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-listvariable", "listVariable", "Variable",
+ DEF_LISTBOX_LIST_VARIABLE, -1, Tk_Offset(Listbox, listVarName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The itemAttrOptionSpecs table defines the valid configuration options for
+ * listbox items
+ */
+static Tk_OptionSpec itemAttrOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ (char *)NULL, -1, Tk_Offset(ItemAttr, border),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
+ (ClientData) DEF_LISTBOX_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ (char *) NULL, -1, Tk_Offset(ItemAttr, fgColor),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ (char *) NULL, -1, Tk_Offset(ItemAttr, selBorder),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
+ (ClientData) DEF_LISTBOX_SELECT_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ (char *) NULL, -1, Tk_Offset(ItemAttr, selFgColor),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
+ (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following tables define the listbox widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the listbox widget command.
+ */
+static CONST char *commandNames[] = {
+ "activate", "bbox", "cget", "configure", "curselection", "delete", "get",
+ "index", "insert", "itemcget", "itemconfigure", "nearest", "scan",
+ "see", "selection", "size", "xview", "yview",
+ (char *) NULL
+};
+
+enum command {
+ COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE,
+ COMMAND_CURSELECTION, COMMAND_DELETE, COMMAND_GET, COMMAND_INDEX,
+ COMMAND_INSERT, COMMAND_ITEMCGET, COMMAND_ITEMCONFIGURE,
+ COMMAND_NEAREST, COMMAND_SCAN, COMMAND_SEE, COMMAND_SELECTION,
+ COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW
+};
+
+static CONST char *selCommandNames[] = {
+ "anchor", "clear", "includes", "set", (char *) NULL
+};
+
+enum selcommand {
+ SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET
+};
+
+static CONST char *scanCommandNames[] = {
+ "mark", "dragto", (char *) NULL
+};
+
+enum scancommand {
+ SCAN_MARK, SCAN_DRAGTO
+};
+
+static CONST char *indexNames[] = {
+ "active", "anchor", "end", (char *)NULL
+};
+
+enum indices {
+ INDEX_ACTIVE, INDEX_ANCHOR, INDEX_END
+};
+
+
+/* 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 objc, Tcl_Obj *CONST objv[],
+ int flags));
+static int ConfigureListboxItem _ANSI_ARGS_ ((Tcl_Interp *interp,
+ Listbox *listPtr, ItemAttr *attrs, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ListboxDeleteSubCmd _ANSI_ARGS_((Listbox *listPtr,
+ int first, int last));
+static void DestroyListbox _ANSI_ARGS_((char *memPtr));
+static void DestroyListboxOptionTables _ANSI_ARGS_ (
+ (ClientData clientData, Tcl_Interp *interp));
+static void DisplayListbox _ANSI_ARGS_((ClientData clientData));
+static int GetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Listbox *listPtr, Tcl_Obj *index, int endIsSize,
+ int *indexPtr));
+static int ListboxInsertSubCmd _ANSI_ARGS_((Listbox *listPtr,
+ int index, int objc, Tcl_Obj *CONST objv[]));
+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 EventuallyRedrawRange _ANSI_ARGS_((Listbox *listPtr,
+ int first, int last));
+static void ListboxScanTo _ANSI_ARGS_((Listbox *listPtr,
+ int x, int y));
+static int 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 ListboxWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ListboxBboxSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
+ Listbox *listPtr, int index));
+static int ListboxSelectionSubCmd _ANSI_ARGS_ (
+ (Tcl_Interp *interp, Listbox *listPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ListboxXviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
+ Listbox *listPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int ListboxYviewSubCmd _ANSI_ARGS_ ((Tcl_Interp *interp,
+ Listbox *listPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static ItemAttr * ListboxGetItemAttributes _ANSI_ARGS_ (
+ (Tcl_Interp *interp, Listbox *listPtr, int index));
+static void ListboxWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int NearestListboxElement _ANSI_ARGS_((Listbox *listPtr,
+ int y));
+static char * ListboxListVarProc _ANSI_ARGS_ ((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static void MigrateHashEntries _ANSI_ARGS_ ((Tcl_HashTable *table,
+ int first, int last, int offset));
+/*
+ * The structure below defines button class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs listboxClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ ListboxWorldChanged, /* worldChangedProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ListboxObjCmd --
+ *
+ * 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_ListboxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Listbox *listPtr;
+ Tk_Window tkwin;
+ ListboxOptionTables *optionTables;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ optionTables = (ListboxOptionTables *)
+ Tcl_GetAssocData(interp, "ListboxOptionTables", NULL);
+ if (optionTables == NULL) {
+ /*
+ * We haven't created the option tables for this widget class yet.
+ * Do it now and save the a pointer to them as the ClientData for
+ * the command, so future invocations will have access to it.
+ */
+
+ optionTables = (ListboxOptionTables *)
+ ckalloc(sizeof(ListboxOptionTables));
+ /* Set up an exit handler to free the optionTables struct */
+ Tcl_SetAssocData(interp, "ListboxOptionTables",
+ DestroyListboxOptionTables, (ClientData) optionTables);
+
+ /* Create the listbox option table and the listbox item option table */
+ optionTables->listboxOptionTable =
+ Tk_CreateOptionTable(interp, optionSpecs);
+ optionTables->itemAttrOptionTable =
+ Tk_CreateOptionTable(interp, itemAttrOptionSpecs);
+ }
+
+ /*
+ * 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));
+ memset((void *) listPtr, 0, (sizeof(Listbox)));
+
+ listPtr->tkwin = tkwin;
+ listPtr->display = Tk_Display(tkwin);
+ listPtr->interp = interp;
+ listPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd,
+ (ClientData) listPtr, ListboxCmdDeletedProc);
+ listPtr->optionTable = optionTables->listboxOptionTable;
+ listPtr->itemAttrOptionTable = optionTables->itemAttrOptionTable;
+ listPtr->selection =
+ (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS);
+ listPtr->itemAttrTable =
+ (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS);
+ listPtr->relief = TK_RELIEF_RAISED;
+ listPtr->textGC = None;
+ listPtr->selFgColorPtr = None;
+ listPtr->selTextGC = None;
+ listPtr->fullLines = 1;
+ listPtr->xScrollUnit = 1;
+ listPtr->exportSelection = 1;
+ listPtr->cursor = None;
+ listPtr->state = STATE_NORMAL;
+ listPtr->gray = None;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the listbox,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve((ClientData) listPtr->tkwin);
+
+ Tk_SetClass(listPtr->tkwin, "Listbox");
+ Tk_SetClassProcs(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 (Tk_InitOptions(interp, (char *)listPtr,
+ optionTables->listboxOptionTable, tkwin) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureListbox(interp, listPtr, objc-2, objv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(listPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxWidgetObjCmd --
+ *
+ * This Tcl_Obj based 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
+ListboxWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about listbox widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Arguments as Tcl_Obj's. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+ int cmdIndex, index;
+ int result = TCL_OK;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the command by looking up the second argument in the list
+ * of valid subcommand names
+ */
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve((ClientData)listPtr);
+ /* The subcommand was valid, so continue processing */
+ switch (cmdIndex) {
+ case COMMAND_ACTIVATE: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (!(listPtr->state & STATE_NORMAL)) {
+ break;
+ }
+
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ listPtr->active = index;
+ EventuallyRedrawRange(listPtr, listPtr->active, listPtr->active);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_BBOX: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ result = ListboxBboxSubCmd(interp, listPtr, index);
+ break;
+ }
+
+ case COMMAND_CGET: {
+ Tcl_Obj *objPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ break;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *)listPtr,
+ listPtr->optionTable, objv[2], listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_CONFIGURE: {
+ Tcl_Obj *objPtr;
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) listPtr,
+ listPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ }
+ } else {
+ result = ConfigureListbox(interp, listPtr, objc-2, objv+2, 0);
+ }
+ break;
+ }
+
+ case COMMAND_CURSELECTION: {
+ char indexStringRep[TCL_INTEGER_SPACE];
+ int i;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ /*
+ * Of course, it would be more efficient to use the Tcl_HashTable
+ * search functions (Tcl_FirstHashEntry, Tcl_NextHashEntry), but
+ * then the result wouldn't be in sorted order. So instead we
+ * loop through the indices in order, adding them to the result
+ * if they are selected
+ */
+ for (i = 0; i < listPtr->nElements; i++) {
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
+ sprintf(indexStringRep, "%d", i);
+ Tcl_AppendElement(interp, indexStringRep);
+ }
+ }
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_DELETE: {
+ int first, last;
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "firstIndex ?lastIndex?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (!(listPtr->state & STATE_NORMAL)) {
+ break;
+ }
+
+ if (first < listPtr->nElements) {
+ /*
+ * if a "last index" was given, get it now; otherwise, use the
+ * first index as the last index
+ */
+ if (objc == 4) {
+ result = GetListboxIndex(interp, listPtr,
+ objv[3], 0, &last);
+ if (result != TCL_OK) {
+ break;
+ }
+ } else {
+ last = first;
+ }
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
+ }
+ result = ListboxDeleteSubCmd(listPtr, first, last);
+ } else {
+ result = TCL_OK;
+ }
+ break;
+ }
+
+ case COMMAND_GET: {
+ int first, last;
+ Tcl_Obj **elemPtrs;
+ int listLen;
+ if (objc != 3 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
+ if (result != TCL_OK) {
+ break;
+ }
+ last = first;
+ if (objc == 4) {
+ result = GetListboxIndex(interp, listPtr, objv[3], 0, &last);
+ if (result != TCL_OK) {
+ break;
+ }
+ }
+ if (first >= listPtr->nElements) {
+ result = TCL_OK;
+ break;
+ }
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (first > last) {
+ result = TCL_OK;
+ break;
+ }
+ result = Tcl_ListObjGetElements(interp, listPtr->listObj, &listLen,
+ &elemPtrs);
+ if (result != TCL_OK) {
+ break;
+ }
+ if (objc == 3) {
+ /*
+ * One element request - we return a string
+ */
+ Tcl_SetObjResult(interp, elemPtrs[first]);
+ } else {
+ Tcl_SetListObj(Tcl_GetObjResult(interp), (last - first + 1),
+ &(elemPtrs[first]));
+ }
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_INDEX:{
+ char buf[TCL_INTEGER_SPACE];
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+ sprintf(buf, "%d", index);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_INSERT: {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "index ?element element ...?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (!(listPtr->state & STATE_NORMAL)) {
+ break;
+ }
+
+ result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3);
+ break;
+ }
+
+ case COMMAND_ITEMCGET: {
+ Tcl_Obj *objPtr;
+ ItemAttr *attrPtr;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index option");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (index < 0 || index >= listPtr->nElements) {
+ Tcl_AppendResult(interp, "item number \"",
+ Tcl_GetString(objv[2]), "\" out of range",
+ (char *)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+
+ attrPtr = ListboxGetItemAttributes(interp, listPtr, index);
+
+ objPtr = Tk_GetOptionValue(interp, (char *)attrPtr,
+ listPtr->itemAttrOptionTable, objv[3], listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_ITEMCONFIGURE: {
+ Tcl_Obj *objPtr;
+ ItemAttr *attrPtr;
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "index ?option? ?value? ?option value ...?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (index < 0 || index >= listPtr->nElements) {
+ Tcl_AppendResult(interp, "item number \"",
+ Tcl_GetString(objv[2]), "\" out of range",
+ (char *)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+
+ attrPtr = ListboxGetItemAttributes(interp, listPtr, index);
+ if (objc <= 4) {
+ objPtr = Tk_GetOptionInfo(interp, (char *)attrPtr,
+ listPtr->itemAttrOptionTable,
+ (objc == 4) ? objv[3] : (Tcl_Obj *) NULL,
+ listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ }
+ } else {
+ result = ConfigureListboxItem(interp, listPtr, attrPtr,
+ objc-3, objv+3);
+ }
+ break;
+ }
+
+ case COMMAND_NEAREST: {
+ char buf[TCL_INTEGER_SPACE];
+ int y;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "y");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = Tcl_GetIntFromObj(interp, objv[2], &y);
+ if (result != TCL_OK) {
+ break;
+ }
+ index = NearestListboxElement(listPtr, y);
+ sprintf(buf, "%d", index);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_SCAN: {
+ int x, y, scanCmdIndex;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y");
+ result = TCL_ERROR;
+ break;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], scanCommandNames,
+ "option", 0, &scanCmdIndex);
+ if (result != TCL_OK) {
+ break;
+ }
+ switch (scanCmdIndex) {
+ case SCAN_MARK: {
+ listPtr->scanMarkX = x;
+ listPtr->scanMarkY = y;
+ listPtr->scanMarkXOffset = listPtr->xOffset;
+ listPtr->scanMarkYIndex = listPtr->topIndex;
+ break;
+ }
+ case SCAN_DRAGTO: {
+ ListboxScanTo(listPtr, x, y);
+ break;
+ }
+ }
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_SEE: {
+ int diff;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements - 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);
+ }
+ }
+ }
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_SELECTION: {
+ if (!(listPtr->state & STATE_NORMAL)) {
+ break;
+ }
+
+ result = ListboxSelectionSubCmd(interp, listPtr, objc, objv);
+ break;
+ }
+
+ case COMMAND_SIZE: {
+ char buf[TCL_INTEGER_SPACE];
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ sprintf(buf, "%d", listPtr->nElements);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_XVIEW: {
+ result = ListboxXviewSubCmd(interp, listPtr, objc, objv);
+ break;
+ }
+
+ case COMMAND_YVIEW: {
+ result = ListboxYviewSubCmd(interp, listPtr, objc, objv);
+ break;
+ }
+ }
+ Tcl_Release((ClientData)listPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxBboxSubCmd --
+ *
+ * This procedure is invoked to process a listbox bbox request.
+ * See the user documentation for more information.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * For valid indices, places the bbox of the requested element in
+ * the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxBboxSubCmd(interp, listPtr, index)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int index; /* Index of the element to get bbox info on */
+{
+ int lastVisibleIndex;
+ /* Determine the index of the last visible item in the listbox */
+ lastVisibleIndex = listPtr->topIndex + listPtr->fullLines
+ + listPtr->partialLine;
+ if (listPtr->nElements < lastVisibleIndex) {
+ lastVisibleIndex = listPtr->nElements;
+ }
+
+ /* Only allow bbox requests for indices that are visible */
+ if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) {
+ char buf[TCL_INTEGER_SPACE * 4];
+ Tcl_Obj *el;
+ char *stringRep;
+ int pixelWidth, stringLen, x, y, result;
+ Tk_FontMetrics fm;
+
+ /* Compute the pixel width of the requested element */
+ result = Tcl_ListObjIndex(interp, listPtr->listObj, index, &el);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ stringRep = Tcl_GetStringFromObj(el, &stringLen);
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen);
+
+ x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
+ y = ((index - listPtr->topIndex)*listPtr->lineHeight)
+ + listPtr->inset + listPtr->selBorderWidth;
+ sprintf(buf, "%d %d %d %d", x, y, pixelWidth, fm.linespace);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxSelectionSubCmd --
+ *
+ * This procedure is invoked to process the selection sub command
+ * for listbox widgets.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May set the interpreter's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxSelectionSubCmd(interp, listPtr, objc, objv)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int objc; /* Number of arguments in the objv array */
+ Tcl_Obj *CONST objv[]; /* Array of arguments to the procedure */
+{
+ int selCmdIndex, first, last;
+ int result = TCL_OK;
+ if (objc != 4 && objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option index ?index?");
+ return TCL_ERROR;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[3], 0, &first);
+ if (result != TCL_OK) {
+ return result;
+ }
+ last = first;
+ if (objc == 5) {
+ result = GetListboxIndex(interp, listPtr, objv[4], 0, &last);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames,
+ "option", 0, &selCmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+ switch (selCmdIndex) {
+ case SELECTION_ANCHOR: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+ if (first >= listPtr->nElements) {
+ first = listPtr->nElements - 1;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ listPtr->selectAnchor = first;
+ result = TCL_OK;
+ break;
+ }
+ case SELECTION_CLEAR: {
+ result = ListboxSelect(listPtr, first, last, 0);
+ break;
+ }
+ case SELECTION_INCLUDES: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)first)) {
+ Tcl_SetResult(interp, "1", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "0", TCL_STATIC);
+ }
+ result = TCL_OK;
+ break;
+ }
+ case SELECTION_SET: {
+ result = ListboxSelect(listPtr, first, last, 1);
+ break;
+ }
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxXviewSubCmd --
+ *
+ * Process the listbox "xview" subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May change the listbox viewing area; may set the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxXviewSubCmd(interp, listPtr, objc, objv)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int objc; /* Number of arguments in the objv array */
+ Tcl_Obj *CONST objv[]; /* Array of arguments to the procedure */
+{
+
+ 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 (objc == 2) {
+ if (listPtr->maxWidth == 0) {
+ Tcl_SetResult(interp, "0 1", TCL_STATIC);
+ } else {
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ fraction = listPtr->xOffset/((double) listPtr->maxWidth);
+ fraction2 = (listPtr->xOffset + windowWidth)
+ /((double) listPtr->maxWidth);
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
+ }
+ sprintf(buf, "%g %g", fraction, fraction2);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ } else if (objc == 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
+ } else {
+ type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_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);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxYviewSubCmd --
+ *
+ * Process the listbox "yview" subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May change the listbox viewing area; may set the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxYviewSubCmd(interp, listPtr, objc, objv)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int objc; /* Number of arguments in the objv array */
+ Tcl_Obj *CONST objv[]; /* Array of arguments to the procedure */
+{
+ int index, count, type;
+ double fraction, fraction2;
+
+ if (objc == 2) {
+ if (listPtr->nElements == 0) {
+ Tcl_SetResult(interp, "0 1", TCL_STATIC);
+ } else {
+ char buf[TCL_DOUBLE_SPACE * 2];
+
+ fraction = listPtr->topIndex/((double) listPtr->nElements);
+ fraction2 = (listPtr->topIndex+listPtr->fullLines)
+ /((double) listPtr->nElements);
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
+ }
+ sprintf(buf, "%g %g", fraction, fraction2);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ } else if (objc == 3) {
+ if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ChangeListboxView(listPtr, index);
+ } else {
+ type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ index = (int) (listPtr->nElements*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);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxGetItemAttributes --
+ *
+ * Returns a pointer to the ItemAttr record for a given index,
+ * creating one if it does not already exist.
+ *
+ * Results:
+ * Pointer to an ItemAttr record.
+ *
+ * Side effects:
+ * Memory may be allocated for the ItemAttr record.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ItemAttr *
+ListboxGetItemAttributes(interp, listPtr, index)
+ Tcl_Interp *interp; /* Pointer to the calling Tcl interpreter */
+ Listbox *listPtr; /* Information about the listbox */
+ int index; /* Index of the item to retrieve attributes
+ * for */
+{
+ int new;
+ Tcl_HashEntry *entry;
+ ItemAttr *attrs;
+
+ entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, (char *)index,
+ &new);
+ if (new) {
+ attrs = (ItemAttr *) ckalloc(sizeof(ItemAttr));
+ attrs->border = NULL;
+ attrs->selBorder = NULL;
+ attrs->fgColor = NULL;
+ attrs->selFgColor = NULL;
+ Tk_InitOptions(interp, (char *)attrs, listPtr->itemAttrOptionTable,
+ listPtr->tkwin);
+ Tcl_SetHashValue(entry, (ClientData) attrs);
+ }
+ attrs = (ItemAttr *)Tcl_GetHashValue(entry);
+ return attrs;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch search;
+
+ /* If we have an internal list object, free it */
+ if (listPtr->listObj != NULL) {
+ Tcl_DecrRefCount(listPtr->listObj);
+ listPtr->listObj = NULL;
+ }
+
+ if (listPtr->listVarName != NULL) {
+ Tcl_UntraceVar(listPtr->interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, (ClientData) listPtr);
+ }
+
+ /* Free the selection hash table */
+ Tcl_DeleteHashTable(listPtr->selection);
+ ckfree((char *)listPtr->selection);
+
+ /* Free the item attribute hash table */
+ for (entry = Tcl_FirstHashEntry(listPtr->itemAttrTable, &search);
+ entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+ ckfree((char *)Tcl_GetHashValue(entry));
+ }
+ Tcl_DeleteHashTable(listPtr->itemAttrTable);
+ ckfree((char *)listPtr->itemAttrTable);
+
+ /*
+ * 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);
+ }
+ if (listPtr->gray != None) {
+ Tk_FreeBitmap(Tk_Display(listPtr->tkwin), listPtr->gray);
+ }
+
+ Tk_FreeConfigOptions((char *)listPtr, listPtr->optionTable,
+ listPtr->tkwin);
+ Tcl_Release((ClientData) listPtr->tkwin);
+ listPtr->tkwin = NULL;
+ ckfree((char *) listPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyListboxOptionTables --
+ *
+ * This procedure is registered as an exit callback when the listbox
+ * command is first called. It cleans up the OptionTables structure
+ * allocated by that command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyListboxOptionTables(clientData, interp)
+ ClientData clientData; /* Pointer to the OptionTables struct */
+ Tcl_Interp *interp; /* Pointer to the calling interp */
+{
+ ckfree((char *)clientData);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureListbox --
+ *
+ * This procedure is called to process an objv/objc list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * a listbox widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for listPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureListbox(interp, listPtr, objc, objv, 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 objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *oldListObj = NULL;
+ Tcl_Obj *errorResult = NULL;
+ int oldExport, error;
+
+ oldExport = listPtr->exportSelection;
+ if (listPtr->listVarName != NULL) {
+ Tcl_UntraceVar(interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, (ClientData) listPtr);
+ }
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) listPtr,
+ listPtr->optionTable, objc, objv,
+ listPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border.
+ */
+
+ 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);
+ }
+
+ /* Verify the current status of the list var.
+ * PREVIOUS STATE | NEW STATE | ACTION
+ * ---------------+------------+----------------------------------
+ * no listvar | listvar | If listvar does not exist, create
+ * it and copy the internal list obj's
+ * content to the new var. If it does
+ * exist, toss the internal list obj.
+ *
+ * listvar | no listvar | Copy old listvar content to the
+ * internal list obj
+ *
+ * listvar | listvar | no special action
+ *
+ * no listvar | no listvar | no special action
+ */
+ oldListObj = listPtr->listObj;
+ if (listPtr->listVarName != NULL) {
+ Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
+ (char *) NULL, TCL_GLOBAL_ONLY);
+ int dummy;
+ if (listVarObj == NULL) {
+ listVarObj = (oldListObj ? oldListObj : Tcl_NewObj());
+ if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *) NULL,
+ listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ if (oldListObj == NULL) {
+ Tcl_DecrRefCount(listVarObj);
+ }
+ continue;
+ }
+ }
+ /* Make sure the object is a good list object */
+ if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy)
+ != TCL_OK) {
+ Tcl_AppendResult(listPtr->interp,
+ ": invalid -listvariable value", (char *) NULL);
+ continue;
+ }
+
+ listPtr->listObj = listVarObj;
+ Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, (ClientData) listPtr);
+ } else if (listPtr->listObj == NULL) {
+ listPtr->listObj = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(listPtr->listObj);
+ if (oldListObj != NULL) {
+ Tcl_DecrRefCount(oldListObj);
+ }
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /* Make sure that the list length is correct */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ ListboxWorldChanged((ClientData) listPtr);
+ return TCL_OK;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureListboxItem --
+ *
+ * This procedure is called to process an objv/objc list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * a listbox item.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for a listbox item; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureListboxItem(interp, listPtr, attrs, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Listbox *listPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ ItemAttr *attrs; /* Information about the item to configure */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ Tk_SavedOptions savedOptions;
+
+ if (Tk_SetOptions(interp, (char *)attrs,
+ listPtr->itemAttrOptionTable, objc, objv, listPtr->tkwin,
+ &savedOptions, (int *)NULL) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+ Tk_FreeSavedOptions(&savedOptions);
+ 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;
+
+ if (listPtr->state & STATE_NORMAL) {
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ } else {
+ if (listPtr->dfgColorPtr != NULL) {
+ gcValues.foreground = listPtr->dfgColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ } else {
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ mask = GCForeground | GCFont;
+ if (listPtr->gray == None) {
+ listPtr->gray = Tk_GetBitmap(NULL, listPtr->tkwin, "gray50");
+ }
+ if (listPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = listPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ }
+ }
+
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ 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_GetGC(listPtr->tkwin, mask, &gcValues);
+ 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;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-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;
+ GC gc;
+ int i, limit, x, y, width, prevSelected, freeGC;
+ Tk_FontMetrics fm;
+ Tcl_Obj *curElement;
+ Tcl_HashEntry *entry;
+ char *stringRep;
+ int stringLen;
+ ItemAttr *attrs;
+ Tk_3DBorder selectedBg;
+ XGCValues gcValues;
+ unsigned long mask;
+ 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 & LISTBOX_DELETED) {
+ return;
+ }
+
+ if (listPtr->flags & MAXWIDTH_IS_STALE) {
+ ListboxComputeGeometry(listPtr, 0, 1, 0);
+ listPtr->flags &= ~MAXWIDTH_IS_STALE;
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+
+ Tcl_Preserve((ClientData) listPtr);
+ if (listPtr->flags & UPDATE_V_SCROLLBAR) {
+ ListboxUpdateVScrollbar(listPtr);
+ if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
+ Tcl_Release((ClientData) listPtr);
+ return;
+ }
+ }
+ if (listPtr->flags & UPDATE_H_SCROLLBAR) {
+ ListboxUpdateHScrollbar(listPtr);
+ if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
+ Tcl_Release((ClientData) listPtr);
+ return;
+ }
+ }
+ listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR);
+ Tcl_Release((ClientData) listPtr);
+
+ /*
+ * 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);
+
+ /* Display each item in the listbox */
+ limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
+ if (limit >= listPtr->nElements) {
+ limit = listPtr->nElements-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 (i = listPtr->topIndex; i <= limit; i++) {
+ x = listPtr->inset;
+ y = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ + listPtr->inset;
+ gc = listPtr->textGC;
+ freeGC = 0;
+ /*
+ * Lookup this item in the item attributes table, to see if it has
+ * special foreground/background colors
+ */
+ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i);
+
+ /*
+ * If the listbox is enabled, items may be drawn differently;
+ * they may be drawn selected, or they may have special foreground
+ * or background colors.
+ */
+ if (listPtr->state & STATE_NORMAL) {
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
+ /* Selected items are drawn differently. */
+ gc = listPtr->selTextGC;
+ width = Tk_Width(tkwin) - 2*listPtr->inset;
+ selectedBg = listPtr->selBorder;
+
+ /* If there is attribute information for this item,
+ * adjust the drawing accordingly */
+ if (entry != NULL) {
+ attrs = (ItemAttr *)Tcl_GetHashValue(entry);
+ /* Default GC has the values from the widget at large */
+ gcValues.foreground = listPtr->selFgColorPtr->pixel;
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+
+ if (attrs->selBorder != NULL) {
+ selectedBg = attrs->selBorder;
+ }
+
+ if (attrs->selFgColor != NULL) {
+ gcValues.foreground = attrs->selFgColor->pixel;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ freeGC = 1;
+ }
+ }
+
+ Tk_Fill3DRectangle(tkwin, pixmap, selectedBg, 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" & "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" & "right" vars, computed above, have non-zero
+ * values that extend the top and bottom bevels so that
+ * the mitered corners are off-screen.
+ */
+
+ /* Draw left bevel */
+ if (left == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
+ x, y, listPtr->selBorderWidth, listPtr->lineHeight,
+ 1, TK_RELIEF_RAISED);
+ }
+ /* Draw right bevel */
+ if (right == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
+ x + width - listPtr->selBorderWidth, y,
+ listPtr->selBorderWidth, listPtr->lineHeight,
+ 0, TK_RELIEF_RAISED);
+ }
+ /* Draw top bevel */
+ if (!prevSelected) {
+ Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg,
+ x-left, y, width+left+right,
+ listPtr->selBorderWidth,
+ 1, 1, 1, TK_RELIEF_RAISED);
+ }
+ /* Draw bottom bevel */
+ if (i + 1 == listPtr->nElements ||
+ Tcl_FindHashEntry(listPtr->selection,
+ (char *)(i + 1)) == NULL ) {
+ Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left,
+ y + listPtr->lineHeight - listPtr->selBorderWidth,
+ width+left+right, listPtr->selBorderWidth, 0, 0, 0,
+ TK_RELIEF_RAISED);
+ }
+ prevSelected = 1;
+ } else {
+ /*
+ * If there is an item attributes record for this item, draw
+ * the background box and set the foreground color accordingly
+ */
+ if (entry != NULL) {
+ attrs = (ItemAttr *)Tcl_GetHashValue(entry);
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+
+ /*
+ * If the item has its own background color, draw it now.
+ */
+
+ if (attrs->border != NULL) {
+ width = Tk_Width(tkwin) - 2*listPtr->inset;
+ Tk_Fill3DRectangle(tkwin, pixmap, attrs->border, x, y,
+ width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
+ }
+
+ /*
+ * If the item has its own foreground, use it to override
+ * the value in the gcValues structure.
+ */
+
+ if ((listPtr->state & STATE_NORMAL)
+ && attrs->fgColor != NULL) {
+ gcValues.foreground = attrs->fgColor->pixel;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ freeGC = 1;
+ }
+ }
+ prevSelected = 0;
+ }
+ }
+
+ /* Draw the actual text of this item */
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ y += fm.ascent + listPtr->selBorderWidth;
+ x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement);
+ stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
+ Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont,
+ stringRep, stringLen, x, y);
+
+ /* If this is the active element, apply the activestyle to it. */
+ if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
+ if (listPtr->activeStyle == ACTIVE_STYLE_UNDERLINE) {
+ /* Underline the text. */
+ Tk_UnderlineChars(listPtr->display, pixmap, gc,
+ listPtr->tkfont, stringRep, x, y, 0, stringLen);
+ } else if (listPtr->activeStyle == ACTIVE_STYLE_DOTBOX) {
+#ifdef WIN32
+ /*
+ * This provides for exact default look and feel on Windows.
+ */
+ TkWinDCState state;
+ HDC dc;
+ RECT rect;
+
+ dc = TkWinGetDrawableDC(listPtr->display, pixmap, &state);
+ rect.left = listPtr->inset;
+ rect.top = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ + listPtr->inset;
+ rect.right = rect.left + width;
+ rect.bottom = rect.top + listPtr->lineHeight;
+ DrawFocusRect(dc, &rect);
+ TkWinReleaseDrawableDC(pixmap, dc, &state);
+#else
+ /*
+ * Draw a dotted box around the text.
+ */
+ x = listPtr->inset;
+ y = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ + listPtr->inset;
+ width = Tk_Width(tkwin) - 2*listPtr->inset - 1;
+
+ gcValues.line_style = LineOnOffDash;
+ gcValues.line_width = listPtr->selBorderWidth;
+ if (gcValues.line_width <= 0) {
+ gcValues.line_width = 1;
+ }
+ gcValues.dash_offset = 0;
+ gcValues.dashes = 1;
+ /*
+ * You would think the XSetDashes was necessary, but it
+ * appears that the default dotting for just saying we
+ * want dashes appears to work correctly.
+ static char dashList[] = { 1 };
+ static int dashLen = sizeof(dashList);
+ XSetDashes(listPtr->display, gc, 0, dashList, dashLen);
+ */
+ mask = GCLineWidth | GCLineStyle | GCDashList | GCDashOffset;
+ XChangeGC(listPtr->display, gc, mask, &gcValues);
+ XDrawRectangle(listPtr->display, pixmap, gc, x, y,
+ (unsigned) width, (unsigned) listPtr->lineHeight - 1);
+ if (!freeGC) {
+ /* Don't bother changing if it is about to be freed. */
+ gcValues.line_style = LineSolid;
+ XChangeGC(listPtr->display, gc, GCLineStyle, &gcValues);
+ }
+#endif
+ }
+ }
+
+ if (freeGC) {
+ Tk_FreeGC(listPtr->display, gc);
+ }
+ }
+
+ /*
+ * 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 fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
+ if (listPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ listPtr->highlightWidth, pixmap);
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ 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. */
+{
+ int width, height, pixelWidth, pixelHeight;
+ Tk_FontMetrics fm;
+ Tcl_Obj *element;
+ int textLength;
+ char *text;
+ int i, result;
+
+ if (fontChanged || maxIsStale) {
+ listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1);
+ if (listPtr->xScrollUnit == 0) {
+ listPtr->xScrollUnit = 1;
+ }
+ listPtr->maxWidth = 0;
+ for (i = 0; i < listPtr->nElements; i++) {
+ /* Compute the pixel width of the current element */
+ result = Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
+ &element);
+ if (result != TCL_OK) {
+ continue;
+ }
+ text = Tcl_GetStringFromObj(element, &textLength);
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, text, textLength);
+ if (pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = 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->nElements;
+ 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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxInsertSubCmd --
+ *
+ * This procedure is invoked to handle the listbox "insert"
+ * subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * New elements are added to the listbox pointed to by listPtr;
+ * a refresh callback is registered for the listbox.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxInsertSubCmd(listPtr, index, objc, objv)
+ register Listbox *listPtr; /* Listbox that is to get the new
+ * elements. */
+ int index; /* Add the new elements before this
+ * element. */
+ int objc; /* Number of new elements to add. */
+ Tcl_Obj *CONST objv[]; /* New elements (one per entry). */
+{
+ int i, oldMaxWidth;
+ Tcl_Obj *newListObj;
+ int pixelWidth;
+ int result;
+ char *stringRep;
+ int length;
+
+ oldMaxWidth = listPtr->maxWidth;
+ for (i = 0; i < objc; i++) {
+ /*
+ * Check if any of the new elements are wider than the current widest;
+ * if so, update our notion of "widest."
+ */
+ stringRep = Tcl_GetStringFromObj(objv[i], &length);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
+ if (pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = pixelWidth;
+ }
+ }
+
+ /* Adjust selection and attribute information for every index after
+ * the first index */
+ MigrateHashEntries(listPtr->selection, index, listPtr->nElements-1, objc);
+ MigrateHashEntries(listPtr->itemAttrTable, index, listPtr->nElements-1,
+ objc);
+
+ /* If the object is shared, duplicate it before writing to it */
+ if (Tcl_IsShared(listPtr->listObj)) {
+ newListObj = Tcl_DuplicateObj(listPtr->listObj);
+ } else {
+ newListObj = listPtr->listObj;
+ }
+ result =
+ Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0, objc, objv);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_IncrRefCount(newListObj);
+ /* Clean up the old reference */
+ Tcl_DecrRefCount(listPtr->listObj);
+
+ /* Set the internal pointer to the new obj */
+ listPtr->listObj = newListObj;
+
+ /* If there is a listvar, make sure it points at the new object */
+ if (listPtr->listVarName != NULL) {
+ if (Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName,
+ (char *)NULL, newListObj, TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DecrRefCount(newListObj);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Get the new list length */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ /*
+ * Update the "special" indices (anchor, topIndex, active) to account
+ * for the renumbering that just occurred. Then arrange for the new
+ * information to be displayed.
+ */
+
+ if (index <= listPtr->selectAnchor) {
+ listPtr->selectAnchor += objc;
+ }
+ if (index < listPtr->topIndex) {
+ listPtr->topIndex += objc;
+ }
+ if (index <= listPtr->active) {
+ listPtr->active += objc;
+ if ((listPtr->active >= listPtr->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ if (listPtr->maxWidth != oldMaxWidth) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ ListboxComputeGeometry(listPtr, 0, 0, 0);
+ EventuallyRedrawRange(listPtr, index, listPtr->nElements-1);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxDeleteSubCmd --
+ *
+ * Process a listbox "delete" subcommand by removing one or more
+ * elements from a listbox widget.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * The listbox will be modified and (eventually) redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxDeleteSubCmd(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. */
+{
+ int count, i, widthChanged;
+ Tcl_Obj *newListObj;
+ Tcl_Obj *element;
+ int length;
+ char *stringRep;
+ int result;
+ int pixelWidth;
+ Tcl_HashEntry *entry;
+
+ /*
+ * 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->nElements) {
+ last = listPtr->nElements-1;
+ }
+ count = last + 1 - first;
+ if (count <= 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Foreach deleted index we must:
+ * a) remove selection information
+ * b) check the width of the element; if it is equal to the max, set
+ * widthChanged to 1, because it may be the only element with that
+ * width
+ */
+ widthChanged = 0;
+ for (i = first; i <= last; i++) {
+ /* Remove selection information */
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ listPtr->numSelected--;
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i);
+ if (entry != NULL) {
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ /* Check width of the element. We only have to check if widthChanged
+ * has not already been set to 1, because we only need one maxWidth
+ * element to disappear for us to have to recompute the width
+ */
+ if (widthChanged == 0) {
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element);
+ stringRep = Tcl_GetStringFromObj(element, &length);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
+ if (pixelWidth == listPtr->maxWidth) {
+ widthChanged = 1;
+ }
+ }
+ }
+
+ /* Adjust selection and attribute info for indices after lastIndex */
+ MigrateHashEntries(listPtr->selection, last+1,
+ listPtr->nElements-1, count*-1);
+ MigrateHashEntries(listPtr->itemAttrTable, last+1,
+ listPtr->nElements-1, count*-1);
+
+ /* Delete the requested elements */
+ if (Tcl_IsShared(listPtr->listObj)) {
+ newListObj = Tcl_DuplicateObj(listPtr->listObj);
+ } else {
+ newListObj = listPtr->listObj;
+ }
+ result = Tcl_ListObjReplace(listPtr->interp,
+ newListObj, first, count, 0, NULL);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_IncrRefCount(newListObj);
+ /* Clean up the old reference */
+ Tcl_DecrRefCount(listPtr->listObj);
+
+ /* Set the internal pointer to the new obj */
+ listPtr->listObj = newListObj;
+
+ /* Get the new list length */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ /* If there is a listvar, make sure it points at the new object */
+ if (listPtr->listVarName != NULL) {
+ if (Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName,
+ (char *)NULL, newListObj, TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DecrRefCount(newListObj);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * 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->nElements - listPtr->fullLines)) {
+ listPtr->topIndex = listPtr->nElements - 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->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ ListboxComputeGeometry(listPtr, 0, widthChanged, 0);
+ if (widthChanged) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ EventuallyRedrawRange(listPtr, first, listPtr->nElements-1);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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) {
+ EventuallyRedrawRange(listPtr,
+ NearestListboxElement(listPtr, eventPtr->xexpose.y),
+ NearestListboxElement(listPtr, eventPtr->xexpose.y
+ + eventPtr->xexpose.height));
+ } else if (eventPtr->type == DestroyNotify) {
+ if (!(listPtr->flags & LISTBOX_DELETED)) {
+ listPtr->flags |= LISTBOX_DELETED;
+ Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
+ if (listPtr->setGrid) {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ if (listPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayListbox, clientData);
+ }
+ Tcl_EventuallyFree(clientData, 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.
+ */
+
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags |= GOT_FOCUS;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags &= ~GOT_FOCUS;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-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;
+
+ /*
+ * 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 (!(listPtr->flags & LISTBOX_DELETED)) {
+ Tk_DestroyWindow(listPtr->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 the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetListboxIndex(interp, listPtr, indexObj, endIsSize, indexPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ Listbox *listPtr; /* Listbox for which the index is being
+ * specified. */
+ Tcl_Obj *indexObj; /* 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 result;
+ int index;
+ char *stringRep;
+
+ /* First see if the index is one of the named indices */
+ result = Tcl_GetIndexFromObj(NULL, indexObj, indexNames, "", 0, &index);
+ if (result == TCL_OK) {
+ switch (index) {
+ case INDEX_ACTIVE: {
+ /* "active" index */
+ *indexPtr = listPtr->active;
+ break;
+ }
+
+ case INDEX_ANCHOR: {
+ /* "anchor" index */
+ *indexPtr = listPtr->selectAnchor;
+ break;
+ }
+
+ case INDEX_END: {
+ /* "end" index */
+ if (endIsSize) {
+ *indexPtr = listPtr->nElements;
+ } else {
+ *indexPtr = listPtr->nElements - 1;
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+ }
+
+ /* The index didn't match any of the named indices; maybe it's an @x,y */
+ stringRep = Tcl_GetString(indexObj);
+ if (stringRep[0] == '@') {
+ /* @x,y index */
+ int y;
+ char *start, *end;
+ start = stringRep + 1;
+ strtol(start, &end, 0);
+ if ((start == end) || (*end != ',')) {
+ Tcl_AppendResult(interp, "bad listbox index \"", stringRep,
+ "\": must be active, anchor, end, @x,y, or a number",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ start = end+1;
+ y = strtol(start, &end, 0);
+ if ((start == end) || (*end != '\0')) {
+ Tcl_AppendResult(interp, "bad listbox index \"", stringRep,
+ "\": must be active, anchor, end, @x,y, or a number",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ *indexPtr = NearestListboxElement(listPtr, y);
+ return TCL_OK;
+ }
+
+ /* Maybe the index is just an integer */
+ if (Tcl_GetIntFromObj(interp, indexObj, indexPtr) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ /* Everything failed, nothing matched. Throw up an error message */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad listbox index \"",
+ Tcl_GetString(indexObj), "\": 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->nElements - listPtr->fullLines)) {
+ index = listPtr->nElements - listPtr->fullLines;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ if (listPtr->topIndex != index) {
+ listPtr->topIndex = index;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ 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.
+ *
+ * Add half a scroll unit to do entry/text-like synchronization.
+ * [Bug #225025]
+ */
+
+ offset += listPtr->xScrollUnit / 2;
+ 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;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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->nElements - 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->nElements) {
+ index = listPtr->nElements-1;
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxSelect --
+ *
+ * Select or deselect one or more elements in a listbox..
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * 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 int
+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;
+ Tcl_HashEntry *entry;
+ int new;
+
+ if (last < first) {
+ i = first;
+ first = last;
+ last = i;
+ }
+ if ((last < 0) || (first >= listPtr->nElements)) {
+ return TCL_OK;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
+ }
+ oldCount = listPtr->numSelected;
+ firstRedisplay = -1;
+ increment = select ? 1 : -1;
+
+ /*
+ * For each index in the range, find it in our selection hash table.
+ * If it's not there but should be, add it. If it's there but shouldn't
+ * be, remove it.
+ */
+ for (i = first; i <= last; i++) {
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ if (!select) {
+ Tcl_DeleteHashEntry(entry);
+ listPtr->numSelected--;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
+ } else {
+ if (select) {
+ entry = Tcl_CreateHashEntry(listPtr->selection,
+ (char *)i, &new);
+ Tcl_SetHashValue(entry, (ClientData) NULL);
+ listPtr->numSelected++;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
+ }
+ }
+
+ if (firstRedisplay >= 0) {
+ EventuallyRedrawRange(listPtr, first, last);
+ }
+ if ((oldCount == 0) && (listPtr->numSelected > 0)
+ && (listPtr->exportSelection)) {
+ Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
+ (ClientData) listPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ Tcl_DString selection;
+ int length, count, needNewline;
+ Tcl_Obj *curElement;
+ char *stringRep;
+ int stringLen;
+ Tcl_HashEntry *entry;
+ int i;
+
+ if (!listPtr->exportSelection) {
+ return -1;
+ }
+
+ /*
+ * Use a dynamic string to accumulate the contents of the selection.
+ */
+
+ needNewline = 0;
+ Tcl_DStringInit(&selection);
+ for (i = 0; i < listPtr->nElements; i++) {
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ if (needNewline) {
+ Tcl_DStringAppend(&selection, "\n", 1);
+ }
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
+ &curElement);
+ stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
+ Tcl_DStringAppend(&selection, stringRep, stringLen);
+ 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->nElements > 0)) {
+ ListboxSelect(listPtr, 0, listPtr->nElements-1, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyRedrawRange --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EventuallyRedrawRange(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. */
+{
+ /* We don't have to register a redraw callback if one is already pending,
+ * or if the window doesn't exist, or if the window isn't mapped */
+ if ((listPtr->flags & REDRAW_PENDING)
+ || (listPtr->flags & LISTBOX_DELETED)
+ || !Tk_IsMapped(listPtr->tkwin)) {
+ return;
+ }
+ listPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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[TCL_DOUBLE_SPACE * 2];
+ double first, last;
+ int result;
+ Tcl_Interp *interp;
+
+ if (listPtr->yScrollCmd == NULL) {
+ return;
+ }
+ if (listPtr->nElements == 0) {
+ first = 0.0;
+ last = 1.0;
+ } else {
+ first = listPtr->topIndex/((double) listPtr->nElements);
+ last = (listPtr->topIndex+listPtr->fullLines)
+ /((double) listPtr->nElements);
+ 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[TCL_DOUBLE_SPACE * 2];
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxListVarProc --
+ *
+ * Called whenever the trace on the listbox list var fires.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ListboxListVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ CONST char *name1; /* Not used. */
+ CONST char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ Listbox *listPtr = (Listbox *)clientData;
+ Tcl_Obj *oldListObj, *varListObj;
+ int oldLength;
+ int i;
+ Tcl_HashEntry *entry;
+
+ /* Bwah hahahaha -- puny mortal, you can't unset a -listvar'd variable! */
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2Ex(interp, listPtr->listVarName,
+ (char *)NULL, listPtr->listObj, TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, clientData);
+ return (char *)NULL;
+ }
+ } else {
+ oldListObj = listPtr->listObj;
+ varListObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName,
+ (char *)NULL, TCL_GLOBAL_ONLY);
+ /*
+ * Make sure the new value is a good list; if it's not, disallow
+ * the change -- the fact that it is a listvar means that it must
+ * always be a valid list -- and return an error message.
+ */
+ if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) {
+ Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
+ oldListObj, TCL_GLOBAL_ONLY);
+ return("invalid listvar value");
+ }
+
+ listPtr->listObj = varListObj;
+ /* Incr the obj ref count so it doesn't vanish if the var is unset */
+ Tcl_IncrRefCount(listPtr->listObj);
+ /* Clean up the ref to our old list obj */
+ Tcl_DecrRefCount(oldListObj);
+ }
+
+ /*
+ * If the list length has decreased, then we should clean up selection and
+ * attributes information for elements past the end of the new list
+ */
+ oldLength = listPtr->nElements;
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+ if (listPtr->nElements < oldLength) {
+ for (i = listPtr->nElements; i < oldLength; i++) {
+ /* Clean up selection */
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ listPtr->numSelected--;
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ /* Clean up attributes */
+ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *)i);
+ if (entry != NULL) {
+ Tcl_DeleteHashEntry(entry);
+ }
+ }
+ }
+
+ if (oldLength != listPtr->nElements) {
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
+ listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
+ if (listPtr->topIndex < 0) {
+ listPtr->topIndex = 0;
+ }
+ }
+ }
+
+ /*
+ * The computed maxWidth may have changed as a result of this operation.
+ * However, we don't want to recompute it every time this trace fires
+ * (imagine the user doing 1000 lappends to the listvar). Therefore, set
+ * the MAXWIDTH_IS_STALE flag, which will cause the width to be recomputed
+ * next time the list is redrawn.
+ */
+ listPtr->flags |= MAXWIDTH_IS_STALE;
+
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ return (char*)NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MigrateHashEntries --
+ *
+ * Given a hash table with entries keyed by a single integer value,
+ * move all entries in a given range by a fixed amount, so that
+ * if in the original table there was an entry with key n and
+ * the offset was i, in the new table that entry would have key n + i.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Rekeys some hash table entries.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MigrateHashEntries(table, first, last, offset)
+ Tcl_HashTable *table;
+ int first;
+ int last;
+ int offset;
+{
+ int i, new;
+ Tcl_HashEntry *entry;
+ ClientData clientData;
+
+ if (offset == 0) {
+ return;
+ }
+ /* It's more efficient to do one if/else and nest the for loops inside,
+ * although we could avoid some code duplication if we nested the if/else
+ * inside the for loops */
+ if (offset > 0) {
+ for (i = last; i >= first; i--) {
+ entry = Tcl_FindHashEntry(table, (char *)i);
+ if (entry != NULL) {
+ clientData = Tcl_GetHashValue(entry);
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_CreateHashEntry(table, (char *)(i + offset), &new);
+ Tcl_SetHashValue(entry, clientData);
+ }
+ }
+ } else {
+ for (i = first; i <= last; i++) {
+ entry = Tcl_FindHashEntry(table, (char *)i);
+ if (entry != NULL) {
+ clientData = Tcl_GetHashValue(entry);
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_CreateHashEntry(table, (char *)(i + offset), &new);
+ Tcl_SetHashValue(entry, clientData);
+ }
+ }
+ }
+ return;
+}
+
diff --git a/tcl/generic/tkMacWinMenu.c b/tcl/generic/tkMacWinMenu.c
new file mode 100644
index 00000000000..a0bf8026a11
--- /dev/null
+++ b/tcl/generic/tkMacWinMenu.c
@@ -0,0 +1,143 @@
+/*
+ * 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"
+
+typedef struct ThreadSpecificData {
+ int postCommandGeneration;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+
+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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_Preserve((ClientData) menuPtr);
+
+ /*
+ * First, let's process the post command on ourselves. If this command
+ * destroys this menu, or if there was an error, we are done.
+ */
+
+ 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]->namePtr != NULL)) {
+ if ((menuPtr->entries[index]->childMenuRefPtr != NULL)
+ && (menuPtr->entries[index]->childMenuRefPtr->menuPtr
+ != NULL)) {
+ cascadeMenuPtr =
+ menuPtr->entries[index]->childMenuRefPtr->menuPtr;
+ if (cascadeMenuPtr->postCommandGeneration !=
+ tsdPtr->postCommandGeneration) {
+ cascadeMenuPtr->postCommandGeneration =
+ tsdPtr->postCommandGeneration;
+ result = PreprocessMenu(cascadeMenuPtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ finished = 0;
+ break;
+ }
+ }
+ }
+ }
+ } 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;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->postCommandGeneration++;
+ menuPtr->postCommandGeneration = tsdPtr->postCommandGeneration;
+ return PreprocessMenu(menuPtr);
+}
diff --git a/tcl/generic/tkMain.c b/tcl/generic/tkMain.c
new file mode 100644
index 00000000000..3fb23290274
--- /dev/null
+++ b/tcl/generic/tkMain.c
@@ -0,0 +1,453 @@
+/*
+ * tkMain.c --
+ *
+ * This file contains a generic main program for Tk-based applications.
+ * It can be used as-is for many applications, just by supplying a
+ * different appInitProc procedure for each specific application.
+ * Or, it can be used as a template for creating new main programs
+ * for Tk applications.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <ctype.h>
+#include <stdio.h>
+#include <string.h>
+#include <tcl.h>
+#include <tclInt.h>
+#include <tk.h>
+#include "tkInt.h"
+#ifdef NO_STDLIB_H
+# include "../compat/stdlib.h"
+#else
+# include <stdlib.h>
+#endif
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+
+typedef struct ThreadSpecificData {
+ Tcl_Interp *interp; /* Interpreter for this thread. */
+ Tcl_DString command; /* Used to assemble lines of terminal input
+ * into Tcl commands. */
+ Tcl_DString line; /* Used to read the next line from the
+ * terminal input. */
+ int tty; /* Non-zero means standard input is a
+ * terminal-like device. Zero means it's
+ * a file. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Declarations for various library procedures and variables (don't want
+ * to include tkInt.h or tkPort.h here, because people might copy this
+ * file out of the Tk source directory to make their own modified versions).
+ * Note: don't declare "exit" here even though a declaration is really
+ * needed, because it will conflict with a declaration elsewhere on
+ * some systems.
+ */
+
+#if !defined(__WIN32__) && !defined(_WIN32)
+#if !defined(MAC_TCL)
+extern int isatty _ANSI_ARGS_((int fd));
+#else
+#include <unistd.h>
+#endif
+extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
+#endif
+
+/*
+ * 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_MainEx --
+ *
+ * Main program for Wish and most other Tk-based applications.
+ *
+ * Results:
+ * None. This procedure never returns (it exits the process when
+ * it's done.
+ *
+ * Side effects:
+ * This procedure initializes the Tk world and then starts
+ * interpreting commands; almost anything could happen, depending
+ * on the script being interpreted.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tk_MainEx(argc, argv, appInitProc, interp)
+ int argc; /* Number of arguments. */
+ char **argv; /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc; /* Application-specific initialization
+ * procedure to call after most
+ * initialization but before starting
+ * to execute commands. */
+ Tcl_Interp *interp;
+{
+ char *args;
+ CONST char *fileName;
+ char buf[TCL_INTEGER_SPACE];
+ int code;
+ size_t length;
+ Tcl_Channel inChannel, outChannel;
+ Tcl_DString argString;
+ ThreadSpecificData *tsdPtr;
+#ifdef __WIN32__
+ HANDLE handle;
+#endif
+
+ /*
+ * Ensure that we are getting the matching version of Tcl. This is
+ * really only an issue when Tk is loaded dynamically.
+ */
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ abort();
+ }
+
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_FindExecutable(argv[0]);
+ tsdPtr->interp = interp;
+
+#if (defined(__WIN32__) || defined(MAC_TCL))
+ Tk_InitConsoleChannels(interp);
+#endif
+
+#ifdef TCL_MEM_DEBUG
+ Tcl_InitMemory(interp);
+#endif
+
+ /*
+ * Parse command-line arguments. A leading "-file" argument is
+ * ignored (a historical relic from the distant past). If the
+ * next argument doesn't start with a "-" then strip it off and
+ * use it as the name of a script file to process.
+ */
+
+ fileName = TclGetStartupScriptFileName();
+
+ if (argc > 1) {
+ length = strlen(argv[1]);
+ if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
+ argc--;
+ argv++;
+ }
+ }
+ if (fileName == NULL) {
+ 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, (CONST char **)argv+1);
+ Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
+ Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&argString);
+ ckfree(args);
+ sprintf(buf, "%d", argc-1);
+
+ if (fileName == NULL) {
+ Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
+ } else {
+ fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString);
+ }
+ Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
+
+ /*
+ * Set the "tcl_interactive" variable.
+ */
+
+ /*
+ * For now, under Windows, we assume we are not running as a console mode
+ * app, so we need to use the GUI console. In order to enable this, we
+ * always claim to be running on a tty. This probably isn't the right
+ * way to do it.
+ */
+
+#ifdef __WIN32__
+ handle = GetStdHandle(STD_INPUT_HANDLE);
+
+ if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)
+ || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
+ /*
+ * If it's a bad or closed handle, then it's been connected
+ * to a wish console window.
+ */
+
+ tsdPtr->tty = 1;
+ } else if (GetFileType(handle) == FILE_TYPE_CHAR) {
+ /*
+ * A character file handle is a tty by definition.
+ */
+
+ tsdPtr->tty = 1;
+ } else {
+ tsdPtr->tty = 0;
+ }
+
+#else
+ tsdPtr->tty = isatty(0);
+#endif
+ Tcl_SetVar(interp, "tcl_interactive",
+ ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+
+ /*
+ * Invoke application-specific initialization.
+ */
+
+ if ((*appInitProc)(interp) != TCL_OK) {
+ TkpDisplayWarning(Tcl_GetStringResult(interp),
+ "Application initialization failed");
+ }
+
+ /*
+ * Invoke the script specified on the command line, if any.
+ */
+
+ if (fileName != NULL) {
+ Tcl_ResetResult(interp);
+ code = Tcl_EvalFile(interp, fileName);
+ if (code != TCL_OK) {
+ /*
+ * The following statement guarantees that the errorInfo
+ * variable is set properly.
+ */
+
+ Tcl_AddErrorInfo(interp, "");
+ TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
+ TCL_GLOBAL_ONLY), "Error in startup script");
+ Tcl_DeleteInterp(interp);
+ Tcl_Exit(1);
+ }
+ tsdPtr->tty = 0;
+ } else {
+
+ /*
+ * Evaluate the .rc file, if one has been specified.
+ */
+
+ Tcl_SourceRCFile(interp);
+
+ /*
+ * Establish a channel handler for stdin.
+ */
+
+ inChannel = Tcl_GetStdChannel(TCL_STDIN);
+ if (inChannel) {
+ Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
+ (ClientData) inChannel);
+ }
+ if (tsdPtr->tty) {
+ Prompt(interp, 0);
+ }
+ }
+ Tcl_DStringFree(&argString);
+
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ if (outChannel) {
+ Tcl_Flush(outChannel);
+ }
+ Tcl_DStringInit(&tsdPtr->command);
+ Tcl_DStringInit(&tsdPtr->line);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Loop infinitely, waiting for commands to execute. When there
+ * are no windows left, Tk_MainLoop returns and we exit.
+ */
+
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_Interp *interp = tsdPtr->interp;
+
+ count = Tcl_Gets(chan, &tsdPtr->line);
+
+ if (count < 0) {
+ if (!gotPartial) {
+ if (tsdPtr->tty) {
+ Tcl_Exit(0);
+ } else {
+ Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
+ }
+ return;
+ }
+ }
+
+ (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
+ &tsdPtr->line), -1);
+ cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
+ Tcl_DStringFree(&tsdPtr->line);
+ if (!Tcl_CommandComplete(cmd)) {
+ gotPartial = 1;
+ goto prompt;
+ }
+ gotPartial = 0;
+
+ /*
+ * 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(&tsdPtr->command);
+ if (Tcl_GetStringResult(interp)[0] != '\0') {
+ if ((code != TCL_OK) || (tsdPtr->tty)) {
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
+ }
+ }
+ }
+
+ /*
+ * Output a prompt.
+ */
+
+ prompt:
+ if (tsdPtr->tty) {
+ Prompt(interp, gotPartial);
+ }
+ Tcl_ResetResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ Tcl_Obj *promptCmd;
+ int code;
+ Tcl_Channel outChannel, errChannel;
+
+ promptCmd = Tcl_GetVar2Ex(interp,
+ partial ? "tcl_prompt2" : "tcl_prompt1", NULL, 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_WriteChars(outChannel, "% ", 2);
+ }
+ }
+ } else {
+ code = Tcl_EvalObjEx(interp, promptCmd, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (script that generates prompt)");
+ /*
+ * We must check that errChannel is a real channel - it
+ * is possible that someone has transferred stderr out of
+ * this interpreter with "interp transfer".
+ */
+
+ errChannel = Tcl_GetChannel(interp, "stderr", NULL);
+ if (errChannel != (Tcl_Channel) NULL) {
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
+ }
+ goto defaultPrompt;
+ }
+ }
+ outChannel = Tcl_GetChannel(interp, "stdout", NULL);
+ if (outChannel != (Tcl_Channel) NULL) {
+ Tcl_Flush(outChannel);
+ }
+}
diff --git a/tcl/generic/tkMenu.c b/tcl/generic/tkMenu.c
new file mode 100644
index 00000000000..1d5218ac8dd
--- /dev/null
+++ b/tcl/generic/tkMenu.c
@@ -0,0 +1,3490 @@
+/*
+ * tkMenu.c --
+ *
+ * This file contains most of the code for implementing menus in Tk. It takes
+ * care of all of the generic (platform-independent) parts of menus, and
+ * is supplemented by platform-specific files. The geometry calculation
+ * and drawing code for menus is in the file tkMenuDraw.c
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * 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.
+ *
+ */
+
+#if 0
+
+/*
+ * used only to test for old config code
+ */
+
+#define __NO_OLD_CONFIG
+#endif
+
+#include "tkPort.h"
+#include "tkMenu.h"
+
+#define MENU_HASH_KEY "tkMenus"
+
+typedef struct ThreadSpecificData {
+ int menusInitialized; /* Flag indicates whether thread-specific
+ * elements of the Windows Menu module
+ * have been initialized. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following flag indicates whether the process-wide state for
+ * the Menu module has been intialized. The Mutex protects access to
+ * that flag.
+ */
+
+static int menusInitialized;
+TCL_DECLARE_MUTEX(menuMutex)
+
+/*
+ * Configuration specs for individual menu entries. If this changes, be sure
+ * to update code in TkpMenuInit that changes the font string entry.
+ */
+
+char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL};
+
+static CONST char *menuEntryTypeStrings[] = {
+ "cascade", "checkbutton", "command", "radiobutton", "separator",
+ (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -compound option.
+ * It is used with the "enum compound" declaration in tkMenu.h
+ */
+
+static char *compoundStrings[] = {
+ "bottom", "center", "left", "none", "right", "top", (char *) NULL
+};
+
+Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1,
+ TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_FG,
+ Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACCELERATOR,
+ Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BITMAP,
+ Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COLUMN_BREAK,
+ -1, Tk_Offset(TkMenuEntry, columnBreak)},
+ {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COMMAND,
+ Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_MENU_ENTRY_COMPOUND, -1, Tk_Offset(TkMenuEntry, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FONT,
+ Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FG,
+ Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_HIDE_MARGIN,
+ -1, Tk_Offset(TkMenuEntry, hideMargin)},
+ {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_IMAGE,
+ Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_LABEL,
+ Tk_Offset(TkMenuEntry, labelPtr), -1, 0},
+ {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_STATE,
+ -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) tkMenuStateStrings},
+ {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)},
+ {TK_OPTION_END}
+};
+
+Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END}
+};
+
+Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn)},
+ {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_OFF_VALUE,
+ Tk_Offset(TkMenuEntry, offValuePtr), -1},
+ {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ON_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1},
+ {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_CHECK_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
+};
+
+Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn)},
+ {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_RADIO_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
+};
+
+Tk_OptionSpec tkCascadeEntryConfigSpecs[] = {
+ {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_MENU,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
+};
+
+Tk_OptionSpec tkTearoffEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) tkMenuStateStrings},
+ {TK_OPTION_END}
+};
+
+static Tk_OptionSpec *specsArray[] = {
+ tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs,
+ tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs,
+ tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs};
+
+/*
+ * Menu type strings for use with Tcl_GetIndexFromObj.
+ */
+
+static CONST char *menuTypeStrings[] = {"normal", "tearoff", "menubar",
+ (char *) NULL};
+
+Tk_OptionSpec tkMenuConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground",
+ "Foreground", DEF_MENU_ACTIVE_BG_COLOR,
+ Tk_Offset(TkMenu, activeBorderPtr), -1, 0,
+ (ClientData) DEF_MENU_ACTIVE_BG_MONO},
+ {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth",
+ "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
+ Tk_Offset(TkMenu, activeBorderWidthPtr), -1},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground",
+ "Background", DEF_MENU_ACTIVE_FG_COLOR,
+ Tk_Offset(TkMenu, activeFgPtr), -1, 0,
+ (ClientData) DEF_MENU_ACTIVE_FG_MONO},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0,
+ (ClientData) DEF_MENU_BG_MONO},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background"},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MENU_BORDER_WIDTH,
+ Tk_Offset(TkMenu, borderWidthPtr), -1, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MENU_CURSOR,
+ Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
+ Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) DEF_MENU_DISABLED_FG_MONO},
+ {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1},
+ {TK_OPTION_STRING, "-postcommand", "postCommand", "Command",
+ DEF_MENU_POST_COMMAND,
+ Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1},
+ {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background",
+ DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0,
+ (ClientData) DEF_MENU_SELECT_MONO},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENU_TAKE_FOCUS,
+ Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff",
+ DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)},
+ {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand",
+ "TearOffCommand", DEF_MENU_TEAROFF_CMD,
+ Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-title", "title", "Title",
+ DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1,
+ TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING_TABLE, "-type", "type", "Type",
+ DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) menuTypeStrings},
+ {TK_OPTION_END}
+};
+
+/*
+ * Command line options. Put here because MenuCmd has to look at them
+ * along with MenuWidgetObjCmd.
+ */
+
+static CONST char *menuOptions[] = {
+ "activate", "add", "cget", "clone", "configure", "delete", "entrycget",
+ "entryconfigure", "index", "insert", "invoke", "post", "postcascade",
+ "type", "unpost", "yposition", (char *) NULL
+};
+enum options {
+ MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE,
+ MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX,
+ MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE,
+ MENU_UNPOST, MENU_YPOSITION
+};
+
+/*
+ * Prototypes for static procedures in this file:
+ */
+
+static int CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
+ Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString));
+static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[]));
+static int ConfigureMenuCloneEntries _ANSI_ARGS_((
+ Tcl_Interp *interp, TkMenu *menuPtr, int index,
+ int objc, Tcl_Obj *CONST objv[]));
+static int ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
+ int first, int last));
+static void DestroyMenuHashTable _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+static void DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr));
+static void DestroyMenuEntry _ANSI_ARGS_((char *memPtr));
+static int GetIndexFromCoords
+ _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
+ char *string, int *indexPtr));
+static int MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, Tcl_Obj *objPtr));
+static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int MenuCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void MenuCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
+ int type));
+static char * MenuVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static int MenuWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void MenuWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int PostProcessEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
+static void RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr));
+static void UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
+
+/*
+ * The structure below is a list of procs that respond to certain window
+ * manager events. One of these includes a font change, which forces
+ * the geometry proc to be called.
+ */
+
+static Tk_ClassProcs menuClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ MenuWorldChanged /* worldChangedProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCreateMenuCmd --
+ *
+ * Called by Tk at initialization time to create the menu
+ * command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCreateMenuCmd(interp)
+ Tcl_Interp *interp; /* Interpreter we are creating the
+ * command in. */
+{
+ TkMenuOptionTables *optionTablesPtr =
+ (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables));
+
+ optionTablesPtr->menuOptionTable =
+ Tk_CreateOptionTable(interp, tkMenuConfigSpecs);
+ optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]);
+ optionTablesPtr->entryOptionTables[COMMAND_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]);
+ optionTablesPtr->entryOptionTables[CASCADE_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]);
+ optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]);
+ optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]);
+ optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]);
+
+ Tcl_CreateObjCommand(interp, "menu", MenuCmd,
+ (ClientData) optionTablesPtr, NULL);
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "menu", "menu");
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuCmd --
+ *
+ * This procedure is invoked to process the "menu" Tcl
+ * command. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ Tk_Window tkwin = Tk_MainWindow(interp);
+ Tk_Window new;
+ register TkMenu *menuPtr;
+ TkMenuReferences *menuRefPtr;
+ int i, index;
+ int toplevel;
+ char *windowName;
+ static CONST char *typeStringList[] = {"-type", (char *) NULL};
+ TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ TkMenuInit();
+
+ toplevel = 1;
+ for (i = 2; i < (objc - 1); i++) {
+ if (Tcl_GetIndexFromObj(NULL, objv[i], typeStringList, NULL, 0, &index)
+ != TCL_ERROR) {
+ if ((Tcl_GetIndexFromObj(NULL, objv[i + 1], menuTypeStrings, NULL,
+ 0, &index) == TCL_OK) && (index == MENUBAR)) {
+ toplevel = 0;
+ }
+ break;
+ }
+ }
+
+ windowName = Tcl_GetStringFromObj(objv[1], NULL);
+ new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? ""
+ : NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize the data structure for the menu.
+ */
+
+ menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu));
+ menuPtr->tkwin = new;
+ menuPtr->display = Tk_Display(new);
+ menuPtr->interp = interp;
+ menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd,
+ (ClientData) menuPtr, MenuCmdDeletedProc);
+ menuPtr->entries = NULL;
+ menuPtr->numEntries = 0;
+ menuPtr->active = -1;
+ menuPtr->borderPtr = NULL;
+ menuPtr->borderWidthPtr = NULL;
+ menuPtr->reliefPtr = NULL;
+ menuPtr->activeBorderPtr = NULL;
+ menuPtr->activeBorderWidthPtr = NULL;
+ menuPtr->fontPtr = NULL;
+ menuPtr->fgPtr = NULL;
+ menuPtr->disabledFgPtr = NULL;
+ menuPtr->activeFgPtr = NULL;
+ menuPtr->indicatorFgPtr = NULL;
+ menuPtr->tearoff = 0;
+ menuPtr->tearoffCommandPtr = NULL;
+ menuPtr->cursorPtr = None;
+ menuPtr->takeFocusPtr = NULL;
+ menuPtr->postCommandPtr = NULL;
+ menuPtr->postCommandGeneration = 0;
+ menuPtr->postedCascade = NULL;
+ menuPtr->nextInstancePtr = NULL;
+ menuPtr->masterMenuPtr = menuPtr;
+ menuPtr->menuType = UNKNOWN_TYPE;
+ menuPtr->menuFlags = 0;
+ menuPtr->parentTopLevelPtr = NULL;
+ menuPtr->menuTypePtr = NULL;
+ menuPtr->titlePtr = NULL;
+ menuPtr->errorStructPtr = NULL;
+ menuPtr->optionTablesPtr = optionTablesPtr;
+ TkMenuInitializeDrawingFields(menuPtr);
+
+ Tk_SetClass(menuPtr->tkwin, "Menu");
+ Tk_SetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
+ if (Tk_InitOptions(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ ckfree((char *) menuPtr);
+ return TCL_ERROR;
+ }
+
+
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
+ Tk_PathName(menuPtr->tkwin));
+ menuRefPtr->menuPtr = menuPtr;
+ menuPtr->menuRefPtr = menuRefPtr;
+ if (TCL_OK != TkpNewMenu(menuPtr)) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ ckfree((char *) menuPtr);
+ return TCL_ERROR;
+ }
+
+ Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
+ TkMenuEventProc, (ClientData) menuPtr);
+ if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If a menu has a parent menu pointing to it as a cascade entry, the
+ * parent menu needs to be told that this menu now exists so that
+ * the platform-part of the menu is correctly updated.
+ *
+ * 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;
+ Tcl_Obj *newMenuName;
+ Tcl_Obj *newObjv[2];
+
+ while (cascadeListPtr != NULL) {
+
+ nextCascadePtr = cascadeListPtr->nextCascadePtr;
+
+ /*
+ * If we have a new master menu, and an existing cloned menu
+ * points to this menu in a cascade entry, we have to clone
+ * the new menu and point the entry to the clone instead
+ * of the menu we are creating. Otherwise, ConfigureMenuEntry
+ * will hook up the platform-specific cascade linkages now
+ * that the menu we are creating exists.
+ */
+
+ if ((menuPtr->masterMenuPtr != menuPtr)
+ || ((menuPtr->masterMenuPtr == menuPtr)
+ && ((cascadeListPtr->menuPtr->masterMenuPtr
+ == cascadeListPtr->menuPtr)))) {
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ } else {
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *windowNamePtr = Tcl_NewStringObj(
+ Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1);
+
+ Tcl_IncrRefCount(normalPtr);
+ Tcl_IncrRefCount(windowNamePtr);
+ newMenuName = TkNewMenuName(menuPtr->interp,
+ windowNamePtr, menuPtr);
+ Tcl_IncrRefCount(newMenuName);
+ CloneMenu(menuPtr, newMenuName, normalPtr);
+
+ /*
+ * Now we can set the new menu instance to be the cascade entry
+ * of the parent's instance.
+ */
+
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = newMenuName;
+ Tcl_IncrRefCount(newObjv[0]);
+ ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
+ Tcl_DecrRefCount(normalPtr);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ Tcl_DecrRefCount(windowNamePtr);
+ }
+ cascadeListPtr = nextCascadePtr;
+ }
+ }
+
+ /*
+ * If there already exist toplevel widgets that refer to this menu,
+ * 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;
+ }
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuWidgetObjCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about menu widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ register TkMenu *menuPtr = (TkMenu *) clientData;
+ register TkMenuEntry *mePtr;
+ int result = TCL_OK;
+ int option;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0,
+ &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) menuPtr);
+
+ switch ((enum options) option) {
+ case MENU_ACTIVATE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "activate index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (menuPtr->active == index) {
+ goto done;
+ }
+ if ((index >= 0)
+ && ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
+ || (menuPtr->entries[index]->state
+ == ENTRY_DISABLED))) {
+ index = -1;
+ }
+ result = TkActivateMenuEntry(menuPtr, index);
+ break;
+ }
+ case MENU_ADD:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?");
+ goto error;
+ }
+
+ if (MenuAddOrInsert(interp, menuPtr, (Tcl_Obj *) NULL,
+ objc - 2, objv + 2) != TCL_OK) {
+ goto error;
+ }
+ break;
+ case MENU_CGET: {
+ Tcl_Obj *resultPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, objv[2],
+ menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
+ }
+ case MENU_CLONE:
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "clone newMenuName ?menuType?");
+ goto error;
+ }
+ result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]);
+ break;
+ case MENU_CONFIGURE: {
+ Tcl_Obj *resultPtr;
+
+ if (objc == 2) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable,
+ (Tcl_Obj *) NULL, menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else if (objc == 3) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable,
+ objv[2], menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else {
+ result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2);
+ }
+ if (result != TCL_OK) {
+ goto error;
+ }
+ break;
+ }
+ case MENU_DELETE: {
+ int first, last;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first)
+ != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first;
+ } else {
+ if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last)
+ != TCL_OK) {
+ goto error;
+ }
+ }
+ if (menuPtr->tearoff && (first == 0)) {
+
+ /*
+ * Sorry, can't delete the tearoff entry; must reconfigure
+ * the menu.
+ */
+
+ first = 1;
+ }
+ if ((first < 0) || (last < first)) {
+ goto done;
+ }
+ DeleteMenuCloneEntries(menuPtr, first, last);
+ break;
+ }
+ case MENU_ENTRYCGET: {
+ int index;
+ Tcl_Obj *resultPtr;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ Tcl_Preserve((ClientData) mePtr);
+ resultPtr = Tk_GetOptionValue(interp, (char *) mePtr,
+ mePtr->optionTable, objv[3], menuPtr->tkwin);
+ Tcl_Release((ClientData) mePtr);
+ if (resultPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
+ }
+ case MENU_ENTRYCONFIGURE: {
+ int index;
+ Tcl_Obj *resultPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "entryconfigure index ?option value ...?");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ Tcl_Preserve((ClientData) mePtr);
+ if (objc == 3) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
+ mePtr->optionTable, (Tcl_Obj *) NULL, menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else if (objc == 4) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
+ mePtr->optionTable, objv[3], menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else {
+ result = ConfigureMenuCloneEntries(interp, menuPtr, index,
+ objc - 3, objv + 3);
+ }
+ Tcl_Release((ClientData) mePtr);
+ break;
+ }
+ case MENU_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "index string");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ Tcl_SetResult(interp, "none", TCL_STATIC);
+ } else {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ }
+ break;
+ }
+ case MENU_INSERT:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "insert index type ?options?");
+ goto error;
+ }
+ if (MenuAddOrInsert(interp, menuPtr, objv[2], objc - 3,
+ objv + 3) != TCL_OK) {
+ goto error;
+ }
+ break;
+ case MENU_INVOKE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ result = TkInvokeMenu(interp, menuPtr, index);
+ break;
+ }
+ case MENU_POST: {
+ int x, y;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "post x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+
+ /*
+ * Tearoff menus are posted differently on Mac and Windows than
+ * non-tearoffs. TkpPostMenu does not actually map the menu's
+ * window on those platforms, and popup menus have to be
+ * handled specially.
+ */
+
+ if (menuPtr->menuType != TEAROFF_MENU) {
+ result = TkpPostMenu(interp, menuPtr, x, y);
+ } else {
+ result = TkPostTearoffMenu(interp, menuPtr, x, y);
+ }
+ break;
+ }
+ case MENU_POSTCASCADE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "postcascade index");
+ goto error;
+ }
+
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if ((index < 0) || (menuPtr->entries[index]->type
+ != CASCADE_ENTRY)) {
+ result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
+ } else {
+ result = TkPostSubmenu(interp, menuPtr,
+ menuPtr->entries[index]);
+ }
+ break;
+ }
+ case MENU_TYPE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ if (menuPtr->entries[index]->type == TEAROFF_ENTRY) {
+ Tcl_SetResult(interp, "tearoff", TCL_STATIC);
+ } else {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ menuEntryTypeStrings[menuPtr->entries[index]->type],
+ -1);
+ }
+ break;
+ }
+ case MENU_UNPOST:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "unpost");
+ goto error;
+ }
+ Tk_UnmapWindow(menuPtr->tkwin);
+ result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
+ break;
+ case MENU_YPOSITION:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "yposition index");
+ goto error;
+ }
+ result = MenuDoYPosition(interp, menuPtr, objv[2]);
+ break;
+ }
+ done:
+ Tcl_Release((ClientData) menuPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) menuPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInvokeMenu --
+ *
+ * Given a menu and an index, takes the appropriate action for the
+ * 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 == ENTRY_DISABLED) {
+ goto done;
+ }
+ Tcl_Preserve((ClientData) mePtr);
+ if (mePtr->type == TEAROFF_ENTRY) {
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "tk::TearOffMenu ", -1);
+ Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1);
+ result = Tcl_Eval(interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ } else if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ && (mePtr->namePtr != NULL)) {
+ Tcl_Obj *valuePtr;
+
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ valuePtr = mePtr->offValuePtr;
+ } else {
+ valuePtr = mePtr->onValuePtr;
+ }
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(valuePtr);
+ if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ } else if ((mePtr->type == RADIO_BUTTON_ENTRY)
+ && (mePtr->namePtr != NULL)) {
+ Tcl_Obj *valuePtr = mePtr->onValuePtr;
+
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(valuePtr);
+ if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ }
+ /*
+ * We check numEntries in addition to whether the menu entry
+ * has a command because that goes to zero if the menu gets
+ * deleted (e.g., during command evaluation).
+ */
+ if ((menuPtr->numEntries != 0) && (result == TCL_OK)
+ && (mePtr->commandPtr != NULL)) {
+ Tcl_Obj *commandPtr = mePtr->commandPtr;
+
+ Tcl_IncrRefCount(commandPtr);
+ result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(commandPtr);
+ }
+ Tcl_Release((ClientData) mePtr);
+ done:
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuInstance --
+ *
+ * This procedure is invoked by TkDestroyMenu
+ * 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;
+ TkMenu *menuInstancePtr;
+ TkMenuEntry *cascadePtr, *nextCascadePtr;
+ Tcl_Obj *newObjv[2];
+ TkMenu *parentMasterMenuPtr;
+ TkMenuEntry *parentMasterEntryPtr;
+
+ /*
+ * If the menu has any cascade menu entries pointing to it, the cascade
+ * entries need to be told that the menu is going away. We need to clear
+ * the menu ptr field in the menu reference at this point in the code
+ * so that everything else can forget about this menu properly. We also
+ * need to reset -menu field of all entries that are not master menus
+ * 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) {
+ nextCascadePtr = cascadePtr->nextCascadePtr;
+
+ if (menuPtr->masterMenuPtr != menuPtr) {
+ Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
+
+ parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
+ parentMasterEntryPtr =
+ parentMasterMenuPtr->entries[cascadePtr->index];
+ newObjv[0] = menuNamePtr;
+ newObjv[1] = parentMasterEntryPtr->namePtr;
+ /*
+ * It is possible that the menu info is out of sync, and
+ * these things point to NULL, so verify existence [Bug: 3402]
+ */
+ if (newObjv[0] && newObjv[1]) {
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ ConfigureMenuEntry(cascadePtr, 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ }
+ } else {
+ ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL);
+ }
+ }
+
+ if (menuPtr->masterMenuPtr != menuPtr) {
+ for (menuInstancePtr = menuPtr->masterMenuPtr;
+ menuInstancePtr != NULL;
+ menuInstancePtr = menuInstancePtr->nextInstancePtr) {
+ if (menuInstancePtr->nextInstancePtr == menuPtr) {
+ menuInstancePtr->nextInstancePtr =
+ menuInstancePtr->nextInstancePtr->nextInstancePtr;
+ break;
+ }
+ }
+ } else if (menuPtr->nextInstancePtr != NULL) {
+ panic("Attempting to delete master menu when there are still clones.");
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeConfigOptions handle all the standard option-related
+ * stuff.
+ */
+
+ for (i = menuPtr->numEntries; --i >= 0; ) {
+ /*
+ * As each menu entry is deleted from the end of the array of
+ * entries, decrement menuPtr->numEntries. Otherwise, the act of
+ * deleting menu entry i will dereference freed memory attempting
+ * to queue a redraw for menu entries (i+1)...numEntries.
+ */
+
+ DestroyMenuEntry((char *) menuPtr->entries[i]);
+ menuPtr->numEntries = i;
+ }
+ if (menuPtr->entries != NULL) {
+ ckfree((char *) menuPtr->entries);
+ }
+ TkMenuFreeDrawOptions(menuPtr);
+ Tk_FreeConfigOptions((char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDestroyMenu --
+ *
+ * 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_FreeConfigOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ UnhookCascadeEntry(mePtr);
+ }
+ if (mePtr->image != NULL) {
+ Tk_FreeImage(mePtr->image);
+ }
+ if (mePtr->selectImage != NULL) {
+ Tk_FreeImage(mePtr->selectImage);
+ }
+ if (((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY))
+ && (mePtr->namePtr != NULL)) {
+ char *varName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ Tcl_UntraceVar(menuPtr->interp, varName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+ TkpDestroyMenuEntry(mePtr);
+ TkMenuEntryFreeDrawOptions(mePtr);
+ Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin);
+ ckfree((char *) mePtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MenuWorldChanged --
+ *
+ * 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 the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, font, etc. get set
+ * for menuPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenu(interp, menuPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkMenu *menuPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ int i;
+ TkMenu *menuListPtr, *cleanupPtr;
+ int result;
+
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+ menuListPtr->errorStructPtr = (Tk_SavedOptions *)
+ ckalloc(sizeof(Tk_SavedOptions));
+ result = Tk_SetOptions(interp, (char *) menuListPtr,
+ menuListPtr->optionTablesPtr->menuOptionTable, objc, objv,
+ menuListPtr->tkwin, menuListPtr->errorStructPtr, (int *) NULL);
+ if (result != TCL_OK) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+ if (menuListPtr->errorStructPtr != NULL) {
+ Tk_RestoreSavedOptions(menuListPtr->errorStructPtr);
+ ckfree((char *) menuListPtr->errorStructPtr);
+ menuListPtr->errorStructPtr = NULL;
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * When a menu is created, the type is in all of the arguments
+ * to the menu command. Let Tk_ConfigureWidget take care of
+ * parsing them, and then set the type after we can look at
+ * the type string. Once set, a menu's type cannot be changed
+ */
+
+ if (menuListPtr->menuType == UNKNOWN_TYPE) {
+ Tcl_GetIndexFromObj(NULL, menuListPtr->menuTypePtr,
+ menuTypeStrings, NULL, 0, &menuListPtr->menuType);
+
+ /*
+ * Configure the new window to be either a pop-up menu
+ * or a tear-off menu.
+ * We don't do this for menubars since they are not toplevel
+ * windows. Also, since this gets called before CloneMenu has
+ * a chance to set the menuType field, we have to look at the
+ * menuTypeName field to tell that this is a menu bar.
+ */
+
+ if (menuListPtr->menuType == MASTER_MENU) {
+ TkpMakeMenuWindow(menuListPtr->tkwin, 1);
+ } else if (menuListPtr->menuType == TEAROFF_MENU) {
+ TkpMakeMenuWindow(menuListPtr->tkwin, 0);
+ }
+ }
+
+
+ /*
+ * Depending on the -tearOff option, make sure that there is or
+ * isn't an initial tear-off entry at the beginning of the menu.
+ */
+
+ if (menuListPtr->tearoff) {
+ if ((menuListPtr->numEntries == 0)
+ || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
+ if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+ if (menuListPtr->errorStructPtr != NULL) {
+ Tk_RestoreSavedOptions(menuListPtr->errorStructPtr);
+ ckfree((char *) menuListPtr->errorStructPtr);
+ menuListPtr->errorStructPtr = NULL;
+ }
+ return TCL_ERROR;
+ }
+ }
+ } else if ((menuListPtr->numEntries > 0)
+ && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
+ int i;
+
+ Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
+ DestroyMenuEntry);
+
+ for (i = 0; i < menuListPtr->numEntries - 1; i++) {
+ menuListPtr->entries[i] = menuListPtr->entries[i + 1];
+ menuListPtr->entries[i]->index = i;
+ }
+ menuListPtr->numEntries--;
+ if (menuListPtr->numEntries == 0) {
+ ckfree((char *) menuListPtr->entries);
+ menuListPtr->entries = NULL;
+ }
+ }
+
+ TkMenuConfigureDrawOptions(menuListPtr);
+
+ /*
+ * After reconfiguring a menu, we need to reconfigure all of the
+ * entries in the menu, since some of the things in the children
+ * (such as graphics contexts) may have to change to reflect changes
+ * in the parent.
+ */
+
+ for (i = 0; i < menuListPtr->numEntries; i++) {
+ TkMenuEntry *mePtr;
+
+ mePtr = menuListPtr->entries[i];
+ ConfigureMenuEntry(mePtr, 0, (Tcl_Obj **) NULL);
+ }
+
+ TkEventuallyRecomputeMenu(menuListPtr);
+ }
+
+ for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_FreeSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PostProcessEntry --
+ *
+ * This is called by ConfigureMenuEntry to do all of the configuration
+ * after Tk_SetOptions is called. This is separate
+ * so that error handling is easier.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get
+ * set for mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PostProcessEntry(mePtr)
+ TkMenuEntry *mePtr; /* The entry we are configuring. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ int index = mePtr->index;
+ char *name;
+ Tk_Image image;
+
+ /*
+ * The code below handles special configuration stuff not taken
+ * care of by Tk_ConfigureWidget, such as special processing for
+ * defaults, sizing strings, graphics contexts, etc.
+ */
+
+ if (mePtr->labelPtr == NULL) {
+ mePtr->labelLength = 0;
+ } else {
+ Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength);
+ }
+ if (mePtr->accelPtr == NULL) {
+ mePtr->accelLength = 0;
+ } else {
+ Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength);
+ }
+
+ /*
+ * If this is a cascade entry, the platform-specific data of the child
+ * menu has to be updated. Also, the links that point to parents and
+ * cascades have to be updated.
+ */
+
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
+ TkMenuEntry *cascadeEntryPtr;
+ int alreadyThere;
+ TkMenuReferences *menuRefPtr;
+ char *oldHashKey = NULL; /* Initialization only needed to
+ * prevent compiler warning. */
+
+ /*
+ * This is a cascade entry. If the menu that the cascade entry
+ * is pointing to has changed, we need to remove this entry
+ * from the list of entries pointing to the old menu, and add a
+ * cascade reference to the list of entries pointing to the
+ * new menu.
+ *
+ * BUG: We are not recloning for special case #3 yet.
+ */
+
+ name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ if (mePtr->childMenuRefPtr != NULL) {
+ oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
+ mePtr->childMenuRefPtr->hashEntryPtr);
+ if (strcmp(oldHashKey, name) != 0) {
+ UnhookCascadeEntry(mePtr);
+ }
+ }
+
+ if ((mePtr->childMenuRefPtr == NULL)
+ || (strcmp(oldHashKey, name) != 0)) {
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name);
+ mePtr->childMenuRefPtr = menuRefPtr;
+
+ if (menuRefPtr->parentEntryPtr == NULL) {
+ menuRefPtr->parentEntryPtr = mePtr;
+ } else {
+ alreadyThere = 0;
+ for (cascadeEntryPtr = menuRefPtr->parentEntryPtr;
+ 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;
+ }
+
+ /*
+ * Get the images for the entry, if there are any. Allocate the
+ * new images before freeing the old ones, so that the reference
+ * counts don't go to zero and cause image data to be discarded.
+ */
+
+ if (mePtr->imagePtr != NULL) {
+ char *imageString = Tcl_GetStringFromObj(mePtr->imagePtr, NULL);
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString,
+ TkMenuImageProc, (ClientData) mePtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mePtr->image != NULL) {
+ Tk_FreeImage(mePtr->image);
+ }
+ mePtr->image = image;
+ if (mePtr->selectImagePtr != NULL) {
+ char *selectImageString = Tcl_GetStringFromObj(
+ mePtr->selectImagePtr, NULL);
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString,
+ TkMenuSelectImageProc, (ClientData) mePtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mePtr->selectImage != NULL) {
+ Tk_FreeImage(mePtr->selectImage);
+ }
+ mePtr->selectImage = image;
+
+ if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ Tcl_Obj *valuePtr;
+ char *name;
+
+ if (mePtr->namePtr == NULL) {
+ if (mePtr->labelPtr == NULL) {
+ mePtr->namePtr = NULL;
+ } else {
+ mePtr->namePtr = Tcl_DuplicateObj(mePtr->labelPtr);
+ Tcl_IncrRefCount(mePtr->namePtr);
+ }
+ }
+ if (mePtr->onValuePtr == NULL) {
+ if (mePtr->labelPtr == NULL) {
+ mePtr->onValuePtr = NULL;
+ } else {
+ mePtr->onValuePtr = Tcl_DuplicateObj(mePtr->labelPtr);
+ Tcl_IncrRefCount(mePtr->onValuePtr);
+ }
+ }
+
+ /*
+ * Select the entry if the associated variable has the
+ * appropriate value, initialize the variable if it doesn't
+ * exist, then set a trace on the variable to monitor future
+ * changes to its value.
+ */
+
+ if (mePtr->namePtr != NULL) {
+ valuePtr = Tcl_ObjGetVar2(menuPtr->interp, mePtr->namePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ } else {
+ valuePtr = NULL;
+ }
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ if (valuePtr != NULL) {
+ if (mePtr->onValuePtr != NULL) {
+ char *value = Tcl_GetStringFromObj(valuePtr, NULL);
+ char *onValue = Tcl_GetStringFromObj(mePtr->onValuePtr,
+ NULL);
+
+
+ if (strcmp(value, onValue) == 0) {
+ mePtr->entryFlags |= ENTRY_SELECTED;
+ }
+ }
+ } else {
+ if (mePtr->namePtr != NULL) {
+ Tcl_ObjSetVar2(menuPtr->interp, mePtr->namePtr, NULL,
+ (mePtr->type == CHECK_BUTTON_ENTRY)
+ ? mePtr->offValuePtr
+ : Tcl_NewObj(),
+ TCL_GLOBAL_ONLY);
+ }
+ }
+ if (mePtr->namePtr != NULL) {
+ name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ Tcl_TraceVar(menuPtr->interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuEntry --
+ *
+ * This procedure is called to process an argv/argc list in order
+ * to configure (or reconfigure) one entry in a menu.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get
+ * set for mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuEntry(mePtr, objc, objv)
+ register TkMenuEntry *mePtr; /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ Tk_SavedOptions errorStruct;
+ int result;
+
+ /*
+ * If this entry is a check button or radio button, then remove
+ * its old trace procedure.
+ */
+
+ if ((mePtr->namePtr != NULL)
+ && ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY))) {
+ char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ Tcl_UntraceVar(menuPtr->interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+
+ result = TCL_OK;
+ if (menuPtr->tkwin != NULL) {
+ if (Tk_SetOptions(menuPtr->interp, (char *) mePtr,
+ mePtr->optionTable, objc, objv, menuPtr->tkwin,
+ &errorStruct, (int *) NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ result = PostProcessEntry(mePtr);
+ if (result != TCL_OK) {
+ Tk_RestoreSavedOptions(&errorStruct);
+ PostProcessEntry(mePtr);
+ }
+ Tk_FreeSavedOptions(&errorStruct);
+ }
+
+ TkEventuallyRecomputeMenu(menuPtr);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuCloneEntries --
+ *
+ * Calls ConfigureMenuEntry for each menu in the clone chain.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get
+ * set for mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuCloneEntries(interp, menuPtr, index, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ TkMenu *menuPtr; /* Information about whole menu. */
+ int index; /* Index of mePtr within menuPtr's
+ * entries. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ TkMenuEntry *mePtr;
+ TkMenu *menuListPtr;
+ int cascadeEntryChanged = 0;
+ TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL;
+ Tcl_Obj *oldCascadePtr = NULL;
+ char *newCascadeName;
+
+ /*
+ * Cascades are kind of tricky here. This is special case #3 in the comment
+ * at the top of this file. Basically, if a menu is the master menu of a
+ * clone chain, and has an entry with a cascade menu, the clones of
+ * the menu will point to clones of the cascade menu. We have
+ * to destroy the clones of the cascades, clone the new cascade
+ * menu, and configure the entry to point to the new clone.
+ */
+
+ mePtr = menuPtr->masterMenuPtr->entries[index];
+ if (mePtr->type == CASCADE_ENTRY) {
+ oldCascadePtr = mePtr->namePtr;
+ if (oldCascadePtr != NULL) {
+ Tcl_IncrRefCount(oldCascadePtr);
+ }
+ }
+
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ char *oldCascadeName;
+
+ if (mePtr->namePtr != NULL) {
+ newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ } else {
+ newCascadeName = NULL;
+ }
+
+ if ((oldCascadePtr == NULL) && (mePtr->namePtr == NULL)) {
+ cascadeEntryChanged = 0;
+ } else if (((oldCascadePtr == NULL) && (mePtr->namePtr != NULL))
+ || ((oldCascadePtr != NULL)
+ && (mePtr->namePtr == NULL))) {
+ cascadeEntryChanged = 1;
+ } else {
+ oldCascadeName = Tcl_GetStringFromObj(oldCascadePtr,
+ NULL);
+ cascadeEntryChanged = (strcmp(oldCascadeName, newCascadeName)
+ != 0);
+ }
+ if (oldCascadePtr != NULL) {
+ Tcl_DecrRefCount(oldCascadePtr);
+ }
+ }
+
+ if (cascadeEntryChanged) {
+ if (mePtr->namePtr != NULL) {
+ newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ newCascadeName);
+ }
+ }
+
+ for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr;
+ menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+
+ mePtr = menuListPtr->entries[index];
+
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
+ oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ mePtr->namePtr);
+
+ if ((oldCascadeMenuRefPtr != NULL)
+ && (oldCascadeMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr);
+ }
+ }
+
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
+ if (cascadeMenuRefPtr->menuPtr != NULL) {
+ Tcl_Obj *newObjv[2];
+ Tcl_Obj *newCloneNamePtr;
+ Tcl_Obj *pathNamePtr = Tcl_NewStringObj(
+ Tk_PathName(menuListPtr->tkwin), -1);
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *menuObjPtr = Tcl_NewStringObj("-menu", -1);
+
+ Tcl_IncrRefCount(pathNamePtr);
+ newCloneNamePtr = TkNewMenuName(menuPtr->interp,
+ pathNamePtr,
+ cascadeMenuRefPtr->menuPtr);
+ Tcl_IncrRefCount(newCloneNamePtr);
+ Tcl_IncrRefCount(normalPtr);
+ CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneNamePtr,
+ normalPtr);
+
+ newObjv[0] = menuObjPtr;
+ newObjv[1] = newCloneNamePtr;
+ Tcl_IncrRefCount(menuObjPtr);
+ ConfigureMenuEntry(mePtr, 2, newObjv);
+ Tcl_DecrRefCount(newCloneNamePtr);
+ Tcl_DecrRefCount(pathNamePtr);
+ Tcl_DecrRefCount(normalPtr);
+ Tcl_DecrRefCount(menuObjPtr);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMenuIndex --
+ *
+ * Parse a textual index into a menu and return the numerical
+ * index of the indicated entry.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the entry index corresponding to string
+ * (ranges from -1 to the number of entries in the menu minus
+ * one). Otherwise an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetMenuIndex(interp, menuPtr, objPtr, lastOK, indexPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ TkMenu *menuPtr; /* Menu for which the index is being
+ * specified. */
+ Tcl_Obj *objPtr; /* Specification of an entry in menu. See
+ * manual entry for valid .*/
+ int lastOK; /* Non-zero means its OK to return index
+ * just *after* last entry. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ int i;
+ char *string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
+ *indexPtr = menuPtr->active;
+ goto success;
+ }
+
+ if (((string[0] == 'l') && (strcmp(string, "last") == 0))
+ || ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
+ *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
+ goto success;
+ }
+
+ if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
+ *indexPtr = -1;
+ goto success;
+ }
+
+ if (string[0] == '@') {
+ if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
+ == TCL_OK) {
+ goto success;
+ }
+ }
+
+ if (isdigit(UCHAR(string[0]))) {
+ if (Tcl_GetInt(interp, string, &i) == TCL_OK) {
+ if (i >= menuPtr->numEntries) {
+ if (lastOK) {
+ i = menuPtr->numEntries;
+ } else {
+ i = menuPtr->numEntries-1;
+ }
+ } else if (i < 0) {
+ i = -1;
+ }
+ *indexPtr = i;
+ goto success;
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ }
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
+ char *label = (labelPtr == NULL) ? NULL
+ : Tcl_GetStringFromObj(labelPtr, NULL);
+
+ if ((label != NULL)
+ && (Tcl_StringMatch(label, string))) {
+ *indexPtr = i;
+ goto success;
+ }
+ }
+
+ Tcl_AppendResult(interp, "bad menu entry index \"",
+ string, "\"", (char *) NULL);
+ return TCL_ERROR;
+
+success:
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuCmdDeletedProc --
+ *
+ * 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) {
+ 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->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type];
+ mePtr->menuPtr = menuPtr;
+ mePtr->labelPtr = NULL;
+ mePtr->labelLength = 0;
+ mePtr->underline = -1;
+ mePtr->bitmapPtr = NULL;
+ mePtr->imagePtr = NULL;
+ mePtr->image = NULL;
+ mePtr->selectImagePtr = NULL;
+ mePtr->selectImage = NULL;
+ mePtr->accelPtr = NULL;
+ mePtr->accelLength = 0;
+ mePtr->state = ENTRY_DISABLED;
+ mePtr->borderPtr = NULL;
+ mePtr->fgPtr = NULL;
+ mePtr->activeBorderPtr = NULL;
+ mePtr->activeFgPtr = NULL;
+ mePtr->fontPtr = NULL;
+ mePtr->indicatorOn = 0;
+ mePtr->indicatorFgPtr = NULL;
+ mePtr->columnBreak = 0;
+ mePtr->hideMargin = 0;
+ mePtr->commandPtr = NULL;
+ mePtr->namePtr = NULL;
+ mePtr->childMenuRefPtr = NULL;
+ mePtr->onValuePtr = NULL;
+ mePtr->offValuePtr = NULL;
+ mePtr->entryFlags = 0;
+ mePtr->index = index;
+ mePtr->nextCascadePtr = NULL;
+ if (Tk_InitOptions(menuPtr->interp, (char *) mePtr,
+ mePtr->optionTable, menuPtr->tkwin) != TCL_OK) {
+ ckfree((char *) mePtr);
+ return NULL;
+ }
+ TkMenuInitializeEntryDrawingFields(mePtr);
+ if (TkpMenuNewEntry(mePtr) != TCL_OK) {
+ Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable,
+ menuPtr->tkwin);
+ ckfree((char *) mePtr);
+ return NULL;
+ }
+
+ return mePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuAddOrInsert --
+ *
+ * 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, indexPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ TkMenu *menuPtr; /* Widget in which to create new
+ * entry. */
+ Tcl_Obj *indexPtr; /* Object describing index at which
+ * to insert. NULL means insert at
+ * end. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments to command: first arg
+ * is type of entry, others are
+ * config options. */
+{
+ int type, index;
+ TkMenuEntry *mePtr;
+ TkMenu *menuListPtr;
+
+ if (indexPtr != NULL) {
+ if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ index = menuPtr->numEntries;
+ }
+ if (index < 0) {
+ char *indexString = Tcl_GetStringFromObj(indexPtr, NULL);
+ Tcl_AppendResult(interp, "bad index \"", indexString, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (menuPtr->tearoff && (index == 0)) {
+ index = 1;
+ }
+
+ /*
+ * Figure out the type of the new entry.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], menuEntryTypeStrings,
+ "menu entry type", 0, &type) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now we have to add an entry for every instance related to this menu.
+ */
+
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+
+ mePtr = MenuNewEntry(menuListPtr, index, type);
+ if (mePtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
+ TkMenu *errorMenuPtr;
+ int i;
+
+ for (errorMenuPtr = menuPtr->masterMenuPtr;
+ errorMenuPtr != NULL;
+ errorMenuPtr = errorMenuPtr->nextInstancePtr) {
+ Tcl_EventuallyFree((ClientData) errorMenuPtr->entries[index],
+ DestroyMenuEntry);
+ for (i = index; i < errorMenuPtr->numEntries - 1; i++) {
+ 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->namePtr != NULL)
+ && (mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ TkMenu *cascadeMenuPtr =
+ mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
+ Tcl_Obj *newCascadePtr;
+ Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
+ Tcl_Obj *windowNamePtr =
+ Tcl_NewStringObj(Tk_PathName(menuListPtr->tkwin), -1);
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *newObjv[2];
+ TkMenuReferences *menuRefPtr;
+
+ Tcl_IncrRefCount(windowNamePtr);
+ newCascadePtr = TkNewMenuName(menuListPtr->interp,
+ windowNamePtr, cascadeMenuPtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ Tcl_IncrRefCount(normalPtr);
+ CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr);
+
+ menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp,
+ newCascadePtr);
+ if (menuRefPtr == NULL) {
+ panic("CloneMenu failed inside of MenuAddOrInsert.");
+ }
+ newObjv[0] = menuNamePtr;
+ newObjv[1] = newCascadePtr;
+ Tcl_IncrRefCount(menuNamePtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ ConfigureMenuEntry(mePtr, 2, newObjv);
+ Tcl_DecrRefCount(newCascadePtr);
+ Tcl_DecrRefCount(menuNamePtr);
+ Tcl_DecrRefCount(windowNamePtr);
+ Tcl_DecrRefCount(normalPtr);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+ CONST char *name1; /* First part of variable's name. */
+ CONST char *name2; /* Second part of variable's name. */
+ int flags; /* Describes what just happened. */
+{
+ TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
+ TkMenu *menuPtr;
+ CONST char *value;
+ char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ char *onValue;
+
+ menuPtr = mePtr->menuPtr;
+
+ /*
+ * If the variable is being unset, then re-establish the
+ * trace unless the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_TraceVar(interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, clientData);
+ }
+ TkpConfigureMenuEntry(mePtr);
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+ return (char *) NULL;
+ }
+
+ /*
+ * Use the value of the variable to update the selected status of
+ * the menu entry.
+ */
+
+ value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (mePtr->onValuePtr != NULL) {
+ onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, NULL);
+ if (strcmp(value, onValue) == 0) {
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ return (char *) NULL;
+ }
+ mePtr->entryFlags |= ENTRY_SELECTED;
+ } else if (mePtr->entryFlags & ENTRY_SELECTED) {
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ } else {
+ return (char *) NULL;
+ }
+ } else {
+ return (char *) NULL;
+ }
+ TkpConfigureMenuEntry(mePtr);
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 == ENTRY_ACTIVE) {
+ mePtr->state = ENTRY_NORMAL;
+ }
+ TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
+ }
+ menuPtr->active = index;
+ if (index >= 0) {
+ mePtr = menuPtr->entries[index];
+ mePtr->state = ENTRY_ACTIVE;
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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->postCommandPtr != NULL) {
+ Tcl_Obj *postCommandPtr = menuPtr->postCommandPtr;
+
+ Tcl_IncrRefCount(postCommandPtr);
+ result = Tcl_EvalObjEx(menuPtr->interp, postCommandPtr,
+ TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(postCommandPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TkRecomputeMenu(menuPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, newMenuNamePtr, newMenuTypePtr)
+ TkMenu *menuPtr; /* The menu we are going to clone */
+ Tcl_Obj *newMenuNamePtr; /* The name to give the new menu */
+ Tcl_Obj *newMenuTypePtr; /* What kind of menu is this, a normal menu
+ * a menubar, or a tearoff? */
+{
+ int returnResult;
+ int menuType, i;
+ TkMenuReferences *menuRefPtr;
+ Tcl_Obj *menuDupCommandArray[4];
+
+ if (newMenuTypePtr == NULL) {
+ menuType = MASTER_MENU;
+ } else {
+ if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr,
+ menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ menuDupCommandArray[0] = Tcl_NewStringObj("tk::MenuDup", -1);
+ menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ menuDupCommandArray[2] = newMenuNamePtr;
+ if (newMenuTypePtr == NULL) {
+ menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1);
+ } else {
+ menuDupCommandArray[3] = newMenuTypePtr;
+ }
+ for (i = 0; i < 4; i++) {
+ Tcl_IncrRefCount(menuDupCommandArray[i]);
+ }
+ Tcl_Preserve((ClientData) menuPtr);
+ returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0);
+ for (i = 0; i < 4; i++) {
+ Tcl_DecrRefCount(menuDupCommandArray[i]);
+ }
+
+ /*
+ * Make sure the tcl command actually created the clone.
+ */
+
+ if ((returnResult == TCL_OK) &&
+ ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ newMenuNamePtr)) != (TkMenuReferences *) NULL)
+ && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
+ TkMenu *newMenuPtr = menuRefPtr->menuPtr;
+ Tcl_Obj *newObjv[3];
+ 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.
+ */
+
+ newObjv[0] = Tcl_NewStringObj("bindtags", -1);
+ newObjv[1] = Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin), -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ if (Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin,
+ newMenuPtr->interp, 2, newObjv) == TCL_OK) {
+ char *windowName;
+ Tcl_Obj *bindingsPtr =
+ Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp));
+ Tcl_Obj *elementPtr;
+
+ Tcl_IncrRefCount(bindingsPtr);
+ 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);
+ /*
+ * The newElementPtr will have its refCount incremented
+ * here, so we don't need to worry about it any more.
+ */
+ Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
+ i + 1, 0, 1, &newElementPtr);
+ newObjv[2] = bindingsPtr;
+ Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin,
+ menuPtr->interp, 3, newObjv);
+ break;
+ }
+ }
+ Tcl_DecrRefCount(bindingsPtr);
+ }
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ Tcl_ResetResult(menuPtr->interp);
+
+ /*
+ * Clone all of the cascade menus that this menu points to.
+ */
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ TkMenuReferences *cascadeRefPtr;
+ TkMenu *oldCascadePtr;
+
+ if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
+ && (menuPtr->entries[i]->namePtr != NULL)) {
+ cascadeRefPtr =
+ TkFindMenuReferencesObj(menuPtr->interp,
+ menuPtr->entries[i]->namePtr);
+ if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
+ Tcl_Obj *windowNamePtr =
+ Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin),
+ -1);
+ Tcl_Obj *newCascadePtr;
+
+ oldCascadePtr = cascadeRefPtr->menuPtr;
+
+ Tcl_IncrRefCount(windowNamePtr);
+ newCascadePtr = TkNewMenuName(menuPtr->interp,
+ windowNamePtr, oldCascadePtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ CloneMenu(oldCascadePtr, newCascadePtr, NULL);
+
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = newCascadePtr;
+ Tcl_IncrRefCount(newObjv[0]);
+ ConfigureMenuEntry(newMenuPtr->entries[i], 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newCascadePtr);
+ Tcl_DecrRefCount(windowNamePtr);
+ }
+ }
+ }
+
+ returnResult = TCL_OK;
+ } else {
+ returnResult = TCL_ERROR;
+ }
+ 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, objPtr)
+ Tcl_Interp *interp;
+ TkMenu *menuPtr;
+ Tcl_Obj *objPtr;
+{
+ int index;
+
+ TkRecomputeMenu(menuPtr);
+ if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_ResetResult(interp);
+ if (index < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y));
+ }
+
+ return TCL_OK;
+
+error:
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 {
+ Tk_GetPixelsFromObj(interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &x);
+ }
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y)
+ && (x < (menuPtr->entries[i]->x + menuPtr->entries[i]->width))
+ && (y < (menuPtr->entries[i]->y
+ + menuPtr->entries[i]->height))) {
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkNewMenuName(interp, parentPtr, menuPtr)
+ Tcl_Interp *interp; /* The interp the new name has to live in.*/
+ Tcl_Obj *parentPtr; /* The prefix path of the new name. */
+ TkMenu *menuPtr; /* The menu we are cloning. */
+{
+ Tcl_Obj *resultPtr = NULL; /* Initialization needed only to prevent
+ * compiler warning. */
+ Tcl_Obj *childPtr;
+ char *destString;
+ int i;
+ int doDot;
+ Tcl_CmdInfo cmdInfo;
+ Tcl_HashTable *nameTablePtr = NULL;
+ TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
+ char *parentName = Tcl_GetStringFromObj(parentPtr, NULL);
+
+ if (winPtr->mainPtr != NULL) {
+ nameTablePtr = &(winPtr->mainPtr->nameTable);
+ }
+
+ doDot = parentName[strlen(parentName) - 1] != '.';
+
+ childPtr = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ for (destString = Tcl_GetStringFromObj(childPtr, NULL);
+ *destString != '\0'; destString++) {
+ if (*destString == '.') {
+ *destString = '#';
+ }
+ }
+
+ for (i = 0; ; i++) {
+ if (i == 0) {
+ resultPtr = Tcl_DuplicateObj(parentPtr);
+ if (doDot) {
+ Tcl_AppendToObj(resultPtr, ".", -1);
+ }
+ Tcl_AppendObjToObj(resultPtr, childPtr);
+ } else {
+ Tcl_Obj *intPtr;
+
+ Tcl_DecrRefCount(resultPtr);
+ resultPtr = Tcl_DuplicateObj(parentPtr);
+ if (doDot) {
+ Tcl_AppendToObj(resultPtr, ".", -1);
+ }
+ Tcl_AppendObjToObj(resultPtr, childPtr);
+ intPtr = Tcl_NewIntObj(i);
+ Tcl_AppendObjToObj(resultPtr, intPtr);
+ Tcl_DecrRefCount(intPtr);
+ }
+ destString = Tcl_GetStringFromObj(resultPtr, NULL);
+ if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0)
+ && ((nameTablePtr == NULL)
+ || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
+ break;
+ }
+ }
+ Tcl_DecrRefCount(childPtr);
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetWindowMenuBar --
+ *
+ * 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) {
+ Tcl_Obj *cloneMenuPtr;
+ TkMenuReferences *cloneMenuRefPtr;
+ Tcl_Obj *newObjv[4];
+ Tcl_Obj *windowNamePtr = Tcl_NewStringObj(Tk_PathName(tkwin),
+ -1);
+ Tcl_Obj *menubarPtr = Tcl_NewStringObj("menubar", -1);
+
+ /*
+ * Clone the menu and all of the cascades underneath it.
+ */
+
+ Tcl_IncrRefCount(windowNamePtr);
+ cloneMenuPtr = TkNewMenuName(interp, windowNamePtr,
+ menuPtr);
+ Tcl_IncrRefCount(cloneMenuPtr);
+ Tcl_IncrRefCount(menubarPtr);
+ CloneMenu(menuPtr, cloneMenuPtr, menubarPtr);
+
+ cloneMenuRefPtr = TkFindMenuReferencesObj(interp, cloneMenuPtr);
+ if ((cloneMenuRefPtr != NULL)
+ && (cloneMenuRefPtr->menuPtr != NULL)) {
+ Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1);
+ Tcl_Obj *nullPtr = Tcl_NewObj();
+ cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
+ menuBarPtr = cloneMenuRefPtr->menuPtr;
+ newObjv[0] = cursorPtr;
+ newObjv[1] = nullPtr;
+ Tcl_IncrRefCount(cursorPtr);
+ Tcl_IncrRefCount(nullPtr);
+ ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
+ 2, newObjv);
+ Tcl_DecrRefCount(cursorPtr);
+ Tcl_DecrRefCount(nullPtr);
+ }
+
+ TkpSetWindowMenuBar(tkwin, menuBarPtr);
+ Tcl_DecrRefCount(cloneMenuPtr);
+ Tcl_DecrRefCount(menubarPtr);
+ Tcl_DecrRefCount(windowNamePtr);
+ } else {
+ TkpSetWindowMenuBar(tkwin, NULL);
+ }
+
+
+ /*
+ * Add this window to the menu's list of windows that refer
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFindMenuReferencesObj --
+ *
+ * Given a pathname, gives back a pointer to the TkMenuReferences
+ * structure.
+ *
+ * Results:
+ * Returns a pointer to a menu reference structure. Should not
+ * be freed by calller; when a field of the reference is cleared,
+ * TkFreeMenuReferences should be called. Returns NULL if no reference
+ * with this pathname exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkFindMenuReferencesObj(interp, objPtr)
+ Tcl_Interp *interp; /* The interp the menu is living in. */
+ Tcl_Obj *objPtr; /* The path of the menu widget */
+{
+ char *pathName = Tcl_GetStringFromObj(objPtr, NULL);
+ return TkFindMenuReferences(interp, pathName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeMenuReferences --
+ *
+ * This is called after one of the fields in a menu reference
+ * is cleared. It cleans up the ref if it is now empty.
+ *
+ * Results:
+ * None.
+ *
+ * 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 - numDeleted;
+ }
+ 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()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!menusInitialized) {
+ Tcl_MutexLock(&menuMutex);
+ if (!menusInitialized) {
+ TkpMenuInit();
+ menusInitialized = 1;
+ }
+ Tcl_MutexUnlock(&menuMutex);
+ }
+ if (!tsdPtr->menusInitialized) {
+ TkpMenuThreadInit();
+ tsdPtr->menusInitialized = 1;
+ }
+}
diff --git a/tcl/generic/tkMenu.h b/tcl/generic/tkMenu.h
new file mode 100644
index 00000000000..93dfe1e00a7
--- /dev/null
+++ b/tcl/generic/tkMenu.h
@@ -0,0 +1,584 @@
+/*
+ * tkMenu.h --
+ *
+ * Declarations shared among all of the files that implement menu widgets.
+ *
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+
+/*
+ * Legal values for the "compound" field of TkMenuEntry and TkMenuButton records.
+ */
+
+enum compound {
+ COMPOUND_BOTTOM, COMPOUND_CENTER, COMPOUND_LEFT, COMPOUND_NONE,
+ COMPOUND_RIGHT, COMPOUND_TOP
+};
+
+/*
+ * One of the following data structures is kept for each entry of each
+ * menu managed by this file:
+ */
+
+typedef struct TkMenuEntry {
+ int type; /* Type of menu entry; see below for
+ * valid types. */
+ struct TkMenu *menuPtr; /* Menu with which this entry is associated. */
+ Tk_OptionTable optionTable; /* Option table for this menu entry. */
+ Tcl_Obj *labelPtr; /* Main text label displayed in entry (NULL
+ * if no label). */
+ int labelLength; /* Number of non-NULL characters in label. */
+ int state; /* State of button for display purposes:
+ * normal, active, or disabled. */
+ int underline; /* Value of -underline option: specifies index
+ * of character to underline (<0 means don't
+ * underline anything). */
+ Tcl_Obj *underlinePtr; /* Index of character to underline. */
+ Tcl_Obj *bitmapPtr; /* Bitmap to display in menu entry, or None.
+ * If not None then label is ignored. */
+ Tcl_Obj *imagePtr; /* Name of image to display, or
+ * NULL. If non-NULL, bitmap, text, and
+ * textVarName are ignored. */
+ Tk_Image image; /* Image to display in menu entry, or NULL if
+ * none. */
+ Tcl_Obj *selectImagePtr; /* Name of image to display when selected, or
+ * NULL. */
+ Tk_Image selectImage; /* Image to display in entry when selected,
+ * or NULL if none. Ignored if image is
+ * NULL. */
+ Tcl_Obj *accelPtr; /* Accelerator string displayed at right
+ * of menu entry. NULL means no such
+ * accelerator. Malloc'ed. */
+ int accelLength; /* Number of non-NULL characters in
+ * accelerator. */
+ int indicatorOn; /* True means draw indicator, false means
+ * don't draw it. This field is ignored unless
+ * the entry is a radio or check button. */
+ /*
+ * Display attributes
+ */
+
+ Tcl_Obj *borderPtr; /* Structure used to draw background for
+ * entry. NULL means use overall border
+ * for menu. */
+ Tcl_Obj *fgPtr; /* Foreground color to use for entry. NULL
+ * means use foreground color from menu. */
+ Tcl_Obj *activeBorderPtr; /* Used to draw background and border when
+ * element is active. NULL means use
+ * activeBorder from menu. */
+ Tcl_Obj *activeFgPtr; /* Foreground color to use when entry is
+ * active. NULL means use active foreground
+ * from menu. */
+ Tcl_Obj *indicatorFgPtr; /* Color for indicators in radio and check
+ * button entries. NULL means use indicatorFg
+ * GC from menu. */
+ Tcl_Obj *fontPtr; /* Text font for menu entries. NULL means
+ * use overall font for menu. */
+ int columnBreak; /* If this is 0, this item appears below
+ * the item in front of it. If this is
+ * 1, this item starts a new column. This
+ * field is always 0 for tearoff and separator
+ * entries. */
+ int hideMargin; /* If this is 0, then the item has enough
+ * margin to accomodate a standard check mark
+ * and a default right margin. If this is 1,
+ * then the item has no such margins. and
+ * checkbuttons and radiobuttons with this set
+ * will have a rectangle drawn in the indicator
+ * around the item if the item is checked. This
+ * is useful for palette menus. This field is
+ * ignored for separators and tearoffs. */
+ int indicatorSpace; /* The width of the indicator space for this
+ * entry. */
+ int labelWidth; /* Number of pixels to allow for displaying
+ * labels in menu entries. */
+ int compound; /* Value of -compound option; specifies whether
+ * the entry should show both an image and
+ * text, and, if so, how. */
+
+ /*
+ * Information used to implement this entry's action:
+ */
+
+ Tcl_Obj *commandPtr; /* Command to invoke when entry is invoked.
+ * Malloc'ed. */
+ Tcl_Obj *namePtr; /* Name of variable (for check buttons and
+ * radio buttons) or menu (for cascade
+ * entries). Malloc'ed.*/
+ Tcl_Obj *onValuePtr; /* Value to store in variable when selected
+ * (only for radio and check buttons).
+ * Malloc'ed. */
+ Tcl_Obj *offValuePtr; /* Value to store in variable when not
+ * selected (only for check buttons).
+ * Malloc'ed. */
+
+ /*
+ * Information used for drawing this menu entry.
+ */
+
+ 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 CASCADE_ENTRY 0
+#define CHECK_BUTTON_ENTRY 1
+#define COMMAND_ENTRY 2
+#define RADIO_BUTTON_ENTRY 3
+#define SEPARATOR_ENTRY 4
+#define TEAROFF_ENTRY 5
+
+/*
+ * Menu states
+ */
+
+EXTERN char *tkMenuStateStrings[];
+
+#define ENTRY_ACTIVE 0
+#define ENTRY_NORMAL 1
+#define ENTRY_DISABLED 2
+
+/*
+ * A data structure of the following type is kept for each
+ * menu widget:
+ */
+
+typedef struct TkMenu {
+ 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. */
+ Tcl_Obj *menuTypePtr; /* Used to control whether created tkwin
+ * is a toplevel or not. "normal", "menubar",
+ * or "toplevel" */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tcl_Obj *borderPtr; /* Structure used to draw 3-D
+ * border and background for menu. */
+ Tcl_Obj *borderWidthPtr; /* Width of border around whole menu. */
+ Tcl_Obj *activeBorderPtr; /* Used to draw background and border for
+ * active element (if any). */
+ Tcl_Obj *activeBorderWidthPtr;
+ /* Width of border around active element. */
+ Tcl_Obj *reliefPtr; /* 3-d effect: TK_RELIEF_RAISED, etc. */
+ Tcl_Obj *fontPtr; /* Text font for menu entries. */
+ Tcl_Obj *fgPtr; /* Foreground color for entries. */
+ Tcl_Obj *disabledFgPtr; /* Foreground color when disabled. NULL
+ * means use normalFg with a 50% stipple
+ * instead. */
+ Tcl_Obj *activeFgPtr; /* Foreground color for active entry. */
+ Tcl_Obj *indicatorFgPtr; /* Color for indicators in radio and check
+ * button entries. */
+ Pixmap gray; /* Bitmap for drawing disabled entries in
+ * a stippled fashion. None means not
+ * allocated yet. */
+ GC textGC; /* GC for drawing text and other features
+ * of menu entries. */
+ GC disabledGC; /* Used to produce disabled effect. If
+ * 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. */
+ Tcl_Obj *titlePtr; /* The title to use when this menu is torn
+ * off. If this is NULL, a default scheme
+ * will be used to generate a title for
+ * tearoff. */
+ Tcl_Obj *tearoffCommandPtr; /* If non-NULL, points to a command to
+ * run whenever the menu is torn-off. */
+ Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ Tcl_Obj *cursorPtr; /* Current cursor for window, or None. */
+ Tcl_Obj *postCommandPtr; /* Used to detect cycles in cascade hierarchy
+ * trees when preprocessing postcommands
+ * on some platforms. See PostMenu for
+ * more details. */
+ int postCommandGeneration; /* Need to do pre-invocation post command
+ * traversal */
+ int menuFlags; /* Flags for use by X; see below for
+ definition */
+ TkMenuEntry *postedCascade; /* Points to menu entry for cascaded submenu
+ * that is currently posted or NULL if no
+ * submenu posted. */
+ struct TkMenu *nextInstancePtr;
+ /* The next instance of this menu in the
+ * chain. */
+ struct TkMenu *masterMenuPtr;
+ /* A pointer to the original menu for this
+ * clone chain. Points back to this structure
+ * if this menu is a master menu. */
+ struct TkMenuOptionTables *optionTablesPtr;
+ /* A pointer to the collection of option tables
+ * that work with menus and menu entries. */
+ Tk_Window parentTopLevelPtr;/* If this menu is a menubar, this is the
+ * toplevel that owns the menu. Only applicable
+ * for menubar clones.
+ */
+ struct TkMenuReferences *menuRefPtr;
+ /* Each menu is hashed into a table with the
+ * name of the menu's window as the key.
+ * The information in this hash table includes
+ * a pointer to the menu (so that cascades
+ * can find this menu), a pointer to the
+ * list of toplevel widgets that have this
+ * menu as its menubar, and a list of menu
+ * entries that have this menu specified
+ * as a cascade. */
+ TkMenuPlatformData platformData;
+ /* The data for the specific type of menu.
+ * Depends on platform and menu type what
+ * kind of options are in this structure.
+ */
+ Tk_OptionSpec *extensionPtr;
+ /* Needed by the configuration package for
+ * this widget to be extended. */
+ Tk_SavedOptions *errorStructPtr;
+ /* We actually have to allocate these because
+ * multiple menus get changed during one
+ * ConfigureMenu call. */
+} TkMenu;
+
+/*
+ * When the toplevel configure -menu command is executed, the menu may not
+ * exist yet. We need to keep a linked list of windows that reference
+ * a particular menu.
+ */
+
+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;
+
+/*
+ * This structure contains all of the option tables that are needed
+ * by menus.
+ */
+
+typedef struct TkMenuOptionTables {
+ Tk_OptionTable menuOptionTable; /* The option table for menus. */
+ Tk_OptionTable entryOptionTables[6];/* The tables for menu entries. */
+} TkMenuOptionTables;
+
+/*
+ * Flag bits for menus:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * RESIZE_PENDING: Non-zero means a call to ComputeMenuGeometry
+ * 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
+
+/*
+ * Menu-related procedures that are shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+EXTERN int TkActivateMenuEntry _ANSI_ARGS_((TkMenu *menuPtr,
+ int index));
+EXTERN void TkBindMenu _ANSI_ARGS_((
+ Tk_Window tkwin, TkMenu *menuPtr));
+EXTERN TkMenuReferences *
+ TkCreateMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name));
+EXTERN void TkDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkEventuallyRecomputeMenu _ANSI_ARGS_((
+ TkMenu *menuPtr));
+EXTERN void TkEventuallyRedrawMenu _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr));
+EXTERN TkMenuReferences *
+ TkFindMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name));
+EXTERN TkMenuReferences *
+ TkFindMenuReferencesObj _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_Obj *namePtr));
+EXTERN void TkFreeMenuReferences _ANSI_ARGS_((
+ TkMenuReferences *menuRefPtr));
+EXTERN Tcl_HashTable * TkGetMenuHashTable _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int TkGetMenuIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, Tcl_Obj *objPtr, int lastOK,
+ int *indexPtr));
+EXTERN void TkMenuInitializeDrawingFields _ANSI_ARGS_((
+ TkMenu *menuPtr));
+EXTERN void TkMenuInitializeEntryDrawingFields _ANSI_ARGS_((
+ TkMenuEntry *mePtr));
+EXTERN int TkInvokeMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int index));
+EXTERN void TkMenuConfigureDrawOptions _ANSI_ARGS_((
+ TkMenu *menuPtr));
+EXTERN int TkMenuConfigureEntryDrawOptions _ANSI_ARGS_((
+ 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 Tcl_Obj * TkNewMenuName _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *parentNamePtr, TkMenu *menuPtr));
+EXTERN int TkPostCommand _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN int TkPostSubmenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, TkMenuEntry *mePtr));
+EXTERN int TkPostTearoffMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int x, int y));
+EXTERN int TkPreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));
+
+/*
+ * These routines are the platform-dependent routines called by the
+ * common code.
+ */
+
+EXTERN void TkpComputeMenubarGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr));
+EXTERN void TkpComputeStandardMenuGeometry _ANSI_ARGS_
+ ((TkMenu *menuPtr));
+EXTERN int TkpConfigureMenuEntry
+ _ANSI_ARGS_((TkMenuEntry *mePtr));
+EXTERN void TkpDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkpDestroyMenuEntry
+ _ANSI_ARGS_((TkMenuEntry *mEntryPtr));
+EXTERN void TkpDrawMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Drawable d, Tk_Font tkfont,
+ CONST Tk_FontMetrics *menuMetricsPtr, int x,
+ int y, int width, int height, int strictMotif,
+ int drawArrow));
+EXTERN void TkpMenuInit _ANSI_ARGS_((void));
+EXTERN int TkpMenuNewEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
+EXTERN int TkpNewMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN int TkpPostMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int x, int y));
+EXTERN void TkpSetWindowMenuBar _ANSI_ARGS_((Tk_Window tkwin,
+ TkMenu *menuPtr));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKMENU */
+
diff --git a/tcl/generic/tkMenuDraw.c b/tcl/generic/tkMenuDraw.c
new file mode 100644
index 00000000000..20b99095597
--- /dev/null
+++ b/tcl/generic/tkMenuDraw.c
@@ -0,0 +1,1051 @@
+/*
+ * 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 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;
+ Tk_3DBorder border, activeBorder;
+ Tk_Font tkfont;
+ XColor *fg, *activeFg, *indicatorFg;
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border, or filling in complicated
+ * defaults that couldn't be specified to Tk_ConfigureWidget.
+ */
+
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_SetBackgroundFromBorder(menuPtr->tkwin, border);
+
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ gcValues.font = Tk_FontId(tkfont);
+ fg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->fgPtr);
+ gcValues.foreground = fg->pixel;
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->textGC);
+ }
+ menuPtr->textGC = newGC;
+
+ gcValues.font = Tk_FontId(tkfont);
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+ if (menuPtr->disabledFgPtr != NULL) {
+ XColor *disabledFg;
+
+ disabledFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->disabledFgPtr);
+ gcValues.foreground = disabledFg->pixel;
+ mask = GCForeground|GCBackground|GCFont;
+ } else {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (menuPtr->gray == None) {
+ menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
+ "gray50");
+ }
+ if (menuPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ mask = GCForeground|GCFillStyle|GCStipple;
+ }
+ }
+ newGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
+ if (menuPtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
+ }
+ menuPtr->disabledGC = newGC;
+
+ gcValues.foreground = Tk_3DBorderColor(border)->pixel;
+ if (menuPtr->gray == None) {
+ menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
+ "gray50");
+ }
+ if (menuPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ newGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCFillStyle|GCStipple, &gcValues);
+ }
+ if (menuPtr->disabledImageGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
+ }
+ menuPtr->disabledImageGC = newGC;
+
+ gcValues.font = Tk_FontId(tkfont);
+ activeFg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->activeFgPtr);
+ gcValues.foreground = activeFg->pixel;
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ menuPtr->activeBorderPtr);
+ gcValues.background = Tk_3DBorderColor(activeBorder)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
+ }
+ menuPtr->activeGC = newGC;
+
+ indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->indicatorFgPtr);
+ gcValues.foreground = indicatorFg->pixel;
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
+ }
+ menuPtr->indicatorGC = newGC;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = Tk_GetFontFromObj(menuPtr->tkwin,
+ (mePtr->fontPtr != NULL) ? mePtr->fontPtr : menuPtr->fontPtr);
+
+ if (mePtr->state == ENTRY_ACTIVE) {
+ if (index != menuPtr->active) {
+ TkActivateMenuEntry(menuPtr, index);
+ }
+ } else {
+ if (index == menuPtr->active) {
+ TkActivateMenuEntry(menuPtr, -1);
+ }
+ }
+
+ if ((mePtr->fontPtr != NULL)
+ || (mePtr->borderPtr != NULL)
+ || (mePtr->fgPtr != NULL)
+ || (mePtr->activeBorderPtr != NULL)
+ || (mePtr->activeFgPtr != NULL)
+ || (mePtr->indicatorFgPtr != NULL)) {
+ XColor *fg, *indicatorFg, *activeFg;
+ Tk_3DBorder border, activeBorder;
+
+ fg = Tk_GetColorFromObj(menuPtr->tkwin, (mePtr->fgPtr != NULL)
+ ? mePtr->fgPtr : menuPtr->fgPtr);
+ gcValues.foreground = fg->pixel;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr != NULL) ? mePtr->borderPtr
+ : menuPtr->borderPtr);
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+
+ gcValues.font = Tk_FontId(tkfont);
+
+ /*
+ * Note: disable GraphicsExpose events; we know there won't be
+ * obscured areas when copying from an off-screen pixmap to the
+ * screen and this gets rid of unnecessary events.
+ */
+
+ gcValues.graphics_exposures = False;
+ newGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+
+ indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ (mePtr->indicatorFgPtr != NULL) ? mePtr->indicatorFgPtr
+ : menuPtr->indicatorFgPtr);
+ gcValues.foreground = indicatorFg->pixel;
+ newIndicatorGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures,
+ &gcValues);
+
+ if ((menuPtr->disabledFgPtr != NULL) || (mePtr->image != NULL)) {
+ XColor *disabledFg;
+
+ disabledFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->disabledFgPtr);
+ gcValues.foreground = disabledFg->pixel;
+ mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures;
+ } else {
+ gcValues.foreground = gcValues.background;
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ mask = GCForeground|GCFillStyle|GCStipple;
+ }
+ newDisabledGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
+
+ activeFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ (mePtr->activeFgPtr != NULL) ? mePtr->activeFgPtr
+ : menuPtr->activeFgPtr);
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr != NULL) ? mePtr->activeBorderPtr
+ : menuPtr->activeBorderPtr);
+
+ gcValues.foreground = activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(activeBorder)->pixel;
+ newActiveGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ } else {
+ newGC = None;
+ newActiveGC = None;
+ newDisabledGC = None;
+ 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;
+ Tk_FontMetrics menuMetrics;
+ int width;
+ int borderWidth;
+ Tk_3DBorder border;
+ int activeBorderWidth;
+ int relief;
+
+
+ menuPtr->menuFlags &= ~REDRAW_PENDING;
+ if ((menuPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+
+ if (menuPtr->menuType == MENUBAR) {
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, borderWidth,
+ borderWidth, Tk_Width(tkwin) - 2 * borderWidth,
+ Tk_Height(tkwin) - 2 * borderWidth, 0, TK_RELIEF_FLAT);
+ }
+
+ strictMotif = Tk_StrictMotif(menuPtr->tkwin);
+
+ /*
+ * See note in ComputeMenuGeometry. We don't want to be doing font metrics
+ * all of the time.
+ */
+
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &menuMetrics);
+
+ /*
+ * Loop through all of the entries, drawing them one at a time.
+ */
+
+ for (index = 0; index < menuPtr->numEntries; index++) {
+ mePtr = menuPtr->entries[index];
+ if (menuPtr->menuType != MENUBAR) {
+ if (!(mePtr->entryFlags & ENTRY_NEEDS_REDISPLAY)) {
+ continue;
+ }
+ }
+ mePtr->entryFlags &= ~ENTRY_NEEDS_REDISPLAY;
+
+ if (menuPtr->menuType == MENUBAR) {
+ width = mePtr->width;
+ } else {
+ if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
+ width = Tk_Width(menuPtr->tkwin) - mePtr->x
+ - activeBorderWidth;
+ } else {
+ width = mePtr->width + borderWidth;
+ }
+ }
+ TkpDrawMenuEntry(mePtr, Tk_WindowId(menuPtr->tkwin), tkfont,
+ &menuMetrics, mePtr->x, mePtr->y, width,
+ mePtr->height, strictMotif, 1);
+ if ((index > 0) && (menuPtr->menuType != MENUBAR)
+ && mePtr->columnBreak) {
+ mePtr = menuPtr->entries[index - 1];
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border,
+ mePtr->x, mePtr->y + mePtr->height,
+ mePtr->width,
+ Tk_Height(tkwin) - mePtr->y - mePtr->height -
+ activeBorderWidth, 0,
+ TK_RELIEF_FLAT);
+ }
+ }
+
+ if (menuPtr->menuType != MENUBAR) {
+ int x, y, height;
+
+ if (menuPtr->numEntries == 0) {
+ x = y = borderWidth;
+ width = Tk_Width(tkwin) - 2 * activeBorderWidth;
+ height = Tk_Height(tkwin) - 2 * activeBorderWidth;
+ } else {
+ mePtr = menuPtr->entries[menuPtr->numEntries - 1];
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ border, mePtr->x, mePtr->y + mePtr->height, mePtr->width,
+ Tk_Height(tkwin) - mePtr->y - mePtr->height
+ - activeBorderWidth, 0,
+ TK_RELIEF_FLAT);
+ x = mePtr->x + mePtr->width;
+ y = mePtr->y + mePtr->height;
+ width = Tk_Width(tkwin) - x - activeBorderWidth;
+ height = Tk_Height(tkwin) - y - activeBorderWidth;
+ }
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, x, y,
+ width, height, 0, TK_RELIEF_FLAT);
+ }
+
+ Tk_GetReliefFromObj(NULL, menuPtr->reliefPtr, &relief);
+ Tk_Draw3DRectangle(menuPtr->tkwin, Tk_WindowId(tkwin),
+ border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), borderWidth,
+ relief);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMenuEventProc --
+ *
+ * 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) {
+ TkDestroyMenu(menuPtr);
+ menuPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(menuPtr->interp, menuPtr->widgetCmd);
+ }
+ if (menuPtr->menuFlags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayMenu, (ClientData) menuPtr);
+ }
+ if (menuPtr->menuFlags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr);
+ }
+ Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuImageProc --
+ *
+ * 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. */
+{
+ int result, x, y;
+
+ if (mePtr == menuPtr->postedCascade) {
+ return TCL_OK;
+ }
+
+ if (menuPtr->postedCascade != NULL) {
+ char *name = Tcl_GetStringFromObj(menuPtr->postedCascade->namePtr,
+ NULL);
+
+ /*
+ * Note: when unposting a submenu, we have to redraw the entire
+ * parent menu. This is because of a combination of the following
+ * things:
+ * (a) the submenu partially overlaps the parent.
+ * (b) the submenu specifies "save under", which causes the X
+ * server to make a copy of the information under it when it
+ * is posted. When the submenu is unposted, the X server
+ * copies this data back and doesn't generate any Expose
+ * events for the parent.
+ * (c) the parent may have redisplayed itself after the submenu
+ * was posted, in which case the saved information is no
+ * longer correct.
+ * The simplest solution is just force a complete redisplay of
+ * the parent.
+ */
+
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+ result = Tcl_VarEval(interp, name, " unpost", (char *) NULL);
+ menuPtr->postedCascade = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ if ((mePtr != NULL) && (mePtr->namePtr != NULL)
+ && Tk_IsMapped(menuPtr->tkwin)) {
+ /*
+ * Position the cascade with its upper left corner slightly
+ * below and to the left of the upper right corner of the
+ * menu entry (this is an attempt to match Motif behavior).
+ *
+ * The menu has to redrawn so that the entry can change relief.
+ */
+
+ char string[TCL_INTEGER_SPACE * 2];
+ char *name;
+
+ name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ Tk_GetRootCoords(menuPtr->tkwin, &x, &y);
+ AdjustMenuCoords(menuPtr, mePtr, &x, &y, string);
+ result = Tcl_VarEval(interp, name, " post ", string, (char *) NULL);
+ if (result != TCL_OK) {
+ return result;
+ }
+ menuPtr->postedCascade = mePtr;
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 {
+ int borderWidth, activeBorderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ *xPtr += Tk_Width(menuPtr->tkwin) - borderWidth - activeBorderWidth
+ - 2;
+ *yPtr += mePtr->y + activeBorderWidth + 2;
+ }
+ sprintf(string, "%d %d", *xPtr, *yPtr);
+}
diff --git a/tcl/generic/tkMenubutton.c b/tcl/generic/tkMenubutton.c
new file mode 100644
index 00000000000..eb222428431
--- /dev/null
+++ b/tcl/generic/tkMenubutton.c
@@ -0,0 +1,948 @@
+/*
+ * 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"
+
+/*
+ * The following table defines the legal values for the -direction
+ * option. It is used together with the "enum direction" declaration
+ * in tkMenubutton.h.
+ */
+
+static char *directionStrings[] = {
+ "above", "below", "flush", "left", "right", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -state option.
+ * It is used together with the "enum state" declaration in tkMenubutton.h.
+ */
+
+static char *stateStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -compound option.
+ * It is used with the "enum compound" declaration in tkMenuButton.h
+ */
+
+static char *compoundStrings[] = {
+ "bottom", "center", "left", "none", "right", "top", (char *) NULL
+};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_MENUBUTTON_ACTIVE_BG_COLOR, -1,
+ Tk_Offset(TkMenuButton, activeBorder), 0,
+ (ClientData) DEF_MENUBUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_MENUBUTTON_ACTIVE_FG_COLOR, -1,
+ Tk_Offset(TkMenuButton, activeFg),
+ 0, (ClientData) DEF_MENUBUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_MENUBUTTON_ANCHOR, -1,
+ Tk_Offset(TkMenuButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_MENUBUTTON_BG_COLOR, -1, Tk_Offset(TkMenuButton, normalBorder),
+ 0, (ClientData) DEF_MENUBUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_MENUBUTTON_BITMAP, -1, Tk_Offset(TkMenuButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MENUBUTTON_BORDER_WIDTH, -1,
+ Tk_Offset(TkMenuButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MENUBUTTON_CURSOR, -1, Tk_Offset(TkMenuButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-direction", "direction", "Direction",
+ DEF_MENUBUTTON_DIRECTION, -1, Tk_Offset(TkMenuButton, direction),
+ 0, (ClientData) directionStrings, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkMenuButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_MENUBUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MENUBUTTON_FONT, -1, Tk_Offset(TkMenuButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENUBUTTON_FG, -1, Tk_Offset(TkMenuButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_MENUBUTTON_HEIGHT, -1, Tk_Offset(TkMenuButton, heightString),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkMenuButton, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_MENUBUTTON_HIGHLIGHT, -1,
+ Tk_Offset(TkMenuButton, highlightColorPtr), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_MENUBUTTON_HIGHLIGHT_WIDTH,
+ -1, Tk_Offset(TkMenuButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_MENUBUTTON_IMAGE, -1, Tk_Offset(TkMenuButton, imageString),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_MENUBUTTON_INDICATOR, -1, Tk_Offset(TkMenuButton, indicatorOn),
+ 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkMenuButton, justify), 0, 0, 0},
+ {TK_OPTION_STRING, "-menu", "menu", "Menu",
+ DEF_MENUBUTTON_MENU, -1, Tk_Offset(TkMenuButton, menuName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_MENUBUTTON_PADX, -1, Tk_Offset(TkMenuButton, padX),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_MENUBUTTON_PADY, -1, Tk_Offset(TkMenuButton, padY),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENUBUTTON_RELIEF, -1, Tk_Offset(TkMenuButton, relief),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkMenuButton, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_MENUBUTTON_STATE, -1, Tk_Offset(TkMenuButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENUBUTTON_TAKE_FOCUS, -1,
+ Tk_Offset(TkMenuButton, takeFocus), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_MENUBUTTON_TEXT, -1, Tk_Offset(TkMenuButton, text), 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_MENUBUTTON_TEXT_VARIABLE, -1,
+ Tk_Offset(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_MENUBUTTON_UNDERLINE, -1, Tk_Offset(TkMenuButton, underline),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_MENUBUTTON_WIDTH, -1, Tk_Offset(TkMenuButton, widthString),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_MENUBUTTON_WRAP_LENGTH, -1, Tk_Offset(TkMenuButton, wrapLength),
+ 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The following tables define the menubutton widget commands and map the
+ * indexes into the string tables into a single enumerated type used
+ * to dispatch the scale widget command.
+ */
+
+static CONST char *commandNames[] = {
+ "cget", "configure", (char *) NULL
+};
+
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void MenuButtonCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void MenuButtonEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void MenuButtonImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height, int imgWidth,
+ int imgHeight));
+static char * MenuButtonTextVarProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ CONST char *name1, CONST char *name2, int flags));
+static int MenuButtonWidgetObjCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+static int ConfigureMenuButton _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenuButton *mbPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static void DestroyMenuButton _ANSI_ARGS_((char *memPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MenubuttonObjCmd --
+ *
+ * This procedure is invoked to process the "button", "label",
+ * "radiobutton", and "checkbutton" Tcl commands. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_MenubuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register TkMenuButton *mbPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the new window.
+ */
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ Tk_SetClass(tkwin, "Menubutton");
+ mbPtr = TkpCreateMenuButton(tkwin);
+
+ Tk_SetClassProcs(tkwin, &tkpMenubuttonClass, (ClientData) mbPtr);
+
+ /*
+ * Initialize the data structure for the button.
+ */
+
+ mbPtr->tkwin = tkwin;
+ mbPtr->display = Tk_Display (tkwin);
+ mbPtr->interp = interp;
+ mbPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd,
+ (ClientData) mbPtr, MenuButtonCmdDeletedProc);
+ mbPtr->optionTable = optionTable;
+ mbPtr->menuName = NULL;
+ mbPtr->text = NULL;
+ mbPtr->underline = -1;
+ mbPtr->textVarName = NULL;
+ mbPtr->bitmap = None;
+ mbPtr->imageString = NULL;
+ mbPtr->image = NULL;
+ mbPtr->state = STATE_NORMAL;
+ mbPtr->normalBorder = NULL;
+ mbPtr->activeBorder = NULL;
+ mbPtr->borderWidth = 0;
+ mbPtr->relief = TK_RELIEF_FLAT;
+ mbPtr->highlightWidth = 0;
+ mbPtr->highlightBgColorPtr = NULL;
+ mbPtr->highlightColorPtr = NULL;
+ 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->direction = DIRECTION_FLUSH;
+ mbPtr->cursor = None;
+ mbPtr->takeFocus = NULL;
+ mbPtr->flags = 0;
+
+ Tk_CreateEventHandler(mbPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ MenuButtonEventProc, (ClientData) mbPtr);
+
+ if (Tk_InitOptions(interp, (char *) mbPtr, optionTable, tkwin) != TCL_OK) {
+ Tk_DestroyWindow(mbPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureMenuButton(interp, mbPtr, objc-2, objv+2) != TCL_OK) {
+ Tk_DestroyWindow(mbPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(mbPtr->tkwin), -1);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonWidgetObjCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuButtonWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ int result, index;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[1],
+ commandNames, "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve((ClientData) mbPtr);
+
+ switch (index) {
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) mbPtr,
+ mbPtr->optionTable, objv[2], mbPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+
+ case COMMAND_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) mbPtr,
+ mbPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ mbPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureMenuButton(interp, mbPtr, objc-2,
+ objv+2);
+ }
+ break;
+ }
+ }
+ Tcl_Release((ClientData) mbPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) mbPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuButton --
+ *
+ * This procedure is invoked to recycle all of the resources
+ * associated with a menubutton widget. It is invoked as a
+ * when-idle handler in order to make sure that there is no
+ * other use of the menubutton pending at the time of the deletion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the widget is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuButton(memPtr)
+ char *memPtr; /* Info about button widget. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) memPtr;
+ TkpDestroyMenuButton(mbPtr);
+
+ if (mbPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd);
+ if (mbPtr->textVarName != NULL) {
+ Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, (ClientData) mbPtr);
+ }
+ if (mbPtr->image != NULL) {
+ Tk_FreeImage(mbPtr->image);
+ }
+ if (mbPtr->normalTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
+ }
+ if (mbPtr->activeTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
+ }
+ if (mbPtr->disabledGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
+ }
+ if (mbPtr->gray != None) {
+ Tk_FreeBitmap(mbPtr->display, mbPtr->gray);
+ }
+ if (mbPtr->textLayout != NULL) {
+ Tk_FreeTextLayout(mbPtr->textLayout);
+ }
+ Tk_FreeConfigOptions((char *) mbPtr, mbPtr->optionTable,
+ mbPtr->tkwin);
+ mbPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) mbPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuButton --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a menubutton widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for mbPtr; old resources get freed, if there
+ * were any. The menubutton is redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuButton(interp, mbPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkMenuButton *mbPtr;
+ /* Information about widget; may or may
+ * not already have values for some
+ * fields. */
+ int objc; /* Number of valid entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error;
+ Tk_Image image;
+
+ /*
+ * Eliminate any existing trace on variables monitored by the
+ * menubutton.
+ */
+
+ if (mbPtr->textVarName != NULL) {
+ Tcl_UntraceVar(interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, (ClientData) mbPtr);
+ }
+
+ /*
+ * The following loop is potentially executed twice. During the
+ * first pass configuration options get set to their new values.
+ * If there is an error in this pass, we execute a second pass
+ * to restore all the options to their previous values.
+ */
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) mbPtr,
+ mbPtr->optionTable, objc, objv,
+ mbPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border, or filling in complicated
+ * defaults that couldn't be specified to Tk_SetOptions.
+ */
+
+ if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
+ }
+
+ if (mbPtr->highlightWidth < 0) {
+ mbPtr->highlightWidth = 0;
+ }
+
+ if (mbPtr->padX < 0) {
+ mbPtr->padX = 0;
+ }
+ if (mbPtr->padY < 0) {
+ mbPtr->padY = 0;
+ }
+
+ /*
+ * Get the image for the widget, if there is one. Allocate the
+ * new image before freeing the old one, so that the reference
+ * count doesn't go to zero and cause image data to be discarded.
+ */
+
+ if (mbPtr->imageString != NULL) {
+ image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
+ mbPtr->imageString, MenuButtonImageProc,
+ (ClientData) mbPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mbPtr->image != NULL) {
+ Tk_FreeImage(mbPtr->image);
+ }
+ mbPtr->image = image;
+
+ /*
+ * Recompute the geometry for the button.
+ */
+
+ if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
+ if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
+ &mbPtr->width) != TCL_OK) {
+ widthError:
+ Tcl_AddErrorInfo(interp, "\n (processing -width option)");
+ continue;
+ }
+ if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
+ &mbPtr->height) != TCL_OK) {
+ heightError:
+ Tcl_AddErrorInfo(interp, "\n (processing -height option)");
+ continue;
+ }
+ } else {
+ if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
+ != TCL_OK) {
+ goto heightError;
+ }
+ }
+ break;
+ }
+
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ if ((mbPtr->image == NULL) && (mbPtr->bitmap == None)
+ && (mbPtr->textVarName != NULL)) {
+
+ /*
+ * The menubutton displays the value of a variable.
+ * Set up a trace to watch for any changes in it, create
+ * the variable if it doesn't exist, and fetch its
+ * current value.
+ */
+
+ CONST char *value;
+
+ value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
+ TCL_GLOBAL_ONLY);
+ } else {
+ if (mbPtr->text != NULL) {
+ ckfree(mbPtr->text);
+ }
+ mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(mbPtr->text, value);
+ }
+ Tcl_TraceVar(interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, (ClientData) mbPtr);
+ }
+
+ TkMenuButtonWorldChanged((ClientData) mbPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkMenuButtonWorldChanged --
+ *
+ * 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;
+
+ 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_GetGC(mbPtr->tkwin, mask, &gcValues);
+ 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_GetGC(mbPtr->tkwin, mask, &gcValues);
+ if (mbPtr->activeTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
+ }
+ mbPtr->activeTextGC = gc;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel;
+ if ((mbPtr->disabledFg != NULL) && (mbPtr->imageString == NULL)) {
+ gcValues.foreground = mbPtr->disabledFg->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ } else {
+ 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_GetGC(mbPtr->tkwin, mask, &gcValues);
+ 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) {
+ DestroyMenuButton((char *) mbPtr);
+ } 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) {
+ 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. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ CONST 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/tcl/generic/tkMenubutton.h b/tcl/generic/tkMenubutton.h
new file mode 100644
index 00000000000..b3e4b2c34f0
--- /dev/null
+++ b/tcl/generic/tkMenubutton.h
@@ -0,0 +1,242 @@
+/*
+ * 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
+
+#ifndef _TKMENU
+#include "tkMenu.h"
+#endif
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Legal values for the "orient" field of TkMenubutton records.
+ */
+
+enum direction {
+ DIRECTION_ABOVE, DIRECTION_BELOW, DIRECTION_FLUSH,
+ DIRECTION_LEFT, DIRECTION_RIGHT
+};
+
+/*
+ * Legal values for the "state" field of TkMenubutton records.
+ */
+
+enum state {
+ STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
+};
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the widget. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Needed, among
+ * other things, so that resources can bee
+ * freed up even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with menubutton. */
+ Tcl_Command widgetCmd; /* Token for menubutton's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ char *menuName; /* Name of menu associated with widget.
+ * Malloc-ed. */
+
+ /*
+ * Information about what's displayed in the menu button:
+ */
+
+ 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:
+ */
+
+ enum state state; /* State of button for display purposes:
+ * normal, active, or disabled. */
+ Tk_3DBorder normalBorder; /* Structure used to draw 3-D
+ * border and background when window
+ * isn't active. NULL means no such
+ * border exists. */
+ Tk_3DBorder activeBorder; /* Structure used to draw 3-D
+ * border and background when window
+ * 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:
+ */
+
+ int compound; /* Value of -compound option; specifies whether
+ * the menubutton should show both an image and
+ * text, and, if so, how. */
+
+ enum direction direction; /* Direction for where to pop the menu.
+ * Valid directions are "above", "below",
+ * "left", "right", and "flush". "flush"
+ * means that the upper left corner of the
+ * menubutton is where the menu pops up.
+ * "above" and "below" will attempt to pop
+ * the menu compleletly above or below
+ * the menu respectively.
+ * "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 Tk_ClassProcs 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/tcl/generic/tkMessage.c b/tcl/generic/tkMessage.c
new file mode 100644
index 00000000000..1bcb4a87af9
--- /dev/null
+++ b/tcl/generic/tkMessage.c
@@ -0,0 +1,891 @@
+/*
+ * tkMessage.c --
+ *
+ * This module implements a message widgets for the Tk
+ * toolkit. A message widget displays a multi-line string
+ * in a window according to a particular aspect ratio.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Ajuba Solutions.
+ *
+ * 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.*/
+ Tk_OptionTable optionTable; /* Table that defines options available for
+ * this widget. */
+ 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. */
+ 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. */
+ Tcl_Obj *padXPtr, *padYPtr; /* Tcl_Obj rep's of padX, padY values. */
+ 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.
+ * MESSAGE_DELETED: The message has been effectively deleted.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+#define MESSAGE_DELETED 8
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_MESSAGE_ANCHOR,
+ -1, Tk_Offset(Message, anchor), 0, 0, 0},
+ {TK_OPTION_INT, "-aspect", "aspect", "Aspect", DEF_MESSAGE_ASPECT,
+ -1, Tk_Offset(Message, aspect), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_MESSAGE_BG_COLOR, -1, Tk_Offset(Message, border), 0,
+ (ClientData) DEF_MESSAGE_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, (char *) NULL,
+ 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, (char *) NULL,
+ 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MESSAGE_BORDER_WIDTH, -1,
+ Tk_Offset(Message, borderWidth), 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MESSAGE_CURSOR, -1, Tk_Offset(Message, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL, (char *) NULL,
+ 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MESSAGE_FONT, -1, Tk_Offset(Message, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MESSAGE_FG, -1, Tk_Offset(Message, fgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_MESSAGE_HIGHLIGHT_BG, -1,
+ Tk_Offset(Message, highlightBgColorPtr), 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_MESSAGE_HIGHLIGHT, -1, Tk_Offset(Message, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_MESSAGE_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Message, highlightWidth), 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_MESSAGE_JUSTIFY, -1, Tk_Offset(Message, justify), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_MESSAGE_PADX, Tk_Offset(Message, padXPtr),
+ Tk_Offset(Message, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_MESSAGE_PADY, Tk_Offset(Message, padYPtr),
+ Tk_Offset(Message, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MESSAGE_RELIEF, -1, Tk_Offset(Message, relief), 0, 0, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MESSAGE_TAKE_FOCUS, -1, Tk_Offset(Message, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_MESSAGE_TEXT, -1, Tk_Offset(Message, string), 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_MESSAGE_TEXT_VARIABLE, -1, Tk_Offset(Message, textVarName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_MESSAGE_WIDTH, -1, Tk_Offset(Message, width), 0, 0 ,0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0, 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, CONST char *name1,
+ CONST char *name2, int flags));
+static int MessageWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+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 objc, Tcl_Obj *CONST objv[],
+ 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 Tk_ClassProcs messageClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ MessageWorldChanged, /* worldChangedProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MessageObjCmd --
+ *
+ * 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_MessageObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ register Message *msgPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ msgPtr = (Message *) ckalloc(sizeof(Message));
+ memset(msgPtr, 0, (size_t) sizeof(Message));
+
+ /*
+ * Set values for those fields that don't take a 0 or NULL value.
+ */
+ msgPtr->tkwin = tkwin;
+ msgPtr->display = Tk_Display(tkwin);
+ msgPtr->interp = interp;
+ msgPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(msgPtr->tkwin), MessageWidgetObjCmd,
+ (ClientData) msgPtr, MessageCmdDeletedProc);
+ msgPtr->optionTable = optionTable;
+ msgPtr->relief = TK_RELIEF_FLAT;
+ msgPtr->textGC = None;
+ msgPtr->anchor = TK_ANCHOR_CENTER;
+ msgPtr->aspect = 150;
+ msgPtr->justify = TK_JUSTIFY_LEFT;
+ msgPtr->cursor = None;
+
+ Tk_SetClass(msgPtr->tkwin, "Message");
+ Tk_SetClassProcs(msgPtr->tkwin, &messageClass, (ClientData) msgPtr);
+ Tk_CreateEventHandler(msgPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ MessageEventProc, (ClientData) msgPtr);
+ if (Tk_InitOptions(interp, (char *)msgPtr, optionTable, tkwin) != TCL_OK) {
+ Tk_DestroyWindow(msgPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureMessage(interp, msgPtr, objc-2, objv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(msgPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageWidgetObjCmd --
+ *
+ * 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
+MessageWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about message widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ register Message *msgPtr = (Message *) clientData;
+ static CONST char *optionStrings[] = { "cget", "configure", (char *) NULL };
+ enum options { MESSAGE_CGET, MESSAGE_CONFIGURE };
+ int index;
+ int result = TCL_OK;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve((ClientData) msgPtr);
+
+ switch ((enum options) index) {
+ case MESSAGE_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) msgPtr,
+ msgPtr->optionTable, objv[2], msgPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ }
+ break;
+ }
+ case MESSAGE_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) msgPtr,
+ msgPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ msgPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ }
+ } else {
+ result = ConfigureMessage(interp, msgPtr, objc-2, objv+2, 0);
+ }
+ break;
+ }
+ }
+
+ Tcl_Release((ClientData) msgPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ msgPtr->flags |= MESSAGE_DELETED;
+
+ Tcl_DeleteCommandFromToken(msgPtr->interp, msgPtr->widgetCmd);
+ if (msgPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayMessage, (ClientData) msgPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeConfigOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (msgPtr->textGC != None) {
+ Tk_FreeGC(msgPtr->display, msgPtr->textGC);
+ }
+ if (msgPtr->textLayout != NULL) {
+ 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);
+ }
+ Tk_FreeConfigOptions((char *) msgPtr, msgPtr->optionTable, msgPtr->tkwin);
+ msgPtr->tkwin = NULL;
+ 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 the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for msgPtr; old resources get freed, if there
+ * were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMessage(interp, msgPtr, objc, objv, 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 objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ Tk_SavedOptions savedOptions;
+
+ /*
+ * 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_SetOptions(interp, (char *) msgPtr, msgPtr->optionTable, objc, objv,
+ msgPtr->tkwin, &savedOptions, (int *)NULL) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ 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) {
+ CONST 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 = Tcl_NumUtfChars(msgPtr->string, -1);
+
+ if (msgPtr->highlightWidth < 0) {
+ msgPtr->highlightWidth = 0;
+ }
+
+ Tk_FreeSavedOptions(&savedOptions);
+ 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 = None;
+ Tk_FontMetrics fm;
+ Message *msgPtr;
+
+ msgPtr = (Message *) instanceData;
+
+ if (msgPtr->border != NULL) {
+ Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border);
+ }
+
+ gcValues.font = Tk_FontId(msgPtr->tkfont);
+ gcValues.foreground = msgPtr->fgColorPtr->pixel;
+ gc = Tk_GetGC(msgPtr->tkwin, GCForeground | GCFont, &gcValues);
+ 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;
+ int borderWidth = msgPtr->highlightWidth;
+
+ msgPtr->flags &= ~REDRAW_PENDING;
+ if ((msgPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+ if (msgPtr->border != NULL) {
+ borderWidth += msgPtr->borderWidth;
+ }
+ if (msgPtr->relief == TK_RELIEF_FLAT) {
+ borderWidth = msgPtr->highlightWidth;
+ }
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border,
+ borderWidth, borderWidth,
+ Tk_Width(tkwin) - 2 * borderWidth,
+ Tk_Height(tkwin) - 2 * borderWidth,
+ 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 (borderWidth > msgPtr->highlightWidth) {
+ 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 fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(msgPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ if (msgPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(msgPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, msgPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, 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) {
+ DestroyMessage((char *) clientData);
+ } 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;
+
+ /*
+ * 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 (!(msgPtr->flags & MESSAGE_DELETED)) {
+ Tk_DestroyWindow(msgPtr->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. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register Message *msgPtr = (Message *) clientData;
+ CONST 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 = Tcl_NumUtfChars(value, -1);
+ msgPtr->string = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(msgPtr->string, value);
+ ComputeMessageGeometry(msgPtr);
+
+ if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
+ && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
diff --git a/tcl/generic/tkObj.c b/tcl/generic/tkObj.c
new file mode 100644
index 00000000000..2b44ba731f6
--- /dev/null
+++ b/tcl/generic/tkObj.c
@@ -0,0 +1,858 @@
+/*
+ * tkObj.c --
+ *
+ * This file contains procedures that implement the common Tk object
+ * types
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+
+/*
+ * The following structure is the internal representation for pixel objects.
+ */
+
+typedef struct PixelRep {
+ double value;
+ int units;
+ Tk_Window tkwin;
+ int returnValue;
+} PixelRep;
+
+#define SIMPLE_PIXELREP(objPtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr2 == 0)
+
+#define SET_SIMPLEPIXEL(objPtr, intval) \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval); \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = 0
+
+#define GET_SIMPLEPIXEL(objPtr) \
+ ((int) (objPtr)->internalRep.twoPtrValue.ptr1)
+
+#define SET_COMPLEXPIXEL(objPtr, repPtr) \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr
+
+#define GET_COMPLEXPIXEL(objPtr) \
+ ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)
+
+
+/*
+ * The following structure is the internal representation for mm objects.
+ */
+
+typedef struct MMRep {
+ double value;
+ int units;
+ Tk_Window tkwin;
+ double returnValue;
+} MMRep;
+
+/*
+ * The following structure is the internal representation for window objects.
+ */
+
+typedef struct WindowRep {
+ Tk_Window tkwin;
+ Tk_Window mainwin;
+ long epoch;
+} WindowRep;
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void DupWindowInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void FreeWindowInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static int SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static int SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "pixel"
+ * Tcl object, used for measuring distances. The pixel object remembers
+ * its initial display-independant settings.
+ */
+
+static Tcl_ObjType pixelObjType = {
+ "pixel", /* name */
+ FreePixelInternalRep, /* freeIntRepProc */
+ DupPixelInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetPixelFromAny /* setFromAnyProc */
+};
+
+/*
+ * The following structure defines the implementation of the "pixel"
+ * Tcl object, used for measuring distances. The pixel object remembers
+ * its initial display-independant settings.
+ */
+
+static Tcl_ObjType mmObjType = {
+ "mm", /* name */
+ FreeMMInternalRep, /* freeIntRepProc */
+ DupMMInternalRep, /* dupIntRepProc */
+ UpdateStringOfMM, /* updateStringProc */
+ SetMMFromAny /* setFromAnyProc */
+};
+
+/*
+ * The following structure defines the implementation of the "window"
+ * Tcl object.
+ */
+
+static Tcl_ObjType windowObjType = {
+ "window", /* name */
+ FreeWindowInternalRep, /* freeIntRepProc */
+ DupWindowInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetWindowFromAny /* setFromAnyProc */
+};
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixelsFromObj --
+ *
+ * Attempt to return a pixel value from the Tcl object "objPtr". If the
+ * object is not already a pixel value, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a pixel, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+ int *intPtr; /* Place to store resulting pixels. */
+{
+ int result;
+ double d;
+ PixelRep *pixelPtr;
+ static double bias[] = {
+ 1.0, 10.0, 25.4, 25.4 / 72.0
+ };
+
+ if (objPtr->typePtr != &pixelObjType) {
+ result = SetPixelFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ if (SIMPLE_PIXELREP(objPtr)) {
+ *intPtr = GET_SIMPLEPIXEL(objPtr);
+ } else {
+ pixelPtr = GET_COMPLEXPIXEL(objPtr);
+ if (pixelPtr->tkwin != tkwin) {
+ d = pixelPtr->value;
+ if (pixelPtr->units >= 0) {
+ d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ }
+ if (d < 0) {
+ pixelPtr->returnValue = (int) (d - 0.5);
+ } else {
+ pixelPtr->returnValue = (int) (d + 0.5);
+ }
+ pixelPtr->tkwin = tkwin;
+ }
+ *intPtr = pixelPtr->returnValue;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreePixelInternalRep --
+ *
+ * Deallocate the storage associated with a pixel object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's
+ * internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreePixelInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Pixel object with internal rep to free. */
+{
+ PixelRep *pixelPtr;
+
+ if (!SIMPLE_PIXELREP(objPtr)) {
+ pixelPtr = GET_COMPLEXPIXEL(objPtr);
+ ckfree((char *) pixelPtr);
+ }
+ SET_SIMPLEPIXEL(objPtr, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupPixelInternalRep --
+ *
+ * Initialize the internal representation of a pixel Tcl_Obj to a
+ * copy of the internal representation of an existing pixel object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to the pixel corresponding to
+ * srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupPixelInternalRep(srcPtr, copyPtr)
+ register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ PixelRep *oldPtr, *newPtr;
+
+ copyPtr->typePtr = srcPtr->typePtr;
+
+ if (SIMPLE_PIXELREP(srcPtr)) {
+ SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));
+ } else {
+ oldPtr = GET_COMPLEXPIXEL(srcPtr);
+ newPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
+ newPtr->value = oldPtr->value;
+ newPtr->units = oldPtr->units;
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->returnValue = oldPtr->returnValue;
+ SET_COMPLEXPIXEL(copyPtr, newPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetPixelFromAny --
+ *
+ * Attempt to generate a pixel internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a pixel representation of the object is
+ * stored internally and the type of "objPtr" is set to pixel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetPixelFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *string, *rest;
+ double d;
+ int i, units;
+ PixelRep *pixelPtr;
+
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ d = strtod(string, &rest);
+ if (rest == string) {
+ /*
+ * Must copy string before resetting the result in case a caller
+ * is trying to convert the interpreter's result to pixels.
+ */
+
+ char buf[100];
+
+ error:
+ sprintf(buf, "bad screen distance \"%.50s\"", string);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_ERROR;
+ }
+ while ((*rest != '\0') && isspace(UCHAR(*rest))) {
+ rest++;
+ }
+ switch (*rest) {
+ case '\0':
+ units = -1;
+ break;
+
+ case 'm':
+ units = 0;
+ break;
+
+ case 'c':
+ units = 1;
+ break;
+
+ case 'i':
+ units = 2;
+ break;
+
+ case 'p':
+ units = 3;
+ break;
+
+ default:
+ goto error;
+ }
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &pixelObjType;
+
+ i = (int) d;
+ if ((units < 0) && (i == d)) {
+ SET_SIMPLEPIXEL(objPtr, i);
+ } else {
+ pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
+ pixelPtr->value = d;
+ pixelPtr->units = units;
+ pixelPtr->tkwin = NULL;
+ pixelPtr->returnValue = i;
+ SET_COMPLEXPIXEL(objPtr, pixelPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetMMFromObj --
+ *
+ * Attempt to return an mm value from the Tcl object "objPtr". If the
+ * object is not already an mm value, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a pixel, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get mms. */
+ double *doublePtr; /* Place to store resulting millimeters. */
+{
+ int result;
+ double d;
+ MMRep *mmPtr;
+ static double bias[] = {
+ 10.0, 25.4, 1.0, 25.4 / 72.0
+ };
+
+ if (objPtr->typePtr != &mmObjType) {
+ result = SetMMFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
+ if (mmPtr->tkwin != tkwin) {
+ d = mmPtr->value;
+ if (mmPtr->units == -1) {
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ } else {
+ d *= bias[mmPtr->units];
+ }
+ mmPtr->tkwin = tkwin;
+ mmPtr->returnValue = d;
+ }
+ *doublePtr = mmPtr->returnValue;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMMInternalRep --
+ *
+ * Deallocate the storage associated with a mm object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's
+ * internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMMInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* MM object with internal rep to free. */
+{
+ ckfree((char *) objPtr->internalRep.otherValuePtr);
+ objPtr->internalRep.otherValuePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupMMInternalRep --
+ *
+ * Initialize the internal representation of a pixel Tcl_Obj to a
+ * copy of the internal representation of an existing pixel object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to the pixel corresponding to
+ * srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupMMInternalRep(srcPtr, copyPtr)
+ register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ MMRep *oldPtr, *newPtr;
+
+ copyPtr->typePtr = srcPtr->typePtr;
+ oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;
+ newPtr = (MMRep *) ckalloc(sizeof(MMRep));
+ newPtr->value = oldPtr->value;
+ newPtr->units = oldPtr->units;
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->returnValue = oldPtr->returnValue;
+ copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfMM --
+ *
+ * Update the string representation for a pixel Tcl_Obj
+ * this function is only called, if the pixel Tcl_Obj has no unit,
+ * because with units the string representation is created by
+ * SetMMFromAny
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string is set to a valid string that results from
+ * the double-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfMM(objPtr)
+ register Tcl_Obj *objPtr; /* pixel obj with string rep to update. */
+{
+ MMRep *mmPtr;
+ char buffer[TCL_DOUBLE_SPACE];
+ register int len;
+
+ mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
+ /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */
+ if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) {
+ panic("UpdateStringOfMM: false precondition");
+ }
+
+ Tcl_PrintDouble((Tcl_Interp *) NULL, mmPtr->value, buffer);
+ len = strlen(buffer);
+
+ objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
+ strcpy(objPtr->bytes, buffer);
+ objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetMMFromAny --
+ *
+ * Attempt to generate a mm internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a mm representation of the object is
+ * stored internally and the type of "objPtr" is set to mm.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetMMFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *string, *rest;
+ double d;
+ int units;
+ MMRep *mmPtr;
+
+ static Tcl_ObjType *tclDoubleObjType = NULL;
+ static Tcl_ObjType *tclIntObjType = NULL;
+
+ if (tclDoubleObjType == NULL) {
+ /*
+ * Cache the object types for comaprison below.
+ * This allows optimized checks for standard cases.
+ */
+
+ tclDoubleObjType = Tcl_GetObjType("double");
+ tclIntObjType = Tcl_GetObjType("int");
+ }
+
+ if (objPtr->typePtr == tclDoubleObjType) {
+ Tcl_GetDoubleFromObj(interp, objPtr, &d);
+ units = -1;
+ } else if (objPtr->typePtr == tclIntObjType) {
+ Tcl_GetIntFromObj(interp, objPtr, &units);
+ d = (double) units;
+ units = -1;
+
+ /*
+ * In the case of ints, we need to ensure that a valid
+ * string exists in order for int-but-not-string objects
+ * to be converted back to ints again from mm obj types.
+ */
+ (void) Tcl_GetStringFromObj(objPtr, NULL);
+ } else {
+ /*
+ * It wasn't a known int or double, so parse it.
+ */
+
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ d = strtod(string, &rest);
+ if (rest == string) {
+ /*
+ * Must copy string before resetting the result in case a caller
+ * is trying to convert the interpreter's result to mms.
+ */
+
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*rest != '\0') && isspace(UCHAR(*rest))) {
+ rest++;
+ }
+ switch (*rest) {
+ case '\0':
+ units = -1;
+ break;
+
+ case 'c':
+ units = 0;
+ break;
+
+ case 'i':
+ units = 1;
+ break;
+
+ case 'm':
+ units = 2;
+ break;
+
+ case 'p':
+ units = 3;
+ break;
+
+ default:
+ goto error;
+ }
+ }
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &mmObjType;
+
+ mmPtr = (MMRep *) ckalloc(sizeof(MMRep));
+ mmPtr->value = d;
+ mmPtr->units = units;
+ mmPtr->tkwin = NULL;
+ mmPtr->returnValue = d;
+
+ objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetWindowFromObj --
+ *
+ * Attempt to return a Tk_Window from the Tcl object "objPtr". If the
+ * object is not already a Tk_Window, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a Tk_Window, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin; /* A token to get the main window from. */
+ Tcl_Obj *objPtr; /* The object from which to get boolean. */
+ Tk_Window *windowPtr; /* Place to store resulting window. */
+{
+ register WindowRep *winPtr;
+ TkDisplay *dispPtr = ((TkWindow *)tkwin)->dispPtr;
+ Tk_Window foundWindow;
+
+ if (objPtr->typePtr != &windowObjType) {
+ register int result = SetWindowFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr;
+ if (winPtr == NULL) {
+ winPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
+ objPtr->internalRep.otherValuePtr = (VOID *) winPtr;
+ goto parseWindowString;
+
+ } else if (tkwin != winPtr->mainwin ||
+ dispPtr->deletionEpoch != winPtr->epoch) {
+ parseWindowString:
+ foundWindow = Tk_NameToWindow(interp,
+ Tcl_GetStringFromObj(objPtr, NULL), tkwin);
+ if (foundWindow == NULL) {
+ return TCL_ERROR;
+ }
+
+ winPtr->tkwin = foundWindow;
+ winPtr->mainwin = tkwin;
+ winPtr->epoch = dispPtr->deletionEpoch;
+ }
+
+ *windowPtr = winPtr->tkwin;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWindowFromAny --
+ *
+ * Attempt to generate a Tk_Window internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a standard window value is stored as "objPtr"s
+ * internal representation and the type of "objPtr" is set to Tk_Window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetWindowFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetStringFromObj(objPtr, NULL);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &windowObjType;
+ objPtr->internalRep.otherValuePtr = NULL;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupWindowInternalRep --
+ *
+ * Initialize the internal representation of a window Tcl_Obj to a
+ * copy of the internal representation of an existing window object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to refer to the same window as
+ * srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupWindowInternalRep(srcPtr, copyPtr)
+ register Tcl_Obj *srcPtr;
+ register Tcl_Obj *copyPtr;
+{
+ register WindowRep *oldPtr, *newPtr;
+
+ copyPtr->typePtr = srcPtr->typePtr;
+ oldPtr = srcPtr->internalRep.otherValuePtr;
+ if (oldPtr == NULL) {
+ copyPtr->internalRep.otherValuePtr = NULL;
+ } else {
+ newPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->mainwin = oldPtr->mainwin;
+ newPtr->epoch = oldPtr->epoch;
+ copyPtr->internalRep.otherValuePtr = (VOID *)newPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeWindowInternalRep --
+ *
+ * Deallocate the storage associated with a window object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's
+ * internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeWindowInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Window object with internal rep to free. */
+{
+ if (objPtr->internalRep.otherValuePtr != NULL) {
+ ckfree((char *) objPtr->internalRep.otherValuePtr);
+ objPtr->internalRep.otherValuePtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkRegisterObjTypes --
+ *
+ * Registers Tk's Tcl_ObjType structures with the Tcl run-time.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * All instances of Tcl_ObjType structues used in Tk are registered
+ * with Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkRegisterObjTypes()
+{
+ Tcl_RegisterObjType(&tkBorderObjType);
+ Tcl_RegisterObjType(&tkBitmapObjType);
+ Tcl_RegisterObjType(&tkColorObjType);
+ Tcl_RegisterObjType(&tkCursorObjType);
+ Tcl_RegisterObjType(&tkFontObjType);
+ Tcl_RegisterObjType(&mmObjType);
+ Tcl_RegisterObjType(&tkOptionObjType);
+ Tcl_RegisterObjType(&pixelObjType);
+ Tcl_RegisterObjType(&tkStateKeyObjType);
+ Tcl_RegisterObjType(&windowObjType);
+}
diff --git a/tcl/generic/tkOldConfig.c b/tcl/generic/tkOldConfig.c
new file mode 100644
index 00000000000..e555013000a
--- /dev/null
+++ b/tcl/generic/tkOldConfig.c
@@ -0,0 +1,1032 @@
+/*
+ * tkOldConfig.c --
+ *
+ * This file contains the Tk_ConfigureWidget procedure. THIS FILE
+ * IS HERE FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION
+ * PACKAGE SHOULD BE USED FOR NEW PROJECTS.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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, CONST char *argvName,
+ int needFlags, int hateFlags));
+static char * FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specPtr,
+ char *widgRec));
+static CONST char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specPtr,
+ char *widgRec, char *buffer,
+ Tcl_FreeProc **freeProcPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigureWidget --
+ *
+ * Process command-line options and database options to
+ * fill in fields of a widget record with resources and
+ * other parameters.
+ *
+ * Results:
+ * A standard Tcl return value. In case of an error,
+ * the interp's result will hold an error message.
+ *
+ * Side effects:
+ * The fields of widgRec get filled in with information
+ * from argc/argv and the option database. Old information
+ * in widgRec's fields gets recycled.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window containing widget (needed to
+ * set up X resources). */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ int argc; /* Number of elements in argv. */
+ CONST 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. */
+
+ if (tkwin == NULL) {
+ /*
+ * Either we're not really in Tk, or the main window was destroyed and
+ * we're on our way out of the application
+ */
+ Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ 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_Uid structs (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) {
+ CONST char *arg;
+
+ if (flags & TK_CONFIG_OBJS) {
+ arg = Tcl_GetStringFromObj((Tcl_Obj *) *argv, NULL);
+ } else {
+ arg = *argv;
+ }
+ specPtr = FindConfigSpec(interp, specs, arg, needFlags, hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process the entry.
+ */
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "value for \"", arg,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (flags & TK_CONFIG_OBJS) {
+ arg = Tcl_GetString((Tcl_Obj *) argv[1]);
+ } else {
+ arg = argv[1];
+ }
+ if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) {
+ char msg[100];
+
+ sprintf(msg, "\n (processing \"%.40s\" option)",
+ specPtr->argvName);
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+ specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
+ }
+
+ /*
+ * Pass three: scan through all of the specs again; if no
+ * command-line argument matched a spec, then check for info
+ * in the option database. If there was nothing in the
+ * database, then use the default.
+ */
+
+ if (!(flags & TK_CONFIG_ARGV_ONLY)) {
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
+ || (specPtr->argvName == NULL)
+ || (specPtr->type == TK_CONFIG_SYNONYM)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ value = NULL;
+ if (specPtr->dbName != NULL) {
+ value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
+ }
+ if (value != NULL) {
+ if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
+ TCL_OK) {
+ char msg[200];
+
+ sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")",
+ "database entry for",
+ specPtr->dbName, Tk_PathName(tkwin));
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+ } else {
+ if (specPtr->defValue != NULL) {
+ value = Tk_GetUid(specPtr->defValue);
+ } else {
+ value = NULL;
+ }
+ if ((value != NULL) && !(specPtr->specFlags
+ & TK_CONFIG_DONT_SET_DEFAULT)) {
+ if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
+ TCL_OK) {
+ char msg[200];
+
+ sprintf(msg,
+ "\n (%s \"%.50s\" in widget \"%.50s\")",
+ "default value for",
+ specPtr->dbName, Tk_PathName(tkwin));
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindConfigSpec --
+ *
+ * Search through a table of configuration specs, looking for
+ * one that matches a given argvName.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL
+ * if nothing matched. In that case an error message is left
+ * in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_ConfigSpec *
+FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_ConfigSpec *specs; /* Pointer to table of configuration
+ * specifications for a widget. */
+ CONST 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. */
+ Tk_Uid value; /* Value to use to fill in widgRec. */
+ int valueIsUid; /* Non-zero means value is a Tk_Uid;
+ * zero means it's an ordinary string. */
+ char *widgRec; /* Record whose fields are to be
+ * modified. Values must be properly
+ * initialized. */
+{
+ char *ptr;
+ Tk_Uid uid;
+ int nullValue;
+
+ nullValue = 0;
+ if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
+ nullValue = 1;
+ }
+
+ do {
+ ptr = widgRec + specPtr->offset;
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_INT:
+ if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_DOUBLE:
+ if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_STRING: {
+ char *old, *new;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ new = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(new, value);
+ }
+ old = *((char **) ptr);
+ if (old != NULL) {
+ ckfree(old);
+ }
+ *((char **) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_UID:
+ if (nullValue) {
+ *((Tk_Uid *) ptr) = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ *((Tk_Uid *) ptr) = uid;
+ }
+ break;
+ case TK_CONFIG_COLOR: {
+ XColor *newPtr, *oldPtr;
+
+ if (nullValue) {
+ newPtr = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ newPtr = Tk_GetColor(interp, tkwin, uid);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ oldPtr = *((XColor **) ptr);
+ if (oldPtr != NULL) {
+ Tk_FreeColor(oldPtr);
+ }
+ *((XColor **) ptr) = newPtr;
+ break;
+ }
+ case TK_CONFIG_FONT: {
+ Tk_Font new;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ new = Tk_GetFont(interp, tkwin, value);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_FreeFont(*((Tk_Font *) ptr));
+ *((Tk_Font *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap new, old;
+
+ if (nullValue) {
+ new = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_GetBitmap(interp, tkwin, uid);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Pixmap *) ptr);
+ if (old != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), old);
+ }
+ *((Pixmap *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder new, old;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_Get3DBorder(interp, tkwin, uid);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Tk_3DBorder *) ptr);
+ if (old != NULL) {
+ Tk_Free3DBorder(old);
+ }
+ *((Tk_3DBorder *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_RELIEF:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR: {
+ Tk_Cursor new, old;
+
+ if (nullValue) {
+ new = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_GetCursor(interp, tkwin, uid);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Tk_Cursor *) ptr);
+ if (old != None) {
+ Tk_FreeCursor(Tk_Display(tkwin), old);
+ }
+ *((Tk_Cursor *) ptr) = new;
+ if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
+ Tk_DefineCursor(tkwin, new);
+ }
+ break;
+ }
+ case TK_CONFIG_JUSTIFY:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_ANCHOR:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_CAP_STYLE:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_JOIN_STYLE:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_PIXELS:
+ if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_MM:
+ if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_WINDOW: {
+ Tk_Window tkwin2;
+
+ if (nullValue) {
+ tkwin2 = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, value, tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ *((Tk_Window *) ptr) = tkwin2;
+ break;
+ }
+ case TK_CONFIG_CUSTOM:
+ if ((*specPtr->customPtr->parseProc)(
+ specPtr->customPtr->clientData, interp, tkwin,
+ value, widgRec, specPtr->offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ default: {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "bad config table: unknown type %d",
+ specPtr->type);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ specPtr++;
+ } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigureInfo --
+ *
+ * Return information about the configuration options
+ * for a window, and their current values.
+ *
+ * Results:
+ * Always returns TCL_OK. The interp's result will be modified
+ * hold a description of either a single configuration option
+ * available for "widgRec" via "specs", or all the configuration
+ * options available. In the "all" case, the result will
+ * available for "widgRec" via "specs". The result will
+ * be a list, each of whose entries describes one option.
+ * Each entry will itself be a list containing the option's
+ * name for use on command lines, database name, database
+ * class, default value, and current value (empty string
+ * if none). For options that are synonyms, the list will
+ * contain only two values: name and synonym name. If the
+ * "name" argument is non-NULL, then the only information
+ * returned is that for the named argument (i.e. the corresponding
+ * entry in the overall list is returned).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ CONST char *argvName; /* If non-NULL, indicates a single option
+ * whose info is to be returned. Otherwise
+ * info is returned for all options. */
+ int flags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. */
+{
+ register Tk_ConfigSpec *specPtr;
+ int needFlags, hateFlags;
+ char *list;
+ char *leader = "{";
+
+ needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
+ if (Tk_Depth(tkwin) <= 1) {
+ hateFlags = TK_CONFIG_COLOR_ONLY;
+ } else {
+ hateFlags = TK_CONFIG_MONO_ONLY;
+ }
+
+ /*
+ * If information is only wanted for a single configuration
+ * spec, then handle that one spec specially.
+ */
+
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ if (argvName != NULL) {
+ specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
+ hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp,
+ FormatConfigInfo(interp, tkwin, specPtr, widgRec),
+ TCL_DYNAMIC);
+ return TCL_OK;
+ }
+
+ /*
+ * Loop through all the specs, creating a big list with all
+ * their information.
+ */
+
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if ((argvName != NULL) && (specPtr->argvName != argvName)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+ list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
+ Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
+ ckfree(list);
+ leader = " {";
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FormatConfigInfo --
+ *
+ * Create a valid Tcl list holding the configuration information
+ * for a single configuration option.
+ *
+ * Results:
+ * A Tcl list, dynamically allocated. The caller is expected to
+ * arrange for this list to be freed eventually.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+FormatConfigInfo(interp, tkwin, specPtr, widgRec)
+ Tcl_Interp *interp; /* Interpreter to use for things
+ * like floating-point precision. */
+ Tk_Window tkwin; /* Window corresponding to widget. */
+ register Tk_ConfigSpec *specPtr; /* Pointer to information describing
+ * option. */
+ char *widgRec; /* Pointer to record holding current
+ * values of info for widget. */
+{
+ CONST char *argv[6];
+ char *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((char *)argv[4]);
+ } else {
+ (*freeProc)((char *)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 CONST 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. */
+{
+ CONST char *ptr, *result;
+
+ *freeProcPtr = NULL;
+ ptr = widgRec + specPtr->offset;
+ result = "";
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (*((int *) ptr) == 0) {
+ result = "0";
+ } else {
+ result = "1";
+ }
+ break;
+ case TK_CONFIG_INT:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_DOUBLE:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_STRING:
+ result = (*(char **) ptr);
+ if (result == NULL) {
+ result = "";
+ }
+ break;
+ case TK_CONFIG_UID: {
+ Tk_Uid uid = *((Tk_Uid *) ptr);
+ if (uid != NULL) {
+ result = uid;
+ }
+ break;
+ }
+ case TK_CONFIG_COLOR: {
+ XColor *colorPtr = *((XColor **) ptr);
+ if (colorPtr != NULL) {
+ result = Tk_NameOfColor(colorPtr);
+ }
+ break;
+ }
+ case TK_CONFIG_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) ptr);
+ if (tkfont != NULL) {
+ result = Tk_NameOfFont(tkfont);
+ }
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) ptr);
+ if (pixmap != None) {
+ result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
+ }
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) ptr);
+ if (border != NULL) {
+ result = Tk_NameOf3DBorder(border);
+ }
+ break;
+ }
+ case TK_CONFIG_RELIEF:
+ result = Tk_NameOfRelief(*((int *) ptr));
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) ptr);
+ if (cursor != None) {
+ result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
+ }
+ break;
+ }
+ case TK_CONFIG_JUSTIFY:
+ result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
+ break;
+ case TK_CONFIG_ANCHOR:
+ result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
+ break;
+ case TK_CONFIG_CAP_STYLE:
+ result = Tk_NameOfCapStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_JOIN_STYLE:
+ result = Tk_NameOfJoinStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_PIXELS:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_MM:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_WINDOW: {
+ Tk_Window tkwin;
+
+ tkwin = *((Tk_Window *) ptr);
+ if (tkwin != NULL) {
+ result = Tk_PathName(tkwin);
+ }
+ break;
+ }
+ case TK_CONFIG_CUSTOM:
+ result = (*specPtr->customPtr->printProc)(
+ specPtr->customPtr->clientData, tkwin, widgRec,
+ specPtr->offset, freeProcPtr);
+ break;
+ default:
+ result = "?? unknown type ??";
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ConfigureValue --
+ *
+ * This procedure returns the current value of a configuration
+ * option for a widget.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code (TCL_OK or
+ * TCL_ERROR). The interp's result will be set to hold either the value
+ * of the option given by argvName (if TCL_OK is returned) or
+ * an error message (if TCL_ERROR is returned).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ CONST 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;
+ Tcl_FreeProc *freeProc;
+ CONST char *result;
+ char buffer[200];
+
+ 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;
+ }
+ result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, &freeProc);
+ Tcl_SetResult(interp, (char *) result, TCL_VOLATILE);
+ if (freeProc != NULL) {
+ if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
+ ckfree((char *)result);
+ } else {
+ (*freeProc)((char *)result);
+ }
+ }
+ 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/tcl/generic/tkOption.c b/tcl/generic/tkOption.c
new file mode 100644
index 00000000000..2decd353971
--- /dev/null
+++ b/tcl/generic/tkOption.c
@@ -0,0 +1,1634 @@
+/*
+ * tkOption.c --
+ *
+ * This module contains procedures to manage the option
+ * database, which allows various strings to be associated
+ * with windows either by name or by class or both.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ *
+ * The structure of the option db tree is a little confusing. There are
+ * four different kinds of nodes in the tree:
+ * interior class nodes
+ * interior name nodes
+ * leaf class nodes
+ * leaf name nodes
+ *
+ * All interior nodes refer to _window_ classes and names; all leaf nodes
+ * refer to _option_ classes and names. When looking for a particular option,
+ * therefore, you must compare interior node values to corresponding window
+ * values, and compare leaf node values to corresponding option values.
+ *
+ * The tree is actually stored in a collection of arrays; there is one each
+ * combination of WILDCARD/EXACT and CLASS/NAME and NODE/LEAF. The NODE arrays
+ * contain the interior nodes of the tree; each element has a pointer to an
+ * array of elements which are the leaves of the tree. The LEAF arrays, rather
+ * than holding the leaves of the tree, hold a cached subset of the option
+ * database, consisting of the values of all defined options for a single
+ * window, and some additional information about each ancestor of the window
+ * (since some options may be inherited from a parent), all the way back to the
+ * root window.
+ *
+ * Each time a call is made to Tk_GetOption, Tk will attempt to use the cached
+ * information to satisfy the lookup. If the call is for a window other than
+ * that for which options are currently cached, the portion of the cache that
+ * contains information for common ancestors of the two windows is retained and
+ * the remainder is discarded and rebuilt with new information for the new
+ * window.
+ */
+
+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
+
+/*
+ * One of the following structures is used to keep track of each
+ * level in the stacks.
+ */
+
+typedef struct StackLevel {
+ TkWindow *winPtr; /* Window corresponding to this stack
+ * level. */
+ int bases[NUM_STACKS]; /* For each stack, index of first
+ * element on stack corresponding to
+ * this level (used to restore "numUsed"
+ * fields when popping out of a level. */
+} StackLevel;
+
+typedef struct ThreadSpecificData {
+ int initialized; /* 0 means the ThreadSpecific Data structure
+ * for the current thread needs to be
+ * initialized. */
+ ElArray *stacks[NUM_STACKS];
+ TkWindow *cachedWindow;
+ /* Lowest-level window currently
+ * loaded in stacks at present.
+ * NULL means stacks have never
+ * been used, or have been
+ * invalidated because of a change
+ * to the database. */
+ /*
+ * Information about all of the stack levels that are currently
+ * active. This array grows dynamically to become as large as needed.
+ */
+
+ StackLevel *levels; /* Array describing current stack. */
+ int numLevels; /* Total space allocated. */
+ int curLevel; /* Highest level currently in use. Note:
+ * curLevel is never 0! (I don't remember
+ * why anymore...) */
+ /*
+ * The variable below is a serial number for all options entered into
+ * the database so far. It increments on each addition to the option
+ * database. It is used in computing option priorities, so that the
+ * most recent entry wins when choosing between options at the same
+ * priority level.
+ */
+
+ int serial;
+ Element defaultMatch; /* Special "no match" Element to use as
+ * default for searches.*/
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static int AddFromString _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string, int priority));
+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 OptionThreadExitProc _ANSI_ARGS_((
+ ClientData clientData));
+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. */
+ CONST char *name; /* Multi-element name of option. */
+ CONST 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 CONST char *p;
+ CONST char *field;
+ int count, firstField, length;
+#define TMP_SIZE 100
+ char tmp[TMP_SIZE+1];
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->mainPtr->optionRootPtr == NULL) {
+ OptionInit(winPtr->mainPtr);
+ }
+ tsdPtr->cachedWindow = NULL; /* Invalidate the cache. */
+
+ /*
+ * Compute the priority for the new element, including both the
+ * overall level and the serial number (to disambiguate with the
+ * level).
+ */
+
+ if (priority < 0) {
+ priority = 0;
+ } else if (priority > TK_MAX_PRIO) {
+ priority = TK_MAX_PRIO;
+ }
+ newEl.priority = (priority << 24) + tsdPtr->serial;
+ tsdPtr->serial++;
+
+ /*
+ * Parse the option one field at a time.
+ */
+
+ arrayPtrPtr = &(((TkWindow *) tkwin)->mainPtr->optionRootPtr);
+ p = name;
+ 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. */
+ CONST char *name; /* Name of option. */
+ CONST char *className; /* Class of option. NULL means there
+ * is no class for this option: just
+ * check for name. */
+{
+ Tk_Uid nameId, classId = NULL;
+ char *masqName;
+ register Element *elPtr, *bestPtr;
+ register int count;
+ StackLevel *levelPtr;
+ int stackDepth[NUM_STACKS];
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Note: no need to call OptionInit here: it will be done by
+ * the SetupStacks call below (squeeze out those nanoseconds).
+ */
+
+ if (tkwin != (Tk_Window) tsdPtr->cachedWindow) {
+ SetupStacks((TkWindow *) tkwin, 1);
+ }
+
+ /*
+ * Get a default "best" match.
+ */
+
+ bestPtr = &tsdPtr->defaultMatch;
+
+ /*
+ * For megawidget support, we want to have some widget options masquerade
+ * as options for other widgets. For example, a combobox has a button in
+ * it; this button ought to pick up the *Button.background, etc., options.
+ * But because the class of the widget is Combobox, our normal search
+ * won't get that option.
+ *
+ * To work around this, the option name field syntax was extended to allow
+ * for a "." in the name; if this character occurs in the name, then it
+ * indicates that this name contains a new window class and an option name,
+ * ie, "Button.foreground". If we see this form in the name field, we
+ * query the option database directly (since the option stacks will not
+ * have the information we need).
+ */
+
+ masqName = strchr(name, (int)'.');
+ if (masqName != NULL) {
+ /*
+ * This option is masquerading with a different window class.
+ * Search the stack to the depth it was before the current window's
+ * information was pushed (the value for which is stored in the bases
+ * field).
+ */
+ levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
+ nameId = Tk_GetUid(masqName+1);
+ for (count = 0; count < NUM_STACKS; count++) {
+ stackDepth[count] = levelPtr->bases[count];
+ }
+ } else {
+ /*
+ * No option masquerading here. Just use the current level to get the
+ * stack depths.
+ */
+ nameId = Tk_GetUid(name);
+ for (count = 0; count < NUM_STACKS; count++) {
+ stackDepth[count] = tsdPtr->stacks[count]->numUsed;
+ }
+ }
+
+ /*
+ * Probe the stacks for matches.
+ */
+
+ for (elPtr = tsdPtr->stacks[EXACT_LEAF_NAME]->els,
+ count = stackDepth[EXACT_LEAF_NAME]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == nameId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_NAME]->els,
+ count = stackDepth[WILDCARD_LEAF_NAME]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == nameId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+
+ if (className != NULL) {
+ classId = Tk_GetUid(className);
+ for (elPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]->els,
+ count = stackDepth[EXACT_LEAF_CLASS]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == classId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->els,
+ count = stackDepth[WILDCARD_LEAF_CLASS]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == classId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ }
+
+ /*
+ * If this option was masquerading with a different window class,
+ * probe the option database now. Note that this will be inefficient
+ * if the option database is densely populated, or if the widget has many
+ * masquerading options.
+ */
+
+ if (masqName != NULL) {
+ char *masqClass;
+ Tk_Uid nodeId, winClassId, winNameId;
+ unsigned int classNameLength;
+ register Element *nodePtr, *leafPtr;
+ static int searchOrder[] = { EXACT_NODE_NAME,
+ WILDCARD_NODE_NAME,
+ EXACT_NODE_CLASS,
+ WILDCARD_NODE_CLASS,
+ -1 };
+ int *currentPtr, currentStack, leafCount;
+
+ /*
+ * Extract the masquerade class name from the name field.
+ */
+
+ classNameLength = (unsigned int)(masqName - name);
+ masqClass = (char *)ckalloc(classNameLength + 1);
+ strncpy(masqClass, name, classNameLength);
+ masqClass[classNameLength] = '\0';
+
+ winClassId = Tk_GetUid(masqClass);
+ ckfree(masqClass);
+ winNameId = ((TkWindow *)tkwin)->nameUid;
+
+ levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
+
+ for (currentPtr = searchOrder; *currentPtr != -1; currentPtr++) {
+ currentStack = *currentPtr;
+ nodePtr = tsdPtr->stacks[currentStack]->els;
+ count = levelPtr->bases[currentStack];
+
+ /*
+ * For wildcard stacks, check all entries; for non-wildcard
+ * stacks, only check things that matched in the parent.
+ */
+
+ if (!(currentStack & WILDCARD)) {
+ nodePtr += levelPtr[-1].bases[currentStack];
+ count -= levelPtr[-1].bases[currentStack];
+ }
+
+ if (currentStack && CLASS) {
+ nodeId = winClassId;
+ } else {
+ nodeId = winNameId;
+ }
+
+ for ( ; count > 0; nodePtr++, count--) {
+ if (nodePtr->nameUid == nodeId) {
+ leafPtr = nodePtr->child.arrayPtr->els;
+ leafCount = nodePtr->child.arrayPtr->numUsed;
+ for ( ; leafCount > 0; leafPtr++, leafCount--) {
+ if (leafPtr->flags & CLASS && className != NULL) {
+ if (leafPtr->nameUid == classId &&
+ leafPtr->priority > bestPtr->priority) {
+ bestPtr = leafPtr;
+ }
+ } else {
+ if (leafPtr->nameUid == nameId &&
+ leafPtr->priority > bestPtr->priority) {
+ bestPtr = leafPtr;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return bestPtr->child.valueUid;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OptionObjCmd --
+ *
+ * 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_OptionObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of Tcl_Obj arguments. */
+ Tcl_Obj *CONST objv[]; /* Tcl_Obj arguments. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int index, result;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ static CONST char *optionCmds[] = {
+ "add", "clear", "get", "readfile", NULL
+ };
+
+ enum optionVals {
+ OPTION_ADD, OPTION_CLEAR, OPTION_GET, OPTION_READFILE
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cmd arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], optionCmds, "option", 0,
+ &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ result = TCL_OK;
+ switch ((enum optionVals) index) {
+ case OPTION_ADD: {
+ int priority;
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pattern value ?priority?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ priority = TK_INTERACTIVE_PRIO;
+ } else {
+ priority = ParsePriority(interp, Tcl_GetString(objv[4]));
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_AddOption(tkwin, Tcl_GetString(objv[2]),
+ Tcl_GetString(objv[3]), priority);
+ break;
+ }
+
+ case OPTION_CLEAR: {
+ TkMainInfo *mainPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+ mainPtr = ((TkWindow *) tkwin)->mainPtr;
+ if (mainPtr->optionRootPtr != NULL) {
+ ClearOptionTree(mainPtr->optionRootPtr);
+ mainPtr->optionRootPtr = NULL;
+ }
+ tsdPtr->cachedWindow = NULL;
+ break;
+ }
+
+ case OPTION_GET: {
+ Tk_Window window;
+ Tk_Uid value;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window name class");
+ return TCL_ERROR;
+ }
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ value = Tk_GetOption(window, Tcl_GetString(objv[3]),
+ Tcl_GetString(objv[4]));
+ if (value != NULL) {
+ Tcl_SetResult(interp, (char *)value, TCL_STATIC);
+ }
+ break;
+ }
+
+ case OPTION_READFILE: {
+ int priority;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?priority?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ priority = ParsePriority(interp, Tcl_GetString(objv[3]));
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ } else {
+ priority = TK_INTERACTIVE_PRIO;
+ }
+ result = ReadOptionFile(interp, tkwin, Tcl_GetString(objv[2]),
+ priority);
+ break;
+ }
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * If this window is in the option stacks, then clear the stacks.
+ */
+
+ if (winPtr->optionLevel != -1) {
+ int i;
+
+ for (i = 1; i <= tsdPtr->curLevel; i++) {
+ tsdPtr->levels[i].winPtr->optionLevel = -1;
+ }
+ tsdPtr->curLevel = -1;
+ tsdPtr->cachedWindow = NULL;
+ }
+
+ /*
+ * If this window was a main window, then delete its option
+ * database.
+ */
+
+ if ((winPtr->mainPtr != NULL) && (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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->optionLevel == -1) {
+ return;
+ }
+
+ /*
+ * Find the lowest stack level that refers to this window, then
+ * flush all of the levels above the matching one.
+ */
+
+ for (i = 1; i <= tsdPtr->curLevel; i++) {
+ if (tsdPtr->levels[i].winPtr == winPtr) {
+ for (j = i; j <= tsdPtr->curLevel; j++) {
+ tsdPtr->levels[j].winPtr->optionLevel = -1;
+ }
+ tsdPtr->curLevel = i-1;
+ basePtr = tsdPtr->levels[i].bases;
+ for (j = 0; j < NUM_STACKS; j++) {
+ arrayPtr = tsdPtr->stacks[j];
+ arrayPtr->numUsed = basePtr[j];
+ arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
+ }
+ if (tsdPtr->curLevel <= 0) {
+ tsdPtr->cachedWindow = NULL;
+ } else {
+ tsdPtr->cachedWindow = tsdPtr->levels[tsdPtr->curLevel].winPtr;
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParsePriority --
+ *
+ * Parse a string priority value.
+ *
+ * Results:
+ * The return value is the integer priority level corresponding
+ * to string, or -1 if string doesn't point to a valid priority level.
+ * In this case, an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 the interp's result. The memory at
+ * string is totally trashed by this procedure. If you care about
+ * its contents, make a copy before calling here.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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')) {
+ char buf[32 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "missing colon on line %d", lineNum);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ } else {
+ *dst = *src;
+ 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') {
+ char buf[32 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "missing value on line %d", lineNum);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse off the value, squeezing out backslash-newline sequences
+ * along the way.
+ */
+
+ dst = value = src;
+ while (*src != '\n') {
+ if (*src == '\0') {
+ char buf[32 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "missing newline on line %d", lineNum);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ } else {
+ *dst = *src;
+ 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 the interp's 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. */
+{
+ CONST char *realName;
+ char *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 = (int) Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_END);
+ (void) Tcl_Seek(chan, (Tcl_WideInt) 0, 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * The following array defines the order in which the current
+ * stacks are searched to find matching entries to add to the
+ * stacks. Given the current priority-based scheme, the order
+ * below is no longer relevant; all that matters is that an
+ * element is on the list *somewhere*. The ordering is a relic
+ * 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) || (tsdPtr->cachedWindow == NULL)) {
+ SetupStacks(winPtr->parentPtr, 0);
+ level = winPtr->parentPtr->optionLevel;
+ }
+ level++;
+ } else {
+ level = 1;
+ }
+
+ /*
+ * Step 2: pop extra unneeded information off the stacks and
+ * mark those windows as no longer having cached information.
+ */
+
+ if (tsdPtr->curLevel >= level) {
+ while (tsdPtr->curLevel >= level) {
+ tsdPtr->levels[tsdPtr->curLevel].winPtr->optionLevel = -1;
+ tsdPtr->curLevel--;
+ }
+ levelPtr = &tsdPtr->levels[level];
+ for (i = 0; i < NUM_STACKS; i++) {
+ arrayPtr = tsdPtr->stacks[i];
+ arrayPtr->numUsed = levelPtr->bases[i];
+ arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
+ }
+ }
+ tsdPtr->curLevel = winPtr->optionLevel = level;
+
+ /*
+ * Step 3: if the root database information isn't loaded or
+ * isn't valid, initialize level 0 of the stack from the
+ * database root (this only happens if winPtr is a main window).
+ */
+
+ if ((tsdPtr->curLevel == 1)
+ && ((tsdPtr->cachedWindow == NULL)
+ || (tsdPtr->cachedWindow->mainPtr != winPtr->mainPtr))) {
+ for (i = 0; i < NUM_STACKS; i++) {
+ arrayPtr = tsdPtr->stacks[i];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ }
+ ExtendStacks(winPtr->mainPtr->optionRootPtr, 0);
+ }
+
+ /*
+ * Step 4: create a new stack level; grow the level array if
+ * we've run out of levels. Clear the stacks for EXACT_LEAF_NAME
+ * and EXACT_LEAF_CLASS (anything that was there is of no use
+ * any more).
+ */
+
+ if (tsdPtr->curLevel >= tsdPtr->numLevels) {
+ StackLevel *newLevels;
+
+ newLevels = (StackLevel *) ckalloc((unsigned)
+ (tsdPtr->numLevels*2*sizeof(StackLevel)));
+ memcpy((VOID *) newLevels, (VOID *) tsdPtr->levels,
+ (tsdPtr->numLevels*sizeof(StackLevel)));
+ ckfree((char *) tsdPtr->levels);
+ tsdPtr->numLevels *= 2;
+ tsdPtr->levels = newLevels;
+ }
+ levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
+ levelPtr->winPtr = winPtr;
+ arrayPtr = tsdPtr->stacks[EXACT_LEAF_NAME];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ arrayPtr = tsdPtr->stacks[EXACT_LEAF_CLASS];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ for (i = 0; i < NUM_STACKS; i++) {
+ levelPtr->bases[i] = tsdPtr->stacks[i]->numUsed;
+ }
+ /*
+ * Step 5: scan the current stack level looking for matches to this
+ * window's name or class; where found, add new information to the
+ * stacks.
+ */
+
+ for (iPtr = searchOrder; *iPtr != -1; iPtr++) {
+ register Element *elPtr;
+ int count;
+ Tk_Uid id;
+
+ i = *iPtr;
+ if (i & CLASS) {
+ id = winPtr->classUid;
+ } else {
+ id = winPtr->nameUid;
+ }
+ elPtr = tsdPtr->stacks[i]->els;
+ count = levelPtr->bases[i];
+
+ /*
+ * For wildcard stacks, check all entries; for non-wildcard
+ * stacks, only check things that matched in the parent.
+ */
+
+ if (!(i & WILDCARD)) {
+ elPtr += levelPtr[-1].bases[i];
+ count -= levelPtr[-1].bases[i];
+ }
+ for ( ; count > 0; elPtr++, count--) {
+ if (elPtr->nameUid != id) {
+ continue;
+ }
+ ExtendStacks(elPtr->child.arrayPtr, leaf);
+ }
+ }
+ tsdPtr->cachedWindow = winPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExtendStacks --
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (elPtr = arrayPtr->els, count = arrayPtr->numUsed;
+ count > 0; elPtr++, count--) {
+ if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) {
+ continue;
+ }
+ tsdPtr->stacks[elPtr->flags] = ExtendArray(
+ tsdPtr->stacks[elPtr->flags], elPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OptionThreadExitProc --
+ *
+ * Free data structures for option handling.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related data structures get freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OptionThreadExitProc(clientData)
+ ClientData clientData; /* not used */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->initialized) {
+ int i;
+ for (i = 0; i < NUM_STACKS; i++) {
+ ckfree((char *) tsdPtr->stacks[i]);
+ }
+ ckfree((char *) tsdPtr->levels);
+ tsdPtr->initialized = 0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Element *defaultMatchPtr = &tsdPtr->defaultMatch;
+
+ /*
+ * First, once-only initialization.
+ */
+
+ if (tsdPtr->initialized == 0) {
+ tsdPtr->initialized = 1;
+ tsdPtr->cachedWindow = NULL;
+ tsdPtr->numLevels = 5;
+ tsdPtr->curLevel = -1;
+ tsdPtr->serial = 0;
+
+ tsdPtr->levels = (StackLevel *) ckalloc((unsigned)
+ (5*sizeof(StackLevel)));
+ for (i = 0; i < NUM_STACKS; i++) {
+ tsdPtr->stacks[i] = NewArray(10);
+ tsdPtr->levels[0].bases[i] = 0;
+ }
+
+ defaultMatchPtr->nameUid = NULL;
+ defaultMatchPtr->child.valueUid = NULL;
+ defaultMatchPtr->priority = -1;
+ defaultMatchPtr->flags = 0;
+ Tcl_CreateThreadExitHandler(OptionThreadExitProc, NULL);
+ }
+
+ /*
+ * 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/tcl/generic/tkPack.c b/tcl/generic/tkPack.c
new file mode 100644
index 00000000000..ab2157152af
--- /dev/null
+++ b/tcl/generic/tkPack.c
@@ -0,0 +1,1851 @@
+/*
+ * tkPack.c --
+ *
+ * This file contains code to implement the "packer"
+ * geometry manager for Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side;
+static CONST char *sideNames[] = {
+ "top", "bottom", "left", "right", (char *) NULL
+};
+
+/* 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. Some is of this space is on each
+ * side. This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int padLeft, padTop; /* The part of padX or padY to use on the
+ * left or top of the widget, respectively.
+ * By default, this is half of padX or padY. */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half of 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
+
+/*
+ * 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 objc, Tcl_Obj *CONST objv[]));
+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 objc,
+ Tcl_Obj *CONST objv[]));
+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));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPrintPadAmount --
+ *
+ * This procedure generates a text value that describes one
+ * of the -padx, -pady, -ipadx, or -ipady configuration options.
+ * The text value generated is appended to the interpreter
+ * result.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+void
+TkPrintPadAmount(interp, switchName, halfSpace, allSpace)
+ Tcl_Interp *interp; /* The interpreter into which the result
+ * is written. */
+ char *switchName; /* One of "padx", "pady", "ipadx" or "ipady" */
+ int halfSpace; /* The left or top padding amount */
+ int allSpace; /* The total amount of padding */
+{
+ char buffer[60 + 2*TCL_INTEGER_SPACE];
+ if (halfSpace*2 == allSpace) {
+ sprintf(buffer, " -%.10s %d", switchName, halfSpace);
+ } else {
+ sprintf(buffer, " -%.10s {%d %d}", switchName, halfSpace,
+ allSpace - halfSpace);
+ }
+ Tcl_AppendResult(interp, buffer, (char *)NULL);
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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_PackObjCmd(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;
+ char *argv2;
+ static CONST char *optionStrings[] = {
+ /* after, append, before and unpack are deprecated */
+ "after", "append", "before", "unpack",
+ "configure", "forget", "info", "propagate", "slaves", (char *) NULL };
+ enum options {
+ PACK_AFTER, PACK_APPEND, PACK_BEFORE, PACK_UNPACK,
+ PACK_CONFIGURE, PACK_FORGET, PACK_INFO, PACK_PROPAGATE, PACK_SLAVES };
+ int index;
+
+ if (objc >= 2) {
+ char *string = Tcl_GetString(objv[1]);
+ if (string[0] == '.') {
+ return ConfigureSlaves(interp, tkwin, objc-1, objv+1);
+ }
+ }
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ /*
+ * Call it again without the deprecated ones to get a proper
+ * error message.
+ * This works well since there can't be any ambiguity between
+ * deprecated and new options.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_GetIndexFromObj(interp, objv[1], &optionStrings[4], "option", 0,
+ &index);
+ return TCL_ERROR;
+ }
+
+ argv2 = Tcl_GetString(objv[2]);
+ if (index == PACK_AFTER) {
+ Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(tkwin2);
+ if (prevPtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv2,
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return PackAfter(interp, prevPtr, prevPtr->masterPtr, objc-3, objv+3);
+ } else if (index == PACK_APPEND) {
+ Packer *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(tkwin2);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ return PackAfter(interp, prevPtr, masterPtr, objc-3, objv+3);
+ } else if (index == PACK_BEFORE) {
+ Packer *packPtr, *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr = GetPacker(tkwin2);
+ if (packPtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv2,
+ "\" 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, objc-3, objv+3);
+ } else if (index == PACK_CONFIGURE) {
+ if (argv2[0] != '.') {
+ Tcl_AppendResult(interp, "bad argument \"", argv2,
+ "\": must be name of window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return ConfigureSlaves(interp, tkwin, objc-2, objv+2);
+ } else if (index == PACK_FORGET) {
+ Tk_Window slave;
+ Packer *slavePtr;
+ int i;
+
+ for (i = 2; i < objc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i], &slave) != TCL_OK) {
+ 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 (index == PACK_INFO) {
+ register Packer *slavePtr;
+ Tk_Window slave;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetPacker(slave);
+ if (slavePtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv2,
+ "\" 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;
+ }
+ TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
+ TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY);
+ TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX);
+ TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY);
+ Tcl_AppendResult(interp, " -side ", sideNames[slavePtr->side],
+ (char *) NULL);
+ } else if (index == PACK_PROPAGATE) {
+ Tk_Window master;
+ Packer *masterPtr;
+ int propagate;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(master);
+ if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(!(masterPtr->flags & DONT_PROPAGATE)));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[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 (index == PACK_SLAVES) {
+ Tk_Window master;
+ Packer *masterPtr, *slavePtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(master);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ }
+ } else if (index == PACK_UNPACK) {
+ Tk_Window tkwin2;
+ Packer *packPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ 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);
+ }
+ }
+
+ 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 abort; /* May get set to non-zero to abort this
+ * repacking operation. */
+ int borderX, borderY;
+ int borderTop, borderBtm;
+ int borderLeft, borderRight;
+ 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.
+ */
+
+ width = maxWidth = Tk_InternalBorderLeft(masterPtr->tkwin) +
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ height = maxHeight = Tk_InternalBorderTop(masterPtr->tkwin) +
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ 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 (maxWidth < Tk_MinReqWidth(masterPtr->tkwin)) {
+ maxWidth = Tk_MinReqWidth(masterPtr->tkwin);
+ }
+ if (maxHeight < Tk_MinReqHeight(masterPtr->tkwin)) {
+ maxHeight = Tk_MinReqHeight(masterPtr->tkwin);
+ }
+
+ /*
+ * 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 = x = Tk_InternalBorderLeft(masterPtr->tkwin);
+ cavityY = y = Tk_InternalBorderTop(masterPtr->tkwin);
+ cavityWidth = Tk_Width(masterPtr->tkwin) -
+ Tk_InternalBorderLeft(masterPtr->tkwin) -
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ cavityHeight = Tk_Height(masterPtr->tkwin) -
+ Tk_InternalBorderTop(masterPtr->tkwin) -
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ 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;
+ borderTop = borderBtm = 0;
+ borderLeft = borderRight = 0;
+ } else {
+ borderX = slavePtr->padX;
+ borderY = slavePtr->padY;
+ borderLeft = slavePtr->padLeft;
+ borderRight = borderX - borderLeft;
+ borderTop = slavePtr->padTop;
+ borderBtm = borderY - borderTop;
+ }
+ 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;
+ }
+ switch (slavePtr->anchor) {
+ case TK_ANCHOR_N:
+ x = frameX + (borderLeft + frameWidth - width - borderRight)/2;
+ y = frameY + borderTop;
+ break;
+ case TK_ANCHOR_NE:
+ x = frameX + frameWidth - width - borderRight;
+ y = frameY + borderTop;
+ break;
+ case TK_ANCHOR_E:
+ x = frameX + frameWidth - width - borderRight;
+ y = frameY + (borderTop + frameHeight - height - borderBtm)/2;
+ break;
+ case TK_ANCHOR_SE:
+ x = frameX + frameWidth - width - borderRight;
+ y = frameY + frameHeight - height - borderBtm;
+ break;
+ case TK_ANCHOR_S:
+ x = frameX + (borderLeft + frameWidth - width - borderRight)/2;
+ y = frameY + frameHeight - height - borderBtm;
+ break;
+ case TK_ANCHOR_SW:
+ x = frameX + borderLeft;
+ y = frameY + frameHeight - height - borderBtm;
+ break;
+ case TK_ANCHOR_W:
+ x = frameX + borderLeft;
+ y = frameY + (borderTop + frameHeight - height - borderBtm)/2;
+ break;
+ case TK_ANCHOR_NW:
+ x = frameX + borderLeft;
+ y = frameY + borderTop;
+ break;
+ case TK_ANCHOR_CENTER:
+ x = frameX + (borderLeft + frameWidth - width - borderRight)/2;
+ y = frameY + (borderTop + frameHeight - height - borderBtm)/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;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->packInit) {
+ dispPtr->packInit = 1;
+ Tcl_InitHashTable(&dispPtr->packerHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there's already packer for this window. If not,
+ * then create a new one.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->packerHashTable, (char *) tkwin,
+ &new);
+ if (!new) {
+ return (Packer *) Tcl_GetHashValue(hPtr);
+ }
+ packPtr = (Packer *) ckalloc(sizeof(Packer));
+ packPtr->tkwin = tkwin;
+ packPtr->masterPtr = NULL;
+ packPtr->nextPtr = NULL;
+ packPtr->slavePtr = NULL;
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->padLeft = packPtr->padTop = 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkParsePadAmount --
+ *
+ * This procedure parses a padding specification and returns
+ * the appropriate padding values. A padding specification can
+ * be either a single pixel width, or a list of two pixel widths.
+ * If a single pixel width, the amount specified is used for
+ * padding on both sides. If two amounts are specified, then
+ * they specify the left/right or top/bottom padding.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * An error message is written to the interpreter is something
+ * is not right.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* A window. Needed by Tk_GetPixels() */
+ Tcl_Obj *specObj; /* The argument to "-padx", "-pady", "-ipadx",
+ * or "-ipady". The thing to be parsed. */
+ int *halfPtr; /* Write the left/top part of padding here */
+ int *allPtr; /* Write the total padding here */
+{
+ char *secondPart; /* The second pixel amount of the list */
+ char *separator = 0; /* Separator between 1st and 2nd pixel widths */
+ int sepChar = 0; /* Character used as the separator */
+ int firstInt, secondInt; /* The two components of the padding */
+ char *padSpec = Tcl_GetString(specObj);
+
+ for (secondPart=padSpec;
+ (*secondPart != '\0') && !isspace(UCHAR(*secondPart));
+ secondPart++)
+ { /* Do nothing */ }
+ if (*secondPart != '\0') {
+ separator = secondPart;
+ sepChar = *secondPart;
+ *secondPart = '\0';
+ secondPart++;
+ while ( isspace(UCHAR(*secondPart)) ) {
+ secondPart++;
+ }
+ if (*secondPart == '\0'){
+ secondPart = 0;
+ *separator = sepChar;
+ }
+ } else {
+ secondPart = 0;
+ }
+ if ((Tk_GetPixels(interp, tkwin, padSpec, &firstInt) != TCL_OK) ||
+ (firstInt < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad pad value \"", padSpec,
+ "\": must be positive screen distance", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (secondPart) {
+ if ((Tk_GetPixels(interp, tkwin, secondPart, &secondInt) != TCL_OK) ||
+ (secondInt < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad 2nd pad value \"", secondPart,
+ "\": must be positive screen distance", (char *) NULL);
+ return TCL_ERROR;
+ }
+ *separator = sepChar;
+ } else {
+ secondInt = firstInt;
+ }
+ if (halfPtr != 0) *halfPtr = firstInt;
+ *allPtr = firstInt + secondInt;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, objc, objv)
+ 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 objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Array of lists, each containing 2
+ * elements: window name and side
+ * against which to pack. */
+{
+ register Packer *packPtr;
+ Tk_Window tkwin, ancestor, parent;
+ int length;
+ Tcl_Obj **options;
+ int index, 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 ( ; objc > 0; objc -= 2, objv += 2, prevPtr = packPtr) {
+ if (objc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: window \"",
+ Tcl_GetString(objv[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.
+ */
+
+ if (TkGetWindowFromObj(interp, masterPtr->tkwin, objv[0], &tkwin)
+ != TCL_OK) {
+ 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_HIERARCHY) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[0]),
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_HIERARCHY) {
+ goto badWindow;
+ }
+ if (tkwin == masterPtr->tkwin) {
+ goto badWindow;
+ }
+ packPtr = GetPacker(tkwin);
+
+ /*
+ * Process options for this window.
+ */
+
+ if (Tcl_ListObjGetElements(interp, objv[1], &optionCount, &options)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->padLeft = packPtr->padTop = 0;
+ packPtr->iPadX = packPtr->iPadY = 0;
+ packPtr->flags &= ~(FILLX|FILLY|EXPAND);
+ packPtr->flags |= OLD_STYLE;
+ for (index = 0 ; index < optionCount; index++) {
+ Tcl_Obj *curOptPtr = options[index];
+ char *curOpt = Tcl_GetStringFromObj(curOptPtr, (int *) &length);
+
+ c = curOpt[0];
+
+ if ((c == 't')
+ && (strncmp(curOpt, "top", (size_t) length)) == 0) {
+ packPtr->side = TOP;
+ } else if ((c == 'b')
+ && (strncmp(curOpt, "bottom", (size_t) length)) == 0) {
+ packPtr->side = BOTTOM;
+ } else if ((c == 'l')
+ && (strncmp(curOpt, "left", (size_t) length)) == 0) {
+ packPtr->side = LEFT;
+ } else if ((c == 'r')
+ && (strncmp(curOpt, "right", (size_t) length)) == 0) {
+ packPtr->side = RIGHT;
+ } else if ((c == 'e')
+ && (strncmp(curOpt, "expand", (size_t) 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);
+ return TCL_ERROR;
+ }
+ if (TkParsePadAmount(interp, tkwin, options[index+1],
+ &packPtr->padLeft, &packPtr->padX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->padX /= 2;
+ packPtr->padLeft /= 2;
+ packPtr->iPadX = 0;
+ index++;
+ } else if ((c == 'p') && (strcmp(curOpt, "pady")) == 0) {
+ if (optionCount < (index+2)) {
+ goto missingPad;
+ }
+ if (TkParsePadAmount(interp, tkwin, options[index+1],
+ &packPtr->padTop, &packPtr->padY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->padY /= 2;
+ packPtr->padTop /= 2;
+ packPtr->iPadY = 0;
+ index++;
+ } else if ((c == 'f') && (length > 1)
+ && (strncmp(curOpt, "frame", (size_t) length) == 0)) {
+ if (optionCount < (index+2)) {
+ Tcl_AppendResult(interp, "wrong # args: \"frame\" ",
+ "option must be followed by anchor point",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_GetAnchorFromObj(interp, options[index+1],
+ &packPtr->anchor) != TCL_OK) {
+ return TCL_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);
+ return TCL_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);
+ }
+ }
+
+ /*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+ if (packPtr->tkwin != NULL) {
+ TkDisplay *dispPtr = ((TkWindow *) packPtr->tkwin)->dispPtr;
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->packerHashTable,
+ (char *) packPtr->tkwin));
+ }
+ if (packPtr->flags & REQUESTED_REPACK) {
+ Tcl_CancelIdleCall(ArrangePacking, (ClientData) packPtr);
+ }
+ packPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) packPtr, DestroyPacker);
+ } else if (eventPtr->type == MapNotify) {
+ /*
+ * 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) {
+ register 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 the interp's result is set to contain an error message.
+ *
+ * Side effects:
+ * Slave windows get taken over by the packer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(interp, tkwin, objc, objv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int objc; /* Number of elements in argv. */
+ Tcl_Obj *CONST objv[]; /* Argument objects: 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, tmp, positionGiven;
+ char *string;
+ static CONST char *optionStrings[] = {
+ "-after", "-anchor", "-before", "-expand", "-fill",
+ "-in", "-ipadx", "-ipady", "-padx", "-pady", "-side", (char *) NULL };
+ enum options {
+ CONF_AFTER, CONF_ANCHOR, CONF_BEFORE, CONF_EXPAND, CONF_FILL,
+ CONF_IN, CONF_IPADX, CONF_IPADY, CONF_PADX, CONF_PADY, CONF_SIDE };
+ int index, side;
+
+ /*
+ * Find out how many windows are specified.
+ */
+
+ for (numWindows = 0; numWindows < objc; numWindows++) {
+ string = Tcl_GetString(objv[numWindows]);
+ if (string[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++) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[j], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_TopWinHierarchy(slave)) {
+ Tcl_AppendResult(interp, "can't pack \"", Tcl_GetString(objv[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->padLeft = slavePtr->padTop = 0;
+ slavePtr->iPadX = slavePtr->iPadY = 0;
+ slavePtr->flags &= ~(FILLX|FILLY|EXPAND);
+ }
+
+ for (i = numWindows; i < objc; i+=2) {
+ if ((i+2) > objc) {
+ Tcl_AppendResult(interp, "extra option \"",
+ Tcl_GetString(objv[i]),
+ "\" (option with no value?)", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == CONF_AFTER) {
+ if (j == 0) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(other);
+ if (prevPtr->masterPtr == NULL) {
+ notPacked:
+ Tcl_AppendResult(interp, "window \"",
+ Tcl_GetString(objv[i+1]),
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = prevPtr->masterPtr;
+ positionGiven = 1;
+ }
+ } else if (index == CONF_ANCHOR) {
+ if (Tk_GetAnchorFromObj(interp, objv[i+1], &slavePtr->anchor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_BEFORE) {
+ if (j == 0) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other)
+ != TCL_OK) {
+ 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 (index == CONF_EXPAND) {
+ if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr->flags &= ~EXPAND;
+ if (tmp) {
+ slavePtr->flags |= EXPAND;
+ }
+ } else if (index == CONF_FILL) {
+ string = Tcl_GetString(objv[i+1]);
+ if (strcmp(string, "none") == 0) {
+ slavePtr->flags &= ~(FILLX|FILLY);
+ } else if (strcmp(string, "x") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLY) | FILLX;
+ } else if (strcmp(string, "y") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLX) | FILLY;
+ } else if (strcmp(string, "both") == 0) {
+ slavePtr->flags |= FILLX|FILLY;
+ } else {
+ Tcl_AppendResult(interp, "bad fill style \"", string,
+ "\": must be none, x, y, or both", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_IN) {
+ if (j == 0) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(other);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ positionGiven = 1;
+ }
+ } else if (index == CONF_IPADX) {
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipadx value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp * 2;
+ } else if (index == CONF_IPADY) {
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipady value \"",
+ Tcl_GetString(objv[i+1]),
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadY = tmp * 2;
+ } else if (index == CONF_PADX) {
+ if (TkParsePadAmount(interp, slave, objv[i+1],
+ &slavePtr->padLeft, &slavePtr->padX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_PADY) {
+ if (TkParsePadAmount(interp, slave, objv[i+1],
+ &slavePtr->padTop, &slavePtr->padY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (index == CONF_SIDE) {
+ if (Tcl_GetIndexFromObj(interp, objv[i+1], sideNames, "side",
+ TCL_EXACT, &side) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr->side = side;
+ }
+ }
+
+ /*
+ * 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_TopWinHierarchy(ancestor)) {
+ Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]),
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (slave == masterPtr->tkwin) {
+ Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[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/tcl/generic/tkPanedWindow.c b/tcl/generic/tkPanedWindow.c
new file mode 100644
index 00000000000..fffe111673e
--- /dev/null
+++ b/tcl/generic/tkPanedWindow.c
@@ -0,0 +1,2752 @@
+/*
+ * tkPanedWindow.c --
+ *
+ * This module implements "paned window" widgets that are object
+ * based. A "paned window" is a widget that manages the geometry for
+ * some number of other widgets, placing a movable "sash" between them,
+ * which can be used to alter the relative sizes of adjacent widgets.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
+ *
+ * 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"
+
+/* 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
+/*
+ * The following table defines the legal values for the -orient option.
+ */
+
+static char *orientStrings[] = {
+ "horizontal", "vertical", (char *) NULL
+};
+
+enum orient { ORIENT_HORIZONTAL, ORIENT_VERTICAL };
+
+typedef struct {
+ Tk_OptionTable pwOptions; /* Token for paned window option table. */
+ Tk_OptionTable slaveOpts; /* Token for slave cget option table. */
+} OptionTables;
+
+/*
+ * One structure of the following type is kept for each window
+ * managed by a paned window widget.
+ */
+
+typedef struct Slave {
+ Tk_Window tkwin; /* Window being managed. */
+
+ int minSize; /* Minimum size of this pane, on the
+ * relevant axis, in pixels. */
+ int padx; /* Additional padding requested for
+ * slave, in the x dimension. */
+ int pady; /* Additional padding requested for
+ * slave, in the y dimension. */
+ Tcl_Obj *widthPtr, *heightPtr; /* Tcl_Obj rep's of slave width/height,
+ * to allow for null values. */
+ int width; /* Slave width. */
+ int height; /* Slave height. */
+ int sticky; /* Sticky string. */
+ int x, y; /* Coordinates of the widget. */
+ int paneWidth, paneHeight; /* Pane dimensions (may be different
+ * from slave width/height). */
+ int sashx, sashy; /* Coordinates of the sash of the
+ * right or bottom of this pane. */
+ int markx, marky; /* Coordinates of the last mark set
+ * for the sash. */
+ int handlex, handley; /* Coordinates of the sash handle. */
+ struct PanedWindow *masterPtr; /* Paned window managing the window. */
+ Tk_Window after; /* Placeholder for parsing options. */
+ Tk_Window before; /* Placeholder for parsing options. */
+} Slave;
+
+/*
+ * A data structure of the following type is kept for each paned window
+ * widget managed by this file:
+ */
+
+typedef struct PanedWindow {
+ Tk_Window tkwin; /* Window that embodies the paned window. */
+ Tk_Window proxywin; /* Window for the resizing proxy. */
+ Display *display; /* X's token for the window's display. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. */
+ Tcl_Command widgetCmd; /* Token for square's widget command. */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ Tk_OptionTable slaveOpts; /* Token for slave cget table. */
+ Tk_3DBorder background; /* Background color. */
+ int borderWidth; /* Value of -borderwidth option. */
+ int relief; /* 3D border effect (TK_RELIEF_RAISED, etc) */
+ Tcl_Obj *widthPtr; /* Tcl_Obj rep for width. */
+ Tcl_Obj *heightPtr; /* Tcl_Obj rep for height. */
+ int width, height; /* Width and height of the widget. */
+ enum orient orient; /* Orientation of the widget. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ int resizeOpaque; /* Boolean indicating whether resize should be
+ * opaque or rubberband style. */
+
+ int sashRelief; /* Relief used to draw sash. */
+ int sashWidth; /* Width of each sash, in pixels. */
+ Tcl_Obj *sashWidthPtr; /* Tcl_Obj rep for sash width. */
+ int sashPad; /* Additional padding around each sash. */
+ Tcl_Obj *sashPadPtr; /* Tcl_Obj rep for sash padding. */
+ int showHandle; /* Boolean indicating whether sash handles
+ * should be drawn. */
+ int handleSize; /* Size of one side of a sash handle (handles
+ * are square), in pixels. */
+ int handlePad; /* Distance from border to draw handle. */
+ Tcl_Obj *handleSizePtr; /* Tcl_Obj rep for handle size. */
+ Tk_Cursor sashCursor; /* Cursor used when mouse is above a sash. */
+
+ GC gc; /* Graphics context for copying from
+ * off-screen pixmap onto screen. */
+ int proxyx, proxyy; /* Proxy x,y coordinates. */
+ Slave **slaves; /* Pointer to array of Slaves. */
+ int numSlaves; /* Number of slaves. */
+ int sizeofSlaves; /* Number of elements in the slaves array. */
+ int flags; /* Flags for widget; see below. */
+} PanedWindow;
+
+/*
+ * Flags used for paned windows:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * been queued to redraw this window.
+ *
+ * WIDGET_DELETED: Non-zero means that the paned window has
+ * been, or is in the process of being, deleted.
+ *
+ * RESIZE_PENDING: Non-zero means that the window might need to
+ * change its size (or the size of its panes)
+ * because of a change in the size of one of its
+ * children.
+ */
+
+#define REDRAW_PENDING 0x0001
+#define WIDGET_DELETED 0x0002
+#define REQUESTED_RELAYOUT 0x0004
+#define RECOMPUTE_GEOMETRY 0x0008
+#define PROXY_REDRAW_PENDING 0x0010
+#define RESIZE_PENDING 0x0020
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+int Tk_PanedWindowObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static void PanedWindowCmdDeletedProc _ANSI_ARGS_((ClientData clientData));
+static int ConfigurePanedWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ PanedWindow *pwPtr, int objc, Tcl_Obj *CONST objv[]));
+static void DestroyPanedWindow _ANSI_ARGS_((PanedWindow *pwPtr));
+static void DisplayPanedWindow _ANSI_ARGS_((ClientData clientData));
+static void PanedWindowEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void ProxyWindowEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void DisplayProxyWindow _ANSI_ARGS_((ClientData clientData));
+void PanedWindowWorldChanged _ANSI_ARGS_((ClientData instanceData));
+static int PanedWindowWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int objc, Tcl_Obj * CONST objv[]));
+static void PanedWindowLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void PanedWindowReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void ArrangePanes _ANSI_ARGS_((ClientData clientData));
+static void Unlink _ANSI_ARGS_((Slave *slavePtr));
+static Slave * GetPane _ANSI_ARGS_((PanedWindow *pwPtr, Tk_Window tkwin));
+static void SlaveStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int PanedWindowSashCommand _ANSI_ARGS_((PanedWindow *pwPtr,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static int PanedWindowProxyCommand _ANSI_ARGS_((PanedWindow *pwPtr,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static void ComputeGeometry _ANSI_ARGS_((PanedWindow *pwPtr));
+static int ConfigureSlaves _ANSI_ARGS_((PanedWindow *pwPtr,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static void DestroyOptionTables _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp));
+static int SetSticky _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj **value, char *recordPtr, int internalOffset,
+ char *oldInternalPtr, int flags));
+static Tcl_Obj *GetSticky _ANSI_ARGS_((ClientData clientData, Tk_Window tkwin,
+ char *recordPtr, int internalOffset));
+static void RestoreSticky _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *internalPtr,
+ char *oldInternalPtr));
+static void AdjustForSticky _ANSI_ARGS_((int sticky, int cavityWidth,
+ int cavityHeight, int *xPtr, int *yPtr,
+ int *slaveWidthPtr, int *slaveHeightPtr));
+static void MoveSash _ANSI_ARGS_((PanedWindow *pwPtr, int sash, int diff));
+static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr));
+static char * ComputeSlotAddress _ANSI_ARGS_((char *recordPtr, int offset));
+static int PanedWindowIdentifyCoords _ANSI_ARGS_((PanedWindow *pwPtr,
+ Tcl_Interp *interp, int x, int y));
+
+#define ValidSashIndex(pwPtr, sash) \
+ (((sash) >= 0) && ((sash) < (pwPtr)->numSlaves))
+
+static Tk_GeomMgr panedWindowMgrType = {
+ "panedwindow", /* name */
+ PanedWindowReqProc, /* requestProc */
+ PanedWindowLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Information used for objv parsing.
+ */
+
+#define GEOMETRY 0x0001
+
+/*
+ * The following structure contains pointers to functions used for processing
+ * the custom "-sticky" option for slave windows.
+ */
+
+static Tk_ObjCustomOption stickyOption = {
+ "sticky", /* name */
+ SetSticky, /* setProc */
+ GetSticky, /* getProc */
+ RestoreSticky, /* restoreProc */
+ (Tk_CustomOptionFreeProc *)NULL, /* freeProc */
+ 0
+};
+
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_PANEDWINDOW_BG_COLOR, -1, Tk_Offset(PanedWindow, background), 0,
+ (ClientData) DEF_PANEDWINDOW_BG_MONO},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background"},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_PANEDWINDOW_BORDERWIDTH, -1, Tk_Offset(PanedWindow, borderWidth),
+ 0, 0, GEOMETRY},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_PANEDWINDOW_CURSOR, -1, Tk_Offset(PanedWindow, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-handlepad", "handlePad", "HandlePad",
+ DEF_PANEDWINDOW_HANDLEPAD, -1, Tk_Offset(PanedWindow, handlePad),
+ 0, 0},
+ {TK_OPTION_PIXELS, "-handlesize", "handleSize", "HandleSize",
+ DEF_PANEDWINDOW_HANDLESIZE, Tk_Offset(PanedWindow, handleSizePtr),
+ Tk_Offset(PanedWindow, handleSize), 0, 0, GEOMETRY},
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_PANEDWINDOW_HEIGHT, Tk_Offset(PanedWindow, heightPtr),
+ Tk_Offset(PanedWindow, height), TK_OPTION_NULL_OK, 0, GEOMETRY},
+ {TK_OPTION_BOOLEAN, "-opaqueresize", "opaqueResize", "OpaqueResize",
+ DEF_PANEDWINDOW_OPAQUERESIZE, -1,
+ Tk_Offset(PanedWindow, resizeOpaque), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",
+ DEF_PANEDWINDOW_ORIENT, -1, Tk_Offset(PanedWindow, orient),
+ 0, (ClientData) orientStrings, GEOMETRY},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_PANEDWINDOW_RELIEF, -1, Tk_Offset(PanedWindow, relief), 0, 0, 0},
+ {TK_OPTION_CURSOR, "-sashcursor", "sashCursor", "Cursor",
+ DEF_PANEDWINDOW_SASHCURSOR, -1, Tk_Offset(PanedWindow, sashCursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-sashpad", "sashPad", "SashPad",
+ DEF_PANEDWINDOW_SASHPAD, -1, Tk_Offset(PanedWindow, sashPad),
+ 0, 0, GEOMETRY},
+ {TK_OPTION_RELIEF, "-sashrelief", "sashRelief", "Relief",
+ DEF_PANEDWINDOW_SASHRELIEF, -1, Tk_Offset(PanedWindow, sashRelief),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-sashwidth", "sashWidth", "Width",
+ DEF_PANEDWINDOW_SASHWIDTH, Tk_Offset(PanedWindow, sashWidthPtr),
+ Tk_Offset(PanedWindow, sashWidth), 0, 0, GEOMETRY},
+ {TK_OPTION_BOOLEAN, "-showhandle", "showHandle", "ShowHandle",
+ DEF_PANEDWINDOW_SHOWHANDLE, -1, Tk_Offset(PanedWindow, showHandle),
+ 0, 0, GEOMETRY},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_PANEDWINDOW_WIDTH, Tk_Offset(PanedWindow, widthPtr),
+ Tk_Offset(PanedWindow, width), TK_OPTION_NULL_OK, 0, GEOMETRY},
+ {TK_OPTION_END}
+};
+
+static Tk_OptionSpec slaveOptionSpecs[] = {
+ {TK_OPTION_WINDOW, "-after", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_AFTER, -1, Tk_Offset(Slave, after),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_WINDOW, "-before", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_BEFORE, -1, Tk_Offset(Slave, before),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_HEIGHT, Tk_Offset(Slave, heightPtr),
+ Tk_Offset(Slave, height), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-minsize", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_MINSIZE, -1, Tk_Offset(Slave, minSize), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_PADX, -1, Tk_Offset(Slave, padx), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_PADY, -1, Tk_Offset(Slave, pady), 0, 0, 0},
+ {TK_OPTION_CUSTOM, "-sticky", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_STICKY, -1, Tk_Offset(Slave, sticky), 0,
+ (ClientData) &stickyOption, 0},
+ {TK_OPTION_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ DEF_PANEDWINDOW_PANE_WIDTH, Tk_Offset(Slave, widthPtr),
+ Tk_Offset(Slave, width), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END}
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PanedWindowObjCmd --
+ *
+ * This procedure is invoked to process the "panedwindow" Tcl
+ * command. It creates a new "panedwindow" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PanedWindowObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
+{
+ PanedWindow *pwPtr;
+ Tk_Window tkwin, parent;
+ OptionTables *pwOpts;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ pwOpts = (OptionTables *)
+ Tcl_GetAssocData(interp, "PanedWindowOptionTables", NULL);
+ if (pwOpts == NULL) {
+ /*
+ * The first time this procedure is invoked, the option tables will
+ * be NULL. We then create the option tables from the templates
+ * and store a pointer to the tables as the command's clinical so
+ * we'll have easy access to it in the future.
+ */
+ pwOpts = (OptionTables *) ckalloc(sizeof(OptionTables));
+ /* Set up an exit handler to free the optionTables struct */
+ Tcl_SetAssocData(interp, "PanedWindowOptionTables",
+ DestroyOptionTables, (ClientData) pwOpts);
+
+ /* Create the paned window option tables. */
+ pwOpts->pwOptions = Tk_CreateOptionTable(interp, optionSpecs);
+ pwOpts->slaveOpts = Tk_CreateOptionTable(interp, slaveOptionSpecs);
+ }
+
+ Tk_SetClass(tkwin, "Panedwindow");
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+
+ pwPtr = (PanedWindow *) ckalloc(sizeof(PanedWindow));
+ memset((void *)pwPtr, 0, (sizeof(PanedWindow)));
+ pwPtr->tkwin = tkwin;
+ pwPtr->display = Tk_Display(tkwin);
+ pwPtr->interp = interp;
+ pwPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(pwPtr->tkwin), PanedWindowWidgetObjCmd,
+ (ClientData) pwPtr, PanedWindowCmdDeletedProc);
+ pwPtr->optionTable = pwOpts->pwOptions;
+ pwPtr->slaveOpts = pwOpts->slaveOpts;
+ pwPtr->relief = TK_RELIEF_RAISED;
+ pwPtr->gc = None;
+ pwPtr->cursor = None;
+ pwPtr->sashCursor = None;
+
+ if (Tk_InitOptions(interp, (char *) pwPtr, pwOpts->pwOptions,
+ tkwin) != TCL_OK) {
+ Tk_DestroyWindow(pwPtr->tkwin);
+ ckfree((char *) pwPtr);
+ return TCL_ERROR;
+ }
+
+ Tk_CreateEventHandler(pwPtr->tkwin, ExposureMask|StructureNotifyMask,
+ PanedWindowEventProc, (ClientData) pwPtr);
+
+ /*
+ * Find the toplevel ancestor of the panedwindow, and make a proxy
+ * win as a child of that window; this way the proxy can always float
+ * above slaves in the panedwindow.
+ */
+ parent = Tk_Parent(pwPtr->tkwin);
+ while (!(Tk_IsTopLevel(parent))) {
+ parent = Tk_Parent(parent);
+ if (parent == NULL) {
+ parent = pwPtr->tkwin;
+ break;
+ }
+ }
+
+ pwPtr->proxywin = Tk_CreateAnonymousWindow(interp, parent, (char *) NULL);
+ Tk_CreateEventHandler(pwPtr->proxywin, ExposureMask, ProxyWindowEventProc,
+ (ClientData) pwPtr);
+
+ if (ConfigurePanedWindow(interp, pwPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(pwPtr->tkwin);
+ Tk_DestroyWindow(pwPtr->proxywin);
+ ckfree((char *) pwPtr);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(pwPtr->tkwin), -1);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowWidgetObjCmd --
+ *
+ * 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
+PanedWindowWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about square widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
+{
+ PanedWindow *pwPtr = (PanedWindow *) clientData;
+ int result = TCL_OK;
+ static CONST char *optionStrings[] = {"add", "cget", "configure", "forget",
+ "identify", "panecget",
+ "paneconfigure", "panes",
+ "proxy", "sash", (char *) NULL};
+ enum options { PW_ADD, PW_CGET, PW_CONFIGURE, PW_FORGET, PW_IDENTIFY,
+ PW_PANECGET, PW_PANECONFIGURE, PW_PANES, PW_PROXY,
+ PW_SASH };
+ Tcl_Obj *resultObj;
+ int index, count, i, x, y;
+ Tk_Window tkwin;
+ Slave *slavePtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "command",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve((ClientData) pwPtr);
+
+ switch ((enum options) index) {
+ case PW_ADD: {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "widget ?widget ...?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = ConfigureSlaves(pwPtr, interp, objc, objv);
+ break;
+ }
+
+ case PW_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ break;
+ }
+ resultObj = Tk_GetOptionValue(interp, (char *) pwPtr,
+ pwPtr->optionTable, objv[2], pwPtr->tkwin);
+ if (resultObj == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ }
+
+ case PW_CONFIGURE: {
+ resultObj = NULL;
+ if (objc <= 3) {
+ resultObj = Tk_GetOptionInfo(interp, (char *) pwPtr,
+ pwPtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ pwPtr->tkwin);
+ if (resultObj == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ } else {
+ result = ConfigurePanedWindow(interp, pwPtr, objc - 2,
+ objv + 2);
+ }
+ break;
+ }
+
+ case PW_FORGET: {
+ Tk_Window slave;
+ int i;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "widget ?widget ...?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ /*
+ * Clean up each window named in the arg list.
+ */
+ for (count = 0, i = 2; i < objc; i++) {
+ slave = Tk_NameToWindow(interp, Tcl_GetString(objv[i]),
+ pwPtr->tkwin);
+ if (slave == NULL) {
+ continue;
+ }
+ slavePtr = GetPane(pwPtr, slave);
+ if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) {
+ count++;
+ Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin);
+ Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask,
+ SlaveStructureProc, (ClientData) slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ Unlink(slavePtr);
+ }
+ if (count != 0) {
+ ComputeGeometry(pwPtr);
+ }
+ }
+ break;
+ }
+
+ case PW_IDENTIFY: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ result = TCL_ERROR;
+ break;
+ }
+
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = PanedWindowIdentifyCoords(pwPtr, interp, x, y);
+ break;
+ }
+
+ case PW_PANECGET: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pane option");
+ result = TCL_ERROR;
+ break;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ pwPtr->tkwin);
+ if (tkwin == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ resultObj = NULL;
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i]->tkwin == tkwin) {
+ resultObj = Tk_GetOptionValue(interp,
+ (char *) pwPtr->slaves[i], pwPtr->slaveOpts,
+ objv[3], tkwin);
+ }
+ }
+ if (i == pwPtr->numSlaves) {
+ Tcl_SetResult(interp, "not managed by this window",
+ TCL_STATIC);
+ }
+ if (resultObj == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ }
+
+ case PW_PANECONFIGURE: {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "pane ?option? ?value option value ...?");
+ result = TCL_ERROR;
+ break;
+ }
+ resultObj = NULL;
+ if (objc <= 4) {
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ pwPtr->tkwin);
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i]->tkwin == tkwin) {
+ resultObj = Tk_GetOptionInfo(interp,
+ (char *) pwPtr->slaves[i],
+ pwPtr->slaveOpts,
+ (objc == 4) ? objv[3] : (Tcl_Obj *) NULL,
+ pwPtr->tkwin);
+ if (resultObj == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ }
+ }
+ } else {
+ result = ConfigureSlaves(pwPtr, interp, objc, objv);
+ }
+ break;
+ }
+
+ case PW_PANES: {
+ resultObj = Tcl_NewObj();
+
+ Tcl_IncrRefCount(resultObj);
+
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ Tcl_ListObjAppendElement(interp, resultObj,
+ Tcl_NewStringObj(Tk_PathName(pwPtr->slaves[i]->tkwin),
+ -1));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ Tcl_DecrRefCount(resultObj);
+ break;
+ }
+
+ case PW_PROXY: {
+ result = PanedWindowProxyCommand(pwPtr, interp, objc, objv);
+ break;
+ }
+
+ case PW_SASH: {
+ result = PanedWindowSashCommand(pwPtr, interp, objc, objv);
+ break;
+ }
+ }
+ Tcl_Release((ClientData) pwPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * Add or alter the configuration options of a slave in a paned
+ * window.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on options; may add a slave to the paned window, may
+ * alter the geometry management options of a slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(pwPtr, interp, objc, objv)
+ PanedWindow *pwPtr; /* Information about paned window. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
+{
+ int i, firstOptionArg, j, found, doubleBw, index, numNewSlaves, haveLoc;
+ int insertIndex;
+ Tk_Window tkwin = NULL, ancestor, parent;
+ Slave *slavePtr, **inserts, **new;
+ Slave options;
+ char *arg;
+
+ /*
+ * Find the non-window name arguments; these are the configure options
+ * for the slaves. Also validate that the window names given are
+ * legitimate (ie, they are real windows, they are not the panedwindow
+ * itself, etc.).
+ */
+ for (i = 2; i < objc; i++) {
+ arg = Tcl_GetString(objv[i]);
+ if (arg[0] == '-') {
+ break;
+ } else {
+ tkwin = Tk_NameToWindow(interp, arg, pwPtr->tkwin);
+ if (tkwin == NULL) {
+ /*
+ * Just a plain old bad window; Tk_NameToWindow filled in an
+ * error message for us.
+ */
+ return TCL_ERROR;
+ } else if (tkwin == pwPtr->tkwin) {
+ /*
+ * A panedwindow cannot manage itself.
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't add ", arg, " to itself",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (Tk_IsTopLevel(tkwin)) {
+ /*
+ * A panedwindow cannot manage a toplevel.
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't add toplevel ", arg, " to ",
+ Tk_PathName(pwPtr->tkwin), (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ /*
+ * Make sure the panedwindow is the parent of the slave,
+ * or a descendant of the slave's parent.
+ */
+ parent = Tk_Parent(tkwin);
+ for (ancestor = pwPtr->tkwin;;ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't add ", arg,
+ " to ", Tk_PathName(pwPtr->tkwin),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+ }
+ firstOptionArg = i;
+
+ /*
+ * Pre-parse the configuration options, to get the before/after specifiers
+ * into an easy-to-find location (a local variable). Also, check the
+ * return from Tk_SetOptions once, here, so we can save a little bit of
+ * extra testing in the for loop below.
+ */
+ memset((void *)&options, 0, sizeof(Slave));
+ if (Tk_SetOptions(interp, (char *) &options, pwPtr->slaveOpts,
+ objc - firstOptionArg, objv + firstOptionArg,
+ pwPtr->tkwin, NULL, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If either -after or -before was given, find the numerical index that
+ * corresponds to the given window. If both -after and -before are
+ * given, the option precedence is: -after, then -before.
+ */
+ index = -1;
+ haveLoc = 0;
+ if (options.after != None) {
+ tkwin = options.after;
+ haveLoc = 1;
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (options.after == pwPtr->slaves[i]->tkwin) {
+ index = i + 1;
+ break;
+ }
+ }
+ } else if (options.before != None) {
+ tkwin = options.before;
+ haveLoc = 1;
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (options.before == pwPtr->slaves[i]->tkwin) {
+ index = i;
+ break;
+ }
+ }
+ }
+
+ /*
+ * If a window was given for -after/-before, but it's not a window
+ * managed by the panedwindow, throw an error
+ */
+ if (haveLoc && index == -1) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "window \"", Tk_PathName(tkwin),
+ "\" is not managed by ", Tk_PathName(pwPtr->tkwin),
+ (char *) NULL);
+ Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts,
+ pwPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate an array to hold, in order, the pointers to the slave
+ * structures corresponding to the windows specified. Some of those
+ * structures may already have existed, some may be new.
+ */
+ inserts = (Slave **)ckalloc(sizeof(Slave *) * (firstOptionArg - 2));
+ insertIndex = 0;
+
+ /*
+ * Populate the inserts array, creating new slave structures as necessary,
+ * applying the options to each structure as we go, and, if necessary,
+ * marking the spot in the original slaves array as empty (for pre-existing
+ * slave structures).
+ */
+ for (i = 0, numNewSlaves = 0; i < firstOptionArg - 2; i++) {
+ /*
+ * We don't check that tkwin is NULL here, because the pre-pass above
+ * guarantees that the input at this stage is good.
+ */
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i + 2]),
+ pwPtr->tkwin);
+
+ found = 0;
+ for (j = 0; j < pwPtr->numSlaves; j++) {
+ if (pwPtr->slaves[j] != NULL && pwPtr->slaves[j]->tkwin == tkwin) {
+ Tk_SetOptions(interp, (char *) pwPtr->slaves[j],
+ pwPtr->slaveOpts, objc - firstOptionArg,
+ objv + firstOptionArg, pwPtr->tkwin, NULL, NULL);
+ found = 1;
+
+ /*
+ * If the slave is supposed to move, add it to the inserts
+ * array now; otherwise, leave it where it is.
+ */
+
+ if (index != -1) {
+ inserts[insertIndex++] = pwPtr->slaves[j];
+ pwPtr->slaves[j] = NULL;
+ }
+ break;
+ }
+ }
+
+ if (found) {
+ continue;
+ }
+
+ /*
+ * Make sure this slave wasn't already put into the inserts array,
+ * ie, when the user specifies the same window multiple times in
+ * a single add commaned.
+ */
+ for (j = 0; j < insertIndex; j++) {
+ if (inserts[j]->tkwin == tkwin) {
+ found = 1;
+ break;
+ }
+ }
+ if (found) {
+ continue;
+ }
+
+ /*
+ * Create a new slave structure and initialize it. All slaves
+ * start out with their "natural" dimensions.
+ */
+
+ slavePtr = (Slave *) ckalloc(sizeof(Slave));
+ memset(slavePtr, 0, sizeof(Slave));
+ Tk_InitOptions(interp, (char *)slavePtr, pwPtr->slaveOpts,
+ pwPtr->tkwin);
+ Tk_SetOptions(interp, (char *)slavePtr, pwPtr->slaveOpts,
+ objc - firstOptionArg, objv + firstOptionArg,
+ pwPtr->tkwin, NULL, NULL);
+ slavePtr->tkwin = tkwin;
+ slavePtr->masterPtr = pwPtr;
+ doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width;
+ if (slavePtr->width > 0) {
+ slavePtr->paneWidth = slavePtr->width;
+ } else {
+ slavePtr->paneWidth = Tk_ReqWidth(tkwin) + doubleBw;
+ }
+ if (slavePtr->height > 0) {
+ slavePtr->paneHeight = slavePtr->height;
+ } else {
+ slavePtr->paneHeight = Tk_ReqHeight(tkwin) + doubleBw;
+ }
+
+ /*
+ * Set up the geometry management callbacks for this slave.
+ */
+
+ Tk_CreateEventHandler(slavePtr->tkwin, StructureNotifyMask,
+ SlaveStructureProc, (ClientData) slavePtr);
+ Tk_ManageGeometry(slavePtr->tkwin, &panedWindowMgrType,
+ (ClientData) slavePtr);
+ inserts[insertIndex++] = slavePtr;
+ numNewSlaves++;
+ }
+
+ /*
+ * Allocate the new slaves array, then copy the slaves into it, in
+ * order.
+ */
+ i = sizeof(Slave *) * (pwPtr->numSlaves+numNewSlaves);
+ new = (Slave **)ckalloc((unsigned) i);
+ memset(new, 0, (size_t) i);
+ if (index == -1) {
+ /*
+ * If none of the existing slaves have to be moved, just copy the old
+ * and append the new.
+ */
+ memcpy((void *)&(new[0]), pwPtr->slaves,
+ sizeof(Slave *) * pwPtr->numSlaves);
+ memcpy((void *)&(new[pwPtr->numSlaves]), inserts,
+ sizeof(Slave *) * numNewSlaves);
+ } else {
+ /*
+ * If some of the existing slaves were moved, the old slaves array
+ * will be partially populated, with some valid and some invalid
+ * entries. Walk through it, copying valid entries to the new slaves
+ * array as we go; when we get to the insert location for the new
+ * slaves, copy the inserts array over, then finish off the old slaves
+ * array.
+ */
+ for (i = 0, j = 0; i < index; i++) {
+ if (pwPtr->slaves[i] != NULL) {
+ new[j] = pwPtr->slaves[i];
+ j++;
+ }
+ }
+
+ memcpy((void *)&(new[j]), inserts, sizeof(Slave *) * (insertIndex));
+ j += firstOptionArg - 2;
+
+ for (i = index; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i] != NULL) {
+ new[j] = pwPtr->slaves[i];
+ j++;
+ }
+ }
+ }
+
+ /*
+ * Make the new slaves array the paned window's slave array, and clean up.
+ */
+ ckfree((void *)pwPtr->slaves);
+ ckfree((void *)inserts);
+ pwPtr->slaves = new;
+
+ /*
+ * Set the paned window's slave count to the new value.
+ */
+ pwPtr->numSlaves += numNewSlaves;
+
+ Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, pwPtr->tkwin);
+
+ ComputeGeometry(pwPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowSashCommand --
+ *
+ * Implementation of the panedwindow sash subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on the arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PanedWindowSashCommand(pwPtr, interp, objc, objv)
+ PanedWindow *pwPtr; /* Pointer to paned window information. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
+{
+ static CONST char *sashOptionStrings[] = { "coord", "dragto", "mark",
+ "place", (char *) NULL };
+ enum sashOptions { SASH_COORD, SASH_DRAGTO, SASH_MARK, SASH_PLACE };
+ int index, sash, x, y, diff;
+ Tcl_Obj *coords[2];
+ Slave *slavePtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], sashOptionStrings,
+ "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_ResetResult(interp);
+ switch ((enum sashOptions) index) {
+ case SASH_COORD: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!ValidSashIndex(pwPtr, sash)) {
+ Tcl_ResetResult(interp);
+ Tcl_SetResult(interp, "invalid sash index", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ slavePtr = pwPtr->slaves[sash];
+
+ coords[0] = Tcl_NewIntObj(slavePtr->sashx);
+ coords[1] = Tcl_NewIntObj(slavePtr->sashy);
+ Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords);
+ break;
+ }
+
+ case SASH_MARK: {
+ if (objc != 6 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?x y?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!ValidSashIndex(pwPtr, sash)) {
+ Tcl_ResetResult(interp);
+ Tcl_SetResult(interp, "invalid sash index", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ if (objc == 6) {
+ if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ pwPtr->slaves[sash]->markx = x;
+ pwPtr->slaves[sash]->marky = y;
+ } else {
+ coords[0] = Tcl_NewIntObj(pwPtr->slaves[sash]->markx);
+ coords[1] = Tcl_NewIntObj(pwPtr->slaves[sash]->marky);
+ Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords);
+ }
+
+ break;
+ }
+
+ case SASH_DRAGTO:
+ case SASH_PLACE: {
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index x y");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!ValidSashIndex(pwPtr, sash)) {
+ Tcl_ResetResult(interp);
+ Tcl_SetResult(interp, "invalid sash index", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ slavePtr = pwPtr->slaves[sash];
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (index == SASH_PLACE) {
+ diff = x - pwPtr->slaves[sash]->sashx;
+ } else {
+ diff = x - pwPtr->slaves[sash]->markx;
+ }
+ } else {
+ if (index == SASH_PLACE) {
+ diff = y - pwPtr->slaves[sash]->sashy;
+ } else {
+ diff = y - pwPtr->slaves[sash]->marky;
+ }
+ }
+
+ MoveSash(pwPtr, sash, diff);
+ ComputeGeometry(pwPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigurePanedWindow --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a paned window widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for pwPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigurePanedWindow(interp, pwPtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ PanedWindow *pwPtr; /* Information about widget. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ Tk_SavedOptions savedOptions;
+ int typemask = 0;
+
+ if (Tk_SetOptions(interp, (char *) pwPtr, pwPtr->optionTable, objc, objv,
+ pwPtr->tkwin, &savedOptions, &typemask) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+
+ Tk_FreeSavedOptions(&savedOptions);
+
+ PanedWindowWorldChanged((ClientData) pwPtr);
+
+ /*
+ * If an option that affects geometry has changed, make a relayout
+ * request.
+ */
+
+ if (typemask & GEOMETRY) {
+ ComputeGeometry(pwPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowWorldChanged --
+ *
+ * This procedure is invoked anytime a paned window's world has
+ * changed in some way that causes the widget to have to recompute
+ * graphics contexts and geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Paned window will be relayed out and redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PanedWindowWorldChanged(instanceData)
+ ClientData instanceData; /* Information about the paned window. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ PanedWindow *pwPtr = (PanedWindow *) instanceData;
+
+ /*
+ * Allocated a graphics context for drawing the paned window widget
+ * elements (background, sashes, etc.).
+ */
+
+ gcValues.background = Tk_3DBorderColor(pwPtr->background)->pixel;
+ newGC = Tk_GetGC(pwPtr->tkwin, GCBackground, &gcValues);
+ if (pwPtr->gc != None) {
+ Tk_FreeGC(pwPtr->display, pwPtr->gc);
+ }
+ pwPtr->gc = newGC;
+
+ /*
+ * Issue geometry size requests to Tk.
+ */
+
+ Tk_SetInternalBorder(pwPtr->tkwin, pwPtr->borderWidth);
+ if (pwPtr->width > 0 || pwPtr->height > 0) {
+ Tk_GeometryRequest(pwPtr->tkwin, pwPtr->width, pwPtr->height);
+ }
+
+ /*
+ * Arrange for the window to be redrawn, if neccessary.
+ */
+
+ if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr);
+ pwPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on paned windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PanedWindowEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ PanedWindow *pwPtr = (PanedWindow *) clientData;
+
+ if (eventPtr->type == Expose) {
+ if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr);
+ pwPtr->flags |= REDRAW_PENDING;
+ }
+ } else if (eventPtr->type == ConfigureNotify) {
+ pwPtr->flags |= REQUESTED_RELAYOUT;
+ if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr);
+ pwPtr->flags |= REDRAW_PENDING;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ DestroyPanedWindow(pwPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowCmdDeletedProc --
+ *
+ * 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
+PanedWindowCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ PanedWindow *pwPtr = (PanedWindow *) clientData;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted or because the command was
+ * deleted, and then this procedure destroys the widget. The
+ * WIDGET_DELETED flag distinguishes these cases.
+ */
+
+ if (!(pwPtr->flags & WIDGET_DELETED)) {
+ Tk_DestroyWindow(pwPtr->tkwin);
+ Tk_DestroyWindow(pwPtr->proxywin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayPanedWindow --
+ *
+ * This procedure redraws the contents of a paned window widget.
+ * 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
+DisplayPanedWindow(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ PanedWindow *pwPtr = (PanedWindow *) clientData;
+ Pixmap pixmap;
+ Tk_Window tkwin = pwPtr->tkwin;
+ int i, sashWidth, sashHeight;
+
+ pwPtr->flags &= ~REDRAW_PENDING;
+ if ((pwPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ if (pwPtr->flags & REQUESTED_RELAYOUT) {
+ ArrangePanes(clientData);
+ }
+
+ /*
+ * Create a pixmap for double-buffering, if necessary.
+ */
+
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ DefaultDepthOfScreen(Tk_Screen(tkwin)));
+
+ /*
+ * Redraw the widget's background and border.
+ */
+ Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), pwPtr->borderWidth,
+ pwPtr->relief);
+
+ /*
+ * Set up boilerplate geometry values for sashes (width, height, common
+ * coordinates).
+ */
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ sashHeight = Tk_Height(tkwin) - (2 * Tk_InternalBorderWidth(tkwin));
+ sashWidth = pwPtr->sashWidth;
+ } else {
+ sashWidth = Tk_Width(tkwin) - (2 * Tk_InternalBorderWidth(tkwin));
+ sashHeight = pwPtr->sashWidth;
+ }
+
+ /*
+ * Draw the sashes.
+ */
+ for (i = 0; i < pwPtr->numSlaves - 1; i++) {
+ Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background,
+ pwPtr->slaves[i]->sashx, pwPtr->slaves[i]->sashy,
+ sashWidth, sashHeight, 1, pwPtr->sashRelief);
+
+ if (pwPtr->showHandle) {
+ Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background,
+ pwPtr->slaves[i]->handlex, pwPtr->slaves[i]->handley,
+ pwPtr->handleSize, pwPtr->handleSize, 1,
+ TK_RELIEF_RAISED);
+ }
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin), pwPtr->gc,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyPanedWindow --
+ *
+ * This procedure is invoked by PanedWindowEventProc to free the
+ * internal structure of a paned window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the paned window is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyPanedWindow(pwPtr)
+ PanedWindow *pwPtr; /* Info about paned window widget. */
+{
+ int i;
+
+ /*
+ * First mark the widget as in the process of being deleted,
+ * so that any code that causes calls to other paned window procedures
+ * will abort.
+ */
+
+ pwPtr->flags |= WIDGET_DELETED;
+
+ /*
+ * Cancel idle callbacks for redrawing the widget and for rearranging
+ * the panes.
+ */
+ if (pwPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayPanedWindow, (ClientData) pwPtr);
+ }
+ if (pwPtr->flags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ArrangePanes, (ClientData) pwPtr);
+ }
+
+ /*
+ * Clean up the slave list; foreach slave:
+ * o Cancel the slave's structure notification callback
+ * o Cancel geometry management for the slave.
+ * o Free memory for the slave
+ */
+
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ Tk_DeleteEventHandler(pwPtr->slaves[i]->tkwin, StructureNotifyMask,
+ SlaveStructureProc, (ClientData) pwPtr->slaves[i]);
+ Tk_ManageGeometry(pwPtr->slaves[i]->tkwin, NULL, NULL);
+ Tk_FreeConfigOptions((char *)pwPtr->slaves[i], pwPtr->slaveOpts,
+ pwPtr->tkwin);
+ ckfree((void *)pwPtr->slaves[i]);
+ pwPtr->slaves[i] = NULL;
+ }
+ if (pwPtr->slaves) {
+ ckfree((char *) pwPtr->slaves);
+ }
+
+ /*
+ * Remove the widget command from the interpreter.
+ */
+
+ Tcl_DeleteCommandFromToken(pwPtr->interp, pwPtr->widgetCmd);
+
+ /*
+ * Let Tk_FreeConfigOptions clean up the rest.
+ */
+
+ Tk_FreeConfigOptions((char *) pwPtr, pwPtr->optionTable, pwPtr->tkwin);
+ pwPtr->tkwin = NULL;
+
+ Tcl_EventuallyFree((ClientData) pwPtr, TCL_DYNAMIC);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowReqProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by a paned window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-arranged at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PanedWindowReqProc(clientData, tkwin)
+ ClientData clientData; /* Paned window's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ Slave *panePtr = (Slave *) clientData;
+ PanedWindow *pwPtr = (PanedWindow *) (panePtr->masterPtr);
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ if (!(pwPtr->flags & RESIZE_PENDING)) {
+ pwPtr->flags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ArrangePanes, (ClientData) pwPtr);
+ }
+ } else {
+ ComputeGeometry(pwPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowLostSlaveProc --
+ *
+ * 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. Causes geometry to
+ * be recomputed for the panedwindow.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PanedWindowLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Grid structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register Slave *slavePtr = (Slave *) clientData;
+ PanedWindow *pwPtr = (PanedWindow *) (slavePtr->masterPtr);
+ if (pwPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask,
+ SlaveStructureProc, (ClientData) slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ slavePtr->tkwin = NULL;
+ ckfree((void *)slavePtr);
+ ComputeGeometry(pwPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrangePanes --
+ *
+ * This procedure is invoked (using the Tcl_DoWhenIdle
+ * mechanism) to re-layout a set of windows managed by
+ * a paned window. It is invoked at idle time so that a
+ * series of pane requests can be merged into a single
+ * layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slaves of masterPtr may get resized or moved.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ArrangePanes(clientData)
+ ClientData clientData; /* Structure describing parent whose slaves
+ * are to be re-layed out. */
+{
+ register PanedWindow *pwPtr = (PanedWindow *) clientData;
+ register Slave *slavePtr;
+ int i, slaveWidth, slaveHeight, slaveX, slaveY, paneWidth, paneHeight;
+ int doubleBw;
+
+ pwPtr->flags &= ~(REQUESTED_RELAYOUT|RESIZE_PENDING);
+
+ /*
+ * 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 (pwPtr->numSlaves == 0) {
+ return;
+ }
+
+ Tcl_Preserve((ClientData) pwPtr);
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ slavePtr = pwPtr->slaves[i];
+
+ /*
+ * Compute the size of this slave. The algorithm (assuming a
+ * horizontal paned window) is:
+ *
+ * 1. Get "base" dimensions. If a width or height is specified
+ * for this slave, use those values; else use the
+ * ReqWidth/ReqHeight.
+ * 2. Using base dimensions, pane dimensions, and sticky values,
+ * determine the x and y, and actual width and height of the
+ * widget.
+ */
+
+ doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width;
+ slaveWidth = (slavePtr->width > 0 ? slavePtr->width :
+ Tk_ReqWidth(slavePtr->tkwin) + doubleBw);
+ slaveHeight = (slavePtr->height > 0 ? slavePtr->height :
+ Tk_ReqHeight(slavePtr->tkwin) + doubleBw);
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ paneWidth = slavePtr->paneWidth;
+ if (i == pwPtr->numSlaves - 1 && Tk_IsMapped(pwPtr->tkwin)) {
+ if (Tk_Width(pwPtr->tkwin) > Tk_ReqWidth(pwPtr->tkwin)) {
+ paneWidth += Tk_Width(pwPtr->tkwin) -
+ Tk_ReqWidth(pwPtr->tkwin) -
+ Tk_InternalBorderWidth(pwPtr->tkwin);
+ }
+ }
+ paneHeight = Tk_Height(pwPtr->tkwin) - (2 * slavePtr->pady) -
+ (2 * Tk_InternalBorderWidth(pwPtr->tkwin));
+ } else {
+ paneHeight = slavePtr->paneHeight;
+ if (i == pwPtr->numSlaves - 1 && Tk_IsMapped(pwPtr->tkwin)) {
+ if (Tk_Height(pwPtr->tkwin) > Tk_ReqHeight(pwPtr->tkwin)) {
+ paneHeight += Tk_Height(pwPtr->tkwin) -
+ Tk_ReqHeight(pwPtr->tkwin) -
+ Tk_InternalBorderWidth(pwPtr->tkwin);
+ }
+ }
+ paneWidth = Tk_Width(pwPtr->tkwin) - (2 * slavePtr->padx) -
+ (2 * Tk_InternalBorderWidth(pwPtr->tkwin));
+ }
+
+ if (slaveWidth > paneWidth) {
+ slaveWidth = paneWidth;
+ }
+ if (slaveHeight > paneHeight) {
+ slaveHeight = paneHeight;
+ }
+
+ slaveX = slavePtr->x;
+ slaveY = slavePtr->y;
+ AdjustForSticky(slavePtr->sticky, paneWidth, paneHeight,
+ &slaveX, &slaveY, &slaveWidth, &slaveHeight);
+
+ slaveX += slavePtr->padx;
+ slaveY += slavePtr->pady;
+
+ /*
+ * Now put the window in the proper spot.
+ */
+ if ((slaveWidth <= 0) || (slaveHeight <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, pwPtr->tkwin,
+ slaveX, slaveY, slaveWidth, slaveHeight);
+ }
+ }
+ Tcl_Release((ClientData) pwPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a slave from a paned window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The paned window will be scheduled for re-arranging and redrawing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(slavePtr)
+ register Slave *slavePtr; /* Window to unlink. */
+{
+ register PanedWindow *masterPtr;
+ int i, j;
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Find the specified slave in the panedwindow's list of slaves, then
+ * remove it from that list.
+ */
+
+ for (i = 0; i < masterPtr->numSlaves; i++) {
+ if (masterPtr->slaves[i] == slavePtr) {
+ for (j = i; j < masterPtr->numSlaves - 1; j++) {
+ masterPtr->slaves[j] = masterPtr->slaves[j + 1];
+ }
+ break;
+ }
+ }
+
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ if (!(masterPtr->flags & REDRAW_PENDING)) {
+ masterPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) masterPtr);
+ }
+
+ /*
+ * Set the slave's masterPtr to NULL, so that we can tell that the
+ * slave is no longer attached to any panedwindow.
+ */
+ slavePtr->masterPtr = NULL;
+
+ masterPtr->numSlaves--;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetPane --
+ *
+ * Given a token to a Tk window, find the pane that corresponds to
+ * that token in a given paned window.
+ *
+ * Results:
+ * Pointer to the slave structure, or NULL if the window is not
+ * managed by this paned window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Slave *
+GetPane(pwPtr, tkwin)
+ PanedWindow *pwPtr; /* Pointer to the paned window info. */
+ Tk_Window tkwin; /* Window to search for. */
+{
+ int i;
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i]->tkwin == tkwin) {
+ return pwPtr->slaves[i];
+ }
+ }
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SlaveStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that's managed by a paned window. This
+ * procedure's only purpose is to clean up when windows are
+ * deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The paned window slave structure associated with the window
+ * is freed, and the slave is disassociated from the paned
+ * window which managed it.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SlaveStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ Slave *slavePtr = (Slave *) clientData;
+ PanedWindow *pwPtr = slavePtr->masterPtr;
+
+ if (eventPtr->type == DestroyNotify) {
+ Unlink(slavePtr);
+ slavePtr->tkwin = NULL;
+ ckfree((void *)slavePtr);
+ ComputeGeometry(pwPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeGeometry --
+ *
+ * Compute geometry for the paned window, including coordinates of
+ * all slave windows and each sash.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recomputes geometry information for a paned window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeGeometry(pwPtr)
+ PanedWindow *pwPtr; /* Pointer to the Paned Window structure. */
+{
+ int i, x, y, doubleBw, internalBw;
+ int reqWidth, reqHeight, sashWidth, sxOff, syOff, hxOff, hyOff, dim;
+ Slave *slavePtr;
+
+ pwPtr->flags |= REQUESTED_RELAYOUT;
+
+ x = y = internalBw = Tk_InternalBorderWidth(pwPtr->tkwin);
+ reqWidth = reqHeight = 0;
+
+ /*
+ * Sashes and handles share space on the display. To simplify
+ * processing below, precompute the x and y offsets of the handles and
+ * sashes within the space occupied by their combination; later, just add
+ * those offsets blindly (avoiding the extra showHandle, etc, checks).
+ */
+ sxOff = syOff = hxOff = hyOff = 0;
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashWidth = pwPtr->handleSize;
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ sxOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ hyOff = pwPtr->handlePad;
+ } else {
+ syOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ hxOff = pwPtr->handlePad;
+ }
+ } else {
+ sashWidth = pwPtr->sashWidth;
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ hxOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ hyOff = pwPtr->handlePad;
+ } else {
+ hyOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ hxOff = pwPtr->handlePad;
+ }
+ }
+
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ slavePtr = pwPtr->slaves[i];
+ /*
+ * First set the coordinates for the top left corner of the slave's
+ * parcel.
+ */
+ slavePtr->x = x;
+ slavePtr->y = y;
+
+ /*
+ * Make sure the pane's paned dimension is at least minsize.
+ * This check may be redundant, since the only way to change a pane's
+ * size is by moving a sash, and that code checks the minsize.
+ */
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (slavePtr->paneWidth < slavePtr->minSize) {
+ slavePtr->paneWidth = slavePtr->minSize;
+ }
+ } else {
+ if (slavePtr->paneHeight < slavePtr->minSize) {
+ slavePtr->paneHeight = slavePtr->minSize;
+ }
+ }
+
+ /*
+ * Compute the location of the sash at the right or bottom of the
+ * parcel.
+ */
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ x += slavePtr->paneWidth + (2 * slavePtr->padx) + pwPtr->sashPad;
+ } else {
+ y += slavePtr->paneHeight + (2 * slavePtr->pady) + pwPtr->sashPad;
+ }
+ slavePtr->sashx = x + sxOff;
+ slavePtr->sashy = y + syOff;
+ slavePtr->handlex = x + hxOff;
+ slavePtr->handley = y + hyOff;
+
+ /*
+ * Compute the location of the next parcel.
+ */
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ x += sashWidth + pwPtr->sashPad;
+ } else {
+ y += sashWidth + pwPtr->sashPad;
+ }
+
+ /*
+ * Find the maximum height/width of the slaves, for computing the
+ * requested height/width of the paned window.
+ */
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ /*
+ * If the slave has an explicit height set, use that; otherwise,
+ * use the slave's requested height.
+ */
+ if (slavePtr->height > 0) {
+ dim = slavePtr->height;
+ } else {
+ doubleBw = (2 * Tk_Changes(slavePtr->tkwin)->border_width);
+ dim = Tk_ReqHeight(slavePtr->tkwin) + doubleBw;
+ }
+ dim += (2 * slavePtr->pady);
+ if (dim > reqHeight) {
+ reqHeight = dim;
+ }
+ } else {
+ /*
+ * If the slave has an explicit width set use that; otherwise,
+ * use the slave's requested width.
+ */
+ if (slavePtr->width > 0) {
+ dim = slavePtr->width;
+ } else {
+ doubleBw = (2 * Tk_Changes(slavePtr->tkwin)->border_width);
+ dim = Tk_ReqWidth(slavePtr->tkwin) + doubleBw;
+ }
+ dim += (2 * slavePtr->padx);
+ if (dim > reqWidth) {
+ reqWidth = dim;
+ }
+ }
+ }
+
+ /*
+ * The loop above should have left x (or y) equal to the sum of the
+ * widths (or heights) of the widgets, plus the size of one sash and
+ * the sash padding for each widget, plus the width of the left (or top)
+ * border of the paned window.
+ *
+ * The requested width (or height) is therefore x (or y) minus the size of
+ * one sash and padding, plus the width of the right (or bottom) border
+ * of the paned window.
+ *
+ * The height (or width) is equal to the maximum height (or width) of
+ * the slaves, plus the width of the border of the top and bottom (or left
+ * and right) of the paned window.
+ */
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ reqWidth = x - (sashWidth + (2 * pwPtr->sashPad)) + internalBw;
+ reqHeight += 2 * internalBw;
+ } else {
+ reqHeight = y - (sashWidth + (2 * pwPtr->sashPad)) + internalBw;
+ reqWidth += 2 * internalBw;
+ }
+ if (pwPtr->width <= 0 && pwPtr->height <= 0) {
+ Tk_GeometryRequest(pwPtr->tkwin, reqWidth, reqHeight);
+ }
+ if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) {
+ pwPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyOptionTables --
+ *
+ * This procedure is registered as an exit callback when the paned window
+ * command is first called. It cleans up the OptionTables structure
+ * allocated by that command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyOptionTables(clientData, interp)
+ ClientData clientData; /* Pointer to the OptionTables struct */
+ Tcl_Interp *interp; /* Pointer to the calling interp */
+{
+ ckfree((char *)clientData);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetSticky -
+ *
+ * Converts an internal boolean combination of "sticky" bits into a
+ * a Tcl string obj containing zero or mor of n, s, e, or w.
+ *
+ * Results:
+ * Tcl_Obj containing the string representation of the sticky value.
+ *
+ * Side effects:
+ * Creates a new Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetSticky(clientData, tkwin, recordPtr, internalOffset)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *recordPtr; /* Pointer to widget record. */
+ int internalOffset; /* Offset within *recordPtr containing the
+ * sticky value. */
+{
+ int sticky = *(int *)(recordPtr + internalOffset);
+ static char buffer[5];
+ int count = 0;
+
+ if (sticky & STICK_NORTH) {
+ buffer[count++] = 'n';
+ }
+ if (sticky & STICK_EAST) {
+ buffer[count++] = 'e';
+ }
+ if (sticky & STICK_SOUTH) {
+ buffer[count++] = 's';
+ }
+ if (sticky & STICK_WEST) {
+ buffer[count++] = 'w';
+ }
+ buffer[count] = '\0';
+
+ return Tcl_NewStringObj(buffer, -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetSticky --
+ *
+ * Converts a Tcl_Obj representing a widgets stickyness into an
+ * integer value.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May store the integer value into the internal representation
+ * pointer. May change the pointer to the Tcl_Obj to NULL to indicate
+ * that the specified string was empty and that is acceptable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetSticky(clientData, interp, tkwin, value, recordPtr, internalOffset,
+ oldInternalPtr, flags)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interp; may be used for errors. */
+ Tk_Window tkwin; /* Window for which option is being set. */
+ Tcl_Obj **value; /* Pointer to the pointer to the value object.
+ * We use a pointer to the pointer because
+ * we may need to return a value (NULL). */
+ char *recordPtr; /* Pointer to storage for the widget record. */
+ int internalOffset; /* Offset within *recordPtr at which the
+ internal value is to be stored. */
+ char *oldInternalPtr; /* Pointer to storage for the old value. */
+ int flags; /* Flags for the option, set Tk_SetOptions. */
+{
+ int sticky = 0;
+ char c, *string, *internalPtr;
+
+ internalPtr = ComputeSlotAddress(recordPtr, internalOffset);
+
+ if (flags & TK_OPTION_NULL_OK && ObjectIsEmpty(*value)) {
+ *value = NULL;
+ } else {
+ /*
+ * Convert the sticky specifier into an integer value.
+ */
+
+ string = Tcl_GetString(*value);
+
+ 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: {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad stickyness value \"",
+ Tcl_GetString(*value), "\": must be a string ",
+ "containing zero or more of n, e, s, and w",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = sticky;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RestoreSticky --
+ *
+ * Restore a sticky option value from a saved value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the old value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RestoreSticky(clientData, tkwin, internalPtr, oldInternalPtr)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *internalPtr; /* Pointer to storage for value. */
+ char *oldInternalPtr; /* Pointer to old value. */
+{
+ *(int *)internalPtr = *(int *)oldInternalPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustForSticky --
+ *
+ * Given the x,y coords of the top-left corner of a pane, the
+ * dimensions of that pane, and the dimensions of a slave, compute
+ * the x,y coords and actual dimensions of the slave based on the slave's
+ * sticky value.
+ *
+ * Results:
+ * No direct return; sets the x, y, slaveWidth and slaveHeight to
+ * correct values.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustForSticky(sticky, cavityWidth, cavityHeight, xPtr, yPtr,
+ slaveWidthPtr, slaveHeightPtr)
+ int sticky; /* Sticky value; see top of file for definition. */
+ int cavityWidth; /* Width of the cavity. */
+ int cavityHeight; /* Height of the cavity. */
+ int *xPtr, *yPtr; /* Initially, coordinates of the top-left
+ * corner of cavity; also return values for
+ * actual x, y coords of slave. */
+ int *slaveWidthPtr; /* Slave width. */
+ int *slaveHeightPtr; /* Slave height. */
+{
+ int diffx=0; /* Cavity width - slave width. */
+ int diffy=0; /* Cavity hight - slave height. */
+
+ if (cavityWidth > *slaveWidthPtr) {
+ diffx = cavityWidth - *slaveWidthPtr;
+ }
+
+ if (cavityHeight > *slaveHeightPtr) {
+ diffy = cavityHeight - *slaveHeightPtr;
+ }
+
+ if ((sticky & STICK_EAST) && (sticky & STICK_WEST)) {
+ *slaveWidthPtr += diffx;
+ }
+ if ((sticky & STICK_NORTH) && (sticky & STICK_SOUTH)) {
+ *slaveHeightPtr += diffy;
+ }
+ if (!(sticky & STICK_WEST)) {
+ *xPtr += (sticky & STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky & STICK_NORTH)) {
+ *yPtr += (sticky & STICK_SOUTH) ? diffy : diffy/2;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MoveSash --
+ *
+ * Move the sash given by index the amount given.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recomputes the sizes of the panes in a panedwindow.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MoveSash(pwPtr, sash, diff)
+ PanedWindow *pwPtr;
+ int sash;
+ int diff;
+{
+ int diffConsumed = 0, i, extra, maxCoord, currCoord;
+ int *lengthPtr, newLength;
+ Slave *slave;
+
+ if (diff > 0) {
+ /*
+ * Growing the pane, at the expense of panes to the right.
+ */
+
+
+ /*
+ * First check that moving the sash the requested distance will not
+ * leave it off the screen. If necessary, clip the requested diff
+ * to the maximum possible while remaining visible.
+ */
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ maxCoord = Tk_Width(pwPtr->tkwin);
+ } else {
+ maxCoord = Tk_ReqWidth(pwPtr->tkwin);
+ }
+ extra = Tk_Width(pwPtr->tkwin) - Tk_ReqWidth(pwPtr->tkwin);
+ currCoord = pwPtr->slaves[sash]->sashx;
+ } else {
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ maxCoord = Tk_Height(pwPtr->tkwin);
+ } else {
+ maxCoord = Tk_ReqHeight(pwPtr->tkwin);
+ }
+ extra = Tk_Height(pwPtr->tkwin) - Tk_ReqHeight(pwPtr->tkwin);
+ currCoord = pwPtr->slaves[sash]->sashy;
+ }
+
+ maxCoord -= (pwPtr->borderWidth + pwPtr->sashWidth + pwPtr->sashPad);
+ if (currCoord + diff >= maxCoord) {
+ diff = maxCoord - currCoord;
+ }
+
+ for (i = sash + 1; i < pwPtr->numSlaves; i++) {
+ if (diffConsumed == diff) {
+ break;
+ }
+ slave = pwPtr->slaves[i];
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ lengthPtr = &(slave->paneWidth);
+ } else {
+ lengthPtr = &(slave->paneHeight);
+ }
+
+ /*
+ * Remove as much space from this pane as possible (constrained
+ * by the minsize value and the visible dimensions of the window).
+ */
+
+ if (i == pwPtr->numSlaves - 1 && extra > 0) {
+ /*
+ * The last pane may have some additional "virtual" space,
+ * if the width (or height) of the paned window is bigger
+ * than the requested width (or height).
+ *
+ * That extra space is not included in the paneWidth
+ * (or paneHeight) value, so we have to handle the last
+ * pane specially.
+ */
+ newLength = (*lengthPtr + extra) - (diff - diffConsumed);
+ if (newLength < slave->minSize) {
+ newLength = slave->minSize;
+ }
+ if (newLength < 0) {
+ newLength = 0;
+ }
+ diffConsumed += (*lengthPtr + extra) - newLength;
+ if (newLength < *lengthPtr) {
+ *lengthPtr = newLength;
+ }
+ } else {
+ newLength = *lengthPtr - (diff - diffConsumed);
+ if (newLength < slave->minSize) {
+ newLength = slave->minSize;
+ }
+ if (newLength < 0) {
+ newLength = 0;
+ }
+ diffConsumed += *lengthPtr - newLength;
+ *lengthPtr = newLength;
+ }
+ }
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ pwPtr->slaves[sash]->paneWidth += diffConsumed;
+ } else {
+ pwPtr->slaves[sash]->paneHeight += diffConsumed;
+ }
+ } else if (diff < 0) {
+ /*
+ * Shrinking the pane; additional space is given to the pane to the
+ * right.
+ */
+ for (i = sash; i >= 0; i--) {
+ if (diffConsumed == diff) {
+ break;
+ }
+ /*
+ * Remove as much space from this pane as possible.
+ */
+ slave = pwPtr->slaves[i];
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ lengthPtr = &(slave->paneWidth);
+ } else {
+ lengthPtr = &(slave->paneHeight);
+ }
+
+ newLength = *lengthPtr + (diff - diffConsumed);
+ if (newLength < slave->minSize) {
+ newLength = slave->minSize;
+ }
+ if (newLength < 0) {
+ newLength = 0;
+ }
+ diffConsumed -= *lengthPtr - newLength;
+ *lengthPtr = newLength;
+ }
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ pwPtr->slaves[sash + 1]->paneWidth -= diffConsumed;
+ } else {
+ pwPtr->slaves[sash + 1]->paneHeight -= diffConsumed;
+ }
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProxyWindowEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on paned window proxy windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ProxyWindowEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ PanedWindow *pwPtr = (PanedWindow *) clientData;
+
+ if (eventPtr->type == Expose) {
+ if (pwPtr->proxywin != NULL &&!(pwPtr->flags & PROXY_REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayProxyWindow, (ClientData) pwPtr);
+ pwPtr->flags |= PROXY_REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayProxyWindow --
+ *
+ * This procedure redraws a paned window proxy 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
+DisplayProxyWindow(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ PanedWindow *pwPtr = (PanedWindow *) clientData;
+ Pixmap pixmap;
+ Tk_Window tkwin = pwPtr->proxywin;
+ pwPtr->flags &= ~PROXY_REDRAW_PENDING;
+ if ((tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Create a pixmap for double-buffering, if necessary.
+ */
+
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ DefaultDepthOfScreen(Tk_Screen(tkwin)));
+
+ /*
+ * Redraw the widget's background and border.
+ */
+ Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 2, pwPtr->sashRelief);
+
+ /*
+ * Copy the pixmap to the display.
+ */
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin), pwPtr->gc,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowProxyCommand --
+ *
+ * Handles the panedwindow proxy subcommand. See the user
+ * documentation for details.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May map or unmap the proxy sash.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PanedWindowProxyCommand(pwPtr, interp, objc, objv)
+ PanedWindow *pwPtr; /* Pointer to paned window information. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
+{
+ static CONST char *optionStrings[] = { "coord", "forget", "place",
+ (char *) NULL };
+ enum options { PROXY_COORD, PROXY_FORGET, PROXY_PLACE };
+ int index, x, y, sashWidth, sashHeight;
+ Tcl_Obj *coords[2];
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case PROXY_COORD:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ coords[0] = Tcl_NewIntObj(pwPtr->proxyx);
+ coords[1] = Tcl_NewIntObj(pwPtr->proxyy);
+ Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords);
+ break;
+
+ case PROXY_FORGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_IsMapped(pwPtr->proxywin)) {
+ Tk_UnmapWindow(pwPtr->proxywin);
+ Tk_UnmaintainGeometry(pwPtr->proxywin, pwPtr->tkwin);
+ }
+ break;
+
+ case PROXY_PLACE: {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (x < 0) {
+ x = 0;
+ }
+ y = Tk_InternalBorderWidth(pwPtr->tkwin);
+ sashWidth = pwPtr->sashWidth;
+ sashHeight = Tk_Height(pwPtr->tkwin) -
+ (2 * Tk_InternalBorderWidth(pwPtr->tkwin));
+ } else {
+ if (y < 0) {
+ y = 0;
+ }
+ x = Tk_InternalBorderWidth(pwPtr->tkwin);
+ sashHeight = pwPtr->sashWidth;
+ sashWidth = Tk_Width(pwPtr->tkwin) -
+ (2 * Tk_InternalBorderWidth(pwPtr->tkwin));
+ }
+
+ /*
+ * Stash the proxy coordinates for future "proxy coord" calls.
+ */
+
+ pwPtr->proxyx = x;
+ pwPtr->proxyy = y;
+
+ /*
+ * Make sure the proxy window is higher in the stacking order
+ * than the slaves, so that it will be visible when drawn.
+ * It would be more correct to push the proxy window just high
+ * enough to appear above the highest slave, but it's much easier
+ * to just force it all the way to the top of the stacking order.
+ */
+
+ Tk_RestackWindow(pwPtr->proxywin, Above, NULL);
+
+ /*
+ * Let Tk_MaintainGeometry take care of placing the window at
+ * the right coordinates.
+ */
+ Tk_MaintainGeometry(pwPtr->proxywin, pwPtr->tkwin,
+ x, y, sashWidth, sashHeight);
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ObjectIsEmpty --
+ *
+ * This procedure tests whether the string value of an object is
+ * empty.
+ *
+ * Results:
+ * The return value is 1 if the string value of objPtr has length
+ * zero, and 0 otherwise.
+ *
+ * Side effects:
+ * May cause object shimmering, since this function can force a
+ * conversion to a string object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ObjectIsEmpty(objPtr)
+ Tcl_Obj *objPtr; /* Object to test. May be NULL. */
+{
+ int length;
+
+ if (objPtr == NULL) {
+ return 1;
+ }
+ if (objPtr->bytes != NULL) {
+ return (objPtr->length == 0);
+ }
+ Tcl_GetStringFromObj(objPtr, &length);
+ return (length == 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeInternalPointer --
+ *
+ * Given a pointer to the start of a record and the offset of a slot
+ * within that record, compute the address of that slot.
+ *
+ * Results:
+ * If offset is non-negative, returns the computed address; else,
+ * returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ComputeSlotAddress(recordPtr, offset)
+ char *recordPtr; /* Pointer to the start of a record. */
+ int offset; /* Offset of a slot within that record; may be < 0. */
+{
+ if (offset >= 0) {
+ return recordPtr + offset;
+ } else {
+ return NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowIdentifyCoords --
+ *
+ * Given a pair of x,y coordinates, identify the panedwindow component
+ * at that point, if any.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Modifies the interpreter's result to contain either an empty list,
+ * or a two element list of the form {sash n} or {handle n} to indicate
+ * that the point lies within the n'th sash or handle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PanedWindowIdentifyCoords(pwPtr, interp, x, y)
+ PanedWindow *pwPtr; /* Information about the widget. */
+ Tcl_Interp *interp; /* Interpreter in which to store result. */
+ int x, y; /* Coordinates of the point to identify. */
+{
+ Tcl_Obj *list;
+ int i, sashHeight, sashWidth, thisx, thisy;
+ int found, isHandle, lpad, rpad, tpad, bpad;
+ list = Tcl_NewObj();
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ sashHeight = Tk_Height(pwPtr->tkwin);
+ } else {
+ sashHeight = Tk_ReqHeight(pwPtr->tkwin);
+ }
+ sashHeight -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin);
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashWidth = pwPtr->handleSize;
+ lpad = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ rpad = pwPtr->handleSize - lpad;
+ lpad += pwPtr->sashPad;
+ rpad += pwPtr->sashPad;
+ } else {
+ sashWidth = pwPtr->sashWidth;
+ lpad = rpad = pwPtr->sashPad;
+ }
+ tpad = bpad = 0;
+ } else {
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashHeight = pwPtr->handleSize;
+ tpad = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ bpad = pwPtr->handleSize - tpad;
+ tpad += pwPtr->sashPad;
+ bpad += pwPtr->sashPad;
+ } else {
+ sashHeight = pwPtr->sashWidth;
+ tpad = bpad = pwPtr->sashPad;
+ }
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ sashWidth = Tk_Width(pwPtr->tkwin);
+ } else {
+ sashWidth = Tk_ReqWidth(pwPtr->tkwin);
+ }
+ sashWidth -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin);
+ lpad = rpad = 0;
+ }
+
+ isHandle = 0;
+ found = -1;
+ for (i = 0; i < pwPtr->numSlaves - 1; i++) {
+ thisx = pwPtr->slaves[i]->sashx;
+ thisy = pwPtr->slaves[i]->sashy;
+
+ if (((thisx - lpad) <= x && x <= (thisx + rpad + sashWidth)) &&
+ ((thisy - tpad) <= y && y <= (thisy + bpad + sashHeight))) {
+ found = i;
+
+ /*
+ * Determine if the point is over the handle or the sash.
+ */
+ if (pwPtr->showHandle) {
+ thisx = pwPtr->slaves[i]->handlex;
+ thisy = pwPtr->slaves[i]->handley;
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (thisy <= y && y <= (thisy + pwPtr->handleSize)) {
+ isHandle = 1;
+ }
+ } else {
+ if (thisx <= x && x <= (thisx + pwPtr->handleSize)) {
+ isHandle = 1;
+ }
+ }
+ }
+ break;
+ }
+ }
+
+ /*
+ * Set results.
+ */
+ if (found != -1) {
+ Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(found));
+ if (isHandle) {
+ Tcl_ListObjAppendElement(interp, list,
+ Tcl_NewStringObj("handle", -1));
+ } else {
+ Tcl_ListObjAppendElement(interp, list,
+ Tcl_NewStringObj("sash", -1));
+ }
+ }
+
+ Tcl_SetObjResult(interp, list);
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkPlace.c b/tcl/generic/tkPlace.c
new file mode 100644
index 00000000000..a2909799e87
--- /dev/null
+++ b/tcl/generic/tkPlace.c
@@ -0,0 +1,1171 @@
+/*
+ * tkPlace.c --
+ *
+ * This file contains code to implement a simple geometry manager
+ * for Tk based on absolute placement or "rubber-sheet" placement.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ */
+
+static char *borderModeStrings[] = {
+ "inside", "outside", "ignore", (char *) NULL
+};
+
+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. */
+ Tk_Window inTkwin; /* Token for the -in 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. */
+ Tcl_Obj *xPtr, *yPtr; /* Tcl_Obj rep's of x, y coords, to keep
+ * pixel spec. information */
+ double relX, relY; /* X and Y coordinates relative to size of
+ * master. */
+ int width, height; /* Absolute dimensions for tkwin. */
+ Tcl_Obj *widthPtr; /* Tcl_Obj rep of width, to keep pixel spec */
+ Tcl_Obj *heightPtr; /* Tcl_Obj rep of height, to keep pixel spec */
+ double relWidth, relHeight; /* Dimensions for tkwin relative to size of
+ * master. */
+ Tcl_Obj *relWidthPtr;
+ Tcl_Obj *relHeightPtr;
+ 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;
+
+/*
+ * Type masks for options:
+ */
+#define IN_MASK 1
+
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_ANCHOR, "-anchor", NULL, NULL, "nw", -1,
+ Tk_Offset(Slave, anchor), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-bordermode", NULL, NULL, "inside", -1,
+ Tk_Offset(Slave, borderMode), 0, (ClientData) borderModeStrings, 0},
+ {TK_OPTION_PIXELS, "-height", NULL, NULL, "", Tk_Offset(Slave, heightPtr),
+ Tk_Offset(Slave, height), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_WINDOW, "-in", NULL, NULL, "", -1, Tk_Offset(Slave, inTkwin),
+ 0, 0, IN_MASK},
+ {TK_OPTION_DOUBLE, "-relheight", NULL, NULL, "",
+ Tk_Offset(Slave, relHeightPtr), Tk_Offset(Slave, relHeight),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-relwidth", NULL, NULL, "",
+ Tk_Offset(Slave, relWidthPtr), Tk_Offset(Slave, relWidth),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-relx", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relX), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-rely", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relY), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-width", NULL, NULL, "", Tk_Offset(Slave, widthPtr),
+ Tk_Offset(Slave, width), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-x", NULL, NULL, "0", Tk_Offset(Slave, xPtr),
+ Tk_Offset(Slave, x), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-y", NULL, NULL, "0", Tk_Offset(Slave, yPtr),
+ Tk_Offset(Slave, y), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * 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 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,
+ Tk_Window tkwin, Tk_OptionTable table,
+ int objc, Tcl_Obj *CONST objv[]));
+static int PlaceInfoCommand _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin));
+static Slave * CreateSlave _ANSI_ARGS_((Tk_Window tkwin));
+static Slave * FindSlave _ANSI_ARGS_((Tk_Window tkwin));
+static Master * CreateMaster _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_PlaceObjCmd --
+ *
+ * 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_PlaceObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin;
+ Slave *slavePtr;
+ char *string;
+ TkDisplay *dispPtr;
+ Tk_OptionTable optionTable;
+ static CONST char *optionStrings[] = {
+ "configure", "forget", "info", "slaves", (char *) NULL
+ };
+ enum options { PLACE_CONFIGURE, PLACE_FORGET, PLACE_INFO, PLACE_SLAVES };
+ int index;
+
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option|pathName args");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ /*
+ * Handle special shortcut where window name is first argument.
+ */
+
+ string = Tcl_GetString(objv[1]);
+ if (string[0] == '.') {
+ tkwin = Tk_NameToWindow(interp, string, Tk_MainWindow(interp));
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize, if that hasn't been done yet.
+ */
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->placeInit) {
+ Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS);
+ dispPtr->placeInit = 1;
+ }
+
+ return ConfigureSlave(interp, tkwin, optionTable, objc-2, objv+2);
+ }
+
+ /*
+ * Handle more general case of option followed by window name followed
+ * by possible additional arguments.
+ */
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ Tk_MainWindow(interp));
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize, if that hasn't been done yet.
+ */
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->placeInit) {
+ Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS);
+ dispPtr->placeInit = 1;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case PLACE_CONFIGURE: {
+ Tcl_Obj *objPtr;
+ if (objc == 3 || objc == 4) {
+ slavePtr = FindSlave(tkwin);
+ if (slavePtr == NULL) {
+ return TCL_OK;
+ }
+ objPtr = Tk_GetOptionInfo(interp, (char *) slavePtr,
+ optionTable,
+ (objc == 4) ? objv[3] : (Tcl_Obj *) NULL, tkwin);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ }
+ } else {
+ return ConfigureSlave(interp, tkwin, optionTable, objc-3,
+ objv+3);
+ }
+ }
+
+ case PLACE_FORGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ slavePtr = FindSlave(tkwin);
+ if (slavePtr == NULL) {
+ return TCL_OK;
+ }
+ if ((slavePtr->masterPtr != NULL) &&
+ (slavePtr->masterPtr->tkwin !=
+ Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
+ (char *) tkwin));
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask,
+ SlaveStructureProc, (ClientData) slavePtr);
+ Tk_ManageGeometry(tkwin, (Tk_GeomMgr *) NULL, (ClientData) NULL);
+ Tk_UnmapWindow(tkwin);
+ ckfree((char *) slavePtr);
+ break;
+ }
+
+ case PLACE_INFO: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ return PlaceInfoCommand(interp, tkwin);
+ }
+
+ case PLACE_SLAVES: {
+ Master *masterPtr;
+ Tcl_Obj *listPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ masterPtr = FindMaster(tkwin);
+ if (masterPtr != NULL) {
+ listPtr = Tcl_NewObj();
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin),-1));
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ }
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSlave --
+ *
+ * Given a Tk_Window token, find the Slave structure corresponding
+ * to that token, creating a new one if necessary.
+ *
+ * Results:
+ * Pointer to the Slave structure.
+ *
+ * Side effects:
+ * A new Slave structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Slave *
+CreateSlave(tkwin)
+ Tk_Window tkwin; /* Token for desired slave. */
+{
+ Tcl_HashEntry *hPtr;
+ register Slave *slavePtr;
+ int new;
+ TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->slaveTable, (char *) tkwin, &new);
+ if (new) {
+ slavePtr = (Slave *) ckalloc(sizeof(Slave));
+ memset(slavePtr, 0, sizeof(Slave));
+ slavePtr->tkwin = tkwin;
+ slavePtr->inTkwin = None;
+ slavePtr->anchor = TK_ANCHOR_NW;
+ slavePtr->borderMode = BM_INSIDE;
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSlave --
+ *
+ * Given a Tk_Window token, find the Slave structure corresponding
+ * to that token. This is purely a lookup function; it will not
+ * create a record if one does not yet exist.
+ *
+ * Results:
+ * Pointer to Slave structure; NULL if none exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Slave *
+FindSlave(tkwin)
+ Tk_Window tkwin; /* Token for desired slave. */
+{
+ Tcl_HashEntry *hPtr;
+ register Slave *slavePtr;
+ TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateMaster --
+ *
+ * Given a Tk_Window token, find the Master structure corresponding
+ * to that token, creating a new one if necessary.
+ *
+ * Results:
+ * Pointer to the Master structure.
+ *
+ * Side effects:
+ * A new Master structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Master *
+CreateMaster(tkwin)
+ Tk_Window tkwin; /* Token for desired master. */
+{
+ Tcl_HashEntry *hPtr;
+ register Master *masterPtr;
+ int new;
+ TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->masterTable, (char *) tkwin, &new);
+ if (new) {
+ masterPtr = (Master *) ckalloc(sizeof(Master));
+ masterPtr->tkwin = tkwin;
+ masterPtr->slavePtr = NULL;
+ masterPtr->flags = 0;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ Tk_CreateEventHandler(masterPtr->tkwin, StructureNotifyMask,
+ MasterStructureProc, (ClientData) masterPtr);
+ } else {
+ masterPtr = (Master *) Tcl_GetHashValue(hPtr);
+ }
+ return masterPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindMaster --
+ *
+ * Given a Tk_Window token, find the Master structure corresponding
+ * to that token. This is simply a lookup procedure; a new record
+ * will not be created if one does not already exist.
+ *
+ * Results:
+ * Pointer to the Master structure; NULL if one does not exist for
+ * the given Tk_Window token.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Master *
+FindMaster(tkwin)
+ Tk_Window tkwin; /* Token for desired master. */
+{
+ Tcl_HashEntry *hPtr;
+ register Master *masterPtr;
+ TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ 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 the interp's result.
+ *
+ * Side effects:
+ * Information in slavePtr may change, and slavePtr's master is
+ * scheduled for reconfiguration.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlave(interp, tkwin, table, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Token for the window to manipulate. */
+ Tk_OptionTable table; /* Token for option table. */
+ int objc; /* Number of config arguments. */
+ Tcl_Obj *CONST objv[]; /* Object values for arguments. */
+{
+ register Master *masterPtr;
+ Tk_SavedOptions savedOptions;
+ int mask;
+ int result = TCL_OK;
+ Slave *slavePtr;
+
+ if (Tk_TopWinHierarchy(tkwin)) {
+ Tcl_AppendResult(interp, "can't use placer on top-level window \"",
+ Tk_PathName(tkwin), "\"; use wm command instead",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ slavePtr = CreateSlave(tkwin);
+
+ if (Tk_SetOptions(interp, (char *)slavePtr, table, objc, objv,
+ slavePtr->tkwin, &savedOptions, &mask) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ if (mask & IN_MASK) {
+ /* -in changed */
+ Tk_Window tkwin;
+ Tk_Window ancestor;
+
+ tkwin = slavePtr->inTkwin;
+
+ /*
+ * 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_TopWinHierarchy(ancestor)) {
+ Tcl_AppendResult(interp, "can't place ",
+ Tk_PathName(slavePtr->tkwin), " relative to ",
+ Tk_PathName(tkwin), (char *) NULL);
+ result = TCL_ERROR;
+ Tk_RestoreSavedOptions(&savedOptions);
+ goto done;
+ }
+ }
+ if (slavePtr->tkwin == tkwin) {
+ Tcl_AppendResult(interp, "can't place ",
+ Tk_PathName(slavePtr->tkwin), " relative to itself",
+ (char *) NULL);
+ result = TCL_ERROR;
+ Tk_RestoreSavedOptions(&savedOptions);
+ 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 = CreateMaster(tkwin);
+ slavePtr->nextPtr = slavePtr->masterPtr->slavePtr;
+ slavePtr->masterPtr->slavePtr = slavePtr;
+ }
+ }
+
+ /*
+ * Set slave flags. First clear the field, then add bits as needed.
+ */
+
+ slavePtr->flags = 0;
+ if (slavePtr->heightPtr) {
+ slavePtr->flags |= CHILD_HEIGHT;
+ }
+
+ if (slavePtr->relHeightPtr) {
+ slavePtr->flags |= CHILD_REL_HEIGHT;
+ }
+
+ if (slavePtr->relWidthPtr) {
+ slavePtr->flags |= CHILD_REL_WIDTH;
+ }
+
+ if (slavePtr->widthPtr) {
+ slavePtr->flags |= CHILD_WIDTH;
+ }
+
+ /*
+ * If there's no master specified for this slave, use its Tk_Parent.
+ * Then arrange for a placement recalculation in the master.
+ */
+
+ Tk_FreeSavedOptions(&savedOptions);
+ done:
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ masterPtr = CreateMaster(Tk_Parent(slavePtr->tkwin));
+ slavePtr->masterPtr = masterPtr;
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ }
+ slavePtr->inTkwin = masterPtr->tkwin;
+ if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlaceInfoCommand --
+ *
+ * Implementation of the [place info] subcommand. See the user
+ * documentation for information on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * If the given tkwin is managed by the placer, this function will
+ * put information about that placement in the interp's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PlaceInfoCommand(interp, tkwin)
+ Tcl_Interp *interp; /* Interp into which to place result. */
+ Tk_Window tkwin; /* Token for the window to get info on. */
+{
+ char buffer[32 + TCL_INTEGER_SPACE];
+ Slave *slavePtr;
+
+ slavePtr = FindSlave(tkwin);
+ if (slavePtr == NULL) {
+ return TCL_OK;
+ }
+ 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);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, masterX, masterY;
+ 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.
+ */
+
+ masterX = masterY = 0;
+ masterWidth = Tk_Width(masterPtr->tkwin);
+ masterHeight = Tk_Height(masterPtr->tkwin);
+ if (slavePtr->borderMode == BM_INSIDE) {
+ masterX = Tk_InternalBorderLeft(masterPtr->tkwin);
+ masterY = Tk_InternalBorderTop(masterPtr->tkwin);
+ masterWidth -= masterX + Tk_InternalBorderRight(masterPtr->tkwin);
+ masterHeight -= masterY +
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ } else if (slavePtr->borderMode == BM_OUTSIDE) {
+ masterX = masterY = -Tk_Changes(masterPtr->tkwin)->border_width;
+ masterWidth -= 2 * masterX;
+ masterHeight -= 2 * masterY;
+ }
+
+ /*
+ * Step 2: compute size of slave (outside dimensions including
+ * border) and location of anchor point within master.
+ */
+
+ x1 = slavePtr->x + masterX + (slavePtr->relX*masterWidth);
+ x = (int) (x1 + ((x1 > 0) ? 0.5 : -0.5));
+ y1 = slavePtr->y + masterY + (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_MaintainGeometry 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;
+ TkDisplay *dispPtr = ((TkWindow *) masterPtr->tkwin)->dispPtr;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if ((masterPtr->slavePtr != NULL)
+ && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = nextPtr) {
+ slavePtr->masterPtr = NULL;
+ nextPtr = slavePtr->nextPtr;
+ slavePtr->nextPtr = NULL;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->masterTable,
+ (char *) masterPtr->tkwin));
+ if (masterPtr->flags & PARENT_RECONFIG_PENDING) {
+ Tcl_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr);
+ }
+ masterPtr->tkwin = NULL;
+ ckfree((char *) masterPtr);
+ } else if (eventPtr->type == MapNotify) {
+ /*
+ * 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;
+ TkDisplay * dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr;
+
+ if (eventPtr->type == DestroyNotify) {
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->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;
+ TkDisplay * dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Tk_UnmapWindow(tkwin);
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
+ (char *) tkwin));
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ (ClientData) slavePtr);
+ ckfree((char *) slavePtr);
+}
diff --git a/tcl/generic/tkPlatDecls.h b/tcl/generic/tkPlatDecls.h
new file mode 100644
index 00000000000..c39e78ae091
--- /dev/null
+++ b/tcl/generic/tkPlatDecls.h
@@ -0,0 +1,300 @@
+/*
+ * tkPlatDecls.h --
+ *
+ * Declarations of functions in the platform-specific public Tcl API.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKPLATDECLS
+#define _TKPLATDECLS
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tk.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+#ifdef __WIN32__
+/* 0 */
+EXTERN Window Tk_AttachHWND _ANSI_ARGS_((Tk_Window tkwin,
+ HWND hwnd));
+/* 1 */
+EXTERN HINSTANCE Tk_GetHINSTANCE _ANSI_ARGS_((void));
+/* 2 */
+EXTERN HWND Tk_GetHWND _ANSI_ARGS_((Window window));
+/* 3 */
+EXTERN Tk_Window Tk_HWNDToWindow _ANSI_ARGS_((HWND hwnd));
+/* 4 */
+EXTERN void Tk_PointerEvent _ANSI_ARGS_((HWND hwnd, int x, int y));
+/* 5 */
+EXTERN int Tk_TranslateWinEvent _ANSI_ARGS_((HWND hwnd,
+ UINT message, WPARAM wParam, LPARAM lParam,
+ LRESULT * result));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 0 */
+EXTERN void Tk_MacSetEmbedHandler _ANSI_ARGS_((
+ Tk_MacEmbedRegisterWinProc * registerWinProcPtr,
+ Tk_MacEmbedGetGrafPortProc * getPortProcPtr,
+ Tk_MacEmbedMakeContainerExistProc * containerExistProcPtr,
+ Tk_MacEmbedGetClipProc * getClipProc,
+ Tk_MacEmbedGetOffsetInParentProc * getOffsetProc));
+/* 1 */
+EXTERN void Tk_MacTurnOffMenus _ANSI_ARGS_((void));
+/* 2 */
+EXTERN void Tk_MacTkOwnsCursor _ANSI_ARGS_((int tkOwnsIt));
+/* 3 */
+EXTERN void TkMacInitMenus _ANSI_ARGS_((Tcl_Interp * interp));
+/* 4 */
+EXTERN void TkMacInitAppleEvents _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 5 */
+EXTERN int TkMacConvertEvent _ANSI_ARGS_((
+ EventRecord * eventPtr));
+/* 6 */
+EXTERN int TkMacConvertTkEvent _ANSI_ARGS_((
+ EventRecord * eventPtr, Window window));
+/* 7 */
+EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height,
+ int flags));
+/* 8 */
+EXTERN void TkMacInvalClipRgns _ANSI_ARGS_((TkWindow * winPtr));
+/* 9 */
+EXTERN int TkMacHaveAppearance _ANSI_ARGS_((void));
+/* 10 */
+EXTERN GWorldPtr TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+/* 0 */
+EXTERN void Tk_MacOSXSetEmbedHandler _ANSI_ARGS_((
+ Tk_MacOSXEmbedRegisterWinProc * registerWinProcPtr,
+ Tk_MacOSXEmbedGetGrafPortProc * getPortProcPtr,
+ Tk_MacOSXEmbedMakeContainerExistProc * containerExistProcPtr,
+ Tk_MacOSXEmbedGetClipProc * getClipProc,
+ Tk_MacOSXEmbedGetOffsetInParentProc * getOffsetProc));
+/* 1 */
+EXTERN void Tk_MacOSXTurnOffMenus _ANSI_ARGS_((void));
+/* 2 */
+EXTERN void Tk_MacOSXTkOwnsCursor _ANSI_ARGS_((int tkOwnsIt));
+/* 3 */
+EXTERN void TkMacOSXInitMenus _ANSI_ARGS_((Tcl_Interp * interp));
+/* 4 */
+EXTERN void TkMacOSXInitAppleEvents _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 5 */
+EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height,
+ int flags));
+/* 6 */
+EXTERN void TkMacOSXInvalClipRgns _ANSI_ARGS_((TkWindow * winPtr));
+/* 7 */
+EXTERN GWorldPtr TkMacOSXGetDrawablePort _ANSI_ARGS_((
+ Drawable drawable));
+/* 8 */
+EXTERN ControlRef TkMacOSXGetRootControl _ANSI_ARGS_((
+ Drawable drawable));
+/* 9 */
+EXTERN void Tk_MacOSXSetupTkNotifier _ANSI_ARGS_((void));
+/* 10 */
+EXTERN int Tk_MacOSXIsAppInFront _ANSI_ARGS_((void));
+#endif /* MAC_OSX_TK */
+
+typedef struct TkPlatStubs {
+ int magic;
+ struct TkPlatStubHooks *hooks;
+
+#ifdef __WIN32__
+ Window (*tk_AttachHWND) _ANSI_ARGS_((Tk_Window tkwin, HWND hwnd)); /* 0 */
+ HINSTANCE (*tk_GetHINSTANCE) _ANSI_ARGS_((void)); /* 1 */
+ HWND (*tk_GetHWND) _ANSI_ARGS_((Window window)); /* 2 */
+ Tk_Window (*tk_HWNDToWindow) _ANSI_ARGS_((HWND hwnd)); /* 3 */
+ void (*tk_PointerEvent) _ANSI_ARGS_((HWND hwnd, int x, int y)); /* 4 */
+ int (*tk_TranslateWinEvent) _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam, LRESULT * result)); /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tk_MacSetEmbedHandler) _ANSI_ARGS_((Tk_MacEmbedRegisterWinProc * registerWinProcPtr, Tk_MacEmbedGetGrafPortProc * getPortProcPtr, Tk_MacEmbedMakeContainerExistProc * containerExistProcPtr, Tk_MacEmbedGetClipProc * getClipProc, Tk_MacEmbedGetOffsetInParentProc * getOffsetProc)); /* 0 */
+ void (*tk_MacTurnOffMenus) _ANSI_ARGS_((void)); /* 1 */
+ void (*tk_MacTkOwnsCursor) _ANSI_ARGS_((int tkOwnsIt)); /* 2 */
+ void (*tkMacInitMenus) _ANSI_ARGS_((Tcl_Interp * interp)); /* 3 */
+ void (*tkMacInitAppleEvents) _ANSI_ARGS_((Tcl_Interp * interp)); /* 4 */
+ int (*tkMacConvertEvent) _ANSI_ARGS_((EventRecord * eventPtr)); /* 5 */
+ int (*tkMacConvertTkEvent) _ANSI_ARGS_((EventRecord * eventPtr, Window window)); /* 6 */
+ void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 7 */
+ void (*tkMacInvalClipRgns) _ANSI_ARGS_((TkWindow * winPtr)); /* 8 */
+ int (*tkMacHaveAppearance) _ANSI_ARGS_((void)); /* 9 */
+ GWorldPtr (*tkMacGetDrawablePort) _ANSI_ARGS_((Drawable drawable)); /* 10 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ void (*tk_MacOSXSetEmbedHandler) _ANSI_ARGS_((Tk_MacOSXEmbedRegisterWinProc * registerWinProcPtr, Tk_MacOSXEmbedGetGrafPortProc * getPortProcPtr, Tk_MacOSXEmbedMakeContainerExistProc * containerExistProcPtr, Tk_MacOSXEmbedGetClipProc * getClipProc, Tk_MacOSXEmbedGetOffsetInParentProc * getOffsetProc)); /* 0 */
+ void (*tk_MacOSXTurnOffMenus) _ANSI_ARGS_((void)); /* 1 */
+ void (*tk_MacOSXTkOwnsCursor) _ANSI_ARGS_((int tkOwnsIt)); /* 2 */
+ void (*tkMacOSXInitMenus) _ANSI_ARGS_((Tcl_Interp * interp)); /* 3 */
+ void (*tkMacOSXInitAppleEvents) _ANSI_ARGS_((Tcl_Interp * interp)); /* 4 */
+ void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 5 */
+ void (*tkMacOSXInvalClipRgns) _ANSI_ARGS_((TkWindow * winPtr)); /* 6 */
+ GWorldPtr (*tkMacOSXGetDrawablePort) _ANSI_ARGS_((Drawable drawable)); /* 7 */
+ ControlRef (*tkMacOSXGetRootControl) _ANSI_ARGS_((Drawable drawable)); /* 8 */
+ void (*tk_MacOSXSetupTkNotifier) _ANSI_ARGS_((void)); /* 9 */
+ int (*tk_MacOSXIsAppInFront) _ANSI_ARGS_((void)); /* 10 */
+#endif /* MAC_OSX_TK */
+} TkPlatStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TkPlatStubs *tkPlatStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifdef __WIN32__
+#ifndef Tk_AttachHWND
+#define Tk_AttachHWND \
+ (tkPlatStubsPtr->tk_AttachHWND) /* 0 */
+#endif
+#ifndef Tk_GetHINSTANCE
+#define Tk_GetHINSTANCE \
+ (tkPlatStubsPtr->tk_GetHINSTANCE) /* 1 */
+#endif
+#ifndef Tk_GetHWND
+#define Tk_GetHWND \
+ (tkPlatStubsPtr->tk_GetHWND) /* 2 */
+#endif
+#ifndef Tk_HWNDToWindow
+#define Tk_HWNDToWindow \
+ (tkPlatStubsPtr->tk_HWNDToWindow) /* 3 */
+#endif
+#ifndef Tk_PointerEvent
+#define Tk_PointerEvent \
+ (tkPlatStubsPtr->tk_PointerEvent) /* 4 */
+#endif
+#ifndef Tk_TranslateWinEvent
+#define Tk_TranslateWinEvent \
+ (tkPlatStubsPtr->tk_TranslateWinEvent) /* 5 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef Tk_MacSetEmbedHandler
+#define Tk_MacSetEmbedHandler \
+ (tkPlatStubsPtr->tk_MacSetEmbedHandler) /* 0 */
+#endif
+#ifndef Tk_MacTurnOffMenus
+#define Tk_MacTurnOffMenus \
+ (tkPlatStubsPtr->tk_MacTurnOffMenus) /* 1 */
+#endif
+#ifndef Tk_MacTkOwnsCursor
+#define Tk_MacTkOwnsCursor \
+ (tkPlatStubsPtr->tk_MacTkOwnsCursor) /* 2 */
+#endif
+#ifndef TkMacInitMenus
+#define TkMacInitMenus \
+ (tkPlatStubsPtr->tkMacInitMenus) /* 3 */
+#endif
+#ifndef TkMacInitAppleEvents
+#define TkMacInitAppleEvents \
+ (tkPlatStubsPtr->tkMacInitAppleEvents) /* 4 */
+#endif
+#ifndef TkMacConvertEvent
+#define TkMacConvertEvent \
+ (tkPlatStubsPtr->tkMacConvertEvent) /* 5 */
+#endif
+#ifndef TkMacConvertTkEvent
+#define TkMacConvertTkEvent \
+ (tkPlatStubsPtr->tkMacConvertTkEvent) /* 6 */
+#endif
+#ifndef TkGenWMConfigureEvent
+#define TkGenWMConfigureEvent \
+ (tkPlatStubsPtr->tkGenWMConfigureEvent) /* 7 */
+#endif
+#ifndef TkMacInvalClipRgns
+#define TkMacInvalClipRgns \
+ (tkPlatStubsPtr->tkMacInvalClipRgns) /* 8 */
+#endif
+#ifndef TkMacHaveAppearance
+#define TkMacHaveAppearance \
+ (tkPlatStubsPtr->tkMacHaveAppearance) /* 9 */
+#endif
+#ifndef TkMacGetDrawablePort
+#define TkMacGetDrawablePort \
+ (tkPlatStubsPtr->tkMacGetDrawablePort) /* 10 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+#ifndef Tk_MacOSXSetEmbedHandler
+#define Tk_MacOSXSetEmbedHandler \
+ (tkPlatStubsPtr->tk_MacOSXSetEmbedHandler) /* 0 */
+#endif
+#ifndef Tk_MacOSXTurnOffMenus
+#define Tk_MacOSXTurnOffMenus \
+ (tkPlatStubsPtr->tk_MacOSXTurnOffMenus) /* 1 */
+#endif
+#ifndef Tk_MacOSXTkOwnsCursor
+#define Tk_MacOSXTkOwnsCursor \
+ (tkPlatStubsPtr->tk_MacOSXTkOwnsCursor) /* 2 */
+#endif
+#ifndef TkMacOSXInitMenus
+#define TkMacOSXInitMenus \
+ (tkPlatStubsPtr->tkMacOSXInitMenus) /* 3 */
+#endif
+#ifndef TkMacOSXInitAppleEvents
+#define TkMacOSXInitAppleEvents \
+ (tkPlatStubsPtr->tkMacOSXInitAppleEvents) /* 4 */
+#endif
+#ifndef TkGenWMConfigureEvent
+#define TkGenWMConfigureEvent \
+ (tkPlatStubsPtr->tkGenWMConfigureEvent) /* 5 */
+#endif
+#ifndef TkMacOSXInvalClipRgns
+#define TkMacOSXInvalClipRgns \
+ (tkPlatStubsPtr->tkMacOSXInvalClipRgns) /* 6 */
+#endif
+#ifndef TkMacOSXGetDrawablePort
+#define TkMacOSXGetDrawablePort \
+ (tkPlatStubsPtr->tkMacOSXGetDrawablePort) /* 7 */
+#endif
+#ifndef TkMacOSXGetRootControl
+#define TkMacOSXGetRootControl \
+ (tkPlatStubsPtr->tkMacOSXGetRootControl) /* 8 */
+#endif
+#ifndef Tk_MacOSXSetupTkNotifier
+#define Tk_MacOSXSetupTkNotifier \
+ (tkPlatStubsPtr->tk_MacOSXSetupTkNotifier) /* 9 */
+#endif
+#ifndef Tk_MacOSXIsAppInFront
+#define Tk_MacOSXIsAppInFront \
+ (tkPlatStubsPtr->tk_MacOSXIsAppInFront) /* 10 */
+#endif
+#endif /* MAC_OSX_TK */
+
+#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKPLATDECLS */
diff --git a/tcl/generic/tkPointer.c b/tcl/generic/tkPointer.c
new file mode 100644
index 00000000000..b9f26174335
--- /dev/null
+++ b/tcl/generic/tkPointer.c
@@ -0,0 +1,653 @@
+/*
+ * 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 __WIN32__
+#include "tkWinInt.h"
+#endif
+
+#if defined(MAC_TCL)
+#include "tkMacInt.h"
+#define Cursor XCursor
+#endif
+
+#if defined(MAC_OSX_TK)
+#include "tkMacOSXInt.h"
+#define Cursor XCursor
+#endif
+
+/*
+ * Mask that selects any of the state bits corresponding to buttons,
+ * plus masks that select individual buttons' bits:
+ */
+
+#define ALL_BUTTONS \
+ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
+static unsigned int buttonMasks[] = {
+ Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
+};
+#define ButtonMask(b) (buttonMasks[(b)-Button1])
+
+typedef struct ThreadSpecificData {
+ TkWindow *grabWinPtr; /* Window that defines the top of the
+ * grab tree in a global grab. */
+ int lastState; /* Last known state flags. */
+ XPoint lastPos; /* Last reported mouse position. */
+ TkWindow *lastWinPtr; /* Last reported mouse window. */
+ TkWindow *restrictWinPtr; /* Window to which all mouse events
+ * will be reported. */
+ TkWindow *cursorWinPtr; /* Window that is currently
+ * controlling the global cursor. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations of procedures used in this file.
+ */
+
+static int GenerateEnterLeave _ANSI_ARGS_((TkWindow *winPtr,
+ int x, int y, int state));
+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 */
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ TkWindow *restrictWinPtr = tsdPtr->restrictWinPtr;
+ TkWindow *lastWinPtr = tsdPtr->lastWinPtr;
+
+ if (winPtr != tsdPtr->lastWinPtr) {
+ if (restrictWinPtr) {
+ int newPos, oldPos;
+
+ newPos = TkPositionInTree(winPtr, restrictWinPtr);
+ oldPos = TkPositionInTree(lastWinPtr, restrictWinPtr);
+
+ /*
+ * 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;
+ }
+ }
+ tsdPtr->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. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ TkWindow *targetWinPtr;
+ XPoint pos;
+ XEvent event;
+ int changes = (state ^ tsdPtr->lastState) & ALL_BUTTONS;
+ int type, b, mask;
+
+ pos.x = x;
+ pos.y = y;
+
+ /*
+ * Use the current keyboard state, but the old mouse button
+ * state since we haven't generated the button events yet.
+ */
+
+ tsdPtr->lastState = (state & ~ALL_BUTTONS) | (tsdPtr->lastState
+ & ALL_BUTTONS);
+
+ /*
+ * Generate Enter/Leave events. If the pointer has crossed window
+ * boundaries, update the current mouse position so we don't generate
+ * redundant motion events.
+ */
+
+ if (GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState)) {
+ tsdPtr->lastPos = pos;
+ }
+
+ /*
+ * Generate ButtonPress/ButtonRelease events based on the differences
+ * between the current button state and the last known button state.
+ */
+
+ for (b = Button1; b <= Button3; b++) {
+ mask = ButtonMask(b);
+ if (changes & mask) {
+ if (state & mask) {
+ type = ButtonPress;
+
+ /*
+ * ButtonPress - Set restrict window if we aren't grabbed, or
+ * if this is the first button down.
+ */
+
+ if (!tsdPtr->restrictWinPtr) {
+ if (!tsdPtr->grabWinPtr) {
+
+ /*
+ * Mouse is not grabbed, so set a button grab.
+ */
+
+ tsdPtr->restrictWinPtr = winPtr;
+ TkpSetCapture(tsdPtr->restrictWinPtr);
+
+ } else if ((tsdPtr->lastState & ALL_BUTTONS) == 0) {
+
+ /*
+ * Mouse is in a non-button grab, so ensure
+ * the button grab is inside the grab tree.
+ */
+
+ if (TkPositionInTree(winPtr, tsdPtr->grabWinPtr)
+ == TK_GRAB_IN_TREE) {
+ tsdPtr->restrictWinPtr = winPtr;
+ } else {
+ tsdPtr->restrictWinPtr = tsdPtr->grabWinPtr;
+ }
+ TkpSetCapture(tsdPtr->restrictWinPtr);
+ }
+ }
+
+ } else {
+ type = ButtonRelease;
+
+ /*
+ * ButtonRelease - Release the mouse capture and clear the
+ * restrict window when the last button is released and we
+ * aren't in a global grab.
+ */
+
+ if ((tsdPtr->lastState & ALL_BUTTONS) == mask) {
+ if (!tsdPtr->grabWinPtr) {
+ TkpSetCapture(NULL);
+ }
+ }
+
+ /*
+ * If we are releasing a restrict window, then we need
+ * to send the button event followed by mouse motion from
+ * the restrict window to the current mouse position.
+ */
+
+ if (tsdPtr->restrictWinPtr) {
+ InitializeEvent(&event, tsdPtr->restrictWinPtr, type, x, y,
+ tsdPtr->lastState, b);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ tsdPtr->lastState &= ~mask;
+ tsdPtr->lastWinPtr = tsdPtr->restrictWinPtr;
+ tsdPtr->restrictWinPtr = NULL;
+
+ GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState);
+ tsdPtr->lastPos = pos;
+ continue;
+ }
+ }
+
+ /*
+ * If a restrict window is set, make sure the pointer event
+ * is reported relative to that window. Otherwise, if a
+ * global grab is in effect then events outside of windows
+ * managed by Tk should be reported to the grab window.
+ */
+
+ if (tsdPtr->restrictWinPtr) {
+ targetWinPtr = tsdPtr->restrictWinPtr;
+ } else if (tsdPtr->grabWinPtr && !winPtr) {
+ targetWinPtr = tsdPtr->grabWinPtr;
+ } else {
+ targetWinPtr = winPtr;
+ }
+
+ /*
+ * If we still have a target window, send the event.
+ */
+
+ if (winPtr != NULL) {
+ InitializeEvent(&event, targetWinPtr, type, x, y,
+ tsdPtr->lastState, b);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ /*
+ * Update the state for the next iteration.
+ */
+
+ tsdPtr->lastState = (type == ButtonPress)
+ ? (tsdPtr->lastState | mask) : (tsdPtr->lastState & ~mask);
+ tsdPtr->lastPos = pos;
+ }
+ }
+
+ /*
+ * Make sure the cursor window is up to date.
+ */
+
+ if (tsdPtr->restrictWinPtr) {
+ targetWinPtr = tsdPtr->restrictWinPtr;
+ } else if (tsdPtr->grabWinPtr) {
+ targetWinPtr = (TkPositionInTree(winPtr, tsdPtr->grabWinPtr)
+ == TK_GRAB_IN_TREE) ? winPtr : tsdPtr->grabWinPtr;
+ } else {
+ targetWinPtr = winPtr;
+ }
+ UpdateCursor(targetWinPtr);
+
+ /*
+ * If no other events caused the position to be updated,
+ * generate a motion event.
+ */
+
+ if (tsdPtr->lastPos.x != pos.x || tsdPtr->lastPos.y != pos.y) {
+ if (tsdPtr->restrictWinPtr) {
+ targetWinPtr = tsdPtr->restrictWinPtr;
+ } else if (tsdPtr->grabWinPtr && !winPtr) {
+ targetWinPtr = tsdPtr->grabWinPtr;
+ }
+
+ if (targetWinPtr != NULL) {
+ InitializeEvent(&event, targetWinPtr, MotionNotify, x, y,
+ tsdPtr->lastState, NotifyNormal);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+ tsdPtr->lastPos = pos;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGrabPointer --
+ *
+ * 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;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ display->request++;
+ tsdPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window);
+ tsdPtr->restrictWinPtr = NULL;
+ TkpSetCapture(tsdPtr->grabWinPtr);
+ if (TkPositionInTree(tsdPtr->lastWinPtr, tsdPtr->grabWinPtr)
+ != TK_GRAB_IN_TREE) {
+ UpdateCursor(tsdPtr->grabWinPtr);
+ }
+ return GrabSuccess;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUngrabPointer --
+ *
+ * Release the current grab.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases the mouse capture.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XUngrabPointer(display, time)
+ Display* display;
+ Time time;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ display->request++;
+ tsdPtr->grabWinPtr = NULL;
+ tsdPtr->restrictWinPtr = NULL;
+ TkpSetCapture(NULL);
+ UpdateCursor(tsdPtr->lastWinPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerDeadWindow --
+ *
+ * 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;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr == tsdPtr->lastWinPtr) {
+ tsdPtr->lastWinPtr = NULL;
+ }
+ if (winPtr == tsdPtr->grabWinPtr) {
+ tsdPtr->grabWinPtr = NULL;
+ }
+ if (winPtr == tsdPtr->restrictWinPtr) {
+ tsdPtr->restrictWinPtr = NULL;
+ }
+ if (!(tsdPtr->restrictWinPtr || tsdPtr->grabWinPtr)) {
+ TkpSetCapture(NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * A window inherits its cursor from its parent if it doesn't
+ * have one of its own. Top level windows inherit the default
+ * cursor.
+ */
+
+ tsdPtr->cursorWinPtr = winPtr;
+ while (winPtr != NULL) {
+ if (winPtr->atts.cursor != None) {
+ cursor = winPtr->atts.cursor;
+ break;
+ } else if (winPtr->flags & TK_TOP_HIERARCHY) {
+ 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);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->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/tcl/generic/tkPort.h b/tcl/generic/tkPort.h
new file mode 100644
index 00000000000..bf4b6e6e87e
--- /dev/null
+++ b/tcl/generic/tkPort.h
@@ -0,0 +1,38 @@
+/*
+ * 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"
+# elif defined(MAC_OSX_TK)
+# include "../macosx/tkMacOSXPort.h"
+# else
+# include "../unix/tkUnixPort.h"
+# endif
+#endif
+
+#endif /* _TKPORT */
diff --git a/tcl/generic/tkRectOval.c b/tcl/generic/tkRectOval.c
new file mode 100644
index 00000000000..7fb0c1e3f8f
--- /dev/null
+++ b/tcl/generic/tkRectOval.c
@@ -0,0 +1,1391 @@
+/*
+ * tkRectOval.c --
+ *
+ * This file implements rectangle and oval items for canvas
+ * widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tk.h"
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.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. */
+ Tk_Outline outline; /* Outline 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. */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Color for filling rectangle/oval. */
+ XColor *activeFillColor; /* Color for filling rectangle/oval if state is active. */
+ XColor *disabledFillColor; /* Color for filling rectangle/oval if state is disabled. */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling item if state is active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling item if state is disabled. */
+ GC fillGC; /* Graphics context for filling item. */
+} RectOvalItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption dashOption = {
+ (Tk_OptionParseProc *) TkCanvasDashParseProc,
+ TkCanvasDashPrintProc, (ClientData) NULL
+};
+static Tk_CustomOption offsetOption = {
+ (Tk_OptionParseProc *) TkOffsetParseProc,
+ TkOffsetPrintProc, (ClientData) TK_OFFSET_RELATIVE
+};
+static Tk_CustomOption pixelOption = {
+ (Tk_OptionParseProc *) TkPixelParseProc,
+ TkPixelPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, activeFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.activeColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, activeFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(RectOvalItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(RectOvalItem, outline.offset),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, disabledFillColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledoutline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, disabledFillStipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-disabledwidth", (char *) NULL, (char *) NULL,
+ "0.0", Tk_Offset(RectOvalItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(RectOvalItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(RectOvalItem, outline.color), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL,
+ "0,0", Tk_Offset(RectOvalItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, outline.stipple),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(Tk_Item, state),TK_CONFIG_NULL_OK,
+ &stateOption},
+ {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_CUSTOM, "-width", (char *) NULL, (char *) NULL,
+ "1.0", Tk_Offset(RectOvalItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {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 objc,
+ Tcl_Obj *CONST objv[], int flags));
+static int CreateRectOval _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+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 objc,
+ Tcl_Obj *CONST objv[]));
+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 */
+ TK_CONFIG_OBJS, /* flags */
+ 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 */
+ TK_CONFIG_OBJS, /* flags */
+ 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
+ * the interp's result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new rectangle or oval item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateRectOval(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of arguments in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ int i = 4;
+
+
+ if (objc == 1) {
+ i = 1;
+ } else if (objc > 1) {
+ char *arg = Tcl_GetString(objv[1]);
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+
+ if (objc < i) {
+ 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.
+ */
+
+ Tk_CreateOutline(&(rectOvalPtr->outline));
+ rectOvalPtr->tsoffset.flags = 0;
+ rectOvalPtr->tsoffset.xoffset = 0;
+ rectOvalPtr->tsoffset.yoffset = 0;
+ rectOvalPtr->fillColor = NULL;
+ rectOvalPtr->activeFillColor = NULL;
+ rectOvalPtr->disabledFillColor = NULL;
+ rectOvalPtr->fillStipple = None;
+ rectOvalPtr->activeFillStipple = None;
+ rectOvalPtr->disabledFillStipple = None;
+ rectOvalPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((RectOvalCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureRectOval(interp, canvas, itemPtr, objc-i, objv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteRectOval(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectOvalCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on rectangles and ovals. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+RectOvalCoords(interp, canvas, itemPtr, objc, objv)
+ 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 objc; /* Number of coordinates supplied in
+ * objv. */
+ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[2]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ } else if ((objc == 1)||(objc == 4)) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 4) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &rectOvalPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &rectOvalPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2],
+ &rectOvalPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3],
+ &rectOvalPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+ } else {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureRectOval --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a rectangle or oval item, such as its border and
+ * background colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureRectOval(interp, canvas, itemPtr, objc, objv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* 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;
+ Tk_TSOffset *tsoffset;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (CONST char **) objv, (char *) rectOvalPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+ state = itemPtr->state;
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ if (rectOvalPtr->outline.activeWidth > rectOvalPtr->outline.width ||
+ rectOvalPtr->outline.activeDash.number != 0 ||
+ rectOvalPtr->outline.activeColor != NULL ||
+ rectOvalPtr->outline.activeStipple != None ||
+ rectOvalPtr->activeFillColor != NULL ||
+ rectOvalPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ tsoffset = &rectOvalPtr->outline.tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((rectOvalPtr->bbox[0]+rectOvalPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((rectOvalPtr->bbox[1]+rectOvalPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[2] + 0.5);
+ }
+
+ /*
+ * Configure the outline graphics context. If mask is non-zero,
+ * the gc has changed and must be reallocated, provided that the
+ * new settings specify a valid outline (non-zero width and non-NULL
+ * color)
+ */
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr,
+ &(rectOvalPtr->outline));
+ if (mask && \
+ rectOvalPtr->outline.width != 0 && \
+ rectOvalPtr->outline.color != NULL) {
+ gcValues.cap_style = CapProjecting;
+ mask |= GCCapStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (rectOvalPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->outline.gc);
+ }
+ rectOvalPtr->outline.gc = newGC;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+ return TCL_OK;
+ }
+
+ color = rectOvalPtr->fillColor;
+ stipple = rectOvalPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (rectOvalPtr->activeFillColor!=NULL) {
+ color = rectOvalPtr->activeFillColor;
+ }
+ if (rectOvalPtr->activeFillStipple!=None) {
+ stipple = rectOvalPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (rectOvalPtr->disabledFillColor!=NULL) {
+ color = rectOvalPtr->disabledFillColor;
+ }
+ if (rectOvalPtr->disabledFillStipple!=None) {
+ stipple = rectOvalPtr->disabledFillStipple;
+ }
+ }
+
+ if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask = GCForeground|GCStipple|GCFillStyle;
+ } else {
+ mask = GCForeground;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (rectOvalPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->fillGC);
+ }
+ rectOvalPtr->fillGC = newGC;
+
+ tsoffset = &rectOvalPtr->tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((rectOvalPtr->bbox[0]+rectOvalPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((rectOvalPtr->bbox[1]+rectOvalPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[3] + 0.5);
+ }
+
+ 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;
+
+ Tk_DeleteOutline(display, &(rectOvalPtr->outline));
+ if (rectOvalPtr->fillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->fillColor);
+ }
+ if (rectOvalPtr->activeFillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->activeFillColor);
+ }
+ if (rectOvalPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->disabledFillColor);
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->fillStipple);
+ }
+ if (rectOvalPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->activeFillStipple);
+ }
+ if (rectOvalPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->disabledFillStipple);
+ }
+ 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, width;
+ Tk_State state = rectOvalPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = rectOvalPtr->outline.width;
+ if (state==TK_STATE_HIDDEN) {
+ rectOvalPtr->header.x1 = rectOvalPtr->header.y1 =
+ rectOvalPtr->header.x2 = rectOvalPtr->header.y2 = -1;
+ return;
+ }
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)rectOvalPtr) {
+ if (rectOvalPtr->outline.activeWidth>width) {
+ width = rectOvalPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (rectOvalPtr->outline.disabledWidth>0) {
+ width = rectOvalPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * 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->outline.gc == None) {
+ /*
+ * The Win32 switch was added for 8.3 to solve a problem
+ * with ovals leaving traces on bottom and right of 1 pixel.
+ * This may not be the correct place to solve it, but it works.
+ */
+#ifdef __WIN32__
+ bloat = 1;
+#else
+ bloat = 0;
+#endif
+ } else {
+ bloat = (int) (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;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+
+ /*
+ * 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(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ fillStipple = rectOvalPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)rectOvalPtr) {
+ if (rectOvalPtr->activeFillStipple!=None) {
+ fillStipple = rectOvalPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (rectOvalPtr->disabledFillStipple!=None) {
+ fillStipple = rectOvalPtr->disabledFillStipple;
+ }
+ }
+
+ if (rectOvalPtr->fillGC != None) {
+ if (fillStipple != None) {
+ Tk_TSOffset *tsoffset;
+ int w=0; int h=0;
+ tsoffset = &rectOvalPtr->tsoffset;
+ if (tsoffset) {
+ int flags = tsoffset->flags;
+ if (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE)) {
+ Tk_SizeOfBitmap(display, fillStipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ }
+ Tk_CanvasSetOffset(canvas, rectOvalPtr->fillGC, tsoffset);
+ if (tsoffset) {
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ }
+ 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 (fillStipple != None) {
+ XSetTSOrigin(display, rectOvalPtr->fillGC, 0, 0);
+ }
+ }
+ if (rectOvalPtr->outline.gc != None) {
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(rectOvalPtr->outline));
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ XDrawRectangle(display, drawable, rectOvalPtr->outline.gc,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1));
+ } else {
+ XDrawArc(display, drawable, rectOvalPtr->outline.gc,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1), 0, 360*64);
+ }
+ Tk_ResetOutlineGC(canvas, itemPtr, &(rectOvalPtr->outline));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = rectPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (rectPtr->outline.activeWidth>width) {
+ width = rectPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (rectPtr->outline.disabledWidth>0) {
+ width = rectPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * 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->outline.gc != None) {
+ inc = 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->outline.gc == 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 -= 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;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = (double) ovalPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (ovalPtr->outline.activeWidth>width) {
+ width = (double) ovalPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (ovalPtr->outline.disabledWidth>0) {
+ width = (double) ovalPtr->outline.disabledWidth;
+ }
+ }
+
+
+ filled = ovalPtr->fillGC != None;
+ if (ovalPtr->outline.gc == 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;
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = rectPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (rectPtr->outline.activeWidth>width) {
+ width = rectPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (rectPtr->outline.disabledWidth>0) {
+ width = rectPtr->outline.disabledWidth;
+ }
+ }
+
+ halfWidth = width/2.0;
+ if (rectPtr->outline.gc == 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->outline.gc != 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;
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+
+ width = ovalPtr->outline.width;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (ovalPtr->outline.activeWidth>width) {
+ width = ovalPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (ovalPtr->outline.disabledWidth>0) {
+ width = ovalPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * Expand the oval to include the width of the outline, if any.
+ */
+
+ halfWidth = width/2.0;
+ if (ovalPtr->outline.gc == 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->outline.gc != None)
+ && (ovalPtr->fillGC == None)) {
+ double centerX, centerY, 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 the interp's result, replacing whatever used to be there.
+ * If no error occurs, then Postscript for the rectangle is
+ * appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+RectOvalToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ char pathCmd[500];
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ double y1, y2;
+ XColor *color;
+ XColor *fillColor;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+
+ 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);
+ }
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
+ color = rectOvalPtr->outline.color;
+ fillColor = rectOvalPtr->fillColor;
+ fillStipple = rectOvalPtr->fillStipple;
+ if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) {
+ if (rectOvalPtr->outline.activeColor!=NULL) {
+ color = rectOvalPtr->outline.activeColor;
+ }
+ if (rectOvalPtr->activeFillColor!=NULL) {
+ fillColor = rectOvalPtr->activeFillColor;
+ }
+ if (rectOvalPtr->activeFillStipple!=None) {
+ fillStipple = rectOvalPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (rectOvalPtr->outline.disabledColor!=NULL) {
+ color = rectOvalPtr->outline.disabledColor;
+ }
+ if (rectOvalPtr->disabledFillColor!=NULL) {
+ fillColor = rectOvalPtr->disabledFillColor;
+ }
+ if (rectOvalPtr->disabledFillStipple!=None) {
+ fillStipple = rectOvalPtr->disabledFillStipple;
+ }
+ }
+
+ /*
+ * First draw the filled area of the rectangle.
+ */
+
+ if (fillColor != NULL) {
+ Tcl_AppendResult(interp, pathCmd, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, fillColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (color != 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 (color != NULL) {
+ Tcl_AppendResult(interp, pathCmd, "0 setlinejoin 2 setlinecap\n",
+ (char *) NULL);
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &(rectOvalPtr->outline))!= TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tcl/generic/tkScale.c b/tcl/generic/tkScale.c
new file mode 100644
index 00000000000..0b260726af1
--- /dev/null
+++ b/tcl/generic/tkScale.c
@@ -0,0 +1,1435 @@
+/*
+ * 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-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 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 "default.h"
+#include "tkInt.h"
+#include "tclMath.h"
+#include "tkScale.h"
+
+/*
+ * The following table defines the legal values for the -orient option.
+ * It is used together with the "enum orient" declaration in tkScale.h.
+ */
+
+static char *orientStrings[] = {
+ "horizontal", "vertical", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -state option.
+ * It is used together with the "enum state" declaration in tkScale.h.
+ */
+
+static char *stateStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
+
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCALE_ACTIVE_BG_COLOR, -1, Tk_Offset(TkScale, activeBorder),
+ 0, (ClientData) DEF_SCALE_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_SCALE_BG_COLOR, -1, Tk_Offset(TkScale, bgBorder),
+ 0, (ClientData) DEF_SCALE_BG_MONO, 0},
+ {TK_OPTION_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement",
+ DEF_SCALE_BIG_INCREMENT, -1, Tk_Offset(TkScale, bigIncrement),
+ 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_SCALE_BORDER_WIDTH, -1, Tk_Offset(TkScale, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_SCALE_COMMAND, -1, Tk_Offset(TkScale, command),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_SCALE_CURSOR, -1, Tk_Offset(TkScale, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-digits", "digits", "Digits",
+ DEF_SCALE_DIGITS, -1, Tk_Offset(TkScale, digits),
+ 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_SCALE_FONT, -1, Tk_Offset(TkScale, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_SCALE_FG_COLOR, -1, Tk_Offset(TkScale, textColorPtr), 0,
+ (ClientData) DEF_SCALE_FG_MONO, 0},
+ {TK_OPTION_DOUBLE, "-from", "from", "From", DEF_SCALE_FROM, -1,
+ Tk_Offset(TkScale, fromValue), 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkScale, highlightBorder),
+ 0, (ClientData) DEF_SCALE_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_SCALE_HIGHLIGHT, -1, Tk_Offset(TkScale, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_SCALE_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(TkScale, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-label", "label", "Label",
+ DEF_SCALE_LABEL, -1, Tk_Offset(TkScale, label),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-length", "length", "Length",
+ DEF_SCALE_LENGTH, -1, Tk_Offset(TkScale, length), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",
+ DEF_SCALE_ORIENT, -1, Tk_Offset(TkScale, orient),
+ 0, (ClientData) orientStrings, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_SCALE_RELIEF, -1, Tk_Offset(TkScale, relief), 0, 0, 0},
+ {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SCALE_REPEAT_DELAY, -1, Tk_Offset(TkScale, repeatDelay),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SCALE_REPEAT_INTERVAL, -1, Tk_Offset(TkScale, repeatInterval),
+ 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-resolution", "resolution", "Resolution",
+ DEF_SCALE_RESOLUTION, -1, Tk_Offset(TkScale, resolution),
+ 0, 0, 0},
+ {TK_OPTION_BOOLEAN, "-showvalue", "showValue", "ShowValue",
+ DEF_SCALE_SHOW_VALUE, -1, Tk_Offset(TkScale, showValue),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-sliderlength", "sliderLength", "SliderLength",
+ DEF_SCALE_SLIDER_LENGTH, -1, Tk_Offset(TkScale, sliderLength),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief",
+ DEF_SCALE_SLIDER_RELIEF, -1, Tk_Offset(TkScale, sliderRelief),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_SCALE_STATE, -1, Tk_Offset(TkScale, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-tickinterval", "tickInterval", "TickInterval",
+ DEF_SCALE_TICK_INTERVAL, -1, Tk_Offset(TkScale, tickInterval),
+ 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-to", "to", "To",
+ DEF_SCALE_TO, -1, Tk_Offset(TkScale, toValue), 0, 0, 0},
+ {TK_OPTION_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCALE_TROUGH_COLOR, -1, Tk_Offset(TkScale, troughColorPtr),
+ 0, (ClientData) DEF_SCALE_TROUGH_MONO, 0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_SCALE_WIDTH, -1, Tk_Offset(TkScale, width), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following tables define the scale widget commands and map the
+ * indexes into the string tables into a single enumerated type used
+ * to dispatch the scale widget command.
+ */
+
+static CONST char *commandNames[] = {
+ "cget", "configure", "coords", "get", "identify", "set", (char *) NULL
+};
+
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_COORDS, COMMAND_GET,
+ COMMAND_IDENTIFY, COMMAND_SET
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ComputeFormat _ANSI_ARGS_((TkScale *scalePtr));
+static void ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr));
+static int ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp,
+ TkScale *scalePtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static void DestroyScale _ANSI_ARGS_((char *memPtr));
+static void ScaleCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ScaleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static char * ScaleVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static int ScaleWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void ScaleWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static void ScaleSetVariable _ANSI_ARGS_((TkScale *scalePtr));
+
+/*
+ * The structure below defines scale class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs scaleClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ ScaleWorldChanged, /* worldChangedProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ScaleObjCmd --
+ *
+ * This procedure is invoked to process the "scale" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ScaleObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ register TkScale *scalePtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already
+ * been created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ Tk_SetClass(tkwin, "Scale");
+ scalePtr = TkpCreateScale(tkwin);
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureScale,
+ * or which ConfigureScale expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ scalePtr->tkwin = tkwin;
+ scalePtr->display = Tk_Display(tkwin);
+ scalePtr->interp = interp;
+ scalePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd,
+ (ClientData) scalePtr, ScaleCmdDeletedProc);
+ scalePtr->optionTable = optionTable;
+ scalePtr->orient = ORIENT_VERTICAL;
+ scalePtr->width = 0;
+ scalePtr->length = 0;
+ scalePtr->value = 0.0;
+ scalePtr->varNamePtr = NULL;
+ scalePtr->fromValue = 0.0;
+ scalePtr->toValue = 0.0;
+ scalePtr->tickInterval = 0.0;
+ scalePtr->resolution = 1.0;
+ scalePtr->digits = 0;
+ scalePtr->bigIncrement = 0.0;
+ scalePtr->command = NULL;
+ scalePtr->repeatDelay = 0;
+ scalePtr->repeatInterval = 0;
+ scalePtr->label = NULL;
+ scalePtr->labelLength = 0;
+ scalePtr->state = STATE_NORMAL;
+ scalePtr->borderWidth = 0;
+ scalePtr->bgBorder = NULL;
+ scalePtr->activeBorder = NULL;
+ scalePtr->sliderRelief = TK_RELIEF_RAISED;
+ scalePtr->troughColorPtr = NULL;
+ scalePtr->troughGC = None;
+ scalePtr->copyGC = None;
+ scalePtr->tkfont = NULL;
+ scalePtr->textColorPtr = NULL;
+ scalePtr->textGC = None;
+ scalePtr->relief = TK_RELIEF_FLAT;
+ scalePtr->highlightWidth = 0;
+ scalePtr->highlightBorder = NULL;
+ scalePtr->highlightColorPtr = NULL;
+ scalePtr->inset = 0;
+ scalePtr->sliderLength = 0;
+ scalePtr->showValue = 0;
+ scalePtr->horizLabelY = 0;
+ scalePtr->horizValueY = 0;
+ scalePtr->horizTroughY = 0;
+ scalePtr->horizTickY = 0;
+ scalePtr->vertTickRightX = 0;
+ scalePtr->vertValueRightX = 0;
+ scalePtr->vertTroughX = 0;
+ scalePtr->vertLabelX = 0;
+ scalePtr->fontHeight = 0;
+ scalePtr->cursor = None;
+ scalePtr->takeFocusPtr = NULL;
+ scalePtr->flags = NEVER_SET;
+
+ Tk_SetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr);
+ Tk_CreateEventHandler(scalePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ScaleEventProc, (ClientData) scalePtr);
+
+ if ((Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin)
+ != TCL_OK) ||
+ (ConfigureScale(interp, scalePtr, objc - 2, objv + 2) != TCL_OK)) {
+ Tk_DestroyWindow(scalePtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(scalePtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWidgetObjCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScaleWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about scale
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+ Tcl_Obj *objPtr;
+ int index, result;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
+ "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve((ClientData) scalePtr);
+
+ switch (index) {
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) scalePtr,
+ scalePtr->optionTable, objv[2], scalePtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+ case COMMAND_CONFIGURE: {
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr,
+ scalePtr->optionTable,
+ (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
+ scalePtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureScale(interp, scalePtr, objc-2, objv+2);
+ }
+ break;
+ }
+ case COMMAND_COORDS: {
+ int x, y ;
+ double value;
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
+ goto error;
+ }
+ if (objc == 3) {
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &value)
+ != TCL_OK) {
+ goto error;
+ }
+ } else {
+ value = scalePtr->value;
+ }
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ x = scalePtr->vertTroughX + scalePtr->width/2
+ + scalePtr->borderWidth;
+ y = TkScaleValueToPixel(scalePtr, value);
+ } else {
+ x = TkScaleValueToPixel(scalePtr, value);
+ y = scalePtr->horizTroughY + scalePtr->width/2
+ + scalePtr->borderWidth;
+ }
+ sprintf(buf, "%d %d", x, y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case COMMAND_GET: {
+ double value;
+ int x, y;
+ char buf[TCL_DOUBLE_SPACE];
+
+ if ((objc != 2) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?");
+ goto error;
+ }
+ if (objc == 2) {
+ value = scalePtr->value;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y)
+ != TCL_OK)) {
+ goto error;
+ }
+ value = TkScalePixelToValue(scalePtr, x, y);
+ }
+ sprintf(buf, scalePtr->format, value);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case COMMAND_IDENTIFY: {
+ int x, y, thing;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "identify x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ thing = TkpScaleElement(scalePtr, x,y);
+ switch (thing) {
+ case TROUGH1:
+ Tcl_SetResult(interp, "trough1", TCL_STATIC);
+ break;
+ case SLIDER:
+ Tcl_SetResult(interp, "slider", TCL_STATIC);
+ break;
+ case TROUGH2:
+ Tcl_SetResult(interp, "trough2", TCL_STATIC);
+ break;
+ }
+ break;
+ }
+ case COMMAND_SET: {
+ double value;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "set value");
+ goto error;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
+ goto error;
+ }
+ if (scalePtr->state != STATE_DISABLED) {
+ TkScaleSetValue(scalePtr, value, 1, 1);
+ }
+ break;
+ }
+ }
+ 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;
+
+ scalePtr->flags |= SCALE_DELETED;
+
+ Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);
+ if (scalePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, (ClientData) scalePtr);
+ }
+ if (scalePtr->troughGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
+ }
+ if (scalePtr->copyGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->copyGC);
+ }
+ if (scalePtr->textGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->textGC);
+ }
+ Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable,
+ scalePtr->tkwin);
+ scalePtr->tkwin = NULL;
+ TkpDestroyScale(scalePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureScale --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a scale widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for scalePtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureScale(interp, scalePtr, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkScale *scalePtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc; /* Number of valid entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error;
+ double oldValue = scalePtr->value;
+
+ /*
+ * Eliminate any existing trace on a variable monitored by the scale.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, (ClientData) scalePtr);
+ }
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) scalePtr,
+ scalePtr->optionTable, objc, objv,
+ scalePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * If the scale is tied to the value of a variable, then set
+ * the scale's value from the value of the variable, if it exists
+ * and it holds a valid double value.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ double value;
+ Tcl_Obj *valuePtr;
+
+ valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ if ((valuePtr != NULL) &&
+ (Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) {
+ scalePtr->value = TkRoundToResolution(scalePtr, value);
+ }
+ }
+
+ /*
+ * Several options need special processing, such as parsing the
+ * orientation and creating GCs.
+ */
+
+ scalePtr->fromValue = TkRoundToResolution(scalePtr,
+ scalePtr->fromValue);
+ scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
+ scalePtr->tickInterval = TkRoundToResolution(scalePtr,
+ scalePtr->tickInterval);
+
+ /*
+ * Make sure that the tick interval has the right sign so that
+ * addition moves from fromValue to toValue.
+ */
+
+ if ((scalePtr->tickInterval < 0)
+ ^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) {
+ scalePtr->tickInterval = -scalePtr->tickInterval;
+ }
+
+ ComputeFormat(scalePtr);
+
+ scalePtr->labelLength = scalePtr->label ? strlen(scalePtr->label) : 0;
+
+ Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);
+
+ if (scalePtr->highlightWidth < 0) {
+ scalePtr->highlightWidth = 0;
+ }
+ scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * 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. We don't set the var here because we need to make
+ * special checks for possibly changed varNamePtr.
+ */
+
+ TkScaleSetValue(scalePtr, scalePtr->value, 0, 1);
+
+ /*
+ * Reestablish the variable trace, if it is needed.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_Obj *valuePtr;
+
+ /*
+ * Set the associated variable only when the new value differs
+ * from the current value, or the variable doesn't yet exist
+ */
+ valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ if ((valuePtr == NULL) || (scalePtr->value != oldValue)
+ || (Tcl_GetDoubleFromObj(NULL, valuePtr, &oldValue) != TCL_OK)
+ || (scalePtr->value != oldValue)) {
+ ScaleSetVariable(scalePtr);
+ }
+ Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, (ClientData) scalePtr);
+ }
+
+ ScaleWorldChanged((ClientData) scalePtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ScaleWorldChanged --
+ *
+ * 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_GetGC(scalePtr->tkwin, GCForeground, &gcValues);
+ 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_GetGC(scalePtr->tkwin, GCForeground | GCFont, &gcValues);
+ 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;
+
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ scalePtr->fontHeight = fm.linespace + SPACING;
+
+ /*
+ * 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.
+ */
+
+ if (scalePtr->orient == ORIENT_HORIZONTAL) {
+ y = scalePtr->inset;
+ extraSpace = 0;
+ if (scalePtr->labelLength != 0) {
+ scalePtr->horizLabelY = y + SPACING;
+ y += scalePtr->fontHeight;
+ extraSpace = SPACING;
+ }
+ if (scalePtr->showValue) {
+ scalePtr->horizValueY = y + SPACING;
+ y += scalePtr->fontHeight;
+ 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 += scalePtr->fontHeight + 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) {
+ DestroyScale((char *) clientData);
+ } 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 (!(scalePtr->flags & SCALE_DELETED)) {
+ scalePtr->flags |= SCALE_DELETED;
+ 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_PENDING)) {
+ scalePtr->flags |= REDRAW_PENDING;
+ 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, tick;
+
+ if (scalePtr->resolution <= 0) {
+ return value;
+ }
+ tick = floor(value/scalePtr->resolution);
+ new = scalePtr->resolution * tick;
+ rem = value - new;
+ if (rem < 0) {
+ if (rem <= -scalePtr->resolution/2) {
+ new = (tick - 1.0) * scalePtr->resolution;
+ }
+ } else {
+ if (rem >= scalePtr->resolution/2) {
+ new = (tick + 1.0) * 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. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register TkScale *scalePtr = (TkScale *) clientData;
+ char *resultStr;
+ double value;
+ Tcl_Obj *valuePtr;
+ int result;
+
+ /*
+ * 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, Tcl_GetString(scalePtr->varNamePtr),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, clientData);
+ scalePtr->flags |= NEVER_SET;
+ TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
+ }
+ return (char *) NULL;
+ }
+
+ /*
+ * If we came here because we updated the variable (in TkScaleSetValue),
+ * then ignore the trace. Otherwise update the scale with the value
+ * of the variable.
+ */
+
+ if (scalePtr->flags & SETTING_VAR) {
+ return (char *) NULL;
+ }
+ resultStr = NULL;
+ valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ result = Tcl_GetDoubleFromObj(interp, valuePtr, &value);
+ if (result != TCL_OK) {
+ resultStr = "can't assign non-numeric value to scale variable";
+ ScaleSetVariable(scalePtr);
+ } else {
+ scalePtr->value = TkRoundToResolution(scalePtr, value);
+
+ /*
+ * This code is a bit tricky because it sets the scale's value before
+ * calling TkScaleSetValue. This way, TkScaleSetValue 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.
+ */
+
+ TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
+ }
+ TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
+
+ return resultStr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkScaleSetValue --
+ *
+ * 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
+TkScaleSetValue(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. */
+{
+ 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->varNamePtr) {
+ ScaleSetVariable(scalePtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleSetVariable --
+ *
+ * This procedure sets the variable associated with a scale, if any.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Other write traces on the variable will trigger.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleSetVariable(scalePtr)
+ register TkScale *scalePtr; /* Info about widget. */
+{
+ if (scalePtr->varNamePtr != NULL) {
+ char string[PRINT_CHARS];
+ sprintf(string, scalePtr->format, scalePtr->value);
+ scalePtr->flags |= SETTING_VAR;
+ Tcl_ObjSetVar2(scalePtr->interp, scalePtr->varNamePtr, NULL,
+ Tcl_NewStringObj(string, -1), TCL_GLOBAL_ONLY);
+ scalePtr->flags &= ~SETTING_VAR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkScalePixelToValue --
+ *
+ * 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
+TkScalePixelToValue(scalePtr, x, y)
+ register TkScale *scalePtr; /* Information about widget. */
+ int x, y; /* Coordinates of point within
+ * window. */
+{
+ double value, pixelRange;
+
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength
+ - 2*scalePtr->inset - 2*scalePtr->borderWidth;
+ value = y;
+ } else {
+ pixelRange = Tk_Width(scalePtr->tkwin) - scalePtr->sliderLength
+ - 2*scalePtr->inset - 2*scalePtr->borderWidth;
+ value = x;
+ }
+
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkScaleValueToPixel --
+ *
+ * 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
+TkScaleValueToPixel(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->orient == ORIENT_VERTICAL)
+ ? Tk_Height(scalePtr->tkwin) : Tk_Width(scalePtr->tkwin))
+ - scalePtr->sliderLength - 2*scalePtr->inset - 2*scalePtr->borderWidth;
+ if (valueRange == 0) {
+ y = 0;
+ } else {
+ y = (int) ((value - scalePtr->fromValue) * pixelRange
+ / valueRange + 0.5);
+ if (y < 0) {
+ y = 0;
+ } else if (y > pixelRange) {
+ y = pixelRange;
+ }
+ }
+ y += scalePtr->sliderLength/2 + scalePtr->inset + scalePtr->borderWidth;
+ return y;
+}
diff --git a/tcl/generic/tkScale.h b/tcl/generic/tkScale.h
new file mode 100644
index 00000000000..972e571fda3
--- /dev/null
+++ b/tcl/generic/tkScale.h
@@ -0,0 +1,256 @@
+/*
+ * tkScale.h --
+ *
+ * Declarations of types and functions used to implement
+ * the scale widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1999-2000 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 _TKSCALE
+#define _TKSCALE
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Legal values for the "orient" field of TkScale records.
+ */
+
+enum orient {
+ ORIENT_HORIZONTAL, ORIENT_VERTICAL
+};
+
+/*
+ * Legal values for the "state" field of TkScale records.
+ */
+
+enum state {
+ STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
+};
+
+/*
+ * A data structure of the following type is kept for each scale
+ * widget managed by this file:
+ */
+
+typedef struct TkScale {
+ Tk_Window tkwin; /* Window that embodies the scale. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with scale. */
+ Tcl_Command widgetCmd; /* Token for scale's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ enum orient orient; /* Orientation for window (vertical or
+ * horizontal). */
+ int width; /* Desired narrow dimension of scale,
+ * in pixels. */
+ int length; /* Desired long dimension of scale,
+ * in pixels. */
+ double value; /* Current value of scale. */
+ Tcl_Obj *varNamePtr; /* Name of variable or NULL.
+ * If non-NULL, scale's value tracks
+ * the contents of this variable and
+ * vice versa. */
+ double fromValue; /* Value corresponding to left or top of
+ * scale. */
+ double toValue; /* Value corresponding to right or bottom
+ * of scale. */
+ double tickInterval; /* Distance between tick marks;
+ * 0 means don't display any tick marks. */
+ double resolution; /* If > 0, all values are rounded to an
+ * even multiple of this value. */
+ int digits; /* Number of significant digits to print
+ * in values. 0 means we get to choose the
+ * number based on resolution and/or the
+ * range of the scale. */
+ char format[10]; /* Sprintf conversion specifier computed from
+ * digits and other information. */
+ double bigIncrement; /* Amount to use for large increments to
+ * scale value. (0 means we pick a value). */
+ char *command; /* Command prefix to use when invoking Tcl
+ * commands because the scale value changed.
+ * NULL means don't invoke commands. */
+ int repeatDelay; /* How long to wait before auto-repeating
+ * on scrolling actions (in ms). */
+ int repeatInterval; /* Interval between autorepeats (in ms). */
+ char *label; /* Label to display above or to right of
+ * scale; NULL means don't display a label. */
+ int labelLength; /* Number of non-NULL chars. in label. */
+ enum state state; /* Values are active, normal, or disabled.
+ * Value of scale cannot be changed when
+ * disabled. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_3DBorder bgBorder; /* Used for drawing slider and other
+ * background areas. */
+ Tk_3DBorder activeBorder; /* For drawing the slider when active. */
+ int sliderRelief; /* Is slider to be drawn raised, sunken,
+ * etc. */
+ XColor *troughColorPtr; /* Color for drawing trough. */
+ GC troughGC; /* For drawing trough. */
+ GC copyGC; /* Used for copying from pixmap onto screen. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *textColorPtr; /* Color for drawing text. */
+ GC textGC; /* GC for drawing text in normal mode. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ Tk_3DBorder highlightBorder;/* Value of -highlightbackground option:
+ * specifies background with which to draw 3-D
+ * default ring and focus highlight area when
+ * highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ int sliderLength; /* Length of slider, measured in pixels along
+ * 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:
+ */
+
+ int fontHeight; /* Height of scale font. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. May be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkScale;
+
+/*
+ * Flag bits for scales:
+ *
+ * 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.
+ * REDRAW_PENDING - 1 means any sort of redraw is pending
+ * 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.
+ * SCALE_DELETED - 1 means the scale widget is being deleted
+ */
+
+#define REDRAW_SLIDER (1<<0)
+#define REDRAW_OTHER (1<<1)
+#define REDRAW_ALL (REDRAW_OTHER|REDRAW_SLIDER)
+#define REDRAW_PENDING (1<<2)
+#define ACTIVE (1<<3)
+#define INVOKE_COMMAND (1<<4)
+#define SETTING_VAR (1<<5)
+#define NEVER_SET (1<<6)
+#define GOT_FOCUS (1<<7)
+#define SCALE_DELETED (1<<8)
+
+/*
+ * 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 scale
+ * widget.
+ */
+
+EXTERN void TkEventuallyRedrawScale _ANSI_ARGS_((TkScale *scalePtr,
+ int what));
+EXTERN double TkRoundToResolution _ANSI_ARGS_((TkScale *scalePtr,
+ double value));
+EXTERN TkScale * TkpCreateScale _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void TkpDestroyScale _ANSI_ARGS_((TkScale *scalePtr));
+EXTERN void TkpDisplayScale _ANSI_ARGS_((ClientData clientData));
+EXTERN int TkpScaleElement _ANSI_ARGS_((TkScale *scalePtr,
+ int x, int y));
+EXTERN void TkScaleSetValue _ANSI_ARGS_((TkScale *scalePtr,
+ double value, int setVar, int invokeCommand));
+EXTERN double TkScalePixelToValue _ANSI_ARGS_((TkScale *scalePtr,
+ int x, int y));
+EXTERN int TkScaleValueToPixel _ANSI_ARGS_((TkScale *scalePtr,
+ double value));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKSCALE */
diff --git a/tcl/generic/tkScrollbar.c b/tcl/generic/tkScrollbar.c
new file mode 100644
index 00000000000..d07e5d0e455
--- /dev/null
+++ b/tcl/generic/tkScrollbar.c
@@ -0,0 +1,711 @@
+/*
+ * 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"
+
+/*
+ * Custom option for handling "-orient"
+ */
+
+static Tk_CustomOption orientOption = {
+ (Tk_OptionParseProc *) TkOrientParseProc,
+ TkOrientPrintProc,
+ (ClientData) NULL
+};
+
+/*
+ * 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_CUSTOM, "-orient", "orient", "Orient",
+ DEF_SCROLLBAR_ORIENT, Tk_Offset(TkScrollbar, vertical), 0,
+ &orientOption},
+ {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, CONST char **argv,
+ int flags));
+static void ScrollbarCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ScrollbarWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, CONST 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. */
+ CONST 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);
+
+ Tk_SetClassProcs(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->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;
+ }
+
+ Tcl_SetResult(interp, Tk_PathName(scrollPtr->tkwin), TCL_STATIC);
+ 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. */
+ CONST 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:
+ Tcl_SetResult(interp, "arrow1", TCL_STATIC);
+ break;
+ case SLIDER:
+ Tcl_SetResult(interp, "slider", TCL_STATIC);
+ break;
+ case BOTTOM_ARROW:
+ Tcl_SetResult(interp, "arrow2", TCL_STATIC);
+ break;
+ }
+ goto done;
+ }
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " activate element\"", (char *) NULL);
+ goto error;
+ }
+ 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;
+ char buf[TCL_DOUBLE_SPACE];
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delta xDelta yDelta\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK)
+ || (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(buf, "%g", fraction);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) {
+ int x, y, pos, length;
+ double fraction;
+ char buf[TCL_DOUBLE_SPACE];
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " fraction x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (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(buf, "%g", fraction);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get\"", (char *) NULL);
+ goto error;
+ }
+ if (scrollPtr->flags & NEW_STYLE_COMMANDS) {
+ char first[TCL_DOUBLE_SPACE], last[TCL_DOUBLE_SPACE];
+
+ Tcl_PrintDouble(interp, scrollPtr->firstFraction, first);
+ Tcl_PrintDouble(interp, scrollPtr->lastFraction, last);
+ Tcl_AppendResult(interp, first, " ", last, (char *) NULL);
+ } else {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", scrollPtr->totalUnits,
+ scrollPtr->windowUnits, scrollPtr->firstUnit,
+ scrollPtr->lastUnit);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
+ int x, y, thing;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " identify x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ thing = TkpScrollbarPosition(scrollPtr, x,y);
+ switch (thing) {
+ case TOP_ARROW:
+ Tcl_SetResult(interp, "arrow1", TCL_STATIC);
+ break;
+ case TOP_GAP:
+ Tcl_SetResult(interp, "trough1", TCL_STATIC);
+ break;
+ case SLIDER:
+ Tcl_SetResult(interp, "slider", TCL_STATIC);
+ break;
+ case BOTTOM_GAP:
+ Tcl_SetResult(interp, "trough2", TCL_STATIC);
+ break;
+ case BOTTOM_ARROW:
+ Tcl_SetResult(interp, "arrow2", TCL_STATIC);
+ break;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
+ int totalUnits, windowUnits, firstUnit, lastUnit;
+
+ if (argc == 4) {
+ double first, last;
+
+ 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 the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for scrollPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ CONST char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ 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 setting the
+ * background from a 3-D border.
+ */
+
+ 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/tcl/generic/tkScrollbar.h b/tcl/generic/tkScrollbar.h
new file mode 100644
index 00000000000..84cb80a75e9
--- /dev/null
+++ b/tcl/generic/tkScrollbar.h
@@ -0,0 +1,206 @@
+/*
+ * 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. */
+ 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 Tk_ClassProcs 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/tcl/generic/tkSelect.c b/tcl/generic/tkSelect.c
new file mode 100644
index 00000000000..ea69a7ca90e
--- /dev/null
+++ b/tcl/generic/tkSelect.c
@@ -0,0 +1,1599 @@
+/*
+ * tkSelect.c --
+ *
+ * This file manages the selection for the Tk toolkit,
+ * translating between the standard X ICCCM conventions
+ * and Tcl commands.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+ int charOffset; /* The offset of the next char to retrieve. */
+ int byteOffset; /* The expected byte offset of the next
+ * chunk. */
+ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character
+ * that is split across chunks.*/
+ 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;
+
+/*
+ * The structure below is used to keep each thread's pending list
+ * separate.
+ */
+
+typedef struct ThreadSpecificData {
+ TkSelInProgress *pendingPtr;
+ /* Topmost search in progress, or
+ * NULL if none. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static int HandleTclCommand _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+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;
+ }
+
+ if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) {
+ /*
+ * If the user asked for a STRING handler and we understand
+ * UTF8_STRING, we implicitly create a UTF8_STRING handler for them.
+ */
+
+ target = winPtr->dispPtr->utf8Atom;
+ for (selPtr = winPtr->selHandlerList; ;
+ selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
+ selPtr->nextPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr;
+ selPtr->selection = selection;
+ selPtr->target = target;
+ selPtr->format = target; /* We want UTF8_STRING format */
+ selPtr->proc = proc;
+ if (selPtr->proc == HandleTclCommand) {
+ /*
+ * The clientData is selection controlled memory, so
+ * we should make a copy for this selPtr.
+ */
+ selPtr->clientData =
+ (ClientData) ckalloc(sizeof(clientData));
+ memcpy(selPtr->clientData, clientData, sizeof(clientData));
+ } else {
+ selPtr->clientData = clientData;
+ }
+ selPtr->size = 8;
+ break;
+ }
+ if ((selPtr->selection == selection)
+ && (selPtr->target == target)) {
+ /*
+ * Looks like we had a utf-8 target already. Leave it alone.
+ */
+
+ break;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the selection handler to be deleted, or return if it doesn't
+ * exist.
+ */
+
+ for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
+ 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 = tsdPtr->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 ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) {
+ /*
+ * If the user asked for a STRING handler and we understand
+ * UTF8_STRING, we may have implicitly created a UTF8_STRING handler
+ * for them. Look for it and delete it as necessary.
+ */
+ TkSelHandler *utf8selPtr;
+
+ target = winPtr->dispPtr->utf8Atom;
+ for (utf8selPtr = winPtr->selHandlerList; utf8selPtr != NULL;
+ utf8selPtr = utf8selPtr->nextPtr) {
+ if ((utf8selPtr->selection == selection)
+ && (utf8selPtr->target == target)) {
+ break;
+ }
+ }
+ if (utf8selPtr != NULL) {
+ if ((utf8selPtr->format == target)
+ && (utf8selPtr->proc == selPtr->proc)
+ && (utf8selPtr->size == selPtr->size)) {
+ /*
+ * This recursive call is OK, because we've
+ * changed the value of 'target'
+ */
+ Tk_DeleteSelHandler(tkwin, selection, target);
+ }
+ }
+ }
+
+ if (selPtr->proc == HandleTclCommand) {
+ /*
+ * Mark the CommandInfo as deleted and free it if we can.
+ */
+
+ ((CommandInfo*)selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
+ }
+ 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 the interp's result.
+ *
+ * Side effects:
+ * The standard X11 protocols are used to retrieve the
+ * selection. When it arrives, it is passed to proc. If
+ * the selection is very large, it will be passed to proc
+ * in several pieces. Proc should have the following
+ * structure:
+ *
+ * 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 the interp's 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ /*
+ * If the selection is owned by a window managed by this
+ * 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 = tsdPtr->pendingPtr;
+ tsdPtr->pendingPtr = &ip;
+ while (1) {
+ count = (selPtr->proc)(selPtr->clientData, offset, buffer,
+ TK_SEL_BYTES_AT_ONCE);
+ if ((count < 0) || (ip.selPtr == NULL)) {
+ tsdPtr->pendingPtr = ip.nextPtr;
+ goto cantget;
+ }
+ if (count > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ buffer[count] = '\0';
+ result = (*proc)(clientData, interp, buffer);
+ if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
+ || (ip.selPtr == NULL)) {
+ break;
+ }
+ offset += count;
+ }
+ tsdPtr->pendingPtr = ip.nextPtr;
+ }
+ return result;
+ }
+
+ /*
+ * The selection is owned by some other process.
+ */
+
+ 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_SelectionObjCmd --
+ *
+ * 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_SelectionObjCmd(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;
+ char *path = NULL;
+ Atom selection;
+ char *selName = NULL, *string;
+ int count, index;
+ Tcl_Obj **objs;
+ static CONST char *optionStrings[] = {
+ "clear", "get", "handle", "own", (char *) NULL
+ };
+ enum options { SELECTION_CLEAR, SELECTION_GET, SELECTION_HANDLE,
+ SELECTION_OWN };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case SELECTION_CLEAR: {
+ static CONST char *clearOptionStrings[] = {
+ "-displayof", "-selection", (char *) NULL
+ };
+ enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION };
+ int clearIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0], clearOptionStrings,
+ "option", 0, &clearIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum clearOptions) clearIndex) {
+ case CLEAR_DISPLAYOF:
+ path = Tcl_GetString(objs[1]);
+ break;
+ case CLEAR_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+ if (count == 1) {
+ path = Tcl_GetString(objs[0]);
+ } else if (count > 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options?");
+ 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);
+ break;
+ }
+
+ case SELECTION_GET: {
+ Atom target;
+ char *targetName = NULL;
+ Tcl_DString selBytes;
+ int result;
+ static CONST char *getOptionStrings[] = {
+ "-displayof", "-selection", "-type", (char *) NULL
+ };
+ enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE };
+ int getIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count>0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0], getOptionStrings,
+ "option", 0, &getIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum getOptions) getIndex) {
+ case GET_DISPLAYOF:
+ path = Tcl_GetString(objs[1]);
+ break;
+ case GET_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ case GET_TYPE:
+ targetName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+ 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_WrongNumArgs(interp, 2, objv, "?options?");
+ return TCL_ERROR;
+ } else if (count == 1) {
+ target = Tk_InternAtom(tkwin, Tcl_GetString(objs[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;
+ }
+
+ case SELECTION_HANDLE: {
+ Atom target, format;
+ char *targetName = NULL;
+ char *formatName = NULL;
+ register CommandInfo *cmdInfoPtr;
+ int cmdLength;
+ static CONST char *handleOptionStrings[] = {
+ "-format", "-selection", "-type", (char *) NULL
+ };
+ enum handleOptions { HANDLE_FORMAT, HANDLE_SELECTION,
+ HANDLE_TYPE };
+ int handleIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0],handleOptionStrings,
+ "option", 0, &handleIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum handleOptions) handleIndex) {
+ case HANDLE_FORMAT:
+ formatName = Tcl_GetString(objs[1]);
+ break;
+ case HANDLE_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ case HANDLE_TYPE:
+ targetName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+
+ if ((count < 2) || (count > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options? window command");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[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, Tcl_GetString(objs[2]));
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (count > 3) {
+ format = Tk_InternAtom(tkwin, Tcl_GetString(objs[3]));
+ } else if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ string = Tcl_GetStringFromObj(objs[1], &cmdLength);
+ if (cmdLength == 0) {
+ Tk_DeleteSelHandler(tkwin, selection, target);
+ } else {
+ cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
+ sizeof(CommandInfo) - 3 + cmdLength));
+ cmdInfoPtr->interp = interp;
+ cmdInfoPtr->charOffset = 0;
+ cmdInfoPtr->byteOffset = 0;
+ cmdInfoPtr->buffer[0] = '\0';
+ cmdInfoPtr->cmdLength = cmdLength;
+ strcpy(cmdInfoPtr->command, string);
+ Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
+ (ClientData) cmdInfoPtr, format);
+ }
+ return TCL_OK;
+ }
+
+ case SELECTION_OWN: {
+ register LostCommand *lostPtr;
+ char *script = NULL;
+ int cmdLength;
+ static CONST char *ownOptionStrings[] = {
+ "-command", "-displayof", "-selection", (char *) NULL
+ };
+ enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION };
+ int ownIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", string,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0], ownOptionStrings,
+ "option", 0, &ownIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum ownOptions) ownIndex) {
+ case OWN_COMMAND:
+ script = Tcl_GetString(objs[1]);
+ break;
+ case OWN_DISPLAYOF:
+ path = Tcl_GetString(objs[1]);
+ break;
+ case OWN_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+
+ if (count > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options? ?window?");
+ 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)) {
+ Tcl_SetResult(interp, Tk_PathName(infoPtr->owner),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (count == 2) {
+ script = Tcl_GetString(objs[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;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelGetInProgress --
+ *
+ * This procedure returns a pointer to the thread-local
+ * list of pending searches.
+ *
+ * Results:
+ * The return value is a pointer to the first search in progress,
+ * or NULL if there are none.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkSelInProgress *
+TkSelGetInProgress _ANSI_ARGS_((void))
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->pendingPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelSetInProgress --
+ *
+ * This procedure is used to set the thread-local list of pending
+ * searches. It is required because the pending list is kept
+ * in thread local storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TkSelSetInProgress(pendingPtr)
+ TkSelInProgress *pendingPtr;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->pendingPtr = pendingPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDeadWindow --
+ *
+ * This procedure is invoked just before a TkWindow is deleted.
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * While deleting all the handlers, be careful to check whether
+ * ConvertSelection or TkSelPropProc are about to process one of the
+ * deleted handlers.
+ */
+
+ while (winPtr->selHandlerList != NULL) {
+ selPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr->nextPtr;
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->selPtr == selPtr) {
+ ipPtr->selPtr = NULL;
+ }
+ }
+ if (selPtr->proc == HandleTclCommand) {
+ /*
+ * Mark the CommandInfo as deleted and free it when we can.
+ */
+
+ ((CommandInfo*)selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
+ }
+ 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");
+
+ /*
+ * Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us
+ * to support older X servers that didn't have UTF8_STRING yet.
+ * This is necessary on Unix systems.
+ * For more information, see:
+ * http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11
+ */
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+ dispPtr->utf8Atom = Tk_InternAtom(tkwin, "UTF8_STRING");
+#else
+ dispPtr->utf8Atom = (Atom) NULL;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, *string;
+ Tcl_Interp *interp = cmdInfoPtr->interp;
+ Tcl_DString oldResult;
+ Tcl_Obj *objPtr;
+ int extraBytes, charOffset, count, numChars;
+ CONST char *p;
+
+ /*
+ * We must also protect the interpreter and the command from being
+ * deleted too soon.
+ */
+
+ Tcl_Preserve(clientData);
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Compute the proper byte offset in the case where the last chunk
+ * split a character.
+ */
+
+ if (offset == cmdInfoPtr->byteOffset) {
+ charOffset = cmdInfoPtr->charOffset;
+ extraBytes = strlen(cmdInfoPtr->buffer);
+ if (extraBytes > 0) {
+ strcpy(buffer, cmdInfoPtr->buffer);
+ maxBytes -= extraBytes;
+ buffer += extraBytes;
+ }
+ } else {
+ cmdInfoPtr->byteOffset = 0;
+ cmdInfoPtr->charOffset = 0;
+ extraBytes = 0;
+ charOffset = 0;
+ }
+
+ /*
+ * 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, charOffset, 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) {
+ objPtr = Tcl_GetObjResult(interp);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ count = (length > maxBytes) ? maxBytes : length;
+ memcpy((VOID *) buffer, (VOID *) string, (size_t) count);
+ buffer[count] = '\0';
+
+ /*
+ * Update the partial character information for the next
+ * retrieval if the command has not been deleted.
+ */
+
+ if (cmdInfoPtr->interp != NULL) {
+ if (length <= maxBytes) {
+ cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
+ cmdInfoPtr->buffer[0] = '\0';
+ } else {
+ p = string;
+ string += count;
+ numChars = 0;
+ while (p < string) {
+ p = Tcl_UtfNext(p);
+ numChars++;
+ }
+ cmdInfoPtr->charOffset += numChars;
+ length = p - string;
+ if (length > 0) {
+ strncpy(cmdInfoPtr->buffer, string, (size_t) length);
+ }
+ cmdInfoPtr->buffer[length] = '\0';
+ }
+ cmdInfoPtr->byteOffset += count + extraBytes;
+ }
+ count += extraBytes;
+ } else {
+ count = -1;
+ }
+ Tcl_DStringResult(interp, &oldResult);
+
+ if (command != staticSpace) {
+ ckfree(command);
+ }
+
+
+ Tcl_Release(clientData);
+ Tcl_Release((ClientData) interp);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ CONST 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;
+ Tk_Uid 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 LostCommand structure. */
+{
+ LostCommand *lostPtr = (LostCommand *) clientData;
+ Tcl_Obj *objPtr;
+ Tcl_Interp *interp;
+
+ interp = lostPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Execute the command. Save the interpreter's result, if any, and
+ * restore it after executing the command.
+ */
+
+ objPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_ResetResult(interp);
+
+ if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_DecrRefCount(objPtr);
+
+ Tcl_Release((ClientData) interp);
+
+ /*
+ * Free the storage for the command, since we're done with it now.
+ */
+
+ ckfree((char *) lostPtr);
+}
diff --git a/tcl/generic/tkSelect.h b/tcl/generic/tkSelect.h
new file mode 100644
index 00000000000..c046f6c4baa
--- /dev/null
+++ b/tcl/generic/tkSelect.h
@@ -0,0 +1,185 @@
+/*
+ * 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. */
+ Tcl_EncodingState encState; /* Holds intermediate state during translations
+ * of data that cross buffer boundaries. */
+ int encFlags; /* Encoding translation state flags. */
+ Tcl_DString buf; /* Buffer to hold translation data. */
+ 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;
+
+/*
+ * Chunk size for retrieving selection. It's defined both in
+ * words and in bytes; the word size is used to allocate
+ * buffer space that's guaranteed to be word-aligned and that
+ * has an extra character for the terminating NULL.
+ */
+
+#define TK_SEL_BYTES_AT_ONCE 4000
+#define TK_SEL_WORDS_AT_ONCE 1001
+
+/*
+ * Declarations for procedures that are used by the selection-related files
+ * but shouldn't be used anywhere else in Tk (or by Tk clients):
+ */
+
+extern TkSelInProgress *
+ TkSelGetInProgress _ANSI_ARGS_((void));
+extern void TkSelSetInProgress _ANSI_ARGS_((
+ TkSelInProgress *pendingPtr));
+
+extern void TkSelClearSelection _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent *eventPtr));
+extern int TkSelDefaultSelection _ANSI_ARGS_((
+ TkSelectionInfo *infoPtr, Atom target,
+ char *buffer, int maxBytes, Atom *typePtr));
+extern int TkSelGetSelection _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc *proc, ClientData clientData));
+#ifndef TkSelUpdateClipboard
+extern void TkSelUpdateClipboard _ANSI_ARGS_((TkWindow *winPtr,
+ TkClipboardTarget *targetPtr));
+#endif
+
+#endif /* _TKSELECT */
diff --git a/tcl/generic/tkSquare.c b/tcl/generic/tkSquare.c
new file mode 100644
index 00000000000..50615ffbcaf
--- /dev/null
+++ b/tcl/generic/tkSquare.c
@@ -0,0 +1,621 @@
+/*
+ * tkSquare.c --
+ *
+ * This module implements "square" widgets that are object
+ * based. A "square" is a widget that displays a single square that can
+ * be moved around and resized. This file is intended as an example
+ * of how to build a widget; it isn't included in the
+ * normal wish, but it is included in "tktest".
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#define __NO_OLD_CONFIG
+#include "tk.h"
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type is kept for each square
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the square. NULL
+ * means window has been deleted but
+ * widget record hasn't been cleaned up yet. */
+ Display *display; /* X's token for the window's display. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. */
+ Tcl_Command widgetCmd; /* Token for square's widget command. */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ Tcl_Obj *xPtr, *yPtr; /* Position of square's upper-left corner
+ * within widget. */
+ int x, y;
+ Tcl_Obj *sizeObjPtr; /* Width and height of square. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tcl_Obj *borderWidthPtr; /* Width of 3-D border around whole widget. */
+ Tcl_Obj *bgBorderPtr;
+ Tcl_Obj *fgBorderPtr;
+ Tcl_Obj *reliefPtr;
+ GC gc; /* Graphics context for copying from
+ * off-screen pixmap onto screen. */
+ Tcl_Obj *doubleBufferPtr; /* Non-zero means double-buffer redisplay
+ * with pixmap; zero means draw straight
+ * onto the display. */
+ int updatePending; /* Non-zero means a call to SquareDisplay
+ * has already been scheduled. */
+} Square;
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ "#d9d9d9", Tk_Offset(Square, bgBorderPtr), -1, 0,
+ (ClientData) "white"},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background"},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ "2", Tk_Offset(Square, borderWidthPtr), -1},
+ {TK_OPTION_BOOLEAN, "-dbl", "doubleBuffer", "DoubleBuffer",
+ "1", Tk_Offset(Square, doubleBufferPtr), -1},
+ {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
+ {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground",
+ "#b03060", Tk_Offset(Square, fgBorderPtr), -1, 0,
+ (ClientData) "black"},
+ {TK_OPTION_PIXELS, "-posx", "posx", "PosX", "0",
+ Tk_Offset(Square, xPtr), -1},
+ {TK_OPTION_PIXELS, "-posy", "posy", "PosY", "0",
+ Tk_Offset(Square, yPtr), -1},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ "raised", Tk_Offset(Square, reliefPtr), -1},
+ {TK_OPTION_PIXELS, "-size", "size", "Size", "20",
+ Tk_Offset(Square, sizeObjPtr), -1},
+ {TK_OPTION_END}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+int SquareObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static void SquareDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int SquareConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ Square *squarePtr));
+static void SquareDestroy _ANSI_ARGS_((char *memPtr));
+static void SquareDisplay _ANSI_ARGS_((ClientData clientData));
+static void KeepInWindow _ANSI_ARGS_((Square *squarePtr));
+static void SquareObjEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int SquareWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int objc, Tcl_Obj * CONST objv[]));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareCmd --
+ *
+ * This procedure is invoked to process the "square" Tcl
+ * command. It creates a new "square" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+SquareObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
+{
+ Square *squarePtr;
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Square");
+
+ /*
+ * Create the option table for this widget class. If it has
+ * already been created, the refcount will get bumped and just
+ * the pointer will be returned. The refcount getting bumped
+ * does not concern us, because Tk will ensure the table is
+ * deleted when the interpreter is destroyed.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ /*
+ * Allocate and initialize the widget record. The memset allows
+ * us to set just the non-NULL/0 items.
+ */
+
+ squarePtr = (Square *) ckalloc(sizeof(Square));
+ memset((void *) squarePtr, 0, (sizeof(Square)));
+
+ squarePtr->tkwin = tkwin;
+ squarePtr->display = Tk_Display(tkwin);
+ squarePtr->interp = interp;
+ squarePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(squarePtr->tkwin), SquareWidgetObjCmd,
+ (ClientData) squarePtr, SquareDeletedProc);
+ squarePtr->gc = None;
+ squarePtr->optionTable = optionTable;
+
+ if (Tk_InitOptions(interp, (char *) squarePtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(squarePtr->tkwin);
+ ckfree((char *) squarePtr);
+ return TCL_ERROR;
+ }
+
+ Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask,
+ SquareObjEventProc, (ClientData) squarePtr);
+ if (Tk_SetOptions(interp, (char *) squarePtr, optionTable, objc - 2,
+ objv + 2, tkwin, NULL, (int *) NULL) != TCL_OK) {
+ goto error;
+ }
+ if (SquareConfigure(interp, squarePtr) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tk_PathName(squarePtr->tkwin), -1));
+ return TCL_OK;
+
+error:
+ Tk_DestroyWindow(squarePtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareWidgetObjCmd --
+ *
+ * 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
+SquareWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about square widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
+{
+ Square *squarePtr = (Square *) clientData;
+ int result = TCL_OK;
+ static CONST char *squareOptions[] = {"cget", "configure", (char *) NULL};
+ enum {
+ SQUARE_CGET, SQUARE_CONFIGURE
+ };
+ Tcl_Obj *resultObjPtr;
+ int index;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], squareOptions, "command",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve((ClientData) squarePtr);
+
+ switch (index) {
+ case SQUARE_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+ resultObjPtr = Tk_GetOptionValue(interp, (char *) squarePtr,
+ squarePtr->optionTable, objv[2], squarePtr->tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ break;
+ }
+ case SQUARE_CONFIGURE: {
+ resultObjPtr = NULL;
+ if (objc == 2) {
+ resultObjPtr = Tk_GetOptionInfo(interp, (char *) squarePtr,
+ squarePtr->optionTable, (Tcl_Obj *) NULL,
+ squarePtr->tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ }
+ } else if (objc == 3) {
+ resultObjPtr = Tk_GetOptionInfo(interp, (char *) squarePtr,
+ squarePtr->optionTable, objv[2], squarePtr->tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = Tk_SetOptions(interp, (char *) squarePtr,
+ squarePtr->optionTable, objc - 2, objv + 2,
+ squarePtr->tkwin, NULL, (int *) NULL);
+ if (result == TCL_OK) {
+ result = SquareConfigure(interp, squarePtr);
+ }
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ }
+ if (resultObjPtr != NULL) {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ }
+ }
+ Tcl_Release((ClientData) squarePtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) squarePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareConfigure --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a square widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for squarePtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SquareConfigure(interp, squarePtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Square *squarePtr; /* Information about widget. */
+{
+ int borderWidth;
+ Tk_3DBorder bgBorder;
+ int doubleBuffer;
+
+ /*
+ * Set the background for the window and create a graphics context
+ * for use during redisplay.
+ */
+
+ bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin,
+ squarePtr->bgBorderPtr);
+ Tk_SetWindowBackground(squarePtr->tkwin,
+ Tk_3DBorderColor(bgBorder)->pixel);
+ Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer);
+ if ((squarePtr->gc == None) && (doubleBuffer)) {
+ XGCValues gcValues;
+ gcValues.function = GXcopy;
+ gcValues.graphics_exposures = False;
+ squarePtr->gc = Tk_GetGC(squarePtr->tkwin,
+ GCFunction|GCGraphicsExposures, &gcValues);
+ }
+
+ /*
+ * Register the desired geometry for the window. Then arrange for
+ * the window to be redisplayed.
+ */
+
+ Tk_GeometryRequest(squarePtr->tkwin, 200, 150);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
+ &borderWidth);
+ Tk_SetInternalBorder(squarePtr->tkwin, borderWidth);
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ KeepInWindow(squarePtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareObjEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on squares.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SquareObjEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Square *squarePtr = (Square *) clientData;
+
+ if (eventPtr->type == Expose) {
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ } else if (eventPtr->type == ConfigureNotify) {
+ KeepInWindow(squarePtr);
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (squarePtr->tkwin != NULL) {
+ Tk_FreeConfigOptions((char *) squarePtr, squarePtr->optionTable,
+ squarePtr->tkwin);
+ if (squarePtr->gc != None) {
+ Tk_FreeGC(squarePtr->display, squarePtr->gc);
+ }
+ squarePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(squarePtr->interp,
+ squarePtr->widgetCmd);
+ }
+ if (squarePtr->updatePending) {
+ Tcl_CancelIdleCall(SquareDisplay, (ClientData) squarePtr);
+ }
+ Tcl_EventuallyFree((ClientData) squarePtr, SquareDestroy);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SquareDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Square *squarePtr = (Square *) clientData;
+ Tk_Window tkwin = squarePtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ int borderWidth, size, relief;
+ Tk_3DBorder bgBorder, fgBorder;
+ int doubleBuffer;
+
+ squarePtr->updatePending = 0;
+ if (!Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Create a pixmap for double-buffering, if necessary.
+ */
+
+ Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer);
+ if (doubleBuffer) {
+ pm = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ d = pm;
+ } else {
+ d = Tk_WindowId(tkwin);
+ }
+
+ /*
+ * Redraw the widget's background and border.
+ */
+
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
+ &borderWidth);
+ bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin,
+ squarePtr->bgBorderPtr);
+ Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief);
+ Tk_Fill3DRectangle(tkwin, d, bgBorder, 0, 0, Tk_Width(tkwin),
+ Tk_Height(tkwin), borderWidth, relief);
+
+ /*
+ * Display the square.
+ */
+
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size);
+ fgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin,
+ squarePtr->fgBorderPtr);
+ Tk_Fill3DRectangle(tkwin, d, fgBorder, squarePtr->x, squarePtr->y, size,
+ size, borderWidth, TK_RELIEF_RAISED);
+
+ /*
+ * If double-buffered, copy to the screen and release the pixmap.
+ */
+
+ if (doubleBuffer) {
+ XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(Tk_Display(tkwin), pm);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ 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, relief;
+ int borderWidth, size;
+
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->xPtr,
+ &squarePtr->x);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->yPtr,
+ &squarePtr->y);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size);
+ Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief);
+ bd = 0;
+ if (relief != TK_RELIEF_FLAT) {
+ bd = borderWidth;
+ }
+ i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + size);
+ if (i < 0) {
+ squarePtr->x += i;
+ }
+ i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + size);
+ if (i < 0) {
+ squarePtr->y += i;
+ }
+ if (squarePtr->x < bd) {
+ squarePtr->x = bd;
+ }
+ if (squarePtr->y < bd) {
+ squarePtr->y = bd;
+ }
+}
diff --git a/tcl/generic/tkStubImg.c b/tcl/generic/tkStubImg.c
new file mode 100644
index 00000000000..842fb0eceb9
--- /dev/null
+++ b/tcl/generic/tkStubImg.c
@@ -0,0 +1,76 @@
+/*
+ * tkStubImg.c --
+ *
+ * Stub object that will be statically linked into extensions that wish
+ * to access Tk.
+ *
+ * Copyright (c) 1999 Jan Nijtmans.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_InitImageArgs --
+ *
+ * Performs the necessary conversion from Tcl_Obj's to strings
+ * in the createProc for Tcl_CreateImageType. If running under
+ * Tk 8.2 or earlier without the Img-patch, this function has
+ * no effect.
+ *
+ * Results:
+ * argvPtr will point to an argument list which is guaranteed to
+ * contain strings, no matter what Tk version is running.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef Tk_InitImageArgs
+#undef Tk_InitImageArgs
+#endif
+
+void
+Tk_InitImageArgs(interp, argc, argvPtr)
+ Tcl_Interp *interp;
+ int argc;
+ char ***argvPtr;
+{
+ static useNewImage = -1;
+ static char **argv = NULL;
+
+ if (argv) {
+ tclStubsPtr->tcl_Free((char *) argv);
+ argv = NULL;
+ }
+
+ if (useNewImage < 0) {
+ Tcl_CmdInfo cmdInfo;
+ if (!tclStubsPtr->tcl_GetCommandInfo(interp,"image", &cmdInfo)) {
+ tclStubsPtr->tcl_Panic("cannot find the \"image\" command");
+ }
+ if (cmdInfo.isNativeObjectProc == 1) {
+ useNewImage = 1; /* Tk uses the new image interface */
+ } else {
+ useNewImage = 0; /* Tk uses old image interface */
+ }
+ }
+ if (useNewImage && (argc > 0)) {
+ int i;
+ argv = (char **) tclStubsPtr->tcl_Alloc(argc * sizeof(char *));
+ for (i = 0; i < argc; i++) {
+ argv[i] = tclStubsPtr->tcl_GetString((Tcl_Obj *)(*argvPtr)[i]);
+ }
+ *argvPtr = (char **) argv;
+ }
+}
diff --git a/tcl/generic/tkStubInit.c b/tcl/generic/tkStubInit.c
new file mode 100644
index 00000000000..f6558a8f47c
--- /dev/null
+++ b/tcl/generic/tkStubInit.c
@@ -0,0 +1,1132 @@
+/*
+ * tkStubInit.c --
+ *
+ * This file contains the initializers for the Tk stub vectors.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+#if !(defined(__WIN32__) && defined(MAC_TCL) || defined(MAC_OSX_TK))
+/* UNIX */
+#define UNIX_TK
+#endif
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+#if defined(MAC_TCL)
+/* set this locally .. we could have used _TKMACINT */
+#define MAC_TK
+#include "tkMacInt.h"
+#endif
+
+#if defined(MAC_OSX_TK)
+/* set this locally .. we could have used _TKMACINT */
+#include "tkMacOSXInt.h"
+#endif
+
+#include "tkDecls.h"
+#include "tkPlatDecls.h"
+#include "tkIntDecls.h"
+#include "tkIntPlatDecls.h"
+#include "tkIntXlibDecls.h"
+
+/*
+ * Remove macros that will interfere with the definitions below.
+ */
+
+#define Tk_CreateCanvasVisitor ((void (*) _ANSI_ARGS_((Tcl_Interp * interp, \
+ VOID * typePtr))) NULL)
+#define Tk_GetCanvasVisitor ((VOID * (*) _ANSI_ARGS_((Tcl_Interp * interp, \
+ CONST char * name))) NULL)
+
+/*
+ * WARNING: The contents of this file is automatically generated by the
+ * tools/genStubs.tcl script. Any modifications to the function declarations
+ * below should be made in the generic/tk.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+TkIntStubs tkIntStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+ TkAllocWindow, /* 0 */
+ TkBezierPoints, /* 1 */
+ TkBezierScreenPoints, /* 2 */
+ TkBindDeadWindow, /* 3 */
+ TkBindEventProc, /* 4 */
+ TkBindFree, /* 5 */
+ TkBindInit, /* 6 */
+ TkChangeEventWindow, /* 7 */
+ TkClipInit, /* 8 */
+ TkComputeAnchor, /* 9 */
+ TkCopyAndGlobalEval, /* 10 */
+ TkCreateBindingProcedure, /* 11 */
+ TkCreateCursorFromData, /* 12 */
+ TkCreateFrame, /* 13 */
+ TkCreateMainWindow, /* 14 */
+ TkCurrentTime, /* 15 */
+ TkDeleteAllImages, /* 16 */
+ TkDoConfigureNotify, /* 17 */
+ TkDrawInsetFocusHighlight, /* 18 */
+ TkEventDeadWindow, /* 19 */
+ TkFillPolygon, /* 20 */
+ TkFindStateNum, /* 21 */
+ TkFindStateString, /* 22 */
+ TkFocusDeadWindow, /* 23 */
+ TkFocusFilterEvent, /* 24 */
+ TkFocusKeyEvent, /* 25 */
+ TkFontPkgInit, /* 26 */
+ TkFontPkgFree, /* 27 */
+ TkFreeBindingTags, /* 28 */
+ TkpFreeCursor, /* 29 */
+ TkGetBitmapData, /* 30 */
+ TkGetButtPoints, /* 31 */
+ TkGetCursorByName, /* 32 */
+ TkGetDefaultScreenName, /* 33 */
+ TkGetDisplay, /* 34 */
+ TkGetDisplayOf, /* 35 */
+ TkGetFocusWin, /* 36 */
+ TkGetInterpNames, /* 37 */
+ TkGetMiterPoints, /* 38 */
+ TkGetPointerCoords, /* 39 */
+ TkGetServerInfo, /* 40 */
+ TkGrabDeadWindow, /* 41 */
+ TkGrabState, /* 42 */
+ TkIncludePoint, /* 43 */
+ TkInOutEvents, /* 44 */
+ TkInstallFrameMenu, /* 45 */
+ TkKeysymToString, /* 46 */
+ TkLineToArea, /* 47 */
+ TkLineToPoint, /* 48 */
+ TkMakeBezierCurve, /* 49 */
+ TkMakeBezierPostscript, /* 50 */
+ TkOptionClassChanged, /* 51 */
+ TkOptionDeadWindow, /* 52 */
+ TkOvalToArea, /* 53 */
+ TkOvalToPoint, /* 54 */
+ TkpChangeFocus, /* 55 */
+ TkpCloseDisplay, /* 56 */
+ TkpClaimFocus, /* 57 */
+ TkpDisplayWarning, /* 58 */
+ TkpGetAppName, /* 59 */
+ TkpGetOtherWindow, /* 60 */
+ TkpGetWrapperWindow, /* 61 */
+ TkpInit, /* 62 */
+ TkpInitializeMenuBindings, /* 63 */
+ TkpMakeContainer, /* 64 */
+ TkpMakeMenuWindow, /* 65 */
+ TkpMakeWindow, /* 66 */
+ TkpMenuNotifyToplevelCreate, /* 67 */
+ TkpOpenDisplay, /* 68 */
+ TkPointerEvent, /* 69 */
+ TkPolygonToArea, /* 70 */
+ TkPolygonToPoint, /* 71 */
+ TkPositionInTree, /* 72 */
+ TkpRedirectKeyEvent, /* 73 */
+ TkpSetMainMenubar, /* 74 */
+ TkpUseWindow, /* 75 */
+ TkpWindowWasRecentlyDeleted, /* 76 */
+ TkQueueEventForAllChildren, /* 77 */
+ TkReadBitmapFile, /* 78 */
+ TkScrollWindow, /* 79 */
+ TkSelDeadWindow, /* 80 */
+ TkSelEventProc, /* 81 */
+ TkSelInit, /* 82 */
+ TkSelPropProc, /* 83 */
+ NULL, /* 84 */
+ TkSetWindowMenuBar, /* 85 */
+ TkStringToKeysym, /* 86 */
+ TkThickPolyLineToArea, /* 87 */
+ TkWmAddToColormapWindows, /* 88 */
+ TkWmDeadWindow, /* 89 */
+ TkWmFocusToplevel, /* 90 */
+ TkWmMapWindow, /* 91 */
+ TkWmNewWindow, /* 92 */
+ TkWmProtocolEventProc, /* 93 */
+ TkWmRemoveFromColormapWindows, /* 94 */
+ TkWmRestackToplevel, /* 95 */
+ TkWmSetClass, /* 96 */
+ TkWmUnmapWindow, /* 97 */
+ TkDebugBitmap, /* 98 */
+ TkDebugBorder, /* 99 */
+ TkDebugCursor, /* 100 */
+ TkDebugColor, /* 101 */
+ TkDebugConfig, /* 102 */
+ TkDebugFont, /* 103 */
+ TkFindStateNumObj, /* 104 */
+ TkGetBitmapPredefTable, /* 105 */
+ TkGetDisplayList, /* 106 */
+ TkGetMainInfoList, /* 107 */
+ TkGetWindowFromObj, /* 108 */
+ TkpGetString, /* 109 */
+ TkpGetSubFonts, /* 110 */
+ TkpGetSystemDefault, /* 111 */
+ TkpMenuThreadInit, /* 112 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 113 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkClipBox, /* 113 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkClipBox, /* 113 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkClipBox, /* 113 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 114 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkCreateRegion, /* 114 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkCreateRegion, /* 114 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkCreateRegion, /* 114 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 115 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkDestroyRegion, /* 115 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkDestroyRegion, /* 115 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkDestroyRegion, /* 115 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 116 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkIntersectRegion, /* 116 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkIntersectRegion, /* 116 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkIntersectRegion, /* 116 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 117 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkRectInRegion, /* 117 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkRectInRegion, /* 117 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkRectInRegion, /* 117 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 118 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkSetRegion, /* 118 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkSetRegion, /* 118 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkSetRegion, /* 118 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 119 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkUnionRectWithRegion, /* 119 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkUnionRectWithRegion, /* 119 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkUnionRectWithRegion, /* 119 */
+#endif /* MAC_OSX_TK */
+ NULL, /* 120 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 121 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 121 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkpCreateNativeBitmap, /* 121 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkpCreateNativeBitmap, /* 121 */
+#endif /* MAC_OSX_TK */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 122 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 122 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkpDefineNativeBitmaps, /* 122 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkpDefineNativeBitmaps, /* 122 */
+#endif /* MAC_OSX_TK */
+ NULL, /* 123 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 124 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 124 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkpGetNativeAppBitmap, /* 124 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkpGetNativeAppBitmap, /* 124 */
+#endif /* MAC_OSX_TK */
+ NULL, /* 125 */
+ NULL, /* 126 */
+ NULL, /* 127 */
+ NULL, /* 128 */
+ NULL, /* 129 */
+ NULL, /* 130 */
+ NULL, /* 131 */
+ NULL, /* 132 */
+ NULL, /* 133 */
+ NULL, /* 134 */
+ TkpDrawHighlightBorder, /* 135 */
+ TkSetFocusWin, /* 136 */
+ TkpSetKeycodeAndState, /* 137 */
+ TkpGetKeySym, /* 138 */
+ TkpInitKeymapInfo, /* 139 */
+ TkPhotoGetValidRegion, /* 140 */
+ TkWmStackorderToplevel, /* 141 */
+ TkFocusFree, /* 142 */
+ TkClipCleanup, /* 143 */
+ TkGCCleanup, /* 144 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 145 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkSubtractRegion, /* 145 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkSubtractRegion, /* 145 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkSubtractRegion, /* 145 */
+#endif /* MAC_OSX_TK */
+ TkStylePkgInit, /* 146 */
+ TkStylePkgFree, /* 147 */
+};
+
+TkIntPlatStubs tkIntPlatStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+#ifdef __WIN32__
+ TkAlignImageData, /* 0 */
+ NULL, /* 1 */
+ TkGenerateActivateEvents, /* 2 */
+ TkpGetMS, /* 3 */
+ TkPointerDeadWindow, /* 4 */
+ TkpPrintWindowId, /* 5 */
+ TkpScanWindowId, /* 6 */
+ TkpSetCapture, /* 7 */
+ TkpSetCursor, /* 8 */
+ TkpWmSetState, /* 9 */
+ TkSetPixmapColormap, /* 10 */
+ TkWinCancelMouseTimer, /* 11 */
+ TkWinClipboardRender, /* 12 */
+ TkWinEmbeddedEventProc, /* 13 */
+ TkWinFillRect, /* 14 */
+ TkWinGetBorderPixels, /* 15 */
+ TkWinGetDrawableDC, /* 16 */
+ TkWinGetModifierState, /* 17 */
+ TkWinGetSystemPalette, /* 18 */
+ TkWinGetWrapperWindow, /* 19 */
+ TkWinHandleMenuEvent, /* 20 */
+ TkWinIndexOfColor, /* 21 */
+ TkWinReleaseDrawableDC, /* 22 */
+ TkWinResendEvent, /* 23 */
+ TkWinSelectPalette, /* 24 */
+ TkWinSetMenu, /* 25 */
+ TkWinSetWindowPos, /* 26 */
+ TkWinWmCleanup, /* 27 */
+ TkWinXCleanup, /* 28 */
+ TkWinXInit, /* 29 */
+ TkWinSetForegroundWindow, /* 30 */
+ TkWinDialogDebug, /* 31 */
+ TkWinGetMenuSystemDefault, /* 32 */
+ TkWinGetPlatformId, /* 33 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkGenerateActivateEvents, /* 0 */
+ NULL, /* 1 */
+ NULL, /* 2 */
+ TkpGetMS, /* 3 */
+ NULL, /* 4 */
+ TkPointerDeadWindow, /* 5 */
+ TkpSetCapture, /* 6 */
+ TkpSetCursor, /* 7 */
+ TkpWmSetState, /* 8 */
+ NULL, /* 9 */
+ TkAboutDlg, /* 10 */
+ NULL, /* 11 */
+ NULL, /* 12 */
+ TkGetTransientMaster, /* 13 */
+ TkGenerateButtonEvent, /* 14 */
+ NULL, /* 15 */
+ TkGenWMDestroyEvent, /* 16 */
+ NULL, /* 17 */
+ TkMacButtonKeyState, /* 18 */
+ TkMacClearMenubarActive, /* 19 */
+ NULL, /* 20 */
+ TkMacDispatchMenuEvent, /* 21 */
+ TkMacInstallCursor, /* 22 */
+ NULL, /* 23 */
+ TkMacHandleTearoffMenu, /* 24 */
+ NULL, /* 25 */
+ NULL, /* 26 */
+ TkMacDoHLEvent, /* 27 */
+ NULL, /* 28 */
+ TkMacGenerateTime, /* 29 */
+ NULL, /* 30 */
+ TkMacGetScrollbarGrowWindow, /* 31 */
+ TkMacGetXWindow, /* 32 */
+ TkMacGrowToplevel, /* 33 */
+ TkMacHandleMenuSelect, /* 34 */
+ NULL, /* 35 */
+ NULL, /* 36 */
+ NULL, /* 37 */
+ TkMacInvalidateWindow, /* 38 */
+ TkMacIsCharacterMissing, /* 39 */
+ TkMacMakeRealWindowExist, /* 40 */
+ TkMacMakeStippleMap, /* 41 */
+ TkMacMenuClick, /* 42 */
+ TkMacRegisterOffScreenWindow, /* 43 */
+ TkMacResizable, /* 44 */
+ NULL, /* 45 */
+ TkMacSetHelpMenuItemCount, /* 46 */
+ TkMacSetScrollbarGrow, /* 47 */
+ TkMacSetUpClippingRgn, /* 48 */
+ TkMacSetUpGraphicsPort, /* 49 */
+ TkMacUpdateClipRgn, /* 50 */
+ TkMacUnregisterMacWindow, /* 51 */
+ TkMacUseMenuID, /* 52 */
+ TkMacVisableClipRgn, /* 53 */
+ TkMacWinBounds, /* 54 */
+ TkMacWindowOffset, /* 55 */
+ NULL, /* 56 */
+ TkSetMacColor, /* 57 */
+ TkSetWMName, /* 58 */
+ TkSuspendClipboard, /* 59 */
+ NULL, /* 60 */
+ TkMacZoomToplevel, /* 61 */
+ Tk_TopCoordsToWindow, /* 62 */
+ TkMacContainerId, /* 63 */
+ TkMacGetHostToplevel, /* 64 */
+ TkMacPreprocessMenu, /* 65 */
+ TkpIsWindowFloating, /* 66 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ TkGenerateActivateEvents, /* 0 */
+ NULL, /* 1 */
+ NULL, /* 2 */
+ TkPointerDeadWindow, /* 3 */
+ TkpSetCapture, /* 4 */
+ TkpSetCursor, /* 5 */
+ TkpWmSetState, /* 6 */
+ TkAboutDlg, /* 7 */
+ TkMacOSXButtonKeyState, /* 8 */
+ TkMacOSXClearMenubarActive, /* 9 */
+ TkMacOSXDispatchMenuEvent, /* 10 */
+ TkMacOSXInstallCursor, /* 11 */
+ TkMacOSXHandleTearoffMenu, /* 12 */
+ NULL, /* 13 */
+ TkMacOSXDoHLEvent, /* 14 */
+ NULL, /* 15 */
+ TkMacOSXGetXWindow, /* 16 */
+ TkMacOSXGrowToplevel, /* 17 */
+ TkMacOSXHandleMenuSelect, /* 18 */
+ NULL, /* 19 */
+ NULL, /* 20 */
+ TkMacOSXInvalidateWindow, /* 21 */
+ TkMacOSXIsCharacterMissing, /* 22 */
+ TkMacOSXMakeRealWindowExist, /* 23 */
+ TkMacOSXMakeStippleMap, /* 24 */
+ TkMacOSXMenuClick, /* 25 */
+ TkMacOSXRegisterOffScreenWindow, /* 26 */
+ TkMacOSXResizable, /* 27 */
+ TkMacOSXSetHelpMenuItemCount, /* 28 */
+ TkMacOSXSetScrollbarGrow, /* 29 */
+ TkMacOSXSetUpClippingRgn, /* 30 */
+ TkMacOSXSetUpGraphicsPort, /* 31 */
+ TkMacOSXUpdateClipRgn, /* 32 */
+ TkMacOSXUnregisterMacWindow, /* 33 */
+ TkMacOSXUseMenuID, /* 34 */
+ TkMacOSXVisableClipRgn, /* 35 */
+ TkMacOSXWinBounds, /* 36 */
+ TkMacOSXWindowOffset, /* 37 */
+ TkSetMacColor, /* 38 */
+ TkSetWMName, /* 39 */
+ TkSuspendClipboard, /* 40 */
+ TkMacOSXZoomToplevel, /* 41 */
+ Tk_TopCoordsToWindow, /* 42 */
+ TkMacOSXContainerId, /* 43 */
+ TkMacOSXGetHostToplevel, /* 44 */
+ TkMacOSXPreprocessMenu, /* 45 */
+ TkpIsWindowFloating, /* 46 */
+ TkMacOSXGetCapture, /* 47 */
+ NULL, /* 48 */
+ TkGetTransientMaster, /* 49 */
+ TkGenerateButtonEvent, /* 50 */
+ TkGenWMDestroyEvent, /* 51 */
+ NULL, /* 52 */
+ TkpGetMS, /* 53 */
+#endif /* MAC_OSX_TK */
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */
+ TkCreateXEventSource, /* 0 */
+ TkFreeWindowId, /* 1 */
+ TkInitXId, /* 2 */
+ TkpCmapStressed, /* 3 */
+ TkpSync, /* 4 */
+ TkUnixContainerId, /* 5 */
+ TkUnixDoOneXEvent, /* 6 */
+ TkUnixSetMenubar, /* 7 */
+ TkpScanWindowId, /* 8 */
+ TkWmCleanup, /* 9 */
+ TkSendCleanup, /* 10 */
+ TkFreeXId, /* 11 */
+ TkpWmSetState, /* 12 */
+#endif /* X11 */
+};
+
+TkIntXlibStubs tkIntXlibStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+#ifdef __WIN32__
+ XSetDashes, /* 0 */
+ XGetModifierMapping, /* 1 */
+ XCreateImage, /* 2 */
+ XGetImage, /* 3 */
+ XGetAtomName, /* 4 */
+ XKeysymToString, /* 5 */
+ XCreateColormap, /* 6 */
+ XCreatePixmapCursor, /* 7 */
+ XCreateGlyphCursor, /* 8 */
+ XGContextFromGC, /* 9 */
+ XListHosts, /* 10 */
+ XKeycodeToKeysym, /* 11 */
+ XStringToKeysym, /* 12 */
+ XRootWindow, /* 13 */
+ XSetErrorHandler, /* 14 */
+ XIconifyWindow, /* 15 */
+ XWithdrawWindow, /* 16 */
+ XGetWMColormapWindows, /* 17 */
+ XAllocColor, /* 18 */
+ XBell, /* 19 */
+ XChangeProperty, /* 20 */
+ XChangeWindowAttributes, /* 21 */
+ XClearWindow, /* 22 */
+ XConfigureWindow, /* 23 */
+ XCopyArea, /* 24 */
+ XCopyPlane, /* 25 */
+ XCreateBitmapFromData, /* 26 */
+ XDefineCursor, /* 27 */
+ XDeleteProperty, /* 28 */
+ XDestroyWindow, /* 29 */
+ XDrawArc, /* 30 */
+ XDrawLines, /* 31 */
+ XDrawRectangle, /* 32 */
+ XFillArc, /* 33 */
+ XFillPolygon, /* 34 */
+ XFillRectangles, /* 35 */
+ XForceScreenSaver, /* 36 */
+ XFreeColormap, /* 37 */
+ XFreeColors, /* 38 */
+ XFreeCursor, /* 39 */
+ XFreeModifiermap, /* 40 */
+ XGetGeometry, /* 41 */
+ XGetInputFocus, /* 42 */
+ XGetWindowProperty, /* 43 */
+ XGetWindowAttributes, /* 44 */
+ XGrabKeyboard, /* 45 */
+ XGrabPointer, /* 46 */
+ XKeysymToKeycode, /* 47 */
+ XLookupColor, /* 48 */
+ XMapWindow, /* 49 */
+ XMoveResizeWindow, /* 50 */
+ XMoveWindow, /* 51 */
+ XNextEvent, /* 52 */
+ XPutBackEvent, /* 53 */
+ XQueryColors, /* 54 */
+ XQueryPointer, /* 55 */
+ XQueryTree, /* 56 */
+ XRaiseWindow, /* 57 */
+ XRefreshKeyboardMapping, /* 58 */
+ XResizeWindow, /* 59 */
+ XSelectInput, /* 60 */
+ XSendEvent, /* 61 */
+ XSetCommand, /* 62 */
+ XSetIconName, /* 63 */
+ XSetInputFocus, /* 64 */
+ XSetSelectionOwner, /* 65 */
+ XSetWindowBackground, /* 66 */
+ XSetWindowBackgroundPixmap, /* 67 */
+ XSetWindowBorder, /* 68 */
+ XSetWindowBorderPixmap, /* 69 */
+ XSetWindowBorderWidth, /* 70 */
+ XSetWindowColormap, /* 71 */
+ XTranslateCoordinates, /* 72 */
+ XUngrabKeyboard, /* 73 */
+ XUngrabPointer, /* 74 */
+ XUnmapWindow, /* 75 */
+ XWindowEvent, /* 76 */
+ XDestroyIC, /* 77 */
+ XFilterEvent, /* 78 */
+ XmbLookupString, /* 79 */
+ TkPutImage, /* 80 */
+ NULL, /* 81 */
+ XParseColor, /* 82 */
+ XCreateGC, /* 83 */
+ XFreeGC, /* 84 */
+ XInternAtom, /* 85 */
+ XSetBackground, /* 86 */
+ XSetForeground, /* 87 */
+ XSetClipMask, /* 88 */
+ XSetClipOrigin, /* 89 */
+ XSetTSOrigin, /* 90 */
+ XChangeGC, /* 91 */
+ XSetFont, /* 92 */
+ XSetArcMode, /* 93 */
+ XSetStipple, /* 94 */
+ XSetFillRule, /* 95 */
+ XSetFillStyle, /* 96 */
+ XSetFunction, /* 97 */
+ XSetLineAttributes, /* 98 */
+ _XInitImageFuncPtrs, /* 99 */
+ XCreateIC, /* 100 */
+ XGetVisualInfo, /* 101 */
+ XSetWMClientMachine, /* 102 */
+ XStringListToTextProperty, /* 103 */
+ XDrawLine, /* 104 */
+ XWarpPointer, /* 105 */
+ XFillRectangle, /* 106 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ XSetDashes, /* 0 */
+ XGetModifierMapping, /* 1 */
+ XCreateImage, /* 2 */
+ XGetImage, /* 3 */
+ XGetAtomName, /* 4 */
+ XKeysymToString, /* 5 */
+ XCreateColormap, /* 6 */
+ XGContextFromGC, /* 7 */
+ XKeycodeToKeysym, /* 8 */
+ XStringToKeysym, /* 9 */
+ XRootWindow, /* 10 */
+ XSetErrorHandler, /* 11 */
+ XAllocColor, /* 12 */
+ XBell, /* 13 */
+ XChangeProperty, /* 14 */
+ XChangeWindowAttributes, /* 15 */
+ XConfigureWindow, /* 16 */
+ XCopyArea, /* 17 */
+ XCopyPlane, /* 18 */
+ XCreateBitmapFromData, /* 19 */
+ XDefineCursor, /* 20 */
+ XDestroyWindow, /* 21 */
+ XDrawArc, /* 22 */
+ XDrawLines, /* 23 */
+ XDrawRectangle, /* 24 */
+ XFillArc, /* 25 */
+ XFillPolygon, /* 26 */
+ XFillRectangles, /* 27 */
+ XFreeColormap, /* 28 */
+ XFreeColors, /* 29 */
+ XFreeModifiermap, /* 30 */
+ XGetGeometry, /* 31 */
+ XGetWindowProperty, /* 32 */
+ XGrabKeyboard, /* 33 */
+ XGrabPointer, /* 34 */
+ XKeysymToKeycode, /* 35 */
+ XMapWindow, /* 36 */
+ XMoveResizeWindow, /* 37 */
+ XMoveWindow, /* 38 */
+ XQueryPointer, /* 39 */
+ XRaiseWindow, /* 40 */
+ XRefreshKeyboardMapping, /* 41 */
+ XResizeWindow, /* 42 */
+ XSelectInput, /* 43 */
+ XSendEvent, /* 44 */
+ XSetIconName, /* 45 */
+ XSetInputFocus, /* 46 */
+ XSetSelectionOwner, /* 47 */
+ XSetWindowBackground, /* 48 */
+ XSetWindowBackgroundPixmap, /* 49 */
+ XSetWindowBorder, /* 50 */
+ XSetWindowBorderPixmap, /* 51 */
+ XSetWindowBorderWidth, /* 52 */
+ XSetWindowColormap, /* 53 */
+ XUngrabKeyboard, /* 54 */
+ XUngrabPointer, /* 55 */
+ XUnmapWindow, /* 56 */
+ TkPutImage, /* 57 */
+ XParseColor, /* 58 */
+ XCreateGC, /* 59 */
+ XFreeGC, /* 60 */
+ XInternAtom, /* 61 */
+ XSetBackground, /* 62 */
+ XSetForeground, /* 63 */
+ XSetClipMask, /* 64 */
+ XSetClipOrigin, /* 65 */
+ XSetTSOrigin, /* 66 */
+ XChangeGC, /* 67 */
+ XSetFont, /* 68 */
+ XSetArcMode, /* 69 */
+ XSetStipple, /* 70 */
+ XSetFillRule, /* 71 */
+ XSetFillStyle, /* 72 */
+ XSetFunction, /* 73 */
+ XSetLineAttributes, /* 74 */
+ _XInitImageFuncPtrs, /* 75 */
+ XCreateIC, /* 76 */
+ XGetVisualInfo, /* 77 */
+ XSetWMClientMachine, /* 78 */
+ XStringListToTextProperty, /* 79 */
+ XDrawSegments, /* 80 */
+ XForceScreenSaver, /* 81 */
+ XDrawLine, /* 82 */
+ XFillRectangle, /* 83 */
+ XClearWindow, /* 84 */
+ XDrawPoint, /* 85 */
+ XDrawPoints, /* 86 */
+ XWarpPointer, /* 87 */
+ XQueryColor, /* 88 */
+ XQueryColors, /* 89 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ XSetDashes, /* 0 */
+ XGetModifierMapping, /* 1 */
+ XCreateImage, /* 2 */
+ XGetImage, /* 3 */
+ XGetAtomName, /* 4 */
+ XKeysymToString, /* 5 */
+ XCreateColormap, /* 6 */
+ XGContextFromGC, /* 7 */
+ XKeycodeToKeysym, /* 8 */
+ XStringToKeysym, /* 9 */
+ XRootWindow, /* 10 */
+ XSetErrorHandler, /* 11 */
+ XAllocColor, /* 12 */
+ XBell, /* 13 */
+ XChangeProperty, /* 14 */
+ XChangeWindowAttributes, /* 15 */
+ XConfigureWindow, /* 16 */
+ XCopyArea, /* 17 */
+ XCopyPlane, /* 18 */
+ XCreateBitmapFromData, /* 19 */
+ XDefineCursor, /* 20 */
+ XDestroyWindow, /* 21 */
+ XDrawArc, /* 22 */
+ XDrawLines, /* 23 */
+ XDrawRectangle, /* 24 */
+ XFillArc, /* 25 */
+ XFillPolygon, /* 26 */
+ XFillRectangles, /* 27 */
+ XFreeColormap, /* 28 */
+ XFreeColors, /* 29 */
+ XFreeModifiermap, /* 30 */
+ XGetGeometry, /* 31 */
+ XGetWindowProperty, /* 32 */
+ XGrabKeyboard, /* 33 */
+ XGrabPointer, /* 34 */
+ XKeysymToKeycode, /* 35 */
+ XMapWindow, /* 36 */
+ XMoveResizeWindow, /* 37 */
+ XMoveWindow, /* 38 */
+ XQueryPointer, /* 39 */
+ XRaiseWindow, /* 40 */
+ XRefreshKeyboardMapping, /* 41 */
+ XResizeWindow, /* 42 */
+ XSelectInput, /* 43 */
+ XSendEvent, /* 44 */
+ XSetIconName, /* 45 */
+ XSetInputFocus, /* 46 */
+ XSetSelectionOwner, /* 47 */
+ XSetWindowBackground, /* 48 */
+ XSetWindowBackgroundPixmap, /* 49 */
+ XSetWindowBorder, /* 50 */
+ XSetWindowBorderPixmap, /* 51 */
+ XSetWindowBorderWidth, /* 52 */
+ XSetWindowColormap, /* 53 */
+ XUngrabKeyboard, /* 54 */
+ XUngrabPointer, /* 55 */
+ XUnmapWindow, /* 56 */
+ TkPutImage, /* 57 */
+ XParseColor, /* 58 */
+ XCreateGC, /* 59 */
+ XFreeGC, /* 60 */
+ XInternAtom, /* 61 */
+ XSetBackground, /* 62 */
+ XSetForeground, /* 63 */
+ XSetClipMask, /* 64 */
+ XSetClipOrigin, /* 65 */
+ XSetTSOrigin, /* 66 */
+ XChangeGC, /* 67 */
+ XSetFont, /* 68 */
+ XSetArcMode, /* 69 */
+ XSetStipple, /* 70 */
+ XSetFillRule, /* 71 */
+ XSetFillStyle, /* 72 */
+ XSetFunction, /* 73 */
+ XSetLineAttributes, /* 74 */
+ _XInitImageFuncPtrs, /* 75 */
+ XCreateIC, /* 76 */
+ XGetVisualInfo, /* 77 */
+ XSetWMClientMachine, /* 78 */
+ XStringListToTextProperty, /* 79 */
+ XDrawSegments, /* 80 */
+ XForceScreenSaver, /* 81 */
+ XDrawLine, /* 82 */
+ XFillRectangle, /* 83 */
+ XClearWindow, /* 84 */
+ XDrawPoint, /* 85 */
+ XDrawPoints, /* 86 */
+ XWarpPointer, /* 87 */
+ XQueryColor, /* 88 */
+ XQueryColors, /* 89 */
+#endif /* MAC_OSX_TK */
+};
+
+TkPlatStubs tkPlatStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+#ifdef __WIN32__
+ Tk_AttachHWND, /* 0 */
+ Tk_GetHINSTANCE, /* 1 */
+ Tk_GetHWND, /* 2 */
+ Tk_HWNDToWindow, /* 3 */
+ Tk_PointerEvent, /* 4 */
+ Tk_TranslateWinEvent, /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ Tk_MacSetEmbedHandler, /* 0 */
+ Tk_MacTurnOffMenus, /* 1 */
+ Tk_MacTkOwnsCursor, /* 2 */
+ TkMacInitMenus, /* 3 */
+ TkMacInitAppleEvents, /* 4 */
+ TkMacConvertEvent, /* 5 */
+ TkMacConvertTkEvent, /* 6 */
+ TkGenWMConfigureEvent, /* 7 */
+ TkMacInvalClipRgns, /* 8 */
+ TkMacHaveAppearance, /* 9 */
+ TkMacGetDrawablePort, /* 10 */
+#endif /* MAC_TCL */
+#ifdef MAC_OSX_TK
+ Tk_MacOSXSetEmbedHandler, /* 0 */
+ Tk_MacOSXTurnOffMenus, /* 1 */
+ Tk_MacOSXTkOwnsCursor, /* 2 */
+ TkMacOSXInitMenus, /* 3 */
+ TkMacOSXInitAppleEvents, /* 4 */
+ TkGenWMConfigureEvent, /* 5 */
+ TkMacOSXInvalClipRgns, /* 6 */
+ TkMacOSXGetDrawablePort, /* 7 */
+ TkMacOSXGetRootControl, /* 8 */
+ Tk_MacOSXSetupTkNotifier, /* 9 */
+ Tk_MacOSXIsAppInFront, /* 10 */
+#endif /* MAC_OSX_TK */
+};
+
+static TkStubHooks tkStubHooks = {
+ &tkPlatStubs,
+ &tkIntStubs,
+ &tkIntPlatStubs,
+ &tkIntXlibStubs
+};
+
+TkStubs tkStubs = {
+ TCL_STUB_MAGIC,
+ &tkStubHooks,
+ Tk_MainLoop, /* 0 */
+ Tk_3DBorderColor, /* 1 */
+ Tk_3DBorderGC, /* 2 */
+ Tk_3DHorizontalBevel, /* 3 */
+ Tk_3DVerticalBevel, /* 4 */
+ Tk_AddOption, /* 5 */
+ Tk_BindEvent, /* 6 */
+ Tk_CanvasDrawableCoords, /* 7 */
+ Tk_CanvasEventuallyRedraw, /* 8 */
+ Tk_CanvasGetCoord, /* 9 */
+ Tk_CanvasGetTextInfo, /* 10 */
+ Tk_CanvasPsBitmap, /* 11 */
+ Tk_CanvasPsColor, /* 12 */
+ Tk_CanvasPsFont, /* 13 */
+ Tk_CanvasPsPath, /* 14 */
+ Tk_CanvasPsStipple, /* 15 */
+ Tk_CanvasPsY, /* 16 */
+ Tk_CanvasSetStippleOrigin, /* 17 */
+ Tk_CanvasTagsParseProc, /* 18 */
+ Tk_CanvasTagsPrintProc, /* 19 */
+ Tk_CanvasTkwin, /* 20 */
+ Tk_CanvasWindowCoords, /* 21 */
+ Tk_ChangeWindowAttributes, /* 22 */
+ Tk_CharBbox, /* 23 */
+ Tk_ClearSelection, /* 24 */
+ Tk_ClipboardAppend, /* 25 */
+ Tk_ClipboardClear, /* 26 */
+ Tk_ConfigureInfo, /* 27 */
+ Tk_ConfigureValue, /* 28 */
+ Tk_ConfigureWidget, /* 29 */
+ Tk_ConfigureWindow, /* 30 */
+ Tk_ComputeTextLayout, /* 31 */
+ Tk_CoordsToWindow, /* 32 */
+ Tk_CreateBinding, /* 33 */
+ Tk_CreateBindingTable, /* 34 */
+ Tk_CreateErrorHandler, /* 35 */
+ Tk_CreateEventHandler, /* 36 */
+ Tk_CreateGenericHandler, /* 37 */
+ Tk_CreateImageType, /* 38 */
+ Tk_CreateItemType, /* 39 */
+ Tk_CreatePhotoImageFormat, /* 40 */
+ Tk_CreateSelHandler, /* 41 */
+ Tk_CreateWindow, /* 42 */
+ Tk_CreateWindowFromPath, /* 43 */
+ Tk_DefineBitmap, /* 44 */
+ Tk_DefineCursor, /* 45 */
+ Tk_DeleteAllBindings, /* 46 */
+ Tk_DeleteBinding, /* 47 */
+ Tk_DeleteBindingTable, /* 48 */
+ Tk_DeleteErrorHandler, /* 49 */
+ Tk_DeleteEventHandler, /* 50 */
+ Tk_DeleteGenericHandler, /* 51 */
+ Tk_DeleteImage, /* 52 */
+ Tk_DeleteSelHandler, /* 53 */
+ Tk_DestroyWindow, /* 54 */
+ Tk_DisplayName, /* 55 */
+ Tk_DistanceToTextLayout, /* 56 */
+ Tk_Draw3DPolygon, /* 57 */
+ Tk_Draw3DRectangle, /* 58 */
+ Tk_DrawChars, /* 59 */
+ Tk_DrawFocusHighlight, /* 60 */
+ Tk_DrawTextLayout, /* 61 */
+ Tk_Fill3DPolygon, /* 62 */
+ Tk_Fill3DRectangle, /* 63 */
+ Tk_FindPhoto, /* 64 */
+ Tk_FontId, /* 65 */
+ Tk_Free3DBorder, /* 66 */
+ Tk_FreeBitmap, /* 67 */
+ Tk_FreeColor, /* 68 */
+ Tk_FreeColormap, /* 69 */
+ Tk_FreeCursor, /* 70 */
+ Tk_FreeFont, /* 71 */
+ Tk_FreeGC, /* 72 */
+ Tk_FreeImage, /* 73 */
+ Tk_FreeOptions, /* 74 */
+ Tk_FreePixmap, /* 75 */
+ Tk_FreeTextLayout, /* 76 */
+ Tk_FreeXId, /* 77 */
+ Tk_GCForColor, /* 78 */
+ Tk_GeometryRequest, /* 79 */
+ Tk_Get3DBorder, /* 80 */
+ Tk_GetAllBindings, /* 81 */
+ Tk_GetAnchor, /* 82 */
+ Tk_GetAtomName, /* 83 */
+ Tk_GetBinding, /* 84 */
+ Tk_GetBitmap, /* 85 */
+ Tk_GetBitmapFromData, /* 86 */
+ Tk_GetCapStyle, /* 87 */
+ Tk_GetColor, /* 88 */
+ Tk_GetColorByValue, /* 89 */
+ Tk_GetColormap, /* 90 */
+ Tk_GetCursor, /* 91 */
+ Tk_GetCursorFromData, /* 92 */
+ Tk_GetFont, /* 93 */
+ Tk_GetFontFromObj, /* 94 */
+ Tk_GetFontMetrics, /* 95 */
+ Tk_GetGC, /* 96 */
+ Tk_GetImage, /* 97 */
+ Tk_GetImageMasterData, /* 98 */
+ Tk_GetItemTypes, /* 99 */
+ Tk_GetJoinStyle, /* 100 */
+ Tk_GetJustify, /* 101 */
+ Tk_GetNumMainWindows, /* 102 */
+ Tk_GetOption, /* 103 */
+ Tk_GetPixels, /* 104 */
+ Tk_GetPixmap, /* 105 */
+ Tk_GetRelief, /* 106 */
+ Tk_GetRootCoords, /* 107 */
+ Tk_GetScrollInfo, /* 108 */
+ Tk_GetScreenMM, /* 109 */
+ Tk_GetSelection, /* 110 */
+ Tk_GetUid, /* 111 */
+ Tk_GetVisual, /* 112 */
+ Tk_GetVRootGeometry, /* 113 */
+ Tk_Grab, /* 114 */
+ Tk_HandleEvent, /* 115 */
+ Tk_IdToWindow, /* 116 */
+ Tk_ImageChanged, /* 117 */
+ Tk_Init, /* 118 */
+ Tk_InternAtom, /* 119 */
+ Tk_IntersectTextLayout, /* 120 */
+ Tk_MaintainGeometry, /* 121 */
+ Tk_MainWindow, /* 122 */
+ Tk_MakeWindowExist, /* 123 */
+ Tk_ManageGeometry, /* 124 */
+ Tk_MapWindow, /* 125 */
+ Tk_MeasureChars, /* 126 */
+ Tk_MoveResizeWindow, /* 127 */
+ Tk_MoveWindow, /* 128 */
+ Tk_MoveToplevelWindow, /* 129 */
+ Tk_NameOf3DBorder, /* 130 */
+ Tk_NameOfAnchor, /* 131 */
+ Tk_NameOfBitmap, /* 132 */
+ Tk_NameOfCapStyle, /* 133 */
+ Tk_NameOfColor, /* 134 */
+ Tk_NameOfCursor, /* 135 */
+ Tk_NameOfFont, /* 136 */
+ Tk_NameOfImage, /* 137 */
+ Tk_NameOfJoinStyle, /* 138 */
+ Tk_NameOfJustify, /* 139 */
+ Tk_NameOfRelief, /* 140 */
+ Tk_NameToWindow, /* 141 */
+ Tk_OwnSelection, /* 142 */
+ Tk_ParseArgv, /* 143 */
+ Tk_PhotoPutBlock_NoComposite, /* 144 */
+ Tk_PhotoPutZoomedBlock_NoComposite, /* 145 */
+ Tk_PhotoGetImage, /* 146 */
+ Tk_PhotoBlank, /* 147 */
+ Tk_PhotoExpand, /* 148 */
+ Tk_PhotoGetSize, /* 149 */
+ Tk_PhotoSetSize, /* 150 */
+ Tk_PointToChar, /* 151 */
+ Tk_PostscriptFontName, /* 152 */
+ Tk_PreserveColormap, /* 153 */
+ Tk_QueueWindowEvent, /* 154 */
+ Tk_RedrawImage, /* 155 */
+ Tk_ResizeWindow, /* 156 */
+ Tk_RestackWindow, /* 157 */
+ Tk_RestrictEvents, /* 158 */
+ Tk_SafeInit, /* 159 */
+ Tk_SetAppName, /* 160 */
+ Tk_SetBackgroundFromBorder, /* 161 */
+ Tk_SetClass, /* 162 */
+ Tk_SetGrid, /* 163 */
+ Tk_SetInternalBorder, /* 164 */
+ Tk_SetWindowBackground, /* 165 */
+ Tk_SetWindowBackgroundPixmap, /* 166 */
+ Tk_SetWindowBorder, /* 167 */
+ Tk_SetWindowBorderWidth, /* 168 */
+ Tk_SetWindowBorderPixmap, /* 169 */
+ Tk_SetWindowColormap, /* 170 */
+ Tk_SetWindowVisual, /* 171 */
+ Tk_SizeOfBitmap, /* 172 */
+ Tk_SizeOfImage, /* 173 */
+ Tk_StrictMotif, /* 174 */
+ Tk_TextLayoutToPostscript, /* 175 */
+ Tk_TextWidth, /* 176 */
+ Tk_UndefineCursor, /* 177 */
+ Tk_UnderlineChars, /* 178 */
+ Tk_UnderlineTextLayout, /* 179 */
+ Tk_Ungrab, /* 180 */
+ Tk_UnmaintainGeometry, /* 181 */
+ Tk_UnmapWindow, /* 182 */
+ Tk_UnsetGrid, /* 183 */
+ Tk_UpdatePointer, /* 184 */
+ Tk_AllocBitmapFromObj, /* 185 */
+ Tk_Alloc3DBorderFromObj, /* 186 */
+ Tk_AllocColorFromObj, /* 187 */
+ Tk_AllocCursorFromObj, /* 188 */
+ Tk_AllocFontFromObj, /* 189 */
+ Tk_CreateOptionTable, /* 190 */
+ Tk_DeleteOptionTable, /* 191 */
+ Tk_Free3DBorderFromObj, /* 192 */
+ Tk_FreeBitmapFromObj, /* 193 */
+ Tk_FreeColorFromObj, /* 194 */
+ Tk_FreeConfigOptions, /* 195 */
+ Tk_FreeSavedOptions, /* 196 */
+ Tk_FreeCursorFromObj, /* 197 */
+ Tk_FreeFontFromObj, /* 198 */
+ Tk_Get3DBorderFromObj, /* 199 */
+ Tk_GetAnchorFromObj, /* 200 */
+ Tk_GetBitmapFromObj, /* 201 */
+ Tk_GetColorFromObj, /* 202 */
+ Tk_GetCursorFromObj, /* 203 */
+ Tk_GetOptionInfo, /* 204 */
+ Tk_GetOptionValue, /* 205 */
+ Tk_GetJustifyFromObj, /* 206 */
+ Tk_GetMMFromObj, /* 207 */
+ Tk_GetPixelsFromObj, /* 208 */
+ Tk_GetReliefFromObj, /* 209 */
+ Tk_GetScrollInfoObj, /* 210 */
+ Tk_InitOptions, /* 211 */
+ Tk_MainEx, /* 212 */
+ Tk_RestoreSavedOptions, /* 213 */
+ Tk_SetOptions, /* 214 */
+ Tk_InitConsoleChannels, /* 215 */
+ Tk_CreateConsoleWindow, /* 216 */
+ Tk_CreateSmoothMethod, /* 217 */
+ NULL, /* 218 */
+ NULL, /* 219 */
+ Tk_GetDash, /* 220 */
+ Tk_CreateOutline, /* 221 */
+ Tk_DeleteOutline, /* 222 */
+ Tk_ConfigOutlineGC, /* 223 */
+ Tk_ChangeOutlineGC, /* 224 */
+ Tk_ResetOutlineGC, /* 225 */
+ Tk_CanvasPsOutline, /* 226 */
+ Tk_SetTSOrigin, /* 227 */
+ Tk_CanvasGetCoordFromObj, /* 228 */
+ Tk_CanvasSetOffset, /* 229 */
+ Tk_DitherPhoto, /* 230 */
+ Tk_PostscriptBitmap, /* 231 */
+ Tk_PostscriptColor, /* 232 */
+ Tk_PostscriptFont, /* 233 */
+ Tk_PostscriptImage, /* 234 */
+ Tk_PostscriptPath, /* 235 */
+ Tk_PostscriptStipple, /* 236 */
+ Tk_PostscriptY, /* 237 */
+ Tk_PostscriptPhoto, /* 238 */
+ Tk_CreateClientMessageHandler, /* 239 */
+ Tk_DeleteClientMessageHandler, /* 240 */
+ Tk_CreateAnonymousWindow, /* 241 */
+ Tk_SetClassProcs, /* 242 */
+ Tk_SetInternalBorderEx, /* 243 */
+ Tk_SetMinimumRequestSize, /* 244 */
+ Tk_SetCaretPos, /* 245 */
+ Tk_PhotoPutBlock, /* 246 */
+ Tk_PhotoPutZoomedBlock, /* 247 */
+ Tk_CollapseMotionEvents, /* 248 */
+ Tk_RegisterStyleEngine, /* 249 */
+ Tk_GetStyleEngine, /* 250 */
+ Tk_RegisterStyledElement, /* 251 */
+ Tk_GetElementId, /* 252 */
+ Tk_CreateStyle, /* 253 */
+ Tk_GetStyle, /* 254 */
+ Tk_FreeStyle, /* 255 */
+ Tk_NameOfStyle, /* 256 */
+ Tk_AllocStyleFromObj, /* 257 */
+ Tk_GetStyleFromObj, /* 258 */
+ Tk_FreeStyleFromObj, /* 259 */
+ Tk_GetStyledElement, /* 260 */
+ Tk_GetElementSize, /* 261 */
+ Tk_GetElementBox, /* 262 */
+ Tk_GetElementBorderWidth, /* 263 */
+ Tk_DrawElement, /* 264 */
+};
+
+/* !END!: Do not edit above this line. */
+
+#undef UNIX_TK
+#undef MAC_TK
+#undef MAC_OSX_TK
diff --git a/tcl/generic/tkStubLib.c b/tcl/generic/tkStubLib.c
new file mode 100644
index 00000000000..08868276d3f
--- /dev/null
+++ b/tcl/generic/tkStubLib.c
@@ -0,0 +1,119 @@
+/*
+ * tkStubLib.c --
+ *
+ * Stub object that will be statically linked into extensions that wish
+ * to access Tk.
+ *
+ * Copyright (c) 1998 Paul Duffin.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+
+/*
+ * We need to ensure that we use the stub macros so that this file contains
+ * no references to any of the stub functions. This will make it possible
+ * to build an extension that references Tk_InitStubs but doesn't end up
+ * including the rest of the stub functions.
+ */
+
+#ifndef USE_TCL_STUBS
+#define USE_TCL_STUBS
+#endif
+#undef USE_TCL_STUB_PROCS
+
+#ifndef USE_TK_STUBS
+#define USE_TK_STUBS
+#endif
+#undef USE_TK_STUB_PROCS
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+#ifdef MAC_TCL
+#include "tkMacInt.h"
+#endif
+
+#ifdef MAC_OSX_TK
+#include "tkMacOSXInt.h"
+#endif
+
+#include "tkDecls.h"
+#include "tkIntDecls.h"
+#include "tkPlatDecls.h"
+#include "tkIntPlatDecls.h"
+#include "tkIntXlibDecls.h"
+
+/*
+ * Ensure that Tk_InitStubs is built as an exported symbol. The other stub
+ * functions should be built as non-exported symbols.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+TkStubs *tkStubsPtr;
+TkPlatStubs *tkPlatStubsPtr;
+TkIntStubs *tkIntStubsPtr;
+TkIntPlatStubs *tkIntPlatStubsPtr;
+TkIntXlibStubs *tkIntXlibStubsPtr;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_InitStubs --
+ *
+ * Checks that the correct version of Tk is loaded and that it
+ * supports stubs. It then initialises the stub table pointers.
+ *
+ * Results:
+ * The actual version of Tk that satisfies the request, or
+ * NULL to indicate that an error occurred.
+ *
+ * Side effects:
+ * Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef Tk_InitStubs
+#undef Tk_InitStubs
+#endif
+
+CONST char *
+Tk_InitStubs(interp, version, exact)
+ Tcl_Interp *interp;
+ char *version;
+ int exact;
+{
+ CONST char *actualVersion;
+
+ actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, exact,
+ (ClientData *) &tkStubsPtr);
+ if (!actualVersion) {
+ return NULL;
+ }
+
+ if (!tkStubsPtr) {
+ Tcl_SetResult(interp,
+ "This implementation of Tk does not support stubs",
+ TCL_STATIC);
+ return NULL;
+ }
+
+ tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs;
+ tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs;
+ tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs;
+ tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs;
+
+ return actualVersion;
+}
diff --git a/tcl/generic/tkStyle.c b/tcl/generic/tkStyle.c
new file mode 100644
index 00000000000..db1f27e4d34
--- /dev/null
+++ b/tcl/generic/tkStyle.c
@@ -0,0 +1,1664 @@
+/*
+ * tkStyle.c --
+ *
+ * This file implements the widget styles and themes support.
+ *
+ * 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$
+ */
+
+#include "tkInt.h"
+
+/*
+ * The following structure is used to cache widget option specs matching an
+ * element's required options defined by Tk_ElementOptionSpecs. It also holds
+ * information behind Tk_StyledElement opaque tokens.
+ */
+
+typedef struct StyledWidgetSpec {
+ struct StyledElement *elementPtr; /* Pointer to the element holding this
+ * structure. */
+ Tk_OptionTable optionTable; /* Option table for the widget class
+ * using the element. */
+ CONST Tk_OptionSpec **optionsPtr; /* Table of option spec pointers,
+ * matching the option list provided
+ * during element registration.
+ * Malloc'd. */
+} StyledWidgetSpec;
+
+/*
+ * Elements are declared using static templates. But static
+ * information must be completed by dynamic information only
+ * accessible at runtime. For each registered element, an instance of
+ * the following structure is stored in each style engine and used to
+ * cache information about the widget types (identified by their
+ * optionTable) that use the given element.
+ */
+
+typedef struct StyledElement {
+ struct Tk_ElementSpec *specPtr;
+ /* Filled with template provided during
+ * registration. NULL means no implementation
+ * is available for the current engine. */
+ int nbWidgetSpecs; /* Size of the array below. Number of distinct
+ * widget classes (actually, distinct option
+ * tables) that used the element so far. */
+ StyledWidgetSpec *widgetSpecs;
+ /* See above for the structure definition.
+ * Table grows dynamically as new widgets
+ * use the element. Malloc'd. */
+} StyledElement;
+
+/*
+ * The following structure holds information behind Tk_StyleEngine opaque
+ * tokens.
+ */
+
+typedef struct StyleEngine {
+ CONST char *name; /* Name of engine. Points to a hash key. */
+ StyledElement *elements; /* Table of widget element descriptors. Each
+ * element is indexed by a unique system-wide
+ * ID. Table grows dynamically as new elements
+ * are registered. Malloc'd*/
+ struct StyleEngine *parentPtr;
+ /* Parent engine. Engines may be layered to form
+ * a fallback chain, terminated by the default
+ * system engine. */
+} StyleEngine;
+
+/*
+ * Styles are instances of style engines. The following structure holds
+ * information behind Tk_Style opaque tokens.
+ */
+
+typedef struct Style {
+ int refCount; /* Number of active uses of this style.
+ * If this count is 0, then this Style
+ * structure is no longer valid. */
+ Tcl_HashEntry *hashPtr; /* Entry in style table for this structure,
+ * used when deleting it. */
+ CONST char *name; /* Name of style. Points to a hash key. */
+ StyleEngine *enginePtr; /* Style engine of which the style is an
+ * instance. */
+ ClientData clientData; /* Data provided during registration. */
+} Style;
+
+/*
+ * Each registered element uses an instance of the following structure.
+ */
+
+typedef struct Element {
+ CONST char *name; /* Name of element. Points to a hash key. */
+ int id; /* Id of element. */
+ int genericId; /* Id of generic element. */
+ int created; /* Boolean, whether the element was created
+ * explicitly (was registered) or implicitly
+ * (by a derived element). */
+} Element;
+
+/*
+ * Thread-local data.
+ */
+
+typedef struct ThreadSpecificData {
+ int nbInit; /* Number of calls to the init proc. */
+ Tcl_HashTable engineTable; /* Map a name to a style engine. Keys are
+ * strings, values are Tk_StyleEngine
+ * pointers. */
+ StyleEngine *defaultEnginePtr;
+ /* Default, core-defined style engine. Global
+ * fallback for all engines. */
+ Tcl_HashTable styleTable; /* Map a name to a style. Keys are strings,
+ * values are Tk_Style pointers.*/
+ int nbElements; /* Size of the below tables. */
+ Tcl_HashTable elementTable; /* Map a name to an element Id. Keys are
+ * strings, values are integer element IDs. */
+ Element *elements; /* Array of Elements. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+/* TODO: sort alpha. */
+static int CreateElement _ANSI_ARGS_((CONST char *name,
+ int create));
+static void DupStyleObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeElement _ANSI_ARGS_((Element *elementPtr));
+static void FreeStyle _ANSI_ARGS_((Style *stylePtr));
+static void FreeStyledElement _ANSI_ARGS_((
+ StyledElement *elementPtr));
+static void FreeStyleEngine _ANSI_ARGS_((
+ StyleEngine *enginePtr));
+static void FreeStyleObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void FreeWidgetSpec _ANSI_ARGS_((
+ StyledWidgetSpec *widgetSpecPtr));
+static StyledElement * GetStyledElement _ANSI_ARGS_((
+ StyleEngine *enginePtr, int elementId));
+static StyledWidgetSpec * GetWidgetSpec _ANSI_ARGS_((StyledElement *elementPtr,
+ Tk_OptionTable optionTable));
+static void InitElement _ANSI_ARGS_((Element *elementPtr,
+ CONST char *name, int id, int genericId,
+ int created));
+static void InitStyle _ANSI_ARGS_((Style *stylePtr,
+ Tcl_HashEntry *hashPtr, CONST char *name,
+ StyleEngine *enginePtr, ClientData clientData));
+static void InitStyledElement _ANSI_ARGS_((
+ StyledElement *elementPtr));
+static void InitStyleEngine _ANSI_ARGS_((StyleEngine *enginePtr,
+ CONST char *name, StyleEngine *parentPtr));
+static void InitWidgetSpec _ANSI_ARGS_((
+ StyledWidgetSpec *widgetSpecPtr,
+ StyledElement *elementPtr,
+ Tk_OptionTable optionTable));
+static int SetStyleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "style" Tcl
+ * object, used for drawing. The internalRep.otherValuePtr field of
+ * each style object points to the Style structure for the stylefont, or
+ * NULL.
+ */
+
+static Tcl_ObjType styleObjType = {
+ "style", /* name */
+ FreeStyleObjProc, /* freeIntRepProc */
+ DupStyleObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetStyleFromAny /* setFromAnyProc */
+};
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkStylePkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the style
+ * package on a per application basis.
+ *
+ * Results:
+ * Stores data in thread-local storage.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkStylePkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->nbInit != 0) return;
+
+ /*
+ * Initialize tables.
+ */
+
+ Tcl_InitHashTable(&tsdPtr->engineTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&tsdPtr->styleTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&tsdPtr->elementTable, TCL_STRING_KEYS);
+ tsdPtr->nbElements = 0;
+ tsdPtr->elements = NULL;
+
+ /*
+ * Create the default system engine.
+ */
+
+ tsdPtr->defaultEnginePtr =
+ (StyleEngine *) Tk_RegisterStyleEngine(NULL, NULL);
+
+ /*
+ * Create the default system style.
+ */
+
+ Tk_CreateStyle(NULL, (Tk_StyleEngine) tsdPtr->defaultEnginePtr,
+ (ClientData) 0);
+
+ tsdPtr->nbInit++;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkStylePkgFree --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures that were used by the style package
+ * for this application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkStylePkgFree(mainPtr)
+ TkMainInfo *mainPtr; /* The application being deleted. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ StyleEngine *enginePtr;
+ int i;
+
+ tsdPtr->nbInit--;
+ if (tsdPtr->nbInit != 0) return;
+
+ /*
+ * Free styles.
+ */
+
+ entryPtr = Tcl_FirstHashEntry(&tsdPtr->styleTable, &search);
+ while (entryPtr != NULL) {
+ ckfree((char *) Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->styleTable);
+
+ /*
+ * Free engines.
+ */
+
+ entryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
+ while (entryPtr != NULL) {
+ enginePtr = (StyleEngine *) Tcl_GetHashValue(entryPtr);
+ FreeStyleEngine(enginePtr);
+ ckfree((char *) enginePtr);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->engineTable);
+
+ /*
+ * Free elements.
+ */
+
+ for (i = 0; i < tsdPtr->nbElements; i++) {
+ FreeElement(tsdPtr->elements+i);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->elementTable);
+ ckfree((char *) tsdPtr->elements);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_RegisterStyleEngine --
+ *
+ * This procedure is called to register a new style engine. Style engines
+ * are stored in thread-local space.
+ *
+ * Results:
+ * The newly allocated engine.
+ *
+ * Side effects:
+ * Memory allocated. Data added to thread-local table.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyleEngine
+Tk_RegisterStyleEngine(name, parent)
+ CONST char *name; /* Name of the engine to create. NULL or empty
+ * means the default system engine. */
+ Tk_StyleEngine parent; /* The engine's parent. NULL means the default
+ * system engine. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ StyleEngine *enginePtr;
+
+ /*
+ * Attempt to create a new entry in the engine table.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->engineTable, (name?name:""),
+ &newEntry);
+ if (!newEntry) {
+ /*
+ * An engine was already registered by that name.
+ */
+
+ return NULL;
+ }
+
+ /*
+ * Allocate and intitialize a new engine.
+ */
+
+ enginePtr = (StyleEngine *) ckalloc(sizeof(StyleEngine));
+ InitStyleEngine(enginePtr, Tcl_GetHashKey(&tsdPtr->engineTable, entryPtr),
+ (StyleEngine *) parent);
+ Tcl_SetHashValue(entryPtr, (ClientData) enginePtr);
+
+ return (Tk_StyleEngine) enginePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyleEngine --
+ *
+ * Initialize a newly allocated style engine.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyleEngine(enginePtr, name, parentPtr)
+ StyleEngine *enginePtr; /* Points to an uninitialized engine. */
+ CONST char *name; /* Name of the registered engine. NULL or empty
+ * means the default system engine. Usually
+ * points to the hash key. */
+ StyleEngine *parentPtr; /* The engine's parent. NULL means the default
+ * system engine. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int elementId;
+
+ if (name == NULL || *name == '\0') {
+ /*
+ * This is the default style engine.
+ */
+
+ enginePtr->parentPtr = NULL;
+
+ } else if (parentPtr == NULL) {
+ /*
+ * The default style engine is the parent.
+ */
+
+ enginePtr->parentPtr = tsdPtr->defaultEnginePtr;
+
+ } else {
+ enginePtr->parentPtr = parentPtr;
+ }
+
+ /*
+ * Allocate and initialize elements array.
+ */
+
+ if (tsdPtr->nbElements > 0) {
+ enginePtr->elements = (StyledElement *) ckalloc(
+ sizeof(StyledElement) * tsdPtr->nbElements);
+ for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
+ InitStyledElement(enginePtr->elements+elementId);
+ }
+ } else {
+ enginePtr->elements = NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyleEngine --
+ *
+ * Free an engine and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyleEngine(enginePtr)
+ StyleEngine *enginePtr; /* The style engine to free. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int elementId;
+
+ /*
+ * Free allocated elements.
+ */
+
+ for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
+ FreeStyledElement(enginePtr->elements+elementId);
+ }
+ ckfree((char *) enginePtr->elements);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyleEngine --
+ *
+ * Retrieve a registered style engine by its name.
+ *
+ * Results:
+ * A pointer to the style engine, or NULL if none found.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyleEngine
+Tk_GetStyleEngine(name)
+ CONST char *name; /* Name of the engine to retrieve. NULL or
+ * empty means the default system engine. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+
+ if (name == NULL) {
+ return (Tk_StyleEngine) tsdPtr->defaultEnginePtr;
+ }
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->engineTable, (name?name:""));
+ if (!entryPtr) {
+ return NULL;
+ }
+
+ return (Tk_StyleEngine) Tcl_GetHashValue(entryPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitElement --
+ *
+ * Initialize a newly allocated element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitElement(elementPtr, name, id, genericId, created)
+ Element *elementPtr; /* Points to an uninitialized element.*/
+ CONST char *name; /* Name of the registered element. Usually
+ * points to the hash key. */
+ int id; /* Unique element ID. */
+ int genericId; /* ID of generic element. -1 means none. */
+ int created; /* Boolean, whether the element was created
+ * explicitly (was registered) or implicitly
+ * (by a derived element). */
+{
+ elementPtr->name = name;
+ elementPtr->id = id;
+ elementPtr->genericId = genericId;
+ elementPtr->created = (created?1:0);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeElement --
+ *
+ * Free an element and its associated data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeElement(elementPtr)
+ Element *elementPtr; /* The element to free. */
+{
+ /* Nothing to do. */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyledElement --
+ *
+ * Initialize a newly allocated styled element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyledElement(elementPtr)
+ StyledElement *elementPtr; /* Points to an uninitialized element.*/
+{
+ memset(elementPtr, 0, sizeof(StyledElement));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyledElement --
+ *
+ * Free a styled element and its associated data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyledElement(elementPtr)
+ StyledElement *elementPtr; /* The styled element to free. */
+{
+ int i;
+
+ /*
+ * Free allocated widget specs.
+ */
+
+ for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
+ FreeWidgetSpec(elementPtr->widgetSpecs+i);
+ }
+ ckfree((char *) elementPtr->widgetSpecs);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CreateElement --
+ *
+ * Find an existing or create a new element.
+ *
+ * Results:
+ * The unique ID for the created or found element.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+CreateElement(name, create)
+ CONST char *name; /* Name of the element. */
+ int create; /* Boolean, whether the element is being created
+ * explicitly (being registered) or implicitly (by a
+ * derived element). */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr, *engineEntryPtr;
+ Tcl_HashSearch search;
+ int newEntry;
+ int elementId, genericId = -1;
+ char *dot;
+ StyleEngine *enginePtr;
+
+ /*
+ * Find or create the element.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->elementTable, name, &newEntry);
+ if (!newEntry) {
+ elementId = (int) Tcl_GetHashValue(entryPtr);
+ if (create) {
+ tsdPtr->elements[elementId].created = 1;
+ }
+ return elementId;
+ }
+
+ /*
+ * The element didn't exist. If it's a derived element, find or
+ * create its generic element ID.
+ */
+
+ dot = strchr(name, '.');
+ if (dot) {
+ genericId = CreateElement(dot+1, 0);
+ }
+
+ elementId = tsdPtr->nbElements++;
+ Tcl_SetHashValue(entryPtr, (ClientData) elementId);
+
+ /*
+ * Reallocate element table.
+ */
+
+ tsdPtr->elements = (Element *) ckrealloc((char *) tsdPtr->elements,
+ sizeof(Element) * tsdPtr->nbElements);
+ InitElement(tsdPtr->elements+elementId,
+ Tcl_GetHashKey(&tsdPtr->elementTable, entryPtr), elementId,
+ genericId, create);
+
+ /*
+ * Reallocate style engines' element table.
+ */
+
+ engineEntryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
+ while (engineEntryPtr != NULL) {
+ enginePtr = (StyleEngine *) Tcl_GetHashValue(engineEntryPtr);
+
+ enginePtr->elements = (StyledElement *) ckrealloc(
+ (char *) enginePtr->elements,
+ sizeof(StyledElement) * tsdPtr->nbElements);
+ InitStyledElement(enginePtr->elements+elementId);
+
+ engineEntryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ return elementId;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementId --
+ *
+ * Find an existing element.
+ *
+ * Results:
+ * The unique ID for the found element, or -1 if not found.
+ *
+ * Side effects:
+ * Generic elements may be created.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_GetElementId(name)
+ CONST char *name; /* Name of the element. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int genericId = -1;
+ char *dot;
+
+ /*
+ * Find the element Id.
+ */
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->elementTable, name);
+ if (entryPtr) {
+ return (int) Tcl_GetHashValue(entryPtr);
+ }
+
+ /*
+ * Element not found. If the given name was derived, then first search for
+ * the generic element. If found, create the new derived element.
+ */
+
+ dot = strchr(name, '.');
+ if (!dot) {
+ return -1;
+ }
+ genericId = Tk_GetElementId(dot+1);
+ if (genericId == -1) {
+ return -1;
+ }
+ if (!tsdPtr->elements[genericId].created) {
+ /*
+ * The generic element was created implicitly and thus has no real
+ * existence.
+ */
+
+ return -1;
+ } else {
+ /*
+ * The generic element was created explicitly. Create the derived
+ * element.
+ */
+
+ return CreateElement(name, 1);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_RegisterStyledElement --
+ *
+ * Register an implementation of a new or existing element for the
+ * given style engine.
+ *
+ * Results:
+ * The unique ID for the created or found element.
+ *
+ * Side effects:
+ * Elements may be created. Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_RegisterStyledElement(engine, templatePtr)
+ Tk_StyleEngine engine; /* Style engine providing the
+ * implementation. */
+ Tk_ElementSpec *templatePtr; /* Static template information about
+ * the element. */
+{
+ int elementId;
+ StyledElement *elementPtr;
+ Tk_ElementSpec *specPtr;
+ int nbOptions;
+ register Tk_ElementOptionSpec *srcOptions, *dstOptions;
+
+ if (templatePtr->version != TK_STYLE_VERSION_1) {
+ /*
+ * Version mismatch. Do nothing.
+ */
+
+ return -1;
+ }
+
+ if (engine == NULL) {
+ engine = Tk_GetStyleEngine(NULL);
+ }
+
+ /*
+ * Register the element, allocating storage in the various engines if
+ * necessary.
+ */
+
+ elementId = CreateElement(templatePtr->name, 1);
+
+ /*
+ * Initialize the styled element.
+ */
+
+ elementPtr = ((StyleEngine *) engine)->elements+elementId;
+
+ specPtr = (Tk_ElementSpec *) ckalloc(sizeof(Tk_ElementSpec));
+ specPtr->version = templatePtr->version;
+ specPtr->name = ckalloc(strlen(templatePtr->name)+1);
+ strcpy(specPtr->name, templatePtr->name);
+ nbOptions = 0;
+ for (nbOptions = 0, srcOptions = templatePtr->options;
+ srcOptions->name != NULL;
+ nbOptions++, srcOptions++);
+ specPtr->options = (Tk_ElementOptionSpec *) ckalloc(
+ sizeof(Tk_ElementOptionSpec) * (nbOptions+1));
+ for (srcOptions = templatePtr->options, dstOptions = specPtr->options;
+ /* End condition within loop */;
+ srcOptions++, dstOptions++) {
+ if (srcOptions->name == NULL) {
+ dstOptions->name = NULL;
+ break;
+ }
+
+ dstOptions->name = ckalloc(strlen(srcOptions->name)+1);
+ strcpy(dstOptions->name, srcOptions->name);
+ dstOptions->type = srcOptions->type;
+ }
+ specPtr->getSize = templatePtr->getSize;
+ specPtr->getBox = templatePtr->getBox;
+ specPtr->getBorderWidth = templatePtr->getBorderWidth;
+ specPtr->draw = templatePtr->draw;
+
+ elementPtr->specPtr = specPtr;
+ elementPtr->nbWidgetSpecs = 0;
+ elementPtr->widgetSpecs = NULL;
+
+ return elementId;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetStyledElement --
+ *
+ * Get a registered implementation of an existing element for the
+ * given style engine.
+ *
+ * Results:
+ * The styled element descriptor, or NULL if not found.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static StyledElement *
+GetStyledElement(enginePtr, elementId)
+ StyleEngine *enginePtr; /* Style engine providing the implementation.
+ * NULL means the default system engine. */
+ int elementId; /* Unique element ID */{
+ StyledElement *elementPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ StyleEngine *enginePtr2;
+
+ if (enginePtr == NULL) {
+ enginePtr = tsdPtr->defaultEnginePtr;
+ }
+
+ while (elementId >= 0 && elementId < tsdPtr->nbElements) {
+ /*
+ * Look for an implemented element through the engine chain.
+ */
+
+ enginePtr2 = enginePtr;
+ do {
+ elementPtr = enginePtr2->elements+elementId;
+ if (elementPtr->specPtr != NULL) {
+ return elementPtr;
+ }
+ enginePtr2 = enginePtr2->parentPtr;
+ } while (enginePtr2 != NULL);
+
+ /*
+ * None found, try with the generic element.
+ */
+
+ elementId = tsdPtr->elements[elementId].genericId;
+ }
+
+ /*
+ * No matching element found.
+ */
+
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitWidgetSpec --
+ *
+ * Initialize a newly allocated widget spec.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable)
+ StyledWidgetSpec *widgetSpecPtr; /* Points to an uninitialized widget
+ * spec. */
+ StyledElement *elementPtr; /* Styled element descriptor. */
+ Tk_OptionTable optionTable; /* The widget's option table. */
+{
+ int i, nbOptions;
+ Tk_ElementOptionSpec *elementOptionPtr;
+ CONST Tk_OptionSpec *widgetOptionPtr;
+
+ widgetSpecPtr->elementPtr = elementPtr;
+ widgetSpecPtr->optionTable = optionTable;
+
+ /*
+ * Count the number of options.
+ */
+
+ for (nbOptions = 0, elementOptionPtr = elementPtr->specPtr->options;
+ elementOptionPtr->name != NULL;
+ nbOptions++, elementOptionPtr++) {
+ }
+
+ /*
+ * Build the widget option list.
+ */
+
+ widgetSpecPtr->optionsPtr = (CONST Tk_OptionSpec **) ckalloc(
+ sizeof(Tk_OptionSpec *) * nbOptions);
+ for (i = 0, elementOptionPtr = elementPtr->specPtr->options;
+ i < nbOptions;
+ i++, elementOptionPtr++) {
+ widgetOptionPtr = TkGetOptionSpec(elementOptionPtr->name, optionTable);
+
+ /*
+ * Check that the widget option type is compatible with one of the
+ * element's required types.
+ */
+
+ if ( elementOptionPtr->type == TK_OPTION_END
+ || elementOptionPtr->type == widgetOptionPtr->type) {
+ widgetSpecPtr->optionsPtr[i] = widgetOptionPtr;
+ } else {
+ widgetSpecPtr->optionsPtr[i] = NULL;
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeWidgetSpec --
+ *
+ * Free a widget spec and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeWidgetSpec(widgetSpecPtr)
+ StyledWidgetSpec *widgetSpecPtr; /* The widget spec to free. */
+{
+ ckfree((char *) widgetSpecPtr->optionsPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetWidgetSpec --
+ *
+ * Return a new or existing widget spec for the given element and
+ * widget type (identified by its option table).
+ *
+ * Results:
+ * A pointer to the matching widget spec.
+ *
+ * Side effects:
+ * Memory may be allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static StyledWidgetSpec *
+GetWidgetSpec(elementPtr, optionTable)
+ StyledElement *elementPtr; /* Styled element descriptor. */
+ Tk_OptionTable optionTable; /* The widget's option table. */
+{
+ StyledWidgetSpec *widgetSpecPtr;
+ int i;
+
+ /*
+ * Try to find an existing widget spec.
+ */
+
+ for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
+ widgetSpecPtr = elementPtr->widgetSpecs+i;
+ if (widgetSpecPtr->optionTable == optionTable) {
+ return widgetSpecPtr;
+ }
+ }
+
+ /*
+ * Create and initialize a new widget spec.
+ */
+
+ i = elementPtr->nbWidgetSpecs++;
+ elementPtr->widgetSpecs = (StyledWidgetSpec *) ckrealloc(
+ (char *) elementPtr->widgetSpecs,
+ sizeof(StyledWidgetSpec) * elementPtr->nbWidgetSpecs);
+ widgetSpecPtr = elementPtr->widgetSpecs+i;
+ InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable);
+
+ return widgetSpecPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyledElement --
+ *
+ * This procedure returns a styled instance of the given element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyledElement
+Tk_GetStyledElement(style, elementId, optionTable)
+ Tk_Style style; /* The widget style. */
+ int elementId; /* Unique element ID. */
+ Tk_OptionTable optionTable; /* Option table for the widget. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledElement *elementPtr;
+
+ /*
+ * Get an element implementation and call corresponding hook.
+ */
+
+ elementPtr = GetStyledElement((stylePtr?stylePtr->enginePtr:NULL),
+ elementId);
+ if (!elementPtr) {
+ return NULL;
+ }
+
+ return (Tk_StyledElement) GetWidgetSpec(elementPtr, optionTable);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementSize --
+ *
+ * This procedure computes the size of the given widget element according
+ * to its style.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_GetElementSize(style, element, recordPtr, tkwin, width, height, inner, widthPtr,
+ heightPtr)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+ int width, height; /* Requested size. */
+ int inner; /* Boolean. If TRUE, compute the outer
+ * size according to the requested
+ * minimum inner size. If FALSE, compute
+ * the inner size according to the
+ * requested maximum outer size. */
+ int *widthPtr, *heightPtr; /* Returned size. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->getSize(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, width, height, inner,
+ widthPtr, heightPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementBox --
+ *
+ * This procedure computes the bounding or inscribed box coordinates
+ * of the given widget element according to its style and within the
+ * given limits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_GetElementBox(style, element, recordPtr, tkwin, x, y, width, height, inner,
+ xPtr, yPtr, widthPtr, heightPtr)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+ int x, y; /* Top left corner of available area. */
+ int width, height; /* Size of available area. */
+ int inner; /* Boolean. If TRUE, compute the
+ * bounding box according to the
+ * requested inscribed box size. If
+ * FALSE, compute the inscribed box
+ * according to the requested bounding
+ * box. */
+ int *xPtr, *yPtr; /* Returned top left corner. */
+ int *widthPtr, *heightPtr; /* Returned size. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->getBox(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, x, y, width, height,
+ inner, xPtr, yPtr, widthPtr, heightPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementBorderWidth --
+ *
+ * This procedure computes the border widthof the given widget element
+ * according to its style and within the given limits.
+ *
+ * Results:
+ * Border width in pixels. This value is uniform for all four sides.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_GetElementBorderWidth(style, element, recordPtr, tkwin)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ return widgetSpecPtr->elementPtr->specPtr->getBorderWidth(
+ stylePtr->clientData, recordPtr, widgetSpecPtr->optionsPtr, tkwin);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawElement --
+ *
+ * This procedure draw the given widget element in a given drawable area.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawElement(style, element, recordPtr, tkwin, d, x, y, width, height, state)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+ Drawable d; /* Where to draw element. */
+ int x, y; /* Top left corner of element. */
+ int width, height; /* Size of element. */
+ int state; /* Drawing state flags. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->draw(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, d, x, y, width,
+ height, state);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_CreateStyle --
+ *
+ * This procedure is called to create a new style as an instance of the
+ * given engine. Styles are stored in thread-local space.
+ *
+ * Results:
+ * The newly allocated style.
+ *
+ * Side effects:
+ * Memory allocated. Data added to thread-local table. The style's
+ * refCount is incremented.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_CreateStyle(name, engine, clientData)
+ CONST char *name; /* Name of the style to create. NULL or empty
+ * means the default system style. */
+ Tk_StyleEngine engine; /* The style engine. */
+ ClientData clientData; /* Private data passed as is to engine code. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ Style *stylePtr;
+
+ /*
+ * Attempt to create a new entry in the style table.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->styleTable, (name?name:""),
+ &newEntry);
+ if (!newEntry) {
+ /*
+ * A style was already registered by that name.
+ */
+
+ return NULL;
+ }
+
+ /*
+ * Allocate and intitialize a new style.
+ */
+
+ stylePtr = (Style *) ckalloc(sizeof(Style));
+ InitStyle(stylePtr, entryPtr, Tcl_GetHashKey(&tsdPtr->styleTable, entryPtr),
+ (engine?(StyleEngine *) engine:tsdPtr->defaultEnginePtr), clientData);
+ Tcl_SetHashValue(entryPtr, (ClientData) stylePtr);
+ stylePtr->refCount++;
+
+ return (Tk_Style) stylePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_NameOfStyle --
+ *
+ * Given a style, return its registered name.
+ *
+ * Results:
+ * The return value is the name that was passed to Tk_CreateStyle() to
+ * create the style. The storage for the returned string is private
+ * (it points to the corresponding hash key) The caller should not modify
+ * this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfStyle(style)
+ Tk_Style style; /* Style whose name is desired. */
+{
+ Style *stylePtr = (Style *) style;
+
+ return stylePtr->name;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyle --
+ *
+ * Initialize a newly allocated style.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyle(stylePtr, hashPtr, name, enginePtr, clientData)
+ Style *stylePtr; /* Points to an uninitialized style. */
+ Tcl_HashEntry *hashPtr; /* Hash entry for the registered style. */
+ CONST char *name; /* Name of the registered style. NULL or empty
+ * means the default system style. Usually
+ * points to the hash key. */
+ StyleEngine *enginePtr; /* The style engine. */
+ ClientData clientData; /* Private data passed as is to engine code. */
+{
+ stylePtr->refCount = 0;
+ stylePtr->hashPtr = hashPtr;
+ stylePtr->name = name;
+ stylePtr->enginePtr = enginePtr;
+ stylePtr->clientData = clientData;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyle --
+ *
+ * Free a style and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyle(stylePtr)
+ Style *stylePtr; /* The style to free. */
+{
+ /* Nothing to do. */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyle --
+ *
+ * Retrieve a registered style by its name.
+ *
+ * Results:
+ * A pointer to the style engine, or NULL if none found. In the latter
+ * case and if the interp is not NULL, an error message is left in the
+ * interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_GetStyle(interp, name)
+ Tcl_Interp *interp; /* Interp for error return. */
+ CONST char *name; /* Name of the style to retrieve. NULL or empty
+ * means the default system style. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ Style *stylePtr;
+
+ /*
+ * Search for a corresponding entry in the style table.
+ */
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name?name:""));
+ if (entryPtr == NULL) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", NULL);
+ }
+ return (Tk_Style) NULL;
+ }
+ stylePtr = (Style *) Tcl_GetHashValue(entryPtr);
+ stylePtr->refCount++;
+
+ return (Tk_Style) stylePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeStyle --
+ *
+ * Free a style previously created by Tk_CreateStyle.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The style's refCount is decremented. If it reaches zero, the style
+ * is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeStyle(style)
+ Tk_Style style; /* The style to free. */
+{
+ Style *stylePtr = (Style *) style;
+
+ if (stylePtr == NULL) {
+ return;
+ }
+ stylePtr->refCount--;
+ if (stylePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * Keep the default style alive.
+ */
+
+ if (*stylePtr->name == '\0') {
+ stylePtr->refCount = 1;
+ return;
+ }
+
+ Tcl_DeleteHashEntry(stylePtr->hashPtr);
+ FreeStyle(stylePtr);
+ ckfree((char *) stylePtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_AllocStyleFromObj --
+ *
+ * Map the string name of a style to a corresponding Tk_Style. The style
+ * must have already been created by Tk_CreateStyle.
+ *
+ * Results:
+ * The return value is a token for the style that matches objPtr, or
+ * NULL if none found. If NULL is returned, an error message will be
+ * left in interp's result object.
+ *
+ * Side effects:
+ * The style's reference count is incremented. For each call to this
+ * procedure, there should eventually be a call to Tk_FreeStyle() or
+ * Tk_FreeStyleFromObj() so that the database is cleaned up when styles
+ * aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_AllocStyleFromObj(interp, objPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Obj *objPtr; /* Object containing name of the style to
+ * retrieve. */
+{
+ Style *stylePtr;
+
+ if (objPtr->typePtr != &styleObjType) {
+ SetStyleFromAny(interp, objPtr);
+ stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
+ } else {
+ stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
+ stylePtr->refCount++;
+ }
+
+ return (Tk_Style) stylePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetStyleFromObj --
+ *
+ * Find the style that corresponds to a given object. The style must
+ * have already been created by Tk_CreateStyle.
+ *
+ * Results:
+ * The return value is a token for the style that matches objPtr, or
+ * NULL if none found.
+ *
+ * Side effects:
+ * If the object is not already a style ref, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_GetStyleFromObj(objPtr)
+ Tcl_Obj *objPtr; /* The object from which to get the style. */
+{
+ if (objPtr->typePtr != &styleObjType) {
+ SetStyleFromAny((Tcl_Interp *) NULL, objPtr);
+ }
+
+ return (Tk_Style) objPtr->internalRep.otherValuePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeStyleFromObj --
+ *
+ * Called to release a style inside a Tcl_Obj *.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the object is a style ref, the conversion will free its
+ * internal representation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeStyleFromObj(objPtr)
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ if (objPtr->typePtr == &styleObjType) {
+ FreeStyleObjProc(objPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetStyleFromAny --
+ *
+ * Convert the internal representation of a Tcl object to the
+ * style internal form.
+ *
+ * Results:
+ * Always returns TCL_OK. If an error occurs is returned (e.g. the
+ * style doesn't exist), an error message will be left in interp's
+ * result.
+ *
+ * Side effects:
+ * The object is left with its typePtr pointing to styleObjType.
+ * The reference count is incremented (in Tk_GetStyle()).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetStyleFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *name;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ name = Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &styleObjType;
+ objPtr->internalRep.otherValuePtr = (VOID *) Tk_GetStyle(interp, name);
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyleObjProc --
+ *
+ * This proc is called to release an object reference to a style.
+ * Called when the object's internal rep is released.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count is decremented (in Tk_FreeStyle()).
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyleObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ Style *stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
+
+ if (stylePtr != NULL) {
+ Tk_FreeStyle((Tk_Style) stylePtr);
+ objPtr->internalRep.otherValuePtr = NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupStyleObjProc --
+ *
+ * When a cached style object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The style's refCount is incremented and the internal rep of the copy
+ * is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupStyleObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ Style *stylePtr = (Style *) srcObjPtr->internalRep.otherValuePtr;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.otherValuePtr = (VOID *) stylePtr;
+
+ if (stylePtr != NULL) {
+ stylePtr->refCount++;
+ }
+}
diff --git a/tcl/generic/tkTest.c b/tcl/generic/tkTest.c
new file mode 100644
index 00000000000..080589c707f
--- /dev/null
+++ b/tcl/generic/tkTest.c
@@ -0,0 +1,2541 @@
+/*
+ * tkTest.c --
+ *
+ * This file contains C command procedures for a bunch of additional
+ * Tcl commands that are used for testing out Tcl's C interfaces.
+ * These commands are not normally included in Tcl applications;
+ * they're only used for testing.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkText.h"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+#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:
+ */
+
+#ifdef USE_OLD_IMAGE
+static int ImageCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, char **argv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+#else
+static int ImageCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, Tcl_Obj *CONST objv[],
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+#endif
+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 */
+ (Tk_ImageCreateProc *) ImageCreate, /* createProc */
+ ImageGet, /* getProc */
+ ImageDisplay, /* displayProc */
+ ImageFree, /* freeProc */
+ ImageDelete, /* deleteProc */
+ (Tk_ImagePostscriptProc *) NULL,/* postscriptPtr */
+ (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 SquareObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+
+typedef struct CBinding {
+ Tcl_Interp *interp;
+ char *command;
+ char *delete;
+} CBinding;
+
+/*
+ * Header for trivial configuration command items.
+ */
+
+#define ODD TK_CONFIG_USER_BIT
+#define EVEN (TK_CONFIG_USER_BIT << 1)
+
+enum {
+ NONE,
+ ODD_TYPE,
+ EVEN_TYPE
+};
+
+typedef struct TrivialCommandHeader {
+ Tcl_Interp *interp; /* The interp that this command
+ * lives in. */
+ Tk_OptionTable optionTable; /* The option table that go with
+ * this command. */
+ Tk_Window tkwin; /* For widgets, the window associated
+ * with this widget. */
+ Tcl_Command widgetCmd; /* For widgets, the command associated
+ * with this widget. */
+} TrivialCommandHeader;
+
+
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int CBindingEvalProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, XEvent *eventPtr,
+ Tk_Window tkwin, KeySym keySym));
+static void CBindingFreeProc _ANSI_ARGS_((ClientData clientData));
+int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+static int ImageCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TestcbindCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TestbitmapObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestborderObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestcolorObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestcursorObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TestfontObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int TestmakeexistCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TestmenubarCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+#if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)
+static int TestmetricsCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+#endif
+static int TestobjconfigObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int CustomOptionSet _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj **value, char *recordPtr, int internalOffset,
+ char *saveInternalPtr, int flags));
+static Tcl_Obj *CustomOptionGet _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int internalOffset));
+static void CustomOptionRestore _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *internalPtr,
+ char *saveInternalPtr));
+static void CustomOptionFree _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *internalPtr));
+static int TestpropCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TestsendCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TesttextCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+static int TestwrapperCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+#endif
+static void TrivialCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int TrivialConfigObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static void TrivialEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/*
+ * External (platform specific) initialization routine:
+ */
+
+extern int TkplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+#define TkplatformtestInit(x) TCL_OK
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tktest_Init --
+ *
+ * This procedure performs intialization for the Tk test
+ * suite exensions.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error
+ * message in the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Creates several test commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_CreateObjCommand(interp, "square", SquareObjCmd,
+ (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testcbind", TestcbindCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+ Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#endif
+#if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)
+ 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);
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+ Tcl_CreateCommand(interp, "testsend", TestsendCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#endif
+ Tcl_CreateCommand(interp, "testtext", TesttextCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ CONST 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestbitmapObjCmd --
+ *
+ * This procedure implements the "testbitmap" command, which is used
+ * to test color resource handling in tkBitmap tmp.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestbitmapObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "bitmap");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TkDebugBitmap(Tk_MainWindow(interp),
+ Tcl_GetString(objv[1])));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestborderObjCmd --
+ *
+ * This procedure implements the "testborder" command, which is used
+ * to test color resource handling in tkBorder.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestborderObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "border");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TkDebugBorder(Tk_MainWindow(interp),
+ Tcl_GetString(objv[1])));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcolorObjCmd --
+ *
+ * This procedure implements the "testcolor" command, which is used
+ * to test color resource handling in tkColor.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestcolorObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "color");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TkDebugColor(Tk_MainWindow(interp),
+ Tcl_GetString(objv[1])));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcursorObjCmd --
+ *
+ * This procedure implements the "testcursor" command, which is used
+ * to test color resource handling in tkCursor.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestcursorObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cursor");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TkDebugCursor(Tk_MainWindow(interp),
+ Tcl_GetString(objv[1])));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestdeleteappsCmd --
+ *
+ * This procedure implements the "testdeleteapps" command. It cleans
+ * up all the interpreters left behind by the "testnewapp" command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * 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. */
+ CONST char **argv; /* Argument strings. */
+{
+ NewApp *nextPtr;
+
+ while (newAppPtr != NULL) {
+ nextPtr = newAppPtr->nextPtr;
+ Tcl_DeleteInterp(newAppPtr->interp);
+ ckfree((char *) newAppPtr);
+ newAppPtr = nextPtr;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestobjconfigObjCmd --
+ *
+ * This procedure implements the "testobjconfig" command,
+ * which is used to test the procedures in tkConfig.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestobjconfigObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *options[] = {"alltypes", "chain1", "chain2",
+ "configerror", "delete", "info", "internal", "new",
+ "notenoughparams", "twowindows", (char *) NULL};
+ enum {
+ ALL_TYPES,
+ CHAIN1,
+ CHAIN2,
+ CONFIG_ERROR,
+ DEL, /* Can't use DELETE: VC++ compiler barfs. */
+ INFO,
+ INTERNAL,
+ NEW,
+ NOT_ENOUGH_PARAMS,
+ TWO_WINDOWS
+ };
+ static Tk_OptionTable tables[11]; /* Holds pointers to option tables
+ * created by commands below; indexed
+ * with same values as "options"
+ * array. */
+ static Tk_ObjCustomOption CustomOption = {
+ "custom option",
+ CustomOptionSet,
+ CustomOptionGet,
+ CustomOptionRestore,
+ CustomOptionFree,
+ (ClientData) 1
+ };
+ Tk_Window mainWin = (Tk_Window) clientData;
+ Tk_Window tkwin;
+ int index, result = TCL_OK;
+
+ /*
+ * Structures used by the "chain1" subcommand and also shared by
+ * the "chain2" subcommand:
+ */
+
+ typedef struct ExtensionWidgetRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *base1ObjPtr;
+ Tcl_Obj *base2ObjPtr;
+ Tcl_Obj *extension3ObjPtr;
+ Tcl_Obj *extension4ObjPtr;
+ Tcl_Obj *extension5ObjPtr;
+ } ExtensionWidgetRecord;
+ static Tk_OptionSpec baseSpecs[] = {
+ {TK_OPTION_STRING,
+ "-one", "one", "One", "one",
+ Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1},
+ {TK_OPTION_STRING,
+ "-two", "two", "Two", "two",
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1},
+ {TK_OPTION_END}
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case ALL_TYPES: {
+ typedef struct TypesRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *booleanPtr;
+ Tcl_Obj *integerPtr;
+ Tcl_Obj *doublePtr;
+ Tcl_Obj *stringPtr;
+ Tcl_Obj *stringTablePtr;
+ Tcl_Obj *colorPtr;
+ Tcl_Obj *fontPtr;
+ Tcl_Obj *bitmapPtr;
+ Tcl_Obj *borderPtr;
+ Tcl_Obj *reliefPtr;
+ Tcl_Obj *cursorPtr;
+ Tcl_Obj *activeCursorPtr;
+ Tcl_Obj *justifyPtr;
+ Tcl_Obj *anchorPtr;
+ Tcl_Obj *pixelPtr;
+ Tcl_Obj *mmPtr;
+ Tcl_Obj *customPtr;
+ } TypesRecord;
+ TypesRecord *recordPtr;
+ static char *stringTable[] = {"one", "two", "three", "four",
+ (char *) NULL};
+ static Tk_OptionSpec typesSpecs[] = {
+ {TK_OPTION_BOOLEAN,
+ "-boolean", "boolean", "Boolean",
+ "1", Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1},
+ {TK_OPTION_INT,
+ "-integer", "integer", "Integer",
+ "7", Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2},
+ {TK_OPTION_DOUBLE,
+ "-double", "double", "Double",
+ "3.14159", Tk_Offset(TypesRecord, doublePtr), -1, 0, 0,
+ 0x4},
+ {TK_OPTION_STRING,
+ "-string", "string", "String",
+ "foo", Tk_Offset(TypesRecord, stringPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x8},
+ {TK_OPTION_STRING_TABLE,
+ "-stringtable", "StringTable", "stringTable",
+ "one", Tk_Offset(TypesRecord, stringTablePtr), -1,
+ TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10},
+ {TK_OPTION_COLOR,
+ "-color", "color", "Color",
+ "red", Tk_Offset(TypesRecord, colorPtr), -1,
+ TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
+ {TK_OPTION_FONT,
+ "-font", "font", "Font",
+ "Helvetica 12",
+ Tk_Offset(TypesRecord, fontPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x40},
+ {TK_OPTION_BITMAP,
+ "-bitmap", "bitmap", "Bitmap",
+ "gray50",
+ Tk_Offset(TypesRecord, bitmapPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x80},
+ {TK_OPTION_BORDER,
+ "-border", "border", "Border",
+ "blue", Tk_Offset(TypesRecord, borderPtr), -1,
+ TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
+ {TK_OPTION_RELIEF,
+ "-relief", "relief", "Relief",
+ "raised",
+ Tk_Offset(TypesRecord, reliefPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x200},
+ {TK_OPTION_CURSOR,
+ "-cursor", "cursor", "Cursor",
+ "xterm",
+ Tk_Offset(TypesRecord, cursorPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x400},
+ {TK_OPTION_JUSTIFY,
+ "-justify", (char *) NULL, (char *) NULL,
+ "left",
+ Tk_Offset(TypesRecord, justifyPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x800},
+ {TK_OPTION_ANCHOR,
+ "-anchor", "anchor", "Anchor",
+ (char *) NULL,
+ Tk_Offset(TypesRecord, anchorPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x1000},
+ {TK_OPTION_PIXELS,
+ "-pixel", "pixel", "Pixel",
+ "1", Tk_Offset(TypesRecord, pixelPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x2000},
+ {TK_OPTION_CUSTOM,
+ "-custom", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TypesRecord, customPtr), -1,
+ TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000},
+ {TK_OPTION_SYNONYM,
+ "-synonym", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-color",
+ 0x8000},
+ {TK_OPTION_END}
+ };
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ optionTable = Tk_CreateOptionTable(interp,
+ typesSpecs);
+ tables[index] = optionTable;
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = (TypesRecord *) ckalloc(sizeof(TypesRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->booleanPtr = NULL;
+ recordPtr->integerPtr = NULL;
+ recordPtr->doublePtr = NULL;
+ recordPtr->stringPtr = NULL;
+ recordPtr->colorPtr = NULL;
+ recordPtr->fontPtr = NULL;
+ recordPtr->bitmapPtr = NULL;
+ recordPtr->borderPtr = NULL;
+ recordPtr->reliefPtr = NULL;
+ recordPtr->cursorPtr = NULL;
+ recordPtr->justifyPtr = NULL;
+ recordPtr->anchorPtr = NULL;
+ recordPtr->pixelPtr = NULL;
+ recordPtr->mmPtr = NULL;
+ recordPtr->stringTablePtr = NULL;
+ recordPtr->customPtr = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ optionTable, objc - 3, objv + 3, tkwin,
+ (Tk_SavedOptions *) NULL, (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ }
+ } else {
+ Tk_DestroyWindow(tkwin);
+ ckfree((char *) recordPtr);
+ }
+ if (result == TCL_OK) {
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case CHAIN1: {
+ ExtensionWidgetRecord *recordPtr;
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+ optionTable = Tk_CreateOptionTable(interp, baseSpecs);
+ tables[index] = optionTable;
+
+ recordPtr = (ExtensionWidgetRecord *) ckalloc(
+ sizeof(ExtensionWidgetRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
+ recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
+ objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL,
+ (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_FreeConfigOptions((char *) recordPtr, optionTable,
+ tkwin);
+ }
+ }
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case CHAIN2: {
+ ExtensionWidgetRecord *recordPtr;
+ static Tk_OptionSpec extensionSpecs[] = {
+ {TK_OPTION_STRING,
+ "-three", "three", "Three", "three",
+ Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr),
+ -1},
+ {TK_OPTION_STRING,
+ "-four", "four", "Four", "four",
+ Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr),
+ -1},
+ {TK_OPTION_STRING,
+ "-two", "two", "Two", "two and a half",
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr),
+ -1},
+ {TK_OPTION_STRING,
+ "-oneAgain", "oneAgain", "OneAgain", "one again",
+ Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr),
+ -1},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) baseSpecs}
+ };
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+ optionTable = Tk_CreateOptionTable(interp, extensionSpecs);
+ tables[index] = optionTable;
+
+ recordPtr = (ExtensionWidgetRecord *) ckalloc(
+ sizeof(ExtensionWidgetRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
+ recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
+ recordPtr->extension5ObjPtr = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
+ objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL,
+ (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_FreeConfigOptions((char *) recordPtr, optionTable,
+ tkwin);
+ }
+ }
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case CONFIG_ERROR: {
+ typedef struct ErrorWidgetRecord {
+ Tcl_Obj *intPtr;
+ } ErrorWidgetRecord;
+ ErrorWidgetRecord widgetRecord;
+ static Tk_OptionSpec errorSpecs[] = {
+ {TK_OPTION_INT,
+ "-int", "integer", "Integer",
+ "bogus", Tk_Offset(ErrorWidgetRecord, intPtr)},
+ {TK_OPTION_END}
+ };
+ Tk_OptionTable optionTable;
+
+ widgetRecord.intPtr = NULL;
+ optionTable = Tk_CreateOptionTable(interp, errorSpecs);
+ tables[index] = optionTable;
+ return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable,
+ (Tk_Window) NULL);
+ }
+
+ case DEL: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tableName");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tables[index] != NULL) {
+ Tk_DeleteOptionTable(tables[index]);
+ }
+ break;
+ }
+
+ case INFO: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tableName");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index]));
+ break;
+ }
+
+ case INTERNAL: {
+ /*
+ * This command is similar to the "alltypes" command except
+ * that it stores all the configuration options as internal
+ * forms instead of objects.
+ */
+
+ typedef struct InternalRecord {
+ TrivialCommandHeader header;
+ int boolean;
+ int integer;
+ double doubleValue;
+ char *string;
+ int index;
+ XColor *colorPtr;
+ Tk_Font tkfont;
+ Pixmap bitmap;
+ Tk_3DBorder border;
+ int relief;
+ Tk_Cursor cursor;
+ Tk_Justify justify;
+ Tk_Anchor anchor;
+ int pixels;
+ double mm;
+ Tk_Window tkwin;
+ char *custom;
+ } InternalRecord;
+ InternalRecord *recordPtr;
+ static char *internalStringTable[] = {
+ "one", "two", "three", "four", (char *) NULL
+ };
+ static Tk_OptionSpec internalSpecs[] = {
+ {TK_OPTION_BOOLEAN,
+ "-boolean", "boolean", "Boolean",
+ "1", -1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1},
+ {TK_OPTION_INT,
+ "-integer", "integer", "Integer",
+ "148962237", -1, Tk_Offset(InternalRecord, integer),
+ 0, 0, 0x2},
+ {TK_OPTION_DOUBLE,
+ "-double", "double", "Double",
+ "3.14159", -1, Tk_Offset(InternalRecord, doubleValue),
+ 0, 0, 0x4},
+ {TK_OPTION_STRING,
+ "-string", "string", "String",
+ "foo", -1, Tk_Offset(InternalRecord, string),
+ TK_CONFIG_NULL_OK, 0, 0x8},
+ {TK_OPTION_STRING_TABLE,
+ "-stringtable", "StringTable", "stringTable",
+ "one", -1, Tk_Offset(InternalRecord, index),
+ TK_CONFIG_NULL_OK, (ClientData) internalStringTable,
+ 0x10},
+ {TK_OPTION_COLOR,
+ "-color", "color", "Color",
+ "red", -1, Tk_Offset(InternalRecord, colorPtr),
+ TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
+ {TK_OPTION_FONT,
+ "-font", "font", "Font",
+ "Helvetica 12", -1, Tk_Offset(InternalRecord, tkfont),
+ TK_CONFIG_NULL_OK, 0, 0x40},
+ {TK_OPTION_BITMAP,
+ "-bitmap", "bitmap", "Bitmap",
+ "gray50", -1, Tk_Offset(InternalRecord, bitmap),
+ TK_CONFIG_NULL_OK, 0, 0x80},
+ {TK_OPTION_BORDER,
+ "-border", "border", "Border",
+ "blue", -1, Tk_Offset(InternalRecord, border),
+ TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
+ {TK_OPTION_RELIEF,
+ "-relief", "relief", "Relief",
+ "raised", -1, Tk_Offset(InternalRecord, relief),
+ TK_CONFIG_NULL_OK, 0, 0x200},
+ {TK_OPTION_CURSOR,
+ "-cursor", "cursor", "Cursor",
+ "xterm", -1, Tk_Offset(InternalRecord, cursor),
+ TK_CONFIG_NULL_OK, 0, 0x400},
+ {TK_OPTION_JUSTIFY,
+ "-justify", (char *) NULL, (char *) NULL,
+ "left", -1, Tk_Offset(InternalRecord, justify),
+ TK_CONFIG_NULL_OK, 0, 0x800},
+ {TK_OPTION_ANCHOR,
+ "-anchor", "anchor", "Anchor",
+ (char *) NULL, -1, Tk_Offset(InternalRecord, anchor),
+ TK_CONFIG_NULL_OK, 0, 0x1000},
+ {TK_OPTION_PIXELS,
+ "-pixel", "pixel", "Pixel",
+ "1", -1, Tk_Offset(InternalRecord, pixels),
+ TK_CONFIG_NULL_OK, 0, 0x2000},
+ {TK_OPTION_WINDOW,
+ "-window", "window", "Window",
+ (char *) NULL, -1, Tk_Offset(InternalRecord, tkwin),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_CUSTOM,
+ "-custom", (char *) NULL, (char *) NULL,
+ "", -1, Tk_Offset(InternalRecord, custom),
+ TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000},
+ {TK_OPTION_SYNONYM,
+ "-synonym", (char *) NULL, (char *) NULL,
+ (char *) NULL, -1, -1, 0, (ClientData) "-color",
+ 0x8000},
+ {TK_OPTION_END}
+ };
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ optionTable = Tk_CreateOptionTable(interp, internalSpecs);
+ tables[index] = optionTable;
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = (InternalRecord *) ckalloc(sizeof(InternalRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->boolean = 0;
+ recordPtr->integer = 0;
+ recordPtr->doubleValue = 0.0;
+ recordPtr->string = NULL;
+ recordPtr->index = 0;
+ recordPtr->colorPtr = NULL;
+ recordPtr->tkfont = NULL;
+ recordPtr->bitmap = None;
+ recordPtr->border = NULL;
+ recordPtr->relief = TK_RELIEF_FLAT;
+ recordPtr->cursor = NULL;
+ recordPtr->justify = TK_JUSTIFY_LEFT;
+ recordPtr->anchor = TK_ANCHOR_N;
+ recordPtr->pixels = 0;
+ recordPtr->mm = 0.0;
+ recordPtr->tkwin = NULL;
+ recordPtr->custom = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ optionTable, objc - 3, objv + 3, tkwin,
+ (Tk_SavedOptions *) NULL, (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ }
+ } else {
+ Tk_DestroyWindow(tkwin);
+ ckfree((char *) recordPtr);
+ }
+ if (result == TCL_OK) {
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case NEW: {
+ typedef struct FiveRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *one;
+ Tcl_Obj *two;
+ Tcl_Obj *three;
+ Tcl_Obj *four;
+ Tcl_Obj *five;
+ } FiveRecord;
+ FiveRecord *recordPtr;
+ static Tk_OptionSpec smallSpecs[] = {
+ {TK_OPTION_INT,
+ "-one", "one", "One",
+ "1",
+ Tk_Offset(FiveRecord, one), -1},
+ {TK_OPTION_INT,
+ "-two", "two", "Two",
+ "2",
+ Tk_Offset(FiveRecord, two), -1},
+ {TK_OPTION_INT,
+ "-three", "three", "Three",
+ "3",
+ Tk_Offset(FiveRecord, three), -1},
+ {TK_OPTION_INT,
+ "-four", "four", "Four",
+ "4",
+ Tk_Offset(FiveRecord, four), -1},
+ {TK_OPTION_STRING,
+ "-five", NULL, NULL,
+ NULL,
+ Tk_Offset(FiveRecord, five), -1},
+ {TK_OPTION_END}
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "new name ?options?");
+ return TCL_ERROR;
+ }
+
+ recordPtr = (FiveRecord *) ckalloc(sizeof(FiveRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
+ smallSpecs);
+ tables[index] = recordPtr->header.optionTable;
+ recordPtr->header.tkwin = NULL;
+ recordPtr->one = recordPtr->two = recordPtr->three = NULL;
+ recordPtr->four = recordPtr->five = NULL;
+ Tcl_SetObjResult(interp, objv[2]);
+ result = Tk_InitOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, (Tk_Window) NULL);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, objc - 3, objv + 3,
+ (Tk_Window) NULL, (Tk_SavedOptions *) NULL,
+ (int *) NULL);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ } else {
+ Tk_FreeConfigOptions((char *) recordPtr,
+ recordPtr->header.optionTable, (Tk_Window) NULL);
+ }
+ }
+ if (result != TCL_OK) {
+ ckfree((char *) recordPtr);
+ }
+
+ break;
+ }
+ case NOT_ENOUGH_PARAMS: {
+ typedef struct NotEnoughRecord {
+ Tcl_Obj *fooObjPtr;
+ } NotEnoughRecord;
+ NotEnoughRecord record;
+ static Tk_OptionSpec errorSpecs[] = {
+ {TK_OPTION_INT,
+ "-foo", "foo", "Foo",
+ "0", Tk_Offset(NotEnoughRecord, fooObjPtr)},
+ {TK_OPTION_END}
+ };
+ Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1);
+ Tk_OptionTable optionTable;
+
+ record.fooObjPtr = NULL;
+
+ tkwin = Tk_CreateWindowFromPath(interp, mainWin,
+ ".config", (char *) NULL);
+ Tk_SetClass(tkwin, "Config");
+ optionTable = Tk_CreateOptionTable(interp, errorSpecs);
+ tables[index] = optionTable;
+ Tk_InitOptions(interp, (char *) &record, optionTable, tkwin);
+ if (Tk_SetOptions(interp, (char *) &record, optionTable,
+ 1, &newObjPtr, tkwin, (Tk_SavedOptions *) NULL,
+ (int *) NULL)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(newObjPtr);
+ Tk_FreeConfigOptions( (char *) &record, optionTable, tkwin);
+ Tk_DestroyWindow(tkwin);
+ return result;
+ }
+
+ case TWO_WINDOWS: {
+ typedef struct SlaveRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *windowPtr;
+ } SlaveRecord;
+ SlaveRecord *recordPtr;
+ static Tk_OptionSpec slaveSpecs[] = {
+ {TK_OPTION_WINDOW,
+ "-window", "window", "Window",
+ ".bar", Tk_Offset(SlaveRecord, windowPtr), -1,
+ TK_CONFIG_NULL_OK},
+ {TK_OPTION_END}
+ };
+ Tk_Window tkwin = Tk_CreateWindowFromPath(interp,
+ (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = (SlaveRecord *) ckalloc(sizeof(SlaveRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
+ slaveSpecs);
+ tables[index] = recordPtr->header.optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->windowPtr = NULL;
+
+ result = Tk_InitOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, tkwin);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, objc - 3, objv + 3,
+ tkwin, (Tk_SavedOptions *) NULL, (int *) NULL);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ } else {
+ Tk_FreeConfigOptions((char *) recordPtr,
+ recordPtr->header.optionTable, tkwin);
+ }
+ }
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ ckfree((char *) recordPtr);
+ }
+
+ }
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TrivialConfigObjCmd --
+ *
+ * This command is used to test the configuration package. It only
+ * handles the "configure" and "cget" subcommands.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TrivialConfigObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int result = TCL_OK;
+ static CONST char *options[] = {
+ "cget", "configure", "csave", (char *) NULL
+ };
+ enum {
+ CGET, CONFIGURE, CSAVE
+ };
+ Tcl_Obj *resultObjPtr;
+ int index, mask;
+ TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
+ Tk_Window tkwin = headerPtr->tkwin;
+ Tk_SavedOptions saved;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "command",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve(clientData);
+
+ switch (index) {
+ case CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData,
+ headerPtr->optionTable, objv[2], tkwin);
+ if (resultObjPtr != NULL) {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ result = TCL_OK;
+ } else {
+ result = TCL_ERROR;
+ }
+ break;
+ }
+ case CONFIGURE: {
+ if (objc == 2) {
+ resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData,
+ headerPtr->optionTable, (Tcl_Obj *) NULL, tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ } else if (objc == 3) {
+ resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData,
+ headerPtr->optionTable, objv[2], tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ } else {
+ result = Tk_SetOptions(interp, (char *) clientData,
+ headerPtr->optionTable, objc - 2, objv + 2,
+ tkwin, (Tk_SavedOptions *) NULL, &mask);
+ if (result == TCL_OK) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ }
+ }
+ break;
+ }
+ case CSAVE: {
+ result = Tk_SetOptions(interp, (char *) clientData,
+ headerPtr->optionTable, objc - 2, objv + 2,
+ tkwin, &saved, &mask);
+ Tk_FreeSavedOptions(&saved);
+ if (result == TCL_OK) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ }
+ break;
+ }
+ }
+done:
+ Tcl_Release(clientData);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TrivialCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TrivialCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
+ Tk_Window tkwin = headerPtr->tkwin;
+
+ if (tkwin != NULL) {
+ Tk_DestroyWindow(tkwin);
+ } else if (headerPtr->optionTable != NULL) {
+ /*
+ * This is a "new" object, which doesn't have a window, so
+ * we can't depend on cleaning up in the event procedure.
+ * Free its resources here.
+ */
+
+ Tk_FreeConfigOptions((char *) clientData,
+ headerPtr->optionTable, (Tk_Window) NULL);
+ Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TrivialEventProc --
+ *
+ * A dummy event proc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TrivialEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ if (headerPtr->tkwin != NULL) {
+ Tk_FreeConfigOptions((char *) clientData,
+ headerPtr->optionTable, headerPtr->tkwin);
+ headerPtr->optionTable = NULL;
+ headerPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(headerPtr->interp,
+ headerPtr->widgetCmd);
+ }
+ Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestfontObjCmd --
+ *
+ * This procedure implements the "testfont" command, which is used
+ * to test TkFont objects.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestfontObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static CONST char *options[] = {"counts", "subfonts", (char *) NULL};
+ enum option {COUNTS, SUBFONTS};
+ int index;
+ Tk_Window tkwin;
+ Tk_Font tkfont;
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option fontName");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum option) index) {
+ case COUNTS: {
+ Tcl_SetObjResult(interp, TkDebugFont(Tk_MainWindow(interp),
+ Tcl_GetString(objv[2])));
+ break;
+ }
+ case SUBFONTS: {
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ TkpGetSubFonts(interp, tkfont);
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
+#ifdef USE_OLD_IMAGE
+static int
+ImageCreate(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. */
+{
+ TImageMaster *timPtr;
+ char *varName;
+ int i;
+
+ Tk_InitImageArgs(interp, argc, &argv);
+ varName = "log";
+ for (i = 0; i < argc; i += 2) {
+ if (strcmp(argv[i], "-variable") != 0) {
+ Tcl_AppendResult(interp, "bad option name \"",
+ argv[i], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((i+1) == argc) {
+ Tcl_AppendResult(interp, "no value given for \"",
+ argv[i], "\" option", (char *) NULL);
+ return TCL_ERROR;
+ }
+ varName = argv[i+1];
+ }
+#else
+static int
+ImageCreate(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[]; /* 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 < objc; i += 2) {
+ if (strcmp(Tcl_GetString(objv[i]), "-variable") != 0) {
+ Tcl_AppendResult(interp, "bad option name \"",
+ Tcl_GetString(objv[i]), "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((i+1) == objc) {
+ Tcl_AppendResult(interp, "no value given for \"",
+ Tcl_GetString(objv[i]), "\" option", (char *) NULL);
+ return TCL_ERROR;
+ }
+ varName = Tcl_GetString(objv[i+1]);
+ }
+#endif
+ 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. */
+ CONST 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 + TCL_INTEGER_SPACE * 6];
+
+ sprintf(buffer, "%s display %d %d %d %d %d %d",
+ instPtr->masterPtr->imageName, imageX, imageY, width, height,
+ drawableX, drawableY);
+ Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ if (width > (instPtr->masterPtr->width - imageX)) {
+ 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. */
+ CONST 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. */
+ CONST char **argv; /* Argument strings. */
+{
+#ifdef __UNIX__
+ Tk_Window mainWin = (Tk_Window) clientData;
+ Tk_Window tkwin, menubar;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " option ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[1], "window") == 0) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ "window toplevel menubar\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[2], mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (argv[3][0] == 0) {
+ TkUnixSetMenubar(tkwin, NULL);
+ } else {
+ menubar = Tk_NameToWindow(interp, argv[3], mainWin);
+ if (menubar == NULL) {
+ return TCL_ERROR;
+ }
+ TkUnixSetMenubar(tkwin, menubar);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+#else
+ Tcl_SetResult(interp, "testmenubar is supported only under Unix",
+ TCL_STATIC);
+ return TCL_ERROR;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ CONST char **argv; /* Argument strings. */
+{
+ char buf[TCL_INTEGER_SPACE];
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " option ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ 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
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+static int
+TestmetricsCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " option window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ 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. */
+ CONST 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 */
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+static int
+TestsendCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST 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 (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 {
+ Tcl_DString tmp;
+
+ Tcl_DStringInit(&tmp);
+ for (p = Tcl_DStringAppend(&tmp, argv[4],
+ (int) strlen(argv[4]));
+ *p != 0; p++) {
+ if (*p == '\n') {
+ *p = 0;
+ }
+ }
+
+ XChangeProperty(winPtr->dispPtr->display,
+ w, propName, XA_STRING, 8, PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&tmp),
+ p-Tcl_DStringValue(&tmp));
+ Tcl_DStringFree(&tmp);
+ }
+ }
+ } else if (strcmp(argv[1], "serial") == 0) {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", tkSendSerial+1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be bogus, prop, or serial", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TesttextCmd --
+ *
+ * This procedure implements the "testtext" command. It provides
+ * a set of functions for testing text widgets and the associated
+ * functions in tkText*.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Depends on option; see below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TesttextCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ TkText *textPtr;
+ size_t len;
+ int lineIndex, byteIndex, byteOffset;
+ TkTextIndex index;
+ char buf[64];
+ Tcl_CmdInfo info;
+
+ if (argc < 3) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) {
+ return TCL_ERROR;
+ }
+ textPtr = (TkText *) info.clientData;
+ len = strlen(argv[2]);
+ if (strncmp(argv[2], "byteindex", len) == 0) {
+ if (argc != 5) {
+ return TCL_ERROR;
+ }
+ lineIndex = atoi(argv[3]) - 1;
+ byteIndex = atoi(argv[4]);
+
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, byteIndex, &index);
+ } else if (strncmp(argv[2], "forwbytes", len) == 0) {
+ if (argc != 5) {
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ byteOffset = atoi(argv[4]);
+ TkTextIndexForwBytes(&index, byteOffset, &index);
+ } else if (strncmp(argv[2], "backbytes", len) == 0) {
+ if (argc != 5) {
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ byteOffset = atoi(argv[4]);
+ TkTextIndexBackBytes(&index, byteOffset, &index);
+ } else {
+ return TCL_ERROR;
+ }
+
+ TkTextSetMark(textPtr, "insert", &index);
+ TkTextPrintIndex(&index, buf);
+ sprintf(buf + strlen(buf), " %d", index.byteIndex);
+ Tcl_AppendResult(interp, buf, NULL);
+
+ return TCL_OK;
+}
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ CONST 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) {
+ char buf[TCL_INTEGER_SPACE];
+
+ TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr));
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CustomOptionSet, CustomOptionGet, CustomOptionRestore, CustomOptionFree --
+ *
+ * Handlers for object-based custom configuration options. See
+ * Testobjconfigcommand.
+ *
+ * Results:
+ * See user documentation for expected results from these functions.
+ * CustomOptionSet Standard Tcl Result.
+ * CustomOptionGet Tcl_Obj * containing value.
+ * CustomOptionRestore None.
+ * CustomOptionFree None.
+ *
+ * Side effects:
+ * Depends on the function.
+ * CustomOptionSet Sets option value to new setting.
+ * CustomOptionGet Creates a new Tcl_Obj.
+ * CustomOptionRestore Resets option value to original value.
+ * CustomOptionFree Free storage for internal rep of
+ * option.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CustomOptionSet(clientData,interp, tkwin, value, recordPtr, internalOffset,
+ saveInternalPtr, flags)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tcl_Obj **value;
+ char *recordPtr;
+ int internalOffset;
+ char *saveInternalPtr;
+ int flags;
+{
+ int objEmpty, length;
+ char *new, *string, *internalPtr;
+
+ objEmpty = 0;
+
+ if (internalOffset >= 0) {
+ internalPtr = recordPtr + internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+
+ /*
+ * See if the object is empty.
+ */
+ if (value == NULL) {
+ objEmpty = 1;
+ } else {
+ if ((*value)->bytes != NULL) {
+ objEmpty = ((*value)->length == 0);
+ } else {
+ Tcl_GetStringFromObj((*value), &length);
+ objEmpty = (length == 0);
+ }
+ }
+
+ if ((flags & TK_OPTION_NULL_OK) && objEmpty) {
+ *value = NULL;
+ } else {
+ string = Tcl_GetStringFromObj((*value), &length);
+ Tcl_UtfToUpper(string);
+ if (strcmp(string, "BAD") == 0) {
+ Tcl_SetResult(interp, "expected good value, got \"BAD\"",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ if ((*value) != NULL) {
+ string = Tcl_GetStringFromObj((*value), &length);
+ new = ckalloc((size_t) (length + 1));
+ strcpy(new, string);
+ } else {
+ new = NULL;
+ }
+ *((char **) saveInternalPtr) = *((char **) internalPtr);
+ *((char **) internalPtr) = new;
+ }
+
+ return TCL_OK;
+}
+
+static Tcl_Obj *
+CustomOptionGet(clientData, tkwin, recordPtr, internalOffset)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *recordPtr;
+ int internalOffset;
+{
+ return (Tcl_NewStringObj(*(char **)(recordPtr + internalOffset), -1));
+}
+
+static void
+CustomOptionRestore(clientData, tkwin, internalPtr, saveInternalPtr)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *internalPtr;
+ char *saveInternalPtr;
+{
+ *(char **)internalPtr = *(char **)saveInternalPtr;
+ return;
+}
+
+static void
+CustomOptionFree(clientData, tkwin, internalPtr)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *internalPtr;
+{
+ if (*(char **)internalPtr != NULL) {
+ ckfree(*(char **)internalPtr);
+ }
+}
+
diff --git a/tcl/generic/tkText.c b/tcl/generic/tkText.c
new file mode 100644
index 00000000000..eadfd001c22
--- /dev/null
+++ b/tcl/generic/tkText.c
@@ -0,0 +1,3013 @@
+/*
+ * 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.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkUndo.h"
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+#define Style TkStyle
+#define DInfo TkDInfo
+#endif
+
+#include "tkText.h"
+
+/*
+ * Custom options for handling "-state"
+ */
+
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) NULL /* only "normal" and "disabled" */
+};
+
+/*
+ * Information used to parse text configuration options:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BOOLEAN, "-autoseparators", "autoSeparators",
+ "AutoSeparators", DEF_TEXT_AUTO_SEPARATORS,
+ Tk_Offset(TkText, autoSeparators), 0},
+ {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_INT, "-maxundo", "maxUndo", "MaxUndo",
+ DEF_TEXT_MAX_UNDO, Tk_Offset(TkText, maxUndo), 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_CUSTOM, "-state", "state", "State",
+ DEF_TEXT_STATE, Tk_Offset(TkText, state), 0, &stateOption},
+ {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_BOOLEAN, "-undo", "undo", "Undo",
+ DEF_TEXT_UNDO, Tk_Offset(TkText, undo), 0},
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
+ {TK_CONFIG_CUSTOM, "-wrap", "wrap", "Wrap",
+ DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0, &textWrapModeOption},
+ {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_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Boolean variable indicating whether or not special debugging code
+ * should be executed.
+ */
+
+int tkTextDebug = 0;
+
+/*
+ * Custom options for handling "-wrap":
+ */
+
+static int WrapModeParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST char *value, char *widgRec, int offset));
+static char * WrapModePrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+Tk_CustomOption textWrapModeOption = {
+ WrapModeParseProc,
+ WrapModePrintProc,
+ (ClientData) NULL
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WrapModeParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * "-wrap" options for text widgets.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The wrap mode for a given item gets replaced by the wrap mode
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WrapModeParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option (list of tag
+ * names). */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ int c;
+ size_t length;
+
+ register TkWrapMode *wrapPtr = (TkWrapMode *) (widgRec + offset);
+
+ if(value == NULL || *value == 0) {
+ *wrapPtr = TEXT_WRAPMODE_NULL;
+ return TCL_OK;
+ }
+
+ c = value[0];
+ length = strlen(value);
+
+ if ((c == 'c') && (strncmp(value, "char", length) == 0)) {
+ *wrapPtr = TEXT_WRAPMODE_CHAR;
+ return TCL_OK;
+ }
+ if ((c == 'n') && (strncmp(value, "none", length) == 0)) {
+ *wrapPtr = TEXT_WRAPMODE_NONE;
+ return TCL_OK;
+ }
+ if ((c == 'w') && (strncmp(value, "word", length) == 0)) {
+ *wrapPtr = TEXT_WRAPMODE_WORD;
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "bad wrap mode \"", value,
+ "\": must be char, none, or word",
+ (char *) NULL);
+ *wrapPtr = TEXT_WRAPMODE_CHAR;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WrapModePrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-wrap" configuration
+ * option for canvas items.
+ *
+ * Results:
+ * The return value is a string describing the state 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+WrapModePrintProc(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 TkWrapMode *wrapPtr = (TkWrapMode *) (widgRec + offset);
+
+ if (*wrapPtr==TEXT_WRAPMODE_CHAR) {
+ return "char";
+ } else if (*wrapPtr==TEXT_WRAPMODE_NONE) {
+ return "none";
+ } else if (*wrapPtr==TEXT_WRAPMODE_WORD) {
+ return "word";
+ } else {
+ return "";
+ }
+}
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int argc, CONST char **argv,
+ int flags));
+static int DeleteChars _ANSI_ARGS_((TkText *textPtr,
+ CONST char *index1String, CONST char *index2String,
+ TkTextIndex *indexPtr1, TkTextIndex *indexPtr2));
+static void DestroyText _ANSI_ARGS_((char *memPtr));
+static void InsertChars _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, CONST 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 TextIndexSortProc _ANSI_ARGS_((CONST VOID *first,
+ CONST VOID *second));
+static int TextSearchCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TextEditCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TextWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static void TextWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int TextDumpCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static void DumpLine _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int what, TkTextLine *linePtr,
+ int start, int end, int lineno,
+ CONST char *command));
+static int DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key,
+ char *value, CONST char * command,
+ TkTextIndex *index, int what));
+static int TextEditUndo _ANSI_ARGS_((TkText *textPtr));
+static int TextEditRedo _ANSI_ARGS_((TkText *textPtr));
+static void TextGetText _ANSI_ARGS_((TkTextIndex * index1,
+ TkTextIndex * index2, Tcl_DString *dsPtr));
+static void updateDirtyFlag _ANSI_ARGS_((TkText *textPtr));
+
+/*
+ * The structure below defines text class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs textClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TextWorldChanged, /* worldChangedProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+ CONST 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;
+ }
+
+ /*
+ * Create the window.
+ */
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the text widget and initialize everything to zero,
+ * then set the necessary initial (non-NULL) values.
+ */
+
+ textPtr = (TkText *) ckalloc(sizeof(TkText));
+ memset((VOID *) textPtr, 0, 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);
+ Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS);
+ textPtr->state = TK_STATE_NORMAL;
+ textPtr->relief = TK_RELIEF_FLAT;
+ textPtr->cursor = None;
+ textPtr->charWidth = 1;
+ textPtr->wrapMode = TEXT_WRAPMODE_CHAR;
+ textPtr->prevWidth = Tk_Width(new);
+ textPtr->prevHeight = Tk_Height(new);
+ TkTextCreateDInfo(textPtr);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &startIndex);
+ TkTextSetYView(textPtr, &startIndex, 0);
+ textPtr->exportSelection = 1;
+ textPtr->pickEvent.type = LeaveNotify;
+ textPtr->undoStack = TkUndoInitStack(interp,0);
+ textPtr->undo = 1;
+ textPtr->isDirtyIncrement = 1;
+ textPtr->autoSeparators = 1;
+ textPtr->lastEditMode = TK_TEXT_EDIT_OTHER;
+
+ /*
+ * Create the "sel" tag and the "current" and "insert" marks.
+ */
+
+ textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
+ textPtr->selTagPtr->reliefString =
+ (char *) ckalloc(sizeof(DEF_TEXT_SELECT_RELIEF));
+ strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF);
+ textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
+ textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
+ textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);
+
+ Tk_SetClass(textPtr->tkwin, "Text");
+ Tk_SetClassProcs(textPtr->tkwin, &textClass, (ClientData) textPtr);
+ Tk_CreateEventHandler(textPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ TextEventProc, (ClientData) textPtr);
+ Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
+ |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
+ |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
+ TkTextBindProc, (ClientData) textPtr);
+ Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
+ TextFetchSelection, (ClientData) textPtr, XA_STRING);
+ if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(textPtr->tkwin);
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, Tk_PathName(textPtr->tkwin), TCL_STATIC);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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
+TextWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ int c, result = TCL_OK;
+ size_t length;
+ 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) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", x, y, width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ 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;
+ CONST 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;
+ }
+ Tcl_SetResult(interp, ((value) ? "1" : "0"), TCL_STATIC);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 3)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) textPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (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) {
+ Tcl_SetResult(interp, ((tkBTreeDebug) ? "1" : "0"), TCL_STATIC);
+ } else {
+ if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ tkTextDebug = tkBTreeDebug;
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
+ && (length >= 3)) {
+ int i;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delete index1 ?index2 ...?\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->state == TK_STATE_NORMAL) {
+ if (argc < 5) {
+ /*
+ * Simple case requires no predetermination of indices.
+ */
+ result = DeleteChars(textPtr, argv[2],
+ (argc == 4) ? argv[3] : NULL, NULL, NULL);
+ } else {
+ /*
+ * Multi-index pair case requires that we prevalidate the
+ * indices and sort from last to first so that deletes
+ * occur in the exact (unshifted) text. It also needs to
+ * handle partial and fully overlapping ranges. We have to
+ * do this with multiple passes.
+ */
+ TkTextIndex *indices, *ixStart, *ixEnd, *lastStart, *lastEnd;
+ char *useIdx;
+
+ argc -= 2;
+ argv += 2;
+ indices = (TkTextIndex *)
+ ckalloc((argc + 1) * sizeof(TkTextIndex));
+
+ /*
+ * First pass verifies that all indices are valid.
+ */
+ for (i = 0; i < argc; i++) {
+ if (TkTextGetIndex(interp, textPtr, argv[i],
+ &indices[i]) != TCL_OK) {
+ result = TCL_ERROR;
+ ckfree((char *) indices);
+ goto done;
+ }
+ }
+ /*
+ * Pad out the pairs evenly to make later code easier.
+ */
+ if (argc & 1) {
+ indices[i] = indices[i-1];
+ TkTextIndexForwChars(&indices[i], 1, &indices[i]);
+ argc++;
+ }
+ useIdx = (char *) ckalloc((unsigned) argc);
+ memset(useIdx, 0, (unsigned) argc);
+ /*
+ * Do a decreasing order sort so that we delete the end
+ * ranges first to maintain index consistency.
+ */
+ qsort((VOID *) indices, (unsigned) (argc / 2),
+ 2 * sizeof(TkTextIndex), TextIndexSortProc);
+ lastStart = lastEnd = NULL;
+ /*
+ * Second pass will handle bogus ranges (end < start) and
+ * overlapping ranges.
+ */
+ for (i = 0; i < argc; i += 2) {
+ ixStart = &indices[i];
+ ixEnd = &indices[i+1];
+ if (TkTextIndexCmp(ixEnd, ixStart) <= 0) {
+ continue;
+ }
+ if (lastStart) {
+ if (TkTextIndexCmp(ixStart, lastStart) == 0) {
+ /*
+ * Start indices were equal, and the sort placed
+ * the longest range first, so skip this one.
+ */
+ continue;
+ } else if (TkTextIndexCmp(lastStart, ixEnd) < 0) {
+ /*
+ * The next pair has a start range before the end
+ * point of the last range. Constrain the delete
+ * range, but use the pointer values.
+ */
+ *ixEnd = *lastStart;
+ if (TkTextIndexCmp(ixEnd, ixStart) <= 0) {
+ continue;
+ }
+ }
+ }
+ lastStart = ixStart;
+ lastEnd = ixEnd;
+ useIdx[i] = 1;
+ }
+ /*
+ * Final pass take the input from the previous and deletes
+ * the ranges which are flagged to be deleted.
+ */
+ for (i = 0; i < argc; i += 2) {
+ if (useIdx[i]) {
+ /*
+ * We don't need to check the return value because all
+ * indices are preparsed above.
+ */
+ DeleteChars(textPtr, NULL, NULL,
+ &indices[i], &indices[i+1]);
+ }
+ }
+ ckfree((char *) indices);
+ }
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0)
+ && (length >= 2)) {
+ int x, y, width, height, base;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " dlineinfo index\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
+ == 0) {
+ char buf[TCL_INTEGER_SPACE * 5];
+
+ sprintf(buf, "%d %d %d %d %d", x, y, width, height, base);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ } else if ((c == 'e') && (strncmp(argv[1], "edit", length) == 0)) {
+ result = TextEditCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ Tcl_Obj *objPtr = NULL;
+ Tcl_DString ds;
+ int i, found = 0;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get index1 ?index2 ...?\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ for (i = 2; i < argc; i += 2) {
+ if (TkTextGetIndex(interp, textPtr, argv[i], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (i+1 == argc) {
+ index2 = index1;
+ TkTextIndexForwChars(&index2, 1, &index2);
+ } else if (TkTextGetIndex(interp, textPtr, argv[i+1], &index2)
+ != TCL_OK) {
+ if (objPtr) {
+ Tcl_DecrRefCount(objPtr);
+ }
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextIndexCmp(&index1, &index2) < 0) {
+ /*
+ * Place the text in a DString and move it to the result.
+ * Since this could in principle be a megabyte or more, we
+ * want to do it efficiently!
+ */
+ TextGetText(&index1, &index2, &ds);
+ found++;
+ if (found == 1) {
+ Tcl_DStringResult(interp, &ds);
+ } else {
+ if (found == 2) {
+ /*
+ * Move the first item we put into the result into
+ * the first element of the list object.
+ */
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_GetObjResult(interp));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds)));
+ }
+ Tcl_DStringFree(&ds);
+ }
+ }
+ if (found > 1) {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
+ && (length >= 3)) {
+ char buf[200];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " index index\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ TkTextPrintIndex(&index1, buf);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
+ && (length >= 3)) {
+ int i, j, numTags;
+ CONST char **tagNames;
+ TkTextTag **oldTagArrayPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ " insert index chars ?tagList chars tagList ...?\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->state == TK_STATE_NORMAL) {
+ for (j = 3; j < argc; j += 2) {
+ InsertChars(textPtr, &index1, argv[j]);
+ if (argc > (j+1)) {
+ TkTextIndexForwBytes(&index1, (int) strlen(argv[j]),
+ &index2);
+ oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
+ if (oldTagArrayPtr != NULL) {
+ for (i = 0; i < numTags; i++) {
+ TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
+ }
+ ckfree((char *) oldTagArrayPtr);
+ }
+ 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, dump, edit, 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextIndexSortProc --
+ *
+ * This procedure is called by qsort when sorting an array of
+ * indices in *decreasing* order (last to first).
+ *
+ * Results:
+ * The return value is -1 if the first argument should be before
+ * the second element, 0 if it's equivalent, and 1 if it should be
+ * after the second element.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextIndexSortProc(first, second)
+ CONST VOID *first, *second; /* Elements to be compared. */
+{
+ TkTextIndex *pair1 = (TkTextIndex *) first;
+ TkTextIndex *pair2 = (TkTextIndex *) second;
+ int cmp = TkTextIndexCmp(&pair1[1], &pair2[1]);
+
+ if (cmp == 0) {
+ /*
+ * If the first indices were equal, we want the second index of the
+ * pair also to be the greater. Use pointer magic to access the
+ * second index pair.
+ */
+ cmp = TkTextIndexCmp(&pair1[0], &pair2[0]);
+ }
+ if (cmp > 0) {
+ return -1;
+ } else if (cmp < 0) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ }
+ TkUndoFreeStack(textPtr->undoStack);
+
+ /*
+ * 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 the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for textPtr; old resources get freed, if there
+ * were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ CONST 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;
+ }
+
+ TkUndoSetDepth(textPtr->undoStack, textPtr->maxUndo);
+
+ /*
+ * A few other options also need special processing, such as parsing
+ * the geometry and setting the background from a 3-D border.
+ */
+
+ 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->elideString != NULL)
+ || (textPtr->selTagPtr->wrapMode != TEXT_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;
+
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree), 0, &last);
+ TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
+ if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
+ || TkBTreeNextTag(&search)) {
+ Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
+ (ClientData) textPtr);
+ textPtr->flags |= GOT_SELECTION;
+ }
+ }
+
+ /*
+ * Account for state changes that would reenable blinking cursor state.
+ */
+
+ if (textPtr->flags & GOT_FOCUS) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ TextBlinkProc((ClientData) textPtr);
+ }
+
+ /*
+ * 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. */
+ CONST char *string; /* Null-terminated string containing new
+ * information to add to text. */
+{
+ int lineIndex, resetView, offset;
+ TkTextIndex newTop;
+ char indexBuffer[TK_POS_CHARS];
+
+ /*
+ * Don't allow insertions on the last (dummy) line of the text.
+ */
+
+ lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
+ if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
+ lineIndex--;
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
+ }
+
+ /*
+ * Notify the display module that lines are about to change, then do
+ * the insertion. If the insertion occurs on the top line of the
+ * widget (textPtr->topIndex), then we have to recompute topIndex
+ * after the insertion, since the insertion could invalidate it.
+ */
+
+ resetView = offset = 0;
+ if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
+ resetView = 1;
+ offset = textPtr->topIndex.byteIndex;
+ if (offset > indexPtr->byteIndex) {
+ offset += strlen(string);
+ }
+ }
+ TkTextChanged(textPtr, indexPtr, indexPtr);
+ TkBTreeInsertChars(indexPtr, string);
+
+ /*
+ * Push the insertion on the undo stack
+ */
+
+ if ( textPtr->undo ) {
+ TkTextIndex toIndex;
+
+ Tcl_DString actionCommand;
+ Tcl_DString revertCommand;
+
+ if (textPtr->autoSeparators &&
+ textPtr->lastEditMode != TK_TEXT_EDIT_INSERT) {
+ TkUndoInsertUndoSeparator(textPtr->undoStack);
+ }
+
+ textPtr->lastEditMode = TK_TEXT_EDIT_INSERT;
+
+ Tcl_DStringInit(&actionCommand);
+ Tcl_DStringInit(&revertCommand);
+
+ Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&actionCommand," insert ",-1);
+ TkTextPrintIndex(indexPtr,indexBuffer);
+ Tcl_DStringAppend(&actionCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&actionCommand," ",-1);
+ Tcl_DStringAppendElement(&actionCommand,string);
+ Tcl_DStringAppend(&actionCommand,";",-1);
+ Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&actionCommand," mark set insert ",-1);
+ TkTextIndexForwBytes(indexPtr, (int) strlen(string),
+ &toIndex);
+ TkTextPrintIndex(&toIndex, indexBuffer);
+ Tcl_DStringAppend(&actionCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&actionCommand,"; ",-1);
+ Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&actionCommand," see insert",-1);
+
+ Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&revertCommand," delete ",-1);
+ TkTextPrintIndex(indexPtr,indexBuffer);
+ Tcl_DStringAppend(&revertCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&revertCommand," ",-1);
+ TkTextPrintIndex(&toIndex, indexBuffer);
+ Tcl_DStringAppend(&revertCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&revertCommand," ;",-1);
+ Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&revertCommand," mark set insert ",-1);
+ TkTextPrintIndex(indexPtr,indexBuffer);
+ Tcl_DStringAppend(&revertCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&revertCommand,"; ",-1);
+ Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&revertCommand," see insert",-1);
+
+ TkUndoPushAction(textPtr->undoStack,&actionCommand, &revertCommand);
+
+ Tcl_DStringFree(&actionCommand);
+ Tcl_DStringFree(&revertCommand);
+
+ }
+ updateDirtyFlag(textPtr);
+
+ if (resetView) {
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, 0, &newTop);
+ TkTextIndexForwBytes(&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, indexPtr1, indexPtr2)
+ TkText *textPtr; /* Overall information about text widget. */
+ CONST char *index1String; /* String describing location of first
+ * character to delete. */
+ CONST char *index2String; /* String describing location of last
+ * character to delete. NULL means just
+ * delete the one character given by
+ * index1String. */
+ TkTextIndex *indexPtr1; /* index describing location of first
+ * character to delete. */
+ TkTextIndex *indexPtr2; /* index describing location of last
+ * character to delete. NULL means just
+ * delete the one character given by
+ * indexPtr1. */
+{
+ int line1, line2, line, byteIndex, resetView;
+ TkTextIndex index1, index2;
+ char indexBuffer[TK_POS_CHARS];
+
+ /*
+ * Parse the starting and stopping indices.
+ */
+
+ if (index1String != NULL) {
+ 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);
+ }
+ } else {
+ index1 = *indexPtr1;
+ if (indexPtr2 != NULL) {
+ index2 = *indexPtr2;
+ } 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.byteIndex == 0) && (line1 != 0)) {
+ TkTextIndexBackChars(&index1, 1, &index1);
+ line1--;
+ }
+ arrayPtr = TkBTreeGetTags(&index2, &arraySize);
+ if (arrayPtr != NULL) {
+ for (i = 0; i < arraySize; i++) {
+ TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
+ }
+ 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 = 0;
+ line = 0;
+ byteIndex = 0;
+ if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
+ if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
+ /*
+ * Deletion range straddles topIndex: use the beginning
+ * of the range as the new topIndex.
+ */
+
+ resetView = 1;
+ line = line1;
+ byteIndex = index1.byteIndex;
+ } else if (index1.linePtr == textPtr->topIndex.linePtr) {
+ /*
+ * Deletion range starts on top line but after topIndex.
+ * Use the current topIndex as the new one.
+ */
+
+ resetView = 1;
+ line = line1;
+ byteIndex = textPtr->topIndex.byteIndex;
+ }
+ } else if (index2.linePtr == textPtr->topIndex.linePtr) {
+ /*
+ * Deletion range ends on top line but before topIndex.
+ * Figure out what will be the new character index for
+ * the character currently pointed to by topIndex.
+ */
+
+ resetView = 1;
+ line = line2;
+ byteIndex = textPtr->topIndex.byteIndex;
+ if (index1.linePtr != index2.linePtr) {
+ byteIndex -= index2.byteIndex;
+ } else {
+ byteIndex -= (index2.byteIndex - index1.byteIndex);
+ }
+ }
+
+ /*
+ * Push the deletion on the undo stack
+ */
+
+ if (textPtr->undo) {
+ Tcl_DString ds;
+ Tcl_DString actionCommand;
+ Tcl_DString revertCommand;
+
+ if (textPtr->autoSeparators
+ && (textPtr->lastEditMode != TK_TEXT_EDIT_DELETE)) {
+ TkUndoInsertUndoSeparator(textPtr->undoStack);
+ }
+
+ textPtr->lastEditMode = TK_TEXT_EDIT_DELETE;
+
+ Tcl_DStringInit(&actionCommand);
+ Tcl_DStringInit(&revertCommand);
+
+ Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&actionCommand," delete ",-1);
+ TkTextPrintIndex(&index1,indexBuffer);
+ Tcl_DStringAppend(&actionCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&actionCommand," ",-1);
+ TkTextPrintIndex(&index2, indexBuffer);
+ Tcl_DStringAppend(&actionCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&actionCommand,"; ",-1);
+ Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&actionCommand," mark set insert ",-1);
+ TkTextPrintIndex(&index1,indexBuffer);
+ Tcl_DStringAppend(&actionCommand,indexBuffer,-1);
+
+ Tcl_DStringAppend(&actionCommand,"; ",-1);
+ Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&actionCommand," see insert",-1);
+
+ TextGetText(&index1, &index2, &ds);
+
+ Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&revertCommand," insert ",-1);
+ TkTextPrintIndex(&index1,indexBuffer);
+ Tcl_DStringAppend(&revertCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&revertCommand," ",-1);
+ Tcl_DStringAppendElement(&revertCommand,Tcl_DStringValue(&ds));
+ Tcl_DStringAppend(&revertCommand,"; ",-1);
+ Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&revertCommand," mark set insert ",-1);
+ TkTextPrintIndex(&index2, indexBuffer);
+ Tcl_DStringAppend(&revertCommand,indexBuffer,-1);
+ Tcl_DStringAppend(&revertCommand,"; ",-1);
+ Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1);
+ Tcl_DStringAppend(&revertCommand," see insert",-1);
+
+ TkUndoPushAction(textPtr->undoStack,&actionCommand, &revertCommand);
+
+ Tcl_DStringFree(&actionCommand);
+ Tcl_DStringFree(&revertCommand);
+
+ }
+ updateDirtyFlag(textPtr);
+
+ TkBTreeDeleteChars(&index1, &index2);
+ if (resetView) {
+ TkTextMakeByteIndex(textPtr->tree, line, byteIndex, &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) {
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
+ textPtr->abortSelections = 0;
+ } else if (textPtr->abortSelections) {
+ return 0;
+ }
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
+ TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
+ if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
+ if (!TkBTreeNextTag(&search)) {
+ if (offset == 0) {
+ return -1;
+ } else {
+ return 0;
+ }
+ }
+ 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.byteIndex
+ - textPtr->selIndex.byteIndex;
+ if (leftInRange < chunkSize) {
+ chunkSize = leftInRange;
+ if (chunkSize <= 0) {
+ break;
+ }
+ }
+ }
+ if ((segPtr->typePtr == &tkTextCharType)
+ && !TkTextIsElided(textPtr, &textPtr->selIndex)) {
+ memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars
+ + offsetInSeg), (size_t) chunkSize);
+ buffer += chunkSize;
+ maxBytes -= chunkSize;
+ count += chunkSize;
+ }
+ TkTextIndexForwBytes(&textPtr->selIndex, chunkSize,
+ &textPtr->selIndex);
+ }
+
+ /*
+ * Find the beginning of the next range of selected text.
+ */
+
+ 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;
+ XEvent event;
+#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.
+ */
+
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &start);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
+ TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1);
+ TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
+#endif
+
+ /*
+ * Send an event that the selection changed. This is equivalent to
+ * "event generate $textWidget <<Selection>>"
+ */
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = VirtualEvent;
+ event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
+ event.xany.send_event = False;
+ event.xany.window = Tk_WindowId(textPtr->tkwin);
+ event.xany.display = Tk_Display(textPtr->tkwin);
+ ((XVirtualEvent *) &event)->name = Tk_GetUid("Selection");
+ Tk_HandleEvent(&event);
+
+ 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->state == TK_STATE_DISABLED) ||
+ !(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. */
+ CONST char **argv; /* Argument strings. */
+{
+ int backwards, exact, searchElide, c, i, argsLeft, noCase, leftToScan;
+ size_t length;
+ int numLines, startingLine, startingByte, lineNum, firstByte, lastByte;
+ int code, matchLength, matchByte, passes, stopLine, searchWholeText;
+ int patLength;
+ CONST char *arg, *pattern, *varName, *p, *startOfLine;
+ char buffer[20];
+ TkTextIndex index, stopIndex;
+ Tcl_DString line, patDString;
+ TkTextSegment *segPtr;
+ TkTextLine *linePtr;
+ TkTextIndex curIndex;
+ Tcl_Obj *patObj = NULL;
+ Tcl_RegExp regexp = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+
+ /*
+ * Parse switches and other arguments.
+ */
+
+ exact = 1;
+ searchElide = 0;
+ curIndex.tree = textPtr->tree;
+ 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 --, -backward, -count, -elide, -exact, ",
+ "-forward, -nocase, or -regexp", (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)) {
+ Tcl_SetResult(interp, "no value given for \"-count\" option",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ i++;
+ varName = argv[i];
+ } else if ((c == 'e') && (length > 2)
+ && (strncmp(argv[i], "-exact", length) == 0)) {
+ exact = 1;
+ } else if ((c == 'e') && (length > 2)
+ && (strncmp(argv[i], "-elide", length) == 0)) {
+ searchElide = 1;
+ } else if ((c == 'h') && (strncmp(argv[i], "-hidden", length) == 0)) {
+ /*
+ * -hidden is kept around for backwards compatibility with
+ * the dash patch, but -elide is the official option
+ */
+ searchElide = 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 && exact) {
+ Tcl_DStringInit(&patDString);
+ Tcl_DStringAppend(&patDString, pattern, -1);
+ Tcl_UtfToLower(Tcl_DStringValue(&patDString));
+ pattern = Tcl_DStringValue(&patDString);
+ }
+
+ Tcl_DStringInit(&line);
+ if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ numLines = TkBTreeNumLines(textPtr->tree);
+ startingLine = TkBTreeLineIndex(index.linePtr);
+ startingByte = index.byteIndex;
+ if (startingLine >= numLines) {
+ if (backwards) {
+ startingLine = TkBTreeNumLines(textPtr->tree) - 1;
+ startingByte = TkBTreeBytesInLine(TkBTreeFindLine(textPtr->tree,
+ startingLine));
+ } else {
+ startingLine = 0;
+ startingByte = 0;
+ }
+ }
+ if (argsLeft == 1) {
+ if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ 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 {
+ patObj = Tcl_NewStringObj(pattern, -1);
+ Tcl_IncrRefCount(patObj);
+ regexp = Tcl_GetRegExpFromObj(interp, patObj,
+ (noCase ? TCL_REG_NOCASE : 0) | TCL_REG_ADVANCED);
+ if (regexp == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ lineNum = startingLine;
+ code = TCL_OK;
+ 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);
+ curIndex.linePtr = linePtr; curIndex.byteIndex = 0;
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr != &tkTextCharType)
+ || (!searchElide && TkTextIsElided(textPtr, &curIndex))) {
+ 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) {
+ Tcl_DStringSetLength(&line,
+ Tcl_UtfToLower(Tcl_DStringValue(&line)));
+ }
+
+ /*
+ * Check for matches within the current line. If so, and if we're
+ * searching backwards, repeat the search to find the last match
+ * in the line. (Note: The lastByte should include the NULL char
+ * so we can handle searching for end of line easier.)
+ */
+
+ matchByte = -1;
+ firstByte = 0;
+ lastByte = Tcl_DStringLength(&line) + 1;
+ if (lineNum == startingLine) {
+ int indexInDString;
+
+ /*
+ * The starting line is tricky: the first time we see it
+ * we check one part of the line, and the second pass through
+ * we check the other part of the line. We have to be very
+ * careful here because there could be embedded windows or
+ * other things that are not in the extracted line. Rescan
+ * the original line to compute the index in it of the first
+ * character.
+ */
+
+ indexInDString = startingByte;
+ for (segPtr = linePtr->segPtr, leftToScan = startingByte;
+ leftToScan > 0; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ indexInDString -= segPtr->size;
+ }
+ leftToScan -= segPtr->size;
+ }
+
+ passes++;
+ if ((passes == 1) ^ backwards) {
+ /*
+ * Only use the last part of the line.
+ */
+
+ firstByte = indexInDString;
+ if ((firstByte >= Tcl_DStringLength(&line))
+ && !((Tcl_DStringLength(&line) == 0) && !exact)) {
+ goto nextLine;
+ }
+ } else {
+ /*
+ * Use only the first part of the line.
+ */
+
+ lastByte = indexInDString;
+ }
+ }
+ do {
+ int thisLength;
+ Tcl_UniChar ch;
+
+ if (exact) {
+ p = strstr(startOfLine + firstByte, /* INTL: Native. */
+ pattern);
+ if (p == NULL) {
+ break;
+ }
+ i = p - startOfLine;
+ thisLength = patLength;
+ } else {
+ CONST char *start, *end;
+ int match;
+
+ match = Tcl_RegExpExec(interp, regexp,
+ startOfLine + firstByte, startOfLine);
+ if (match < 0) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (!match) {
+ break;
+ }
+ Tcl_RegExpRange(regexp, 0, &start, &end);
+ i = start - startOfLine;
+ thisLength = end - start;
+ }
+ if (i >= lastByte) {
+ break;
+ }
+ matchByte = i;
+ matchLength = thisLength;
+ firstByte = i + Tcl_UtfToUniChar(startOfLine + matchByte, &ch);
+ } while (backwards);
+
+ /*
+ * If we found a match then we're done. Make sure that
+ * the match occurred before the stopping index, if one was
+ * specified.
+ */
+
+ if (matchByte >= 0) {
+ int numChars;
+
+ /*
+ * Convert the byte length to a character count.
+ */
+
+ numChars = Tcl_NumUtfChars(startOfLine + matchByte,
+ matchLength);
+
+ /*
+ * The index information returned by the regular expression
+ * parser only considers textual information: it doesn't
+ * account for embedded windows, elided text (when we are not
+ * searching elided text) or any other non-textual info.
+ * Scan through the line's segments again to adjust both
+ * matchChar and matchCount.
+ *
+ * We will walk through the segments of this line until we have
+ * either reached the end of the match or we have reached the end
+ * of the line.
+ */
+
+ curIndex.linePtr = linePtr; curIndex.byteIndex = 0;
+ for (segPtr = linePtr->segPtr, leftToScan = matchByte;
+ leftToScan >= 0 && segPtr; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType || \
+ (!searchElide && TkTextIsElided(textPtr, &curIndex))) {
+ matchByte += segPtr->size;
+ } else {
+ leftToScan -= segPtr->size;
+ }
+ curIndex.byteIndex += segPtr->size;
+ }
+ for (leftToScan += matchLength; leftToScan > 0;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ numChars += segPtr->size;
+ continue;
+ }
+ leftToScan -= segPtr->size;
+ }
+ TkTextMakeByteIndex(textPtr->tree, lineNum, matchByte, &index);
+ if (!searchWholeText) {
+ if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
+ goto done;
+ }
+ if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) {
+ goto done;
+ }
+ }
+ if (varName != NULL) {
+ sprintf(buffer, "%d", numChars);
+ if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ TkTextPrintIndex(&index, buffer);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+ goto done;
+ }
+
+ /*
+ * Go to the next (or previous) line;
+ */
+
+ 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 && exact) {
+ Tcl_DStringFree(&patDString);
+ }
+ if (patObj != NULL) {
+ Tcl_DecrRefCount(patObj);
+ }
+ 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
+ * the interp's result.
+ *
+ * Side effects:
+ * Memory is allocated for the structure that is returned. It is
+ * up to the caller to free this structure when it is no longer
+ * needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ CONST char **argv;
+ TkTextTabArray *tabArrayPtr;
+ TkTextTab *tabPtr;
+ Tcl_UniChar ch;
+
+ if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
+ return NULL;
+ }
+
+ /*
+ * First find out how many entries we need to allocate in the
+ * 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;
+ }
+ Tcl_UtfToUniChar(argv[i+1], &ch);
+ if (!Tcl_UniCharIsAlpha(ch)) {
+ continue;
+ }
+ i += 1;
+ c = argv[i][0];
+ if ((c == 'l') && (strncmp(argv[i], "left",
+ strlen(argv[i])) == 0)) {
+ tabPtr->alignment = LEFT;
+ } else if ((c == 'r') && (strncmp(argv[i], "right",
+ strlen(argv[i])) == 0)) {
+ tabPtr->alignment = RIGHT;
+ } else if ((c == 'c') && (strncmp(argv[i], "center",
+ 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. */
+ CONST 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;
+ CONST 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);
+ 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.byteIndex, index2.byteIndex, lineno, command);
+ } else {
+ DumpLine(interp, textPtr, what, index1.linePtr,
+ index1.byteIndex, 32000000, lineno, command);
+ linePtr = index1.linePtr;
+ while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
+ lineno++;
+ if (linePtr == index2.linePtr) {
+ break;
+ }
+ DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
+ lineno, command);
+ }
+ DumpLine(interp, textPtr, what, index2.linePtr, 0,
+ index2.byteIndex, lineno, command);
+ }
+ /*
+ * Special case to get the leftovers hiding at the end mark.
+ */
+ if (atEnd) {
+ DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
+ 0, 1, lineno, command);
+
+ }
+ return TCL_OK;
+}
+
+/*
+ * DumpLine
+ * Return information about a given text line from character
+ * position "start" up to, but not including, "end".
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None, but see DumpSegment.
+ */
+static void
+DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
+ Tcl_Interp *interp;
+ TkText *textPtr;
+ int what; /* bit flags to select segment types */
+ TkTextLine *linePtr; /* The current line */
+ int startByte, endByte; /* Byte range to dump */
+ int lineno; /* Line number for indices dump */
+ CONST char *command; /* Script to apply to the segment */
+{
+ int offset;
+ TkTextSegment *segPtr;
+ TkTextIndex index;
+ /*
+ * Must loop through line looking at its segments.
+ * character
+ * toggleOn, toggleOff
+ * mark
+ * image
+ * window
+ */
+
+ for (offset = 0, segPtr = linePtr->segPtr ;
+ (offset < endByte) && (segPtr != (TkTextSegment *)NULL) ;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
+ (offset + segPtr->size > startByte)) {
+ char savedChar; /* Last char used in the seg */
+ int last = segPtr->size; /* Index of savedChar */
+ int first = 0; /* Index of first char in seg */
+ if (offset + segPtr->size > endByte) {
+ last = endByte - offset;
+ }
+ if (startByte > offset) {
+ first = startByte - offset;
+ }
+ savedChar = segPtr->body.chars[last];
+ segPtr->body.chars[last] = '\0';
+
+ TkTextMakeByteIndex(textPtr->tree, lineno, offset + first, &index);
+ DumpSegment(interp, "text", segPtr->body.chars + first,
+ command, &index, what);
+ segPtr->body.chars[last] = savedChar;
+ } else if ((offset >= startByte)) {
+ if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
+ TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
+ char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
+
+ TkTextMakeByteIndex(textPtr->tree, lineno, offset, &index);
+ DumpSegment(interp, "mark", name, command, &index, what);
+ } else if ((what & TK_DUMP_TAG) &&
+ (segPtr->typePtr == &tkTextToggleOnType)) {
+ TkTextMakeByteIndex(textPtr->tree, lineno, offset, &index);
+ DumpSegment(interp, "tagon",
+ segPtr->body.toggle.tagPtr->name,
+ command, &index, what);
+ } else if ((what & TK_DUMP_TAG) &&
+ (segPtr->typePtr == &tkTextToggleOffType)) {
+ TkTextMakeByteIndex(textPtr->tree, lineno, offset, &index);
+ DumpSegment(interp, "tagoff",
+ segPtr->body.toggle.tagPtr->name,
+ command, &index, what);
+ } else if ((what & TK_DUMP_IMG) &&
+ (segPtr->typePtr->name[0] == 'i')) {
+ TkTextEmbImage *eiPtr = (TkTextEmbImage *)&segPtr->body;
+ char *name = (eiPtr->name == NULL) ? "" : eiPtr->name;
+ TkTextMakeByteIndex(textPtr->tree, lineno, offset, &index);
+ DumpSegment(interp, "image", name,
+ command, &index, 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);
+ }
+ TkTextMakeByteIndex(textPtr->tree, lineno, offset, &index);
+ DumpSegment(interp, "window", pathname,
+ command, &index, 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, index, what)
+ Tcl_Interp *interp;
+ char *key; /* Segment type key */
+ char *value; /* Segment value */
+ CONST char *command; /* Script callback */
+ TkTextIndex *index; /* index with line/byte position info */
+ int what; /* Look for TK_DUMP_INDEX bit */
+{
+ char buffer[TCL_INTEGER_SPACE*2];
+ TkTextPrintIndex(index, buffer);
+ if (command == NULL) {
+ Tcl_AppendElement(interp, key);
+ Tcl_AppendElement(interp, value);
+ Tcl_AppendElement(interp, buffer);
+ return TCL_OK;
+ } else {
+ CONST char *argv[4];
+ char *list;
+ int result;
+ argv[0] = key;
+ argv[1] = value;
+ argv[2] = buffer;
+ argv[3] = NULL;
+ list = Tcl_Merge(3, argv);
+ result = Tcl_VarEval(interp, command, " ", list, (char *) NULL);
+ ckfree(list);
+ return result;
+ }
+}
+
+/*
+ * TextEditUndo --
+ * undo the last change.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+static int
+TextEditUndo(textPtr)
+ TkText * textPtr; /* Overall information about text widget. */
+{
+ int status;
+
+ if (!textPtr->undo) {
+ return TCL_OK;
+ }
+
+ /* Turn off the undo feature */
+ textPtr->undo = 0;
+
+ /* The dirty counter should count downwards as we are undoing things */
+ textPtr->isDirtyIncrement = -1;
+
+ /* revert one compound action */
+ status = TkUndoRevert(textPtr->undoStack);
+
+ /* Restore the isdirty increment */
+ textPtr->isDirtyIncrement = 1;
+
+ /* Turn back on the undo feature */
+ textPtr->undo = 1;
+
+ return status;
+}
+
+/*
+ * TextEditRedo --
+ * redo the last undone change.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+static int
+TextEditRedo(textPtr)
+ TkText * textPtr; /* Overall information about text widget. */
+{
+ int status;
+
+ if (!textPtr->undo) {
+ return TCL_OK;
+ }
+
+ /* Turn off the undo feature temporarily */
+ textPtr->undo = 0;
+
+ /* reapply one compound action */
+ status = TkUndoApply(textPtr->undoStack);
+
+ /* Turn back on the undo feature */
+ textPtr->undo = 1;
+
+ return status;
+}
+
+/*
+ * TextEditCmd --
+ *
+ * Handle the subcommands to "$text edit ...".
+ * See documentation for details.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+static int
+TextEditCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ int c, setModified;
+ size_t length;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " edit option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'm') && (strncmp(argv[2], "modified", length) == 0)) {
+ if (argc == 3) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(textPtr->isDirty));
+ } else if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " edit modified ?boolean?\"", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ XEvent event;
+ if (Tcl_GetBoolean(interp, argv[3], &setModified) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /*
+ * Set or reset the dirty info and trigger a Modified event.
+ */
+
+ if (setModified) {
+ textPtr->isDirty = 1;
+ textPtr->modifiedSet = 1;
+ } else {
+ textPtr->isDirty = 0;
+ textPtr->modifiedSet = 0;
+ }
+
+ /*
+ * Send an event that the text was modified. This is equivalent to
+ * "event generate $textWidget <<Modified>>"
+ */
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = VirtualEvent;
+ event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
+ event.xany.send_event = False;
+ event.xany.window = Tk_WindowId(textPtr->tkwin);
+ event.xany.display = Tk_Display(textPtr->tkwin);
+ ((XVirtualEvent *) &event)->name = Tk_GetUid("Modified");
+ Tk_HandleEvent(&event);
+ }
+ } else if ((c == 'r') && (strncmp(argv[2], "redo", length) == 0)
+ && (length >= 3)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " edit redo\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ( TextEditRedo(textPtr) ) {
+ Tcl_AppendResult(interp, "nothing to redo", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((c == 'r') && (strncmp(argv[2], "reset", length) == 0)
+ && (length >= 3)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " edit reset\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkUndoClearStacks(textPtr->undoStack);
+ } else if ((c == 's') && (strncmp(argv[2], "separator", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " edit separator\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkUndoInsertUndoSeparator(textPtr->undoStack);
+ } else if ((c == 'u') && (strncmp(argv[2], "undo", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " edit undo\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ( TextEditUndo(textPtr) ) {
+ Tcl_AppendResult(interp, "nothing to undo",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad edit option \"", argv[2],
+ "\": must be modified, redo, reset, separator or undo",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ * TextGetText --
+ * Returns the text from indexPtr1 to indexPtr2, placing that text
+ * in the Tcl_DString given. That DString should be free or uninitialized.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory will be allocated for the DString. Remember to free it.
+ */
+
+static void
+TextGetText(indexPtr1,indexPtr2, dsPtr)
+ TkTextIndex *indexPtr1;
+ TkTextIndex *indexPtr2;
+ Tcl_DString *dsPtr;
+{
+ TkTextIndex tmpIndex;
+ Tcl_DStringInit(dsPtr);
+
+ TkTextMakeByteIndex(indexPtr1->tree, TkBTreeLineIndex(indexPtr1->linePtr),
+ indexPtr1->byteIndex, &tmpIndex);
+
+ if (TkTextIndexCmp(indexPtr1, indexPtr2) < 0) {
+ while (1) {
+ int offset, last;
+ TkTextSegment *segPtr;
+
+ segPtr = TkTextIndexToSeg(&tmpIndex, &offset);
+ last = segPtr->size;
+ if (tmpIndex.linePtr == indexPtr2->linePtr) {
+ int last2;
+
+ if (indexPtr2->byteIndex == tmpIndex.byteIndex) {
+ break;
+ }
+ last2 = indexPtr2->byteIndex - tmpIndex.byteIndex + offset;
+ if (last2 < last) {
+ last = last2;
+ }
+ }
+ if (segPtr->typePtr == &tkTextCharType) {
+ Tcl_DStringAppend(dsPtr, segPtr->body.chars + offset,
+ last - offset);
+ }
+ TkTextIndexForwBytes(&tmpIndex, last-offset, &tmpIndex);
+ }
+ }
+}
+
+/*
+ * updateDirtyFlag --
+ * increases the dirtyness of the text widget
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+static void updateDirtyFlag (textPtr)
+ TkText *textPtr; /* Information about text widget. */
+{
+ int oldDirtyFlag;
+
+ if (textPtr->modifiedSet) {
+ return;
+ }
+ oldDirtyFlag = textPtr->isDirty;
+ textPtr->isDirty += textPtr->isDirtyIncrement;
+ if (textPtr->isDirty == 0 || oldDirtyFlag == 0) {
+ XEvent event;
+ /*
+ * Send an event that the text was modified. This is equivalent to
+ * "event generate $textWidget <<Modified>>"
+ */
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = VirtualEvent;
+ event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
+ event.xany.send_event = False;
+ event.xany.window = Tk_WindowId(textPtr->tkwin);
+ event.xany.display = Tk_Display(textPtr->tkwin);
+ ((XVirtualEvent *) &event)->name = Tk_GetUid("Modified");
+ Tk_HandleEvent(&event);
+ }
+}
diff --git a/tcl/generic/tkText.h b/tcl/generic/tkText.h
new file mode 100644
index 00000000000..4661330051e
--- /dev/null
+++ b/tcl/generic/tkText.h
@@ -0,0 +1,922 @@
+/*
+ * 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
+
+#ifndef _TKUNDO
+#include "tkUndo.h"
+#endif
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#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 byteIndex; /* 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 numBytes; /* Number of bytes that will be
+ * displayed in the chunk. */
+ int minAscent; /* Minimum space above the baseline
+ * needed by this chunk. */
+ int minDescent; /* Minimum space below the baseline
+ * needed by this chunk. */
+ int minHeight; /* Minimum total line height needed
+ * by this chunk. */
+ int width; /* Width of this chunk, in pixels.
+ * Initially set by chunk-specific
+ * code, but may be increased to
+ * include tab or extra space at end
+ * of line. */
+ int breakIndex; /* Index within chunk of last
+ * acceptable position for a line
+ * (break just before this byte index).
+ * <= 0 means don't break during or
+ * immediately after this chunk. */
+ ClientData clientData; /* Additional information for use
+ * of displayProc and undisplayProc. */
+};
+
+/*
+ * 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 enum { TEXT_WRAPMODE_NULL, TEXT_WRAPMODE_NONE,
+ TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_WORD
+} TkWrapMode;
+
+EXTERN Tk_CustomOption textWrapModeOption;
+
+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. */
+ TkWrapMode wrapMode; /* How to handle wrap-around for this tag.
+ * Must be TEXT_WRAPMODE_CHAR,
+ * TEXT_WRAPMODE_NONE, TEXT_WRAPMODE_WORD,
+ * or TEXT_WRAPMODE_NULL to use wrapmode for
+ * whole widget. */
+ char *elideString; /* -elide option string (malloc-ed).
+ * NULL means option not specified. */
+ int elide; /* Non-zero means that data under this tag
+ * should not be displayed. */
+ 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;
+
+/* enum definining the edit modes of */
+
+typedef enum {
+ TK_TEXT_EDIT_INSERT, /* insert mode */
+ TK_TEXT_EDIT_DELETE, /* delete mode */
+ TK_TEXT_EDIT_OTHER /* none of the above */
+} TkTextEditMode;
+
+/*
+ * 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. */
+ int state; /* Either STATE_NORMAL or STATE_DISABLED. A
+ * text widget is read-only when disabled. */
+
+ /*
+ * Default information for displaying (may be overridden by tags
+ * applied to ranges of characters).
+ */
+
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * 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. */
+
+ /*
+ * Additional information used for displaying:
+ */
+
+ TkWrapMode wrapMode; /* How to handle wrap-around. Must be
+ * TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or
+ * TEXT_WRAPMODE_WORD. */
+ 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. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+
+ /*
+ * Information related to the undo/redo functonality
+ */
+
+ TkUndoRedoStack * undoStack; /* The undo/redo stack */
+
+ int undo; /* non zero means the undo/redo behaviour is
+ * enabled */
+
+ int maxUndo; /* The maximum depth of the undo stack expressed
+ * as the maximum number of compound statements */
+
+ int autoSeparators; /* non zero means the separatorss will be
+ * inserted automatically */
+
+ int modifiedSet; /* Flag indicating that the 'dirtynesss' of
+ * the text widget has been expplicitly set.
+ */
+
+ int isDirty; /* Flag indicating the 'dirtynesss' of the text
+ * widget. If the flag is not zero, unsaved
+ * modifications have been applied to the
+ * text widget */
+
+ int isDirtyIncrement; /* Amount with which the isDirty flag is
+ * incremented every edit action
+ */
+
+ TkTextEditMode lastEditMode; /* Keeps track of what the last edit mode was
+ */
+
+} 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, TkWrapMode 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_SegType tkTextLeftMarkType;
+EXTERN Tk_SegType tkTextRightMarkType;
+EXTERN Tk_SegType tkTextToggleOnType;
+EXTERN Tk_SegType tkTextToggleOffType;
+
+/*
+ * 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 int TkBTreeBytesInLine _ANSI_ARGS_((TkTextLine *linePtr));
+EXTERN TkTextBTree TkBTreeCreate _ANSI_ARGS_((TkText *textPtr));
+EXTERN void TkBTreeDestroy _ANSI_ARGS_((TkTextBTree tree));
+EXTERN void TkBTreeDeleteChars _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr));
+EXTERN TkTextLine * TkBTreeFindLine _ANSI_ARGS_((TkTextBTree tree,
+ int line));
+EXTERN TkTextTag ** TkBTreeGetTags _ANSI_ARGS_((TkTextIndex *indexPtr,
+ int *numTagsPtr));
+EXTERN void TkBTreeInsertChars _ANSI_ARGS_((TkTextIndex *indexPtr,
+ CONST 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,
+ TkWrapMode 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,
+ CONST 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, CONST char *string,
+ TkTextIndex *indexPtr));
+EXTERN TkTextTabArray * TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string));
+EXTERN void TkTextIndexBackBytes _ANSI_ARGS_((
+ CONST TkTextIndex *srcPtr, int count,
+ TkTextIndex *dstPtr));
+EXTERN void TkTextIndexBackChars _ANSI_ARGS_((
+ CONST TkTextIndex *srcPtr, int count,
+ TkTextIndex *dstPtr));
+EXTERN int TkTextIndexCmp _ANSI_ARGS_((
+ CONST TkTextIndex *index1Ptr,
+ CONST TkTextIndex *index2Ptr));
+EXTERN void TkTextIndexForwBytes _ANSI_ARGS_((
+ CONST TkTextIndex *srcPtr, int count,
+ TkTextIndex *dstPtr));
+EXTERN void TkTextIndexForwChars _ANSI_ARGS_((
+ CONST TkTextIndex *srcPtr, int count,
+ TkTextIndex *dstPtr));
+EXTERN TkTextSegment * TkTextIndexToSeg _ANSI_ARGS_((
+ CONST TkTextIndex *indexPtr, int *offsetPtr));
+EXTERN void TkTextInsertDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y, int height,
+ int baseline, Display *display, Drawable dst,
+ int screenY));
+EXTERN void TkTextLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+EXTERN TkTextIndex * TkTextMakeCharIndex _ANSI_ARGS_((TkTextBTree tree,
+ int lineIndex, int charIndex,
+ TkTextIndex *indexPtr));
+EXTERN int TkTextIsElided _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr));
+EXTERN TkTextIndex * TkTextMakeByteIndex _ANSI_ARGS_((TkTextBTree tree,
+ int lineIndex, int byteIndex,
+ TkTextIndex *indexPtr));
+EXTERN int TkTextMarkCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr,
+ CONST char *name, TkTextIndex *indexPtr));
+EXTERN void TkTextMarkSegToIndex _ANSI_ARGS_((TkText *textPtr,
+ TkTextSegment *markPtr, TkTextIndex *indexPtr));
+EXTERN void TkTextEventuallyRepick _ANSI_ARGS_((TkText *textPtr));
+EXTERN void TkTextPickCurrent _ANSI_ARGS_((TkText *textPtr,
+ XEvent *eventPtr));
+EXTERN void TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr,
+ int x, int y, TkTextIndex *indexPtr));
+EXTERN void TkTextPrintIndex _ANSI_ARGS_((
+ CONST TkTextIndex *indexPtr, char *string));
+EXTERN void TkTextRedrawRegion _ANSI_ARGS_((TkText *textPtr,
+ int x, int y, int width, int height));
+EXTERN void TkTextRedrawTag _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *index1Ptr, TkTextIndex *index2Ptr,
+ TkTextTag *tagPtr, int withTag));
+EXTERN void TkTextRelayoutWindow _ANSI_ARGS_((TkText *textPtr));
+EXTERN int TkTextScanCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int TkTextSegToOffset _ANSI_ARGS_((
+ CONST TkTextSegment *segPtr,
+ CONST TkTextLine *linePtr));
+EXTERN TkTextSegment * TkTextSetMark _ANSI_ARGS_((TkText *textPtr,
+ CONST 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, CONST char **argv));
+EXTERN int TkTextImageCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int TkTextImageIndex _ANSI_ARGS_((TkText *textPtr,
+ CONST char *name, TkTextIndex *indexPtr));
+EXTERN int TkTextWindowCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int TkTextWindowIndex _ANSI_ARGS_((TkText *textPtr,
+ CONST char *name, TkTextIndex *indexPtr));
+EXTERN int TkTextXviewCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+EXTERN int TkTextYviewCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, CONST char **argv));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKTEXT */
diff --git a/tcl/generic/tkTextBTree.c b/tcl/generic/tkTextBTree.c
new file mode 100644
index 00000000000..89d7db99ba4
--- /dev/null
+++ b/tcl/generic/tkTextBTree.c
@@ -0,0 +1,3755 @@
+/*
+ * 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. */
+ CONST 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 CONST 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->byteIndex, prevPtr = NULL,
+ segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
+ count -= segPtr->size, prevPtr = segPtr, segPtr = segPtr->nextPtr) {
+ if (segPtr->size > count) {
+ if (count == 0) {
+ return prevPtr;
+ }
+ segPtr = (*segPtr->typePtr->splitProc)(segPtr, count);
+ 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->byteIndex = 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->byteIndex = 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.byteIndex -= offset;
+ }
+ searchPtr->lastPtr = TkTextIndexToSeg(index2Ptr, (int *) NULL);
+ searchPtr->tagPtr = tagPtr;
+ searchPtr->linesLeft = TkBTreeLineIndex(index2Ptr->linePtr) + 1
+ - TkBTreeLineIndex(index1Ptr->linePtr);
+ searchPtr->allTags = (tagPtr == NULL);
+ if (searchPtr->linesLeft == 1) {
+ /*
+ * Starting and stopping segments are in the same line; mark the
+ * search as over immediately if the second segment is before the
+ * first. A search does not return a toggle at the very start of
+ * the range, unless the range is artificially moved up to index0.
+ */
+ if (((index1Ptr == &index0) &&
+ (index1Ptr->byteIndex > index2Ptr->byteIndex)) ||
+ ((index1Ptr != &index0) &&
+ (index1Ptr->byteIndex >= index2Ptr->byteIndex))) {
+ searchPtr->linesLeft = 0;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.byteIndex -= offset;
+
+ /*
+ * Adjust the end of the search so it does find toggles that are right
+ * at the second index specified by the user.
+ */
+
+ if ((TkBTreeLineIndex(index2Ptr->linePtr) == 0) &&
+ (index2Ptr->byteIndex == 0)) {
+ backOne = *index2Ptr;
+ searchPtr->lastPtr = NULL; /* Signals special case for 1.0 */
+ } else {
+ TkTextIndexBackChars(index2Ptr, 1, &backOne);
+ searchPtr->lastPtr = TkTextIndexToSeg(&backOne, (int *) NULL);
+ }
+ searchPtr->tagPtr = tagPtr;
+ searchPtr->linesLeft = TkBTreeLineIndex(index1Ptr->linePtr) + 1
+ - TkBTreeLineIndex(backOne.linePtr);
+ searchPtr->allTags = (tagPtr == NULL);
+ if (searchPtr->linesLeft == 1) {
+ /*
+ * Starting and stopping segments are in the same line; mark the
+ * search as over immediately if the second segment is after the
+ * first.
+ */
+
+ if (index1Ptr->byteIndex <= backOne.byteIndex) {
+ searchPtr->linesLeft = 0;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.byteIndex += segPtr->size;
+ }
+
+ /*
+ * See if there are more lines associated with the current parent
+ * node. If so, go back to the top of the loop to search the next
+ * one.
+ */
+
+ nodePtr = searchPtr->curIndex.linePtr->parentPtr;
+ searchPtr->curIndex.linePtr = searchPtr->curIndex.linePtr->nextPtr;
+ searchPtr->linesLeft--;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+ if (searchPtr->curIndex.linePtr != NULL) {
+ segPtr = searchPtr->curIndex.linePtr->segPtr;
+ searchPtr->curIndex.byteIndex = 0;
+ continue;
+ }
+ if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+
+ /*
+ * 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.byteIndex = 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 byteIndex;
+ int pastLast; /* Saw last marker during scan */
+ int linesSkipped;
+
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * The outermost loop iterates over lines that may potentially contain
+ * a relevant tag transition, starting from the current segment in
+ * the current line. "nextPtr" is maintained as the last segment in
+ * a line that we can look at.
+ */
+
+ while (1) {
+ /*
+ * Check for the last toggle before the current segment on this line.
+ */
+ byteIndex = 0;
+ if (searchPtr->lastPtr == NULL) {
+ /*
+ * Search back to the very beginning, so pastLast is irrelevent.
+ */
+ pastLast = 1;
+ } else {
+ pastLast = 0;
+ }
+ for (prevPtr = NULL, segPtr = searchPtr->curIndex.linePtr->segPtr ;
+ segPtr != NULL && segPtr != searchPtr->nextPtr;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (searchPtr->allTags
+ || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
+ prevPtr = segPtr;
+ searchPtr->curIndex.byteIndex = byteIndex;
+ }
+ if (segPtr == searchPtr->lastPtr) {
+ prevPtr = NULL; /* Segments earlier than last don't count */
+ pastLast = 1;
+ }
+ byteIndex += segPtr->size;
+ }
+ if (prevPtr != NULL) {
+ if (searchPtr->linesLeft == 1 && !pastLast) {
+ /*
+ * We found a segment that is before the stopping index.
+ * Note that it is OK if prevPtr == lastPtr.
+ */
+ 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.byteIndex = 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->byteIndex;
+ 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->byteIndex;
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextIsElided --
+ *
+ * Special case to just return information about elided attribute.
+ * Specialized from TkBTreeGetTags(indexPtr, numTagsPtr)
+ * and GetStyle(textPtr, indexPtr).
+ * Just need to keep track of invisibility settings for each priority,
+ * pick highest one active at end
+ *
+ * Results:
+ * Returns whether this text should be elided or not.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkTextIsElided(textPtr, indexPtr)
+ TkText *textPtr; /* Overall information about text widget. */
+ TkTextIndex *indexPtr; /* The character in the text for which
+ * display information is wanted. */
+{
+#define LOTSA_TAGS 1000
+ int elide = 0; /* if nobody says otherwise, it's visible */
+
+ int deftagCnts[LOTSA_TAGS];
+ int *tagCnts = deftagCnts;
+ TkTextTag *deftagPtrs[LOTSA_TAGS];
+ TkTextTag **tagPtrs = deftagPtrs;
+ int numTags = textPtr->numTags;
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ register TkTextTag *tagPtr;
+ register int i, index;
+
+ /* almost always avoid malloc, so stay out of system calls */
+ if (LOTSA_TAGS < numTags) {
+ tagCnts = (int *)ckalloc((unsigned)sizeof(int) * numTags);
+ tagPtrs = (TkTextTag **)ckalloc((unsigned)sizeof(TkTextTag *) * numTags);
+ }
+
+ for (i=0; i<numTags; i++) {
+ tagCnts[i] = 0;
+ }
+
+ /*
+ * Record tag toggles within the line of indexPtr but preceding
+ * indexPtr.
+ */
+
+ for (index = 0, segPtr = indexPtr->linePtr->segPtr;
+ (index + segPtr->size) <= indexPtr->byteIndex;
+ index += segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType)) {
+ tagPtr = segPtr->body.toggle.tagPtr;
+ if (tagPtr->elideString != NULL) {
+ tagPtrs[tagPtr->priority] = tagPtr;
+ tagCnts[tagPtr->priority]++;
+ }
+ }
+ }
+
+ /*
+ * 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)) {
+ tagPtr = segPtr->body.toggle.tagPtr;
+ if (tagPtr->elideString != NULL) {
+ tagPtrs[tagPtr->priority] = tagPtr;
+ tagCnts[tagPtr->priority]++;
+ }
+ }
+ }
+ }
+
+ /*
+ * 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) {
+ tagPtr = summaryPtr->tagPtr;
+ if (tagPtr->elideString != NULL) {
+ tagPtrs[tagPtr->priority] = tagPtr;
+ tagCnts[tagPtr->priority] += summaryPtr->toggleCount;
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Now traverse from highest priority to lowest,
+ * take elided value from first odd count (= on)
+ */
+
+ for (i = numTags-1; i >=0; i--) {
+ if (tagCnts[i] & 1) {
+#ifndef ALWAYS_SHOW_SELECTION
+ /* who would make the selection elided? */
+ if ((tagPtr == textPtr->selTagPtr)
+ && !(textPtr->flags & GOT_FOCUS)) {
+ continue;
+ }
+#endif
+ elide = tagPtrs[i]->elide;
+ break;
+ }
+ }
+
+ if (LOTSA_TAGS < numTags) {
+ ckfree((char *) tagCnts);
+ ckfree((char *) tagPtrs);
+ }
+
+ return elide;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ count += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size);
+ } else {
+ count += segPtr->size;
+ }
+ }
+ return count;
+}
+
+int
+TkBTreeBytesInLine(linePtr)
+ TkTextLine *linePtr; /* Line whose characters should be
+ * counted. */
+{
+ TkTextSegment *segPtr;
+ int count;
+
+ count = 0;
+ for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ count += segPtr->size;
+ }
+ return count;
+}
diff --git a/tcl/generic/tkTextDisp.c b/tcl/generic/tkTextDisp.c
new file mode 100644
index 00000000000..84e003a519f
--- /dev/null
+++ b/tcl/generic/tkTextDisp.c
@@ -0,0 +1,5225 @@
+/*
+ * 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"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+/*
+ * The following structure describes how to display a range of characters.
+ * The information is generated by scanning all of the tags associated
+ * with the characters and combining that with default information for
+ * the overall widget. These structures form the hash keys for
+ * dInfoPtr->styleTable.
+ */
+
+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. */
+ int elide; /* Non-zero means draw text */
+ TkWrapMode wrapMode; /* How to handle wrap-around for this tag.
+ * One of TEXT_WRAPMODE_CHAR,
+ * TEXT_WRAPMODE_NONE or TEXT_WRAPMODE_WORD.*/
+} 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 macro is used to compare two floating-point numbers
+ * to within a certain degree of scale. Direct comparison fails on
+ * processors where the processor and memory representations of FP
+ * numbers of a particular precision is different (e.g. Intel)
+ */
+
+#define FP_EQUAL_SCALE(double1, double2, scaleFactor) \
+ (fabs((double1)-(double2))*((scaleFactor)+1.0) < 0.3)
+
+/*
+ * The following structure describes one line of the display, which may
+ * be either part or all of one line of the text.
+ */
+
+typedef struct DLine {
+ TkTextIndex index; /* Identifies first character in text
+ * that is displayed on this line. */
+ int byteCount; /* Number of bytes accounted for by this
+ * display line, including a trailing space
+ * or newline that isn't actually displayed. */
+ int y; /* Y-position at which line is supposed to
+ * be drawn (topmost pixel of rectangular
+ * area occupied by line). */
+ int oldY; /* Y-position at which line currently
+ * appears on display. -1 means line isn't
+ * 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.
+ * IS_DISABLED - This Dline cannot be edited.
+ */
+
+#define HAS_3D_BORDER 1
+#define NEW_LAYOUT 2
+#define TOP_LINE 4
+#define BOTTOM_LINE 8
+#define IS_DISABLED 16
+
+/*
+ * 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 newByteOffset; /* Desired x scroll position, measured as the
+ * number of average-size characters off-screen
+ * to the left for a line with no left
+ * margin. */
+ int curPixelOffset; /* Actual x scroll position, measured as the
+ * number of pixels off-screen to the left. */
+ int maxLength; /* Length in pixels of longest line that's
+ * visible in window (length may exceed window
+ * 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 scanMarkIndex; /* Byte index of character that was at the
+ * left edge of the window when the scan
+ * started. */
+ int scanMarkX; /* X-position of mouse at time scan started. */
+ int scanTotalScroll; /* Total scrolling (in screen lines) that has
+ * occurred since scanMarkY was set. */
+ int scanMarkY; /* Y-position of mouse at time scan started. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ 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 numBytes; /* Number of bytes to display. */
+ char chars[4]; /* UTF characters to display. Actual size
+ * will be numBytes, not 4. THIS MUST BE
+ * THE LAST FIELD IN THE STRUCTURE. */
+} CharInfo;
+
+/*
+ * Flag values for TextDInfo structures:
+ *
+ * DINFO_OUT_OF_DATE: Non-zero means that the DLine structures
+ * 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));
+
+/*
+ Definitions of elided procs.
+ Compiler can't inline these since we use pointers to these functions.
+ ElideDisplayProc, ElideUndisplayProc special-cased for speed,
+ as potentially many elided DLine chunks if large, tag toggle-filled
+ elided region.
+*/
+static void ElideBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int index, int y, int lineHeight, int baseline,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+static int ElideMeasureProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int x));
+
+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 maxBytes, int startX,
+ int maxX, int tabOrigin, int *nextXPtr));
+static void MeasureUp _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *srcPtr, int distance,
+ TkTextIndex *dstPtr));
+static int NextTabStop _ANSI_ARGS_((Tk_Font tkfont, int x,
+ int tabOrigin));
+static void UpdateDisplayInfo _ANSI_ARGS_((TkText *textPtr));
+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->newByteOffset = 0;
+ dInfoPtr->curPixelOffset = 0;
+ dInfoPtr->maxLength = 0;
+ dInfoPtr->xScrollFirst = -1;
+ dInfoPtr->xScrollLast = -1;
+ dInfoPtr->yScrollFirst = -1;
+ dInfoPtr->yScrollLast = -1;
+ dInfoPtr->scanMarkIndex = 0;
+ dInfoPtr->scanMarkX = 0;
+ dInfoPtr->scanTotalScroll = 0;
+ dInfoPtr->scanMarkY = 0;
+ dInfoPtr->dLinesInvalidated = 0;
+ dInfoPtr->flags = DINFO_OUT_OF_DATE;
+ textPtr->dInfoPtr = dInfoPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, elidePrio, 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 = elidePrio = 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;
+ styleValues.elide = 0;
+ 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->elideString != NULL)
+ && (tagPtr->priority > elidePrio)) {
+ styleValues.elide = tagPtr->elide;
+ elidePrio = tagPtr->priority;
+ }
+ if ((tagPtr->wrapMode != TEXT_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_GetGC(textPtr->tkwin, mask, &gcValues);
+ } else {
+ stylePtr->bgGC = None;
+ }
+ mask = GCFont;
+ gcValues.font = Tk_FontId(styleValues.tkfont);
+ mask |= GCForeground;
+ gcValues.foreground = styleValues.fgColor->pixel;
+ if (styleValues.fgStipple != None) {
+ gcValues.stipple = styleValues.fgStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ stylePtr->fgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
+ 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);
+ }
+ if (stylePtr->fgGC != None) {
+ 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 breakByteOffset; /* Byte offset of character within
+ * breakChunkPtr just to right of best
+ * break point. */
+ int noCharsYet; /* Non-zero means that no characters
+ * have been placed on the line yet. */
+ int justify; /* How to justify line: taken from
+ * style for the first character in
+ * line. */
+ int jIndent; /* Additional indentation (beyond
+ * margins) due to justification. */
+ int rMargin; /* Right margin width for line. */
+ TkWrapMode wrapMode; /* Wrap mode to use for this line. */
+ int x = 0, maxX = 0; /* Initializations needed only to
+ * stop compiler warnings. */
+ int wholeLine; /* Non-zero means this display line
+ * runs to the end of the text line. */
+ int tabIndex; /* Index of the current tab stop. */
+ int gotTab; /* Non-zero means the current chunk
+ * contains a tab. */
+ TkTextDispChunk *tabChunkPtr; /* Pointer to the chunk containing
+ * the previous tab stop. */
+ int maxBytes; /* Maximum number of bytes to
+ * include in this chunk. */
+ TkTextTabArray *tabArrayPtr; /* Tab stops for line; taken from
+ * style for the first character on
+ * line. */
+ int tabSize; /* Number of pixels consumed by current
+ * tab stop. */
+ TkTextDispChunk *lastCharChunkPtr; /* Pointer to last chunk in display
+ * lines with numBytes > 0. Used to
+ * drop 0-sized chunks from the end
+ * of the line. */
+ int byteOffset, ascent, descent, code, elide, elidesize;
+ StyleValues *sValuePtr;
+
+ /*
+ * Create and initialize a new DLine structure.
+ */
+
+ dlPtr = (DLine *) ckalloc(sizeof(DLine));
+ dlPtr->index = *indexPtr;
+ dlPtr->byteCount = 0;
+ dlPtr->y = 0;
+ dlPtr->oldY = -1;
+ dlPtr->height = 0;
+ dlPtr->baseline = 0;
+ dlPtr->chunkPtr = NULL;
+ dlPtr->nextPtr = NULL;
+ dlPtr->flags = NEW_LAYOUT;
+
+ /*
+ * Special case entirely elide line as there may be 1000s or more
+ */
+ elide = TkTextIsElided(textPtr, indexPtr); /* save a malloc */
+ if (elide && indexPtr->byteIndex==0) {
+ maxBytes = 0;
+ for (segPtr = indexPtr->linePtr->segPtr;
+ elide && (segPtr != NULL);
+ segPtr = segPtr->nextPtr) {
+ if ((elidesize = segPtr->size) > 0) {
+ maxBytes += elidesize;
+ /*
+ * If have we have a tag toggle, there is a chance
+ * that invisibility state changed, so bail out
+ */
+ } else if ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextToggleOnType)) {
+ if (segPtr->body.toggle.tagPtr->elideString != NULL) {
+ elide = (segPtr->typePtr == &tkTextToggleOffType)
+ ^ segPtr->body.toggle.tagPtr->elide;
+ }
+ }
+ }
+
+ if (elide) {
+ dlPtr->byteCount = maxBytes;
+ dlPtr->spaceAbove = dlPtr->spaceBelow = dlPtr->length = 0;
+ return dlPtr;
+ }
+ }
+
+ /*
+ * 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;
+ elide = 0;
+ breakChunkPtr = NULL;
+ breakByteOffset = 0;
+ justify = TK_JUSTIFY_LEFT;
+ tabIndex = -1;
+ tabChunkPtr = NULL;
+ tabArrayPtr = NULL;
+ rMargin = 0;
+ wrapMode = TEXT_WRAPMODE_CHAR;
+ tabSize = 0;
+ lastCharChunkPtr = NULL;
+
+ /*
+ * Find the first segment to consider for the line. Can't call
+ * TkTextIndexToSeg for this because it won't return a segment
+ * with zero size (such as the insertion cursor's mark).
+ */
+
+ for (byteOffset = curIndex.byteIndex, segPtr = curIndex.linePtr->segPtr;
+ (byteOffset > 0) && (byteOffset >= segPtr->size);
+ byteOffset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+
+ while (segPtr != NULL) {
+ /*
+ * Every line still gets at least one chunk due to expectations
+ * in the rest of the code, but we are able to skip elided portions
+ * of the line quickly.
+ * If current chunk is elided and last chunk was too, coalese
+ */
+ if (elide && (lastChunkPtr != NULL)
+ && (lastChunkPtr->displayProc == NULL /*ElideDisplayProc*/)) {
+ if ((elidesize = segPtr->size - byteOffset) > 0) {
+ curIndex.byteIndex += elidesize;
+ lastChunkPtr->numBytes += elidesize;
+ breakByteOffset = lastChunkPtr->breakIndex = lastChunkPtr->numBytes;
+ /*
+ * If have we have a tag toggle, there is a chance
+ * that invisibility state changed, so bail out
+ */
+ } else if ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextToggleOnType)) {
+ if (segPtr->body.toggle.tagPtr->elideString != NULL) {
+ elide = (segPtr->typePtr == &tkTextToggleOffType)
+ ^ segPtr->body.toggle.tagPtr->elide;
+ }
+ }
+
+ byteOffset = 0;
+ segPtr = segPtr->nextPtr;
+ if (segPtr == NULL && chunkPtr != NULL) {
+ ckfree((char *) chunkPtr);
+ }
+ continue;
+ }
+
+ if (segPtr->typePtr->layoutProc == NULL) {
+ segPtr = segPtr->nextPtr;
+ byteOffset = 0;
+ continue;
+ }
+ if (chunkPtr == NULL) {
+ chunkPtr = (TkTextDispChunk *) ckalloc(sizeof(TkTextDispChunk));
+ chunkPtr->nextPtr = NULL;
+ }
+ chunkPtr->stylePtr = GetStyle(textPtr, &curIndex);
+ elide = chunkPtr->stylePtr->sValuePtr->elide;
+
+ /*
+ * Save style information such as justification and indentation,
+ * up until the first character is encountered, then retain that
+ * information for the rest of the line.
+ */
+
+ if (noCharsYet) {
+ tabArrayPtr = chunkPtr->stylePtr->sValuePtr->tabArrayPtr;
+ justify = chunkPtr->stylePtr->sValuePtr->justify;
+ rMargin = chunkPtr->stylePtr->sValuePtr->rMargin;
+ wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode;
+ x = ((curIndex.byteIndex == 0)
+ ? chunkPtr->stylePtr->sValuePtr->lMargin1
+ : chunkPtr->stylePtr->sValuePtr->lMargin2);
+ if (wrapMode == TEXT_WRAPMODE_NONE) {
+ maxX = -1;
+ } else {
+ maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x
+ - rMargin;
+ if (maxX < x) {
+ maxX = x;
+ }
+ }
+ }
+
+ /*
+ * See if there is a tab in the current chunk; if so, only
+ * layout characters up to (and including) the tab.
+ */
+
+ gotTab = 0;
+ maxBytes = segPtr->size - byteOffset;
+ if (!elide && justify == TK_JUSTIFY_LEFT) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ char *p;
+
+ for (p = segPtr->body.chars + byteOffset; *p != 0; p++) {
+ if (*p == '\t') {
+ maxBytes = (p + 1 - segPtr->body.chars) - byteOffset;
+ gotTab = 1;
+ break;
+ }
+ }
+ }
+ }
+ chunkPtr->x = x;
+ if (elide && maxBytes) {
+ /* don't free style here, as other code expects to be able to do that */
+ /*breakByteOffset =*/ chunkPtr->breakIndex = chunkPtr->numBytes = maxBytes;
+ chunkPtr->width = 0;
+ chunkPtr->minAscent = chunkPtr->minDescent = chunkPtr->minHeight = 0;
+
+ /* would just like to point to canonical empty chunk */
+ chunkPtr->displayProc = (Tk_ChunkDisplayProc *) NULL;
+ chunkPtr->undisplayProc = (Tk_ChunkUndisplayProc *) NULL;
+ chunkPtr->measureProc = ElideMeasureProc;
+ chunkPtr->bboxProc = ElideBboxProc;
+
+ code = 1;
+ } else
+ code = (*segPtr->typePtr->layoutProc)(textPtr, &curIndex, segPtr,
+ byteOffset, maxX-tabSize, maxBytes, noCharsYet, wrapMode,
+ chunkPtr);
+ if (code <= 0) {
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ if (code < 0) {
+ /*
+ * This segment doesn't wish to display itself (e.g. most
+ * marks).
+ */
+
+ segPtr = segPtr->nextPtr;
+ byteOffset = 0;
+ continue;
+ }
+
+ /*
+ * No characters from this segment fit in the window: this
+ * means we're at the end of the display line.
+ */
+
+ if (chunkPtr != NULL) {
+ ckfree((char *) chunkPtr);
+ }
+ break;
+ }
+ if (chunkPtr->numBytes > 0) {
+ noCharsYet = 0;
+ lastCharChunkPtr = chunkPtr;
+ }
+ if (lastChunkPtr == NULL) {
+ dlPtr->chunkPtr = chunkPtr;
+ } else {
+ lastChunkPtr->nextPtr = chunkPtr;
+ }
+ lastChunkPtr = chunkPtr;
+ x += chunkPtr->width;
+ if (chunkPtr->breakIndex > 0) {
+ breakByteOffset = chunkPtr->breakIndex;
+ breakIndex = curIndex;
+ breakChunkPtr = chunkPtr;
+ }
+ if (chunkPtr->numBytes != maxBytes) {
+ break;
+ }
+
+ /*
+ * If we're at a new tab, adjust the layout for all the chunks
+ * pertaining to the previous tab. Also adjust the amount of
+ * space left in the line to account for space that will be eaten
+ * up by the tab.
+ */
+
+ if (gotTab) {
+ if (tabIndex >= 0) {
+ AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
+ x = chunkPtr->x + chunkPtr->width;
+ }
+ tabIndex++;
+ tabChunkPtr = chunkPtr;
+ tabSize = SizeOfTab(textPtr, tabArrayPtr, tabIndex, x, maxX);
+ if ((maxX >= 0) && (tabSize >= maxX - x)) {
+ break;
+ }
+ }
+ curIndex.byteIndex += chunkPtr->numBytes;
+ byteOffset += chunkPtr->numBytes;
+ if (byteOffset >= segPtr->size) {
+ byteOffset = 0;
+ segPtr = segPtr->nextPtr;
+ }
+
+ chunkPtr = NULL;
+ }
+ if (noCharsYet) {
+ panic("LayoutDLine couldn't place any characters on a line");
+ }
+ 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;
+ breakByteOffset = breakChunkPtr->numBytes;
+ }
+ if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr)
+ || (breakByteOffset != lastChunkPtr->numBytes))) {
+ while (1) {
+ chunkPtr = breakChunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ breakChunkPtr->nextPtr = chunkPtr->nextPtr;
+ (*chunkPtr->undisplayProc)(textPtr, chunkPtr);
+ ckfree((char *) chunkPtr);
+ }
+ if (breakByteOffset != breakChunkPtr->numBytes) {
+ (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr);
+ segPtr = TkTextIndexToSeg(&breakIndex, &byteOffset);
+ (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex,
+ segPtr, byteOffset, maxX, breakByteOffset, 0,
+ wrapMode, breakChunkPtr);
+ }
+ lastChunkPtr = breakChunkPtr;
+ wholeLine = 0;
+ }
+
+
+ /*
+ * Make tab adjustments for the last tab stop, if there is one.
+ */
+
+ if ((tabIndex >= 0) && (tabChunkPtr != NULL)) {
+ AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
+ }
+
+ /*
+ * Make one more pass over the line to recompute various things
+ * like its height, length, and total number of bytes. Also
+ * modify the x-locations of chunks to reflect justification.
+ * If we're not wrapping, I'm not sure what is the best way to
+ * handle left and center justification: should the total length,
+ * for purposes of justification, be (a) the window width, (b)
+ * the length of the longest line in the window, or (c) the length
+ * of the longest line in the text? (c) isn't available, (b) seems
+ * weird, since it can change with vertical scrolling, so (a) is
+ * what is implemented below.
+ */
+
+ if (wrapMode == TEXT_WRAPMODE_NONE) {
+ maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin;
+ }
+ dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
+ if (justify == TK_JUSTIFY_LEFT) {
+ jIndent = 0;
+ } else if (justify == TK_JUSTIFY_RIGHT) {
+ jIndent = maxX - dlPtr->length;
+ } else {
+ jIndent = (maxX - dlPtr->length)/2;
+ }
+ ascent = descent = 0;
+ for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL;
+ chunkPtr = chunkPtr->nextPtr) {
+ chunkPtr->x += jIndent;
+ dlPtr->byteCount += chunkPtr->numBytes;
+ if (chunkPtr->minAscent > ascent) {
+ ascent = chunkPtr->minAscent;
+ }
+ if (chunkPtr->minDescent > descent) {
+ descent = chunkPtr->minDescent;
+ }
+ if (chunkPtr->minHeight > dlPtr->height) {
+ 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.byteIndex == 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.byteIndex == dlPtr->index.byteIndex) {
+ /*
+ * Case (a) -- can use existing display line as-is.
+ */
+
+ if ((dlPtr->flags & HAS_3D_BORDER) && (prevPtr != NULL)
+ && (prevPtr->flags & (NEW_LAYOUT))) {
+ dlPtr->oldY = -1;
+ }
+ goto lineOK;
+ }
+ if (index.byteIndex < dlPtr->index.byteIndex) {
+ goto makeNewDLine;
+ }
+
+ /*
+ * Case (c) -- dlPtr is useless. Discard it and start
+ * again with the next display line.
+ */
+
+ 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;
+ TkTextIndexForwBytes(&index, dlPtr->byteCount, &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, bytesToCount;
+ DLine *lowestPtr;
+
+ /*
+ * Layout an entire text line (potentially > 1 display line),
+ * then link in as many display lines as fit without moving
+ * the bottom line out of the window. Repeat this until
+ * all the extra space has been used up or we've reached the
+ * beginning of the text.
+ */
+
+ spaceLeft = maxY - y;
+ lineNum = TkBTreeLineIndex(dInfoPtr->dLinePtr->index.linePtr);
+ bytesToCount = dInfoPtr->dLinePtr->index.byteIndex;
+ if (bytesToCount == 0) {
+ bytesToCount = INT_MAX;
+ lineNum--;
+ }
+ for ( ; (lineNum >= 0) && (spaceLeft > 0); lineNum--) {
+ index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
+ index.byteIndex = 0;
+ lowestPtr = NULL;
+
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ if (dlPtr->length == 0 && dlPtr->height == 0) { bytesToCount--; break; } /* elide */
+ TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
+ bytesToCount -= dlPtr->byteCount;
+ } while ((bytesToCount > 0)
+ && (index.linePtr == lowestPtr->index.linePtr));
+
+ /*
+ * Scan through the display lines from the bottom one up to
+ * the top one.
+ */
+
+ 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);
+ bytesToCount = INT_MAX;
+ }
+
+ /*
+ * Now we're all done except that the y-coordinates in all the
+ * DLines are wrong and the top index for the text is wrong.
+ * Update them.
+ */
+
+ 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->newByteOffset > maxOffset) {
+ dInfoPtr->newByteOffset = maxOffset;
+ }
+ if (dInfoPtr->newByteOffset < 0) {
+ dInfoPtr->newByteOffset = 0;
+ }
+ pixelOffset = dInfoPtr->newByteOffset * textPtr->charWidth;
+ if (pixelOffset != dInfoPtr->curPixelOffset) {
+ dInfoPtr->curPixelOffset = pixelOffset;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ dlPtr->oldY = -1;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ if (dlPtr->chunkPtr == NULL) return;
+
+ /*
+ * 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.
+ */
+
+ if (textPtr->state == TK_STATE_NORMAL) {
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
+ if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
+ (*chunkPtr->displayProc)(chunkPtr, x, dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ }
+ }
+ }
+
+ /*
+ * 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).
+ */
+
+ if (chunkPtr->displayProc != NULL)
+ (*chunkPtr->displayProc)(chunkPtr, -chunkPtr->width,
+ dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ } else {
+ /* don't call if elide. This tax ok since not very many visible DLine's in
+ an area, but potentially many elide ones */
+ if (chunkPtr->displayProc != NULL)
+ (*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) {
+ /* Not visible - bail out now */
+ if (rightX + xOffset <= 0) {
+ leftX = rightX;
+ continue;
+ }
+
+ /*
+ * Trim the start position for drawing to be no further away than
+ * -borderWidth. The reason is that on many X servers drawing from
+ * -32768 (or less) to +something simply does not display
+ * correctly. [Patch #541999]
+ */
+ if ((leftX + xOffset) < -(sValuePtr->borderWidth)) {
+ leftX = -sValuePtr->borderWidth - xOffset;
+ }
+ if ((rightX - leftX) > 32767) {
+ rightX = leftX + 32767;
+ }
+
+ 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 && prevPtr->chunkPtr != 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 && dlPtr->nextPtr->chunkPtr != 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 fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(textPtr->highlightBgColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ if (textPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(textPtr->highlightColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ TkpDrawHighlightBorder(textPtr->tkwin, fgGC, bgGC,
+ textPtr->highlightWidth, Tk_WindowId(textPtr->tkwin));
+ } else {
+ TkpDrawHighlightBorder(textPtr->tkwin, bgGC, bgGC,
+ 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->chunkPtr == NULL) continue;
+ 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;
+ }
+ /*prevPtr = dlPtr;*/
+ }
+ 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.byteIndex = 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 = TkTextMakeByteIndex(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree), 0, &endOfText);
+ }
+
+ /*
+ * Initialize a search through all transitions on the tag, starting
+ * with the first transition where the tag's current state is different
+ * from what it will eventually be.
+ */
+
+ 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->byteIndex == 0) {
+ dlPtr = FindDLine(dlPtr, curIndexPtr);
+ } else {
+ TkTextIndex tmp;
+
+ tmp = *curIndexPtr;
+ tmp.byteIndex -= 1;
+ dlPtr = FindDLine(dlPtr, &tmp);
+ }
+ if (dlPtr == NULL) {
+ break;
+ }
+
+ /*
+ * Find the first DLine structure that's past the end of the range.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ endIndexPtr = index2Ptr;
+ } else {
+ curIndexPtr = &search.curIndex;
+ endIndexPtr = curIndexPtr;
+ }
+ endPtr = FindDLine(dlPtr, endIndexPtr);
+ if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr)
+ && (endPtr->index.byteIndex < endIndexPtr->byteIndex)) {
+ endPtr = endPtr->nextPtr;
+ }
+
+ /*
+ * Delete all of the display lines in the range, so that they'll
+ * be re-layed out and redrawn.
+ */
+
+ 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.byteIndex != 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->byteIndex == 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.byteIndex <= indexPtr->byteIndex)) {
+ return;
+ }
+ }
+
+ /*
+ * The desired line isn't already on-screen. Figure out what
+ * it means to be "close" to the top or bottom of the screen.
+ * 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 bytesToCount; /* Maximum number of bytes to measure in
+ * current line. */
+ TkTextIndex bestIndex; /* Best candidate seen so far for result. */
+ TkTextIndex index;
+ DLine *dlPtr, *lowestPtr;
+ int noBestYet; /* 1 means bestIndex hasn't been set. */
+
+ noBestYet = 1;
+ bytesToCount = srcPtr->byteIndex + 1;
+ index.tree = srcPtr->tree;
+ for (lineNum = TkBTreeLineIndex(srcPtr->linePtr); lineNum >= 0;
+ lineNum--) {
+ /*
+ * Layout an entire text line (potentially > 1 display line).
+ * For the first line, which contains srcPtr, only layout the
+ * part up through srcPtr (bytesToCount is non-infinite to
+ * accomplish this). Make a list of all the display lines
+ * in backwards order (the lowest DLine on the screen is first
+ * in the list).
+ */
+
+ index.linePtr = TkBTreeFindLine(srcPtr->tree, lineNum);
+ index.byteIndex = 0;
+ lowestPtr = NULL;
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
+ bytesToCount -= dlPtr->byteCount;
+ } while ((bytesToCount > 0) && (index.linePtr == dlPtr->index.linePtr));
+
+ /*
+ * Scan through the display lines to see if we've covered enough
+ * vertical distance. If so, save the starting index for the
+ * line at the desired location.
+ */
+
+ 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;
+ }
+ bytesToCount = INT_MAX; /* Consider all chars. in next line. */
+ }
+
+ /*
+ * Ran off the beginning of the text. Return the first character
+ * in the text.
+ */
+
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, dstPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextSeeCmd --
+ *
+ * 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. */
+ CONST char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "see". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex index;
+ int x, y, width, height, lineWidth, byteCount, oneThird, delta;
+ DLine *dlPtr;
+ TkTextDispChunk *chunkPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " see index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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);
+ byteCount = index.byteIndex - dlPtr->index.byteIndex;
+ for (chunkPtr = dlPtr->chunkPtr; chunkPtr!=NULL ; chunkPtr = chunkPtr->nextPtr) {
+ if (byteCount < chunkPtr->numBytes) {
+ break;
+ }
+ byteCount -= chunkPtr->numBytes;
+ }
+
+ /*
+ * Call a chunk-specific procedure to find the horizontal range of
+ * the character within the chunk.
+ */
+
+ if (chunkPtr!=NULL) { /* chunkPtr==NULL iff trying to see in elided region */
+ (*chunkPtr->bboxProc)(chunkPtr, byteCount, dlPtr->y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width,
+ &height);
+ delta = x - dInfoPtr->curPixelOffset;
+ oneThird = lineWidth/3;
+ if (delta < 0) {
+ if (delta < -oneThird) {
+ dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth;
+ } else {
+ dInfoPtr->newByteOffset -= ((-delta) + textPtr->charWidth - 1)
+ / textPtr->charWidth;
+ }
+ } else {
+ delta -= (lineWidth - width);
+ if (delta > 0) {
+ if (delta > oneThird) {
+ dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth;
+ } else {
+ dInfoPtr->newByteOffset += (delta + textPtr->charWidth - 1)
+ / textPtr->charWidth;
+ }
+ } else {
+ return TCL_OK;
+ }
+ }}
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ 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. */
+ CONST 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->newByteOffset;
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ if (fraction > 1.0) {
+ fraction = 1.0;
+ }
+ if (fraction < 0) {
+ fraction = 0;
+ }
+ newOffset = (int) (((fraction * dInfoPtr->maxLength) / textPtr->charWidth)
+ + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ charsPerPage = ((dInfoPtr->maxX - dInfoPtr->x) / textPtr->charWidth)
+ - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ newOffset += charsPerPage * count;
+ break;
+ case TK_SCROLL_UNITS:
+ newOffset += count;
+ break;
+ }
+
+ dInfoPtr->newByteOffset = newOffset;
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, bytesToCount, lineNum;
+ TkTextIndex new, index;
+ TkTextLine *lastLinePtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr, *lowestPtr;
+
+ if (offset < 0) {
+ /*
+ * Must scroll up (to show earlier information in the text).
+ * The code below is similar to that in MeasureUp, except that
+ * it counts lines instead of pixels.
+ */
+
+ bytesToCount = textPtr->topIndex.byteIndex + 1;
+ index.tree = textPtr->tree;
+ offset--; /* Skip line containing topIndex. */
+ for (lineNum = TkBTreeLineIndex(textPtr->topIndex.linePtr);
+ lineNum >= 0; lineNum--) {
+ index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
+ index.byteIndex = 0;
+ lowestPtr = NULL;
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
+ bytesToCount -= dlPtr->byteCount;
+ } while ((bytesToCount > 0)
+ && (index.linePtr == dlPtr->index.linePtr));
+
+ for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ offset++;
+ if (offset == 0) {
+ textPtr->topIndex = dlPtr->index;
+ break;
+ }
+ }
+
+ /*
+ * Discard the display lines, then either return or prepare
+ * for the next display line to lay out.
+ */
+
+ FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
+ if (offset >= 0) {
+ goto scheduleUpdate;
+ }
+ bytesToCount = INT_MAX;
+ }
+
+ /*
+ * Ran off the beginning of the text. Return the first character
+ * in the text.
+ */
+
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->topIndex);
+ } else {
+ /*
+ * Scrolling down, to show later information in the text.
+ * Just count lines from the current top of the window.
+ */
+
+ lastLinePtr = TkBTreeFindLine(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree));
+ for (i = 0; i < offset; i++) {
+ dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
+ if (dlPtr->length == 0 && dlPtr->height == 0) offset++;
+ dlPtr->nextPtr = NULL;
+ TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount, &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. */
+ CONST char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "yview". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int pickPlace, lineNum, type, bytesInLine;
+ Tk_FontMetrics fm;
+ int pixels, count;
+ size_t switchLength;
+ double fraction;
+ TkTextIndex index, new;
+ TkTextLine *lastLinePtr;
+ DLine *dlPtr;
+
+ 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) {
+ TkTextMakeByteIndex(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;
+ TkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index);
+ bytesInLine = TkBTreeBytesInLine(index.linePtr);
+ index.byteIndex = (int)((bytesInLine * (fraction-lineNum)) + 0.5);
+ if (index.byteIndex >= bytesInLine) {
+ TkTextMakeByteIndex(textPtr->tree, lineNum + 1, 0, &index);
+ }
+ TkTextSetYView(textPtr, &index, 0);
+ break;
+ case TK_SCROLL_PAGES:
+ /*
+ * Scroll up or down by screenfuls. Actually, use the
+ * window height minus two lines, so that there's some
+ * 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;
+ TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount,
+ &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. */
+ CONST char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "scan". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex index;
+ int c, x, y, totalScroll, newByte, maxByte, gain=10;
+ Tk_FontMetrics fm;
+ size_t length;
+
+ if ((argc != 5) && (argc != 6)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scan mark x y\" or \"",
+ argv[0], " scan dragto x y ?gain?\"", (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;
+ }
+ if ((argc == 6) && (Tcl_GetInt(interp, argv[5], &gain) != 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).
+ */
+
+ newByte = dInfoPtr->scanMarkIndex + (gain*(dInfoPtr->scanMarkX - x))
+ / (textPtr->charWidth);
+ maxByte = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
+ + textPtr->charWidth - 1)/textPtr->charWidth;
+ if (newByte < 0) {
+ newByte = 0;
+ dInfoPtr->scanMarkIndex = 0;
+ dInfoPtr->scanMarkX = x;
+ } else if (newByte > maxByte) {
+ newByte = maxByte;
+ dInfoPtr->scanMarkIndex = maxByte;
+ dInfoPtr->scanMarkX = x;
+ }
+ dInfoPtr->newByteOffset = newByte;
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ totalScroll = (gain*(dInfoPtr->scanMarkY - y)) / fm.linespace;
+ if (totalScroll != dInfoPtr->scanTotalScroll) {
+ index = textPtr->topIndex;
+ ScrollByLines(textPtr, totalScroll-dInfoPtr->scanTotalScroll);
+ dInfoPtr->scanTotalScroll = totalScroll;
+ if ((index.linePtr == textPtr->topIndex.linePtr) &&
+ (index.byteIndex == textPtr->topIndex.byteIndex)) {
+ dInfoPtr->scanTotalScroll = 0;
+ dInfoPtr->scanMarkY = y;
+ }
+ }
+ } else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) {
+ dInfoPtr->scanMarkIndex = dInfoPtr->newByteOffset;
+ dInfoPtr->scanMarkX = x;
+ dInfoPtr->scanTotalScroll = 0;
+ dInfoPtr->scanMarkY = y;
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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 the interp's result is filled in with
+ * two real numbers separated by a space, giving the position of
+ * the left and right edges of the window as fractions from 0 to
+ * 1, where 0 means the left edge of the text and 1 means the right
+ * edge. If report is non-zero, then the interp's result isn't modified
+ * directly, but instead a script is evaluated in interp to report
+ * the new horizontal scroll position to the scrollbar (if the scroll
+ * position hasn't changed then no script is invoked).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetXView(interp, textPtr, report)
+ Tcl_Interp *interp; /* If "report" is FALSE, string
+ * describing visible range gets
+ * stored in the interp's result. */
+ TkText *textPtr; /* Information about text widget. */
+ int report; /* Non-zero means report info to
+ * scrollbar if it has changed. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ char buffer[TCL_DOUBLE_SPACE * 2 + 1];
+ double first, last;
+ int code;
+
+ if (dInfoPtr->maxLength > 0) {
+ first = ((double) dInfoPtr->curPixelOffset)
+ / dInfoPtr->maxLength;
+ last = first + ((double) (dInfoPtr->maxX - dInfoPtr->x))
+ / dInfoPtr->maxLength;
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ } else {
+ first = 0;
+ last = 1.0;
+ }
+ if (!report) {
+ sprintf(buffer, "%g %g", first, last);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+ return;
+ }
+ if (FP_EQUAL_SCALE(first, dInfoPtr->xScrollFirst, dInfoPtr->maxLength) &&
+ FP_EQUAL_SCALE(last, dInfoPtr->xScrollLast, dInfoPtr->maxLength)) {
+ 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 the interp's result is filled in with
+ * two real numbers separated by a space, giving the position of
+ * the top and bottom of the window as fractions from 0 to 1, where
+ * 0 means the beginning of the text and 1 means the end. If
+ * report is non-zero, then the interp's result isn't modified directly,
+ * but a script is evaluated in interp to report the new scroll
+ * position to the scrollbar (if the scroll position hasn't changed
+ * then no script is invoked).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetYView(interp, textPtr, report)
+ Tcl_Interp *interp; /* If "report" is FALSE, string
+ * describing visible range gets
+ * stored in the interp's result. */
+ TkText *textPtr; /* Information about text widget. */
+ int report; /* Non-zero means report info to
+ * scrollbar if it has changed. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ char buffer[TCL_DOUBLE_SPACE * 2 + 1];
+ double first, last;
+ DLine *dlPtr;
+ int totalLines, code, count;
+
+ dlPtr = dInfoPtr->dLinePtr;
+ totalLines = TkBTreeNumLines(textPtr->tree);
+ first = (double) TkBTreeLineIndex(dlPtr->index.linePtr)
+ + (double) dlPtr->index.byteIndex
+ / TkBTreeBytesInLine(dlPtr->index.linePtr);
+ first /= totalLines;
+ while (1) {
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ /*
+ * The last line is only partially visible, so don't
+ * count its characters in what's visible.
+ */
+ count = 0;
+ break;
+ }
+ if (dlPtr->nextPtr == NULL) {
+ count = dlPtr->byteCount;
+ break;
+ }
+ dlPtr = dlPtr->nextPtr;
+ }
+ last = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
+ + ((double) (dlPtr->index.byteIndex + count))
+ / (TkBTreeBytesInLine(dlPtr->index.linePtr));
+ last /= totalLines;
+ if (!report) {
+ sprintf(buffer, "%g %g", first, last);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+ return;
+ }
+ if (FP_EQUAL_SCALE(first, dInfoPtr->yScrollFirst, totalLines) &&
+ FP_EQUAL_SCALE(last, dInfoPtr->yScrollLast, totalLines)) {
+ 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->byteIndex >= (dlPtr->index.byteIndex + dlPtr->byteCount)) {
+ 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, *validdlPtr;
+ 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 = validdlPtr = dInfoPtr->dLinePtr; y >= (dlPtr->y + dlPtr->height);
+ dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->chunkPtr !=NULL) validdlPtr = dlPtr;
+ 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;
+ }
+ }
+ if (dlPtr->chunkPtr == NULL) dlPtr = validdlPtr;
+
+
+ /*
+ * 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->byteIndex += chunkPtr->numBytes,
+ chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr->nextPtr == NULL) {
+ indexPtr->byteIndex += chunkPtr->numBytes;
+ TkTextIndexBackChars(indexPtr, 1, indexPtr);
+ return;
+ }
+ }
+
+ /*
+ * If the chunk has more than one byte in it, ask it which
+ * character is at the desired location.
+ */
+
+ if (chunkPtr->numBytes > 1) {
+ indexPtr->byteIndex += (*chunkPtr->measureProc)(chunkPtr, x);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCharBbox --
+ *
+ * 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 byteIndex;
+
+ /*
+ * 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.
+ */
+
+ byteIndex = indexPtr->byteIndex - dlPtr->index.byteIndex;
+ for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr == NULL) {
+ return -1;
+ }
+ if (byteIndex < chunkPtr->numBytes) {
+ break;
+ }
+ byteIndex -= chunkPtr->numBytes;
+ }
+
+ /*
+ * Call a chunk-specific procedure to find the horizontal range of
+ * the character within the chunk, then fill in the vertical range.
+ * The x-coordinate returned by bboxProc is a coordinate within a
+ * line, not a coordinate on the screen. Translate it to reflect
+ * horizontal scrolling.
+ */
+
+ (*chunkPtr->bboxProc)(chunkPtr, byteIndex, dlPtr->y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr,
+ heightPtr);
+ *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curPixelOffset;
+ if ((byteIndex == (chunkPtr->numBytes - 1)) && (chunkPtr->nextPtr == NULL)) {
+ /*
+ * Last character in display line. Give it all the space up to
+ * the line.
+ */
+
+ if (*xPtr > dInfoPtr->maxX) {
+ *xPtr = dInfoPtr->maxX;
+ }
+ *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;
+ int dlx;
+
+ /*
+ * 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;
+ }
+
+ dlx = (dlPtr->chunkPtr != NULL? dlPtr->chunkPtr->x: 0);
+ *xPtr = dInfoPtr->x - dInfoPtr->curPixelOffset + dlx;
+ *widthPtr = dlPtr->length - dlx;
+ *yPtr = dlPtr->y;
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ *heightPtr = dInfoPtr->maxY - dlPtr->y;
+ } else {
+ *heightPtr = dlPtr->height;
+ }
+ *basePtr = dlPtr->baseline;
+ return 0;
+}
+
+static void
+ElideBboxProc(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. */
+{
+ *xPtr = chunkPtr->x;
+ *yPtr = y;
+ *widthPtr = *heightPtr = 0;
+}
+
+
+static int
+ElideMeasureProc(chunkPtr, x)
+ TkTextDispChunk *chunkPtr; /* Chunk containing desired coord. */
+ int x; /* X-coordinate, in same coordinate
+ * system as chunkPtr->x. */
+{
+ return 0 /*chunkPtr->numBytes - 1*/;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, byteOffset, maxX, maxBytes,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Index of first character to lay out
+ * (corresponds to segPtr and offset). */
+ TkTextSegment *segPtr; /* Segment being layed out. */
+ int byteOffset; /* Byte offset within segment of first
+ * character to consider. */
+ int maxX; /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxBytes; /* Chunk must not include more than this
+ * many characters. */
+ int noCharsYet; /* Non-zero means no characters have been
+ * assigned to this display line yet. */
+ TkWrapMode wrapMode; /* How to handle line wrapping: TEXT_WRAPMODE_CHAR,
+ * TEXT_WRAPMODE_NONE, or TEXT_WRAPMODE_WORD. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ Tk_Font tkfont;
+ int nextX, bytesThatFit, count;
+ CharInfo *ciPtr;
+ char *p;
+ TkTextSegment *nextPtr;
+ Tk_FontMetrics fm;
+
+ /*
+ * Figure out how many characters will fit in the space we've got.
+ * Include the next character, even though it won't fit completely,
+ * if any of the following is true:
+ * (a) the chunk contains no characters and the display line contains
+ * no characters yet (i.e. the line isn't wide enough to hold
+ * even a single character).
+ * (b) at least one pixel of the character is visible, we haven't
+ * already exceeded the character limit, and the next character
+ * is a white space character.
+ */
+
+ p = segPtr->body.chars + byteOffset;
+ tkfont = chunkPtr->stylePtr->sValuePtr->tkfont;
+ bytesThatFit = MeasureChars(tkfont, p, maxBytes, chunkPtr->x, maxX, 0,
+ &nextX);
+ if (bytesThatFit < maxBytes) {
+ if ((bytesThatFit == 0) && noCharsYet) {
+ Tcl_UniChar ch;
+
+ bytesThatFit = MeasureChars(tkfont, p, Tcl_UtfToUniChar(p, &ch),
+ chunkPtr->x, -1, 0, &nextX);
+ }
+ if ((nextX < maxX) && ((p[bytesThatFit] == ' ')
+ || (p[bytesThatFit] == '\t'))) {
+ /*
+ * Space characters are funny, in that they are considered
+ * to fit if there is at least one pixel of space left on the
+ * line. Just give the space character whatever space is left.
+ */
+
+ nextX = maxX;
+ bytesThatFit++;
+ }
+ if (p[bytesThatFit] == '\n') {
+ /*
+ * A newline character takes up no space, so if the previous
+ * character fits then so does the newline.
+ */
+
+ bytesThatFit++;
+ }
+ if (bytesThatFit == 0) {
+ return 0;
+ }
+ }
+
+ Tk_GetFontMetrics(tkfont, &fm);
+
+ /*
+ * Fill in the chunk structure and allocate and initialize a
+ * CharInfo structure. If the last character is a newline
+ * then don't bother to display it.
+ */
+
+ chunkPtr->displayProc = CharDisplayProc;
+ chunkPtr->undisplayProc = CharUndisplayProc;
+ chunkPtr->measureProc = CharMeasureProc;
+ chunkPtr->bboxProc = CharBboxProc;
+ chunkPtr->numBytes = bytesThatFit;
+ chunkPtr->minAscent = fm.ascent + chunkPtr->stylePtr->sValuePtr->offset;
+ chunkPtr->minDescent = fm.descent - chunkPtr->stylePtr->sValuePtr->offset;
+ chunkPtr->minHeight = 0;
+ chunkPtr->width = nextX - chunkPtr->x;
+ chunkPtr->breakIndex = -1;
+ ciPtr = (CharInfo *) ckalloc((unsigned)
+ (sizeof(CharInfo) - 3 + bytesThatFit));
+ chunkPtr->clientData = (ClientData) ciPtr;
+ ciPtr->numBytes = bytesThatFit;
+ strncpy(ciPtr->chars, p, (size_t) bytesThatFit);
+ if (p[bytesThatFit - 1] == '\n') {
+ ciPtr->numBytes--;
+ }
+
+ /*
+ * Compute a break location. If we're in word wrap mode, a
+ * break can occur after any space character, or at the end of
+ * the chunk if the next segment (ignoring those with zero size)
+ * is not a character segment.
+ */
+
+ if (wrapMode != TEXT_WRAPMODE_WORD) {
+ chunkPtr->breakIndex = chunkPtr->numBytes;
+ } else {
+ for (count = bytesThatFit, p += bytesThatFit - 1; count > 0;
+ count--, p--) {
+ if (isspace(UCHAR(*p))) {
+ chunkPtr->breakIndex = count;
+ break;
+ }
+ }
+ if ((bytesThatFit + byteOffset) == segPtr->size) {
+ for (nextPtr = segPtr->nextPtr; nextPtr != NULL;
+ nextPtr = nextPtr->nextPtr) {
+ if (nextPtr->size != 0) {
+ if (nextPtr->typePtr != &tkTextCharType) {
+ chunkPtr->breakIndex = chunkPtr->numBytes;
+ }
+ break;
+ }
+ }
+ }
+ }
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 offsetBytes, 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;
+ offsetBytes = 0;
+ if (x < 0) {
+ offsetBytes = MeasureChars(sValuePtr->tkfont, ciPtr->chars,
+ ciPtr->numBytes, x, 0, x - chunkPtr->x, &offsetX);
+ }
+
+ /*
+ * Draw the text, underline, and overstrike for this chunk.
+ */
+
+ if (!sValuePtr->elide && (ciPtr->numBytes > offsetBytes) && (stylePtr->fgGC != None)) {
+ int numBytes = ciPtr->numBytes - offsetBytes;
+ char *string = ciPtr->chars + offsetBytes;
+
+ if ((numBytes > 0) && (string[numBytes - 1] == '\t')) {
+ numBytes--;
+ }
+ Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string,
+ numBytes, offsetX, y + baseline - sValuePtr->offset);
+ if (sValuePtr->underline) {
+ Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
+ ciPtr->chars + offsetBytes, offsetX,
+ y + baseline - sValuePtr->offset, 0, numBytes);
+
+ }
+ if (sValuePtr->overstrike) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(sValuePtr->tkfont, &fm);
+ Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
+ ciPtr->chars + offsetBytes, offsetX,
+ y + baseline - sValuePtr->offset
+ - fm.descent - (fm.ascent * 3) / 10,
+ 0, numBytes);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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->numBytes - 1, chunkPtr->x, x, 0, &endX);
+ /* CHAR OFFSET */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, byteIndex, y, lineHeight, baseline, xPtr, yPtr,
+ widthPtr, heightPtr)
+ TkTextDispChunk *chunkPtr; /* Chunk containing desired char. */
+ int byteIndex; /* Byte offset of desired character
+ * within the chunk. */
+ int y; /* Topmost pixel in area allocated
+ * for this line. */
+ int lineHeight; /* Height of line, in pixels. */
+ int baseline; /* Location of line's baseline, in
+ * pixels measured down from y. */
+ int *xPtr, *yPtr; /* Gets filled in with coords of
+ * character's upper-left pixel.
+ * X-coord is in same coordinate
+ * system as chunkPtr->x. */
+ int *widthPtr; /* Gets filled in with width of
+ * character, in pixels. */
+ int *heightPtr; /* Gets filled in with height of
+ * character, in pixels. */
+{
+ CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
+ int maxX;
+
+ maxX = chunkPtr->width + chunkPtr->x;
+ MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars,
+ byteIndex, chunkPtr->x, -1, 0, xPtr);
+
+ if (byteIndex == ciPtr->numBytes) {
+ /*
+ * This situation only happens if the last character in a line
+ * is a space character, in which case it absorbs all of the
+ * extra space in the line (see TkTextCharLayoutProc).
+ */
+
+ *widthPtr = maxX - *xPtr;
+ } else if ((ciPtr->chars[byteIndex] == '\t')
+ && (byteIndex == ciPtr->numBytes - 1)) {
+ /*
+ * The desired character is a tab character that terminates a
+ * chunk; give it all the space left in the chunk.
+ */
+
+ *widthPtr = maxX - *xPtr;
+ } else {
+ MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont,
+ ciPtr->chars + byteIndex, 1, *xPtr, -1, 0, widthPtr);
+ if (*widthPtr > maxX) {
+ *widthPtr = maxX - *xPtr;
+ } else {
+ *widthPtr -= *xPtr;
+ }
+ }
+ *yPtr = y + baseline - chunkPtr->minAscent;
+ *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->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->numBytes; p++, i++) {
+ if (isdigit(UCHAR(*p))) {
+ gotDigit = 1;
+ } else if ((*p == '.') || (*p == ',')) {
+ decimal = p-ciPtr->chars;
+ decimalChunkPtr = chunkPtr2;
+ } else if (gotDigit) {
+ if (decimalChunkPtr == NULL) {
+ decimal = p-ciPtr->chars;
+ decimalChunkPtr = chunkPtr2;
+ }
+ goto endOfNumber;
+ }
+ }
+ }
+ endOfNumber:
+ if (decimalChunkPtr != NULL) {
+ int curX;
+
+ ciPtr = (CharInfo *) decimalChunkPtr->clientData;
+ MeasureChars(decimalChunkPtr->stylePtr->sValuePtr->tkfont,
+ ciPtr->chars, decimal, decimalChunkPtr->x, -1, 0, &curX);
+ desired = tabX - (curX - x);
+ goto update;
+ } else {
+ /*
+ * There wasn't a decimal point. Right justify the text.
+ */
+
+ 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, -1, 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->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, -1, 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(tkfont, x, tabOrigin)
+ 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;
+
+ tabWidth = Tk_TextWidth(tkfont, "0", 1) * 8;
+ 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_DrawTextLayout 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 bytes from source
+ * that fit in the span given by startX and maxX. *nextXPtr
+ * is filled in with the x-coordinate at which the first
+ * character that didn't fit would be drawn, if it were to
+ * be drawn.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MeasureChars(tkfont, source, maxBytes, startX, maxX, tabOrigin, nextXPtr)
+ Tk_Font tkfont; /* Font in which to draw characters. */
+ CONST char *source; /* Characters to be displayed. Need not
+ * be NULL-terminated. */
+ int maxBytes; /* Maximum # of bytes to consider from
+ * source. */
+ int startX; /* X-position at which first character will
+ * be drawn. */
+ int maxX; /* Don't consider any character that would
+ * cross this x-position. */
+ int tabOrigin; /* X-location that serves as "origin" for
+ * tab stops. */
+ int *nextXPtr; /* Return x-position of terminating
+ * character here. */
+{
+ int curX, width, ch;
+ CONST char *special, *end, *start;
+
+ ch = 0; /* lint. */
+ curX = startX;
+ special = source;
+ end = source + maxBytes;
+ for (start = source; start < end; ) {
+ if (start >= special) {
+ /*
+ * Find the next special character in the string.
+ */
+
+ for (special = start; special < end; special++) {
+ ch = *special;
+ if ((ch == '\t') || (ch == '\n')) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Special points at the next special character (or the end of the
+ * string). Process characters between start and special.
+ */
+
+ if ((maxX >= 0) && (curX >= maxX)) {
+ break;
+ }
+ start += Tk_MeasureChars(tkfont, start, special - start, maxX - curX,
+ 0, &width);
+ curX += width;
+ if (start < special) {
+ /*
+ * No more chars fit in line.
+ */
+
+ break;
+ }
+ if (special < end) {
+ if (ch == '\t') {
+ start++;
+ } else {
+ break;
+ }
+ }
+ }
+
+ *nextXPtr = curX;
+ return start - source;
+}
diff --git a/tcl/generic/tkTextImage.c b/tcl/generic/tkTextImage.c
new file mode 100644
index 00000000000..3bed0cd1715
--- /dev/null
+++ b/tcl/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) 1997 Sun Microsystems, 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,
+ CONST 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, CONST 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, TkWrapMode 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. */
+ CONST 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--;
+ TkTextMakeByteIndex(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 the interp's result contains an error message..
+ *
+ * Side effects:
+ * Configuration information for the embedded image changes,
+ * such as alignment, or name of the image.
+ *
+ *--------------------------------------------------------------
+ */
+
+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. */
+ CONST 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[4 + TCL_INTEGER_SPACE];
+ sprintf(buf, "#%d",count+1);
+ Tcl_DStringAppend(&newName,buf, -1);
+ }
+ name = Tcl_DStringValue(&newName);
+ hPtr = Tcl_CreateHashEntry(&textPtr->imageTable, name, &new);
+ Tcl_SetHashValue(hPtr, eiPtr);
+ Tcl_AppendResult(textPtr->interp, name , (char *) NULL);
+ 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. */
+ CONST 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. */
+ TkWrapMode wrapMode; /* Wrap mode to use for line: TEXT_WRAPMODE_CHAR,
+ * TEXT_WRAPMODE_NONE, or TEXT_WRAPMODE_WORD. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ int width, height;
+
+ 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 != TEXT_WRAPMODE_NONE)) {
+ return 0;
+ }
+
+ /*
+ * Fill in the chunk structure.
+ */
+
+ chunkPtr->displayProc = EmbImageDisplayProc;
+ chunkPtr->undisplayProc = (Tk_ChunkUndisplayProc *) NULL;
+ chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
+ chunkPtr->bboxProc = EmbImageBboxProc;
+ chunkPtr->numBytes = 1;
+ if (eiPtr->body.ei.align == ALIGN_BASELINE) {
+ chunkPtr->minAscent = height - eiPtr->body.ei.padY;
+ chunkPtr->minDescent = eiPtr->body.ei.padY;
+ chunkPtr->minHeight = 0;
+ } else {
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ 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. */
+ CONST 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->byteIndex = 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.byteIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr);
+ TkTextChanged(eiPtr->body.ei.textPtr, &index, &index);
+}
diff --git a/tcl/generic/tkTextIndex.c b/tcl/generic/tkTextIndex.c
new file mode 100644
index 00000000000..b1a4311ba15
--- /dev/null
+++ b/tcl/generic/tkTextIndex.c
@@ -0,0 +1,1196 @@
+/*
+ * tkTextIndex.c --
+ *
+ * This module provides procedures that manipulate indices for
+ * text widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 CONST char * ForwBack _ANSI_ARGS_((CONST char *string,
+ TkTextIndex *indexPtr));
+static CONST char * StartEnd _ANSI_ARGS_((CONST char *string,
+ TkTextIndex *indexPtr));
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextMakeByteIndex --
+ *
+ * Given a line index and a byte index, look things up in the B-tree
+ * and fill in a TkTextIndex structure.
+ *
+ * Results:
+ * The structure at *indexPtr is filled in with information about the
+ * character at lineIndex and byteIndex (or the closest existing
+ * character, if the specified one doesn't exist), and indexPtr is
+ * returned as result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkTextIndex *
+TkTextMakeByteIndex(tree, lineIndex, byteIndex, indexPtr)
+ TkTextBTree tree; /* Tree that lineIndex and charIndex refer
+ * to. */
+ int lineIndex; /* Index of desired line (0 means first
+ * line of text). */
+ int byteIndex; /* Byte index of desired character. */
+ TkTextIndex *indexPtr; /* Structure to fill in. */
+{
+ TkTextSegment *segPtr;
+ int index;
+ CONST char *p, *start;
+ Tcl_UniChar ch;
+
+ indexPtr->tree = tree;
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ byteIndex = 0;
+ }
+ if (byteIndex < 0) {
+ byteIndex = 0;
+ }
+ indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex);
+ if (indexPtr->linePtr == NULL) {
+ indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree));
+ byteIndex = 0;
+ }
+ if (byteIndex == 0) {
+ indexPtr->byteIndex = byteIndex;
+ return indexPtr;
+ }
+
+ /*
+ * Verify that the index is within the range of the line and points
+ * to a valid character boundary.
+ */
+
+ index = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ /*
+ * Use the index of the last character in the line. Since
+ * the last character on the line is guaranteed to be a '\n',
+ * we can back up a constant sizeof(char) bytes.
+ */
+
+ indexPtr->byteIndex = index - sizeof(char);
+ break;
+ }
+ if (index + segPtr->size > byteIndex) {
+ indexPtr->byteIndex = byteIndex;
+ if ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) {
+ /*
+ * Prevent UTF-8 character from being split up by ensuring
+ * that byteIndex falls on a character boundary. If index
+ * falls in the middle of a UTF-8 character, it will be
+ * adjusted to the end of that UTF-8 character.
+ */
+
+ start = segPtr->body.chars + (byteIndex - index);
+ p = Tcl_UtfPrev(start, segPtr->body.chars);
+ p += Tcl_UtfToUniChar(p, &ch);
+ indexPtr->byteIndex += p - start;
+ }
+ break;
+ }
+ index += segPtr->size;
+ }
+ return indexPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextMakeCharIndex --
+ *
+ * Given a line index and a character index, look things up in the
+ * B-tree and fill in a TkTextIndex structure.
+ *
+ * Results:
+ * The structure at *indexPtr is filled in with information about the
+ * character at lineIndex and charIndex (or the closest existing
+ * character, if the specified one doesn't exist), and indexPtr is
+ * returned as result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkTextIndex *
+TkTextMakeCharIndex(tree, lineIndex, charIndex, indexPtr)
+ TkTextBTree tree; /* Tree that lineIndex and charIndex refer
+ * to. */
+ int lineIndex; /* Index of desired line (0 means first
+ * line of text). */
+ int charIndex; /* Index of desired character. */
+ TkTextIndex *indexPtr; /* Structure to fill in. */
+{
+ register TkTextSegment *segPtr;
+ char *p, *start, *end;
+ int index, offset;
+ Tcl_UniChar ch;
+
+ indexPtr->tree = tree;
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ charIndex = 0;
+ }
+ if (charIndex < 0) {
+ charIndex = 0;
+ }
+ indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex);
+ if (indexPtr->linePtr == NULL) {
+ indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree));
+ charIndex = 0;
+ }
+
+ /*
+ * Verify that the index is within the range of the line.
+ * If not, just use the index of the last character in the line.
+ */
+
+ index = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ /*
+ * Use the index of the last character in the line. Since
+ * the last character on the line is guaranteed to be a '\n',
+ * we can back up a constant sizeof(char) bytes.
+ */
+
+ indexPtr->byteIndex = index - sizeof(char);
+ break;
+ }
+ if (segPtr->typePtr == &tkTextCharType) {
+ /*
+ * Turn character offset into a byte offset.
+ */
+
+ start = segPtr->body.chars;
+ end = start + segPtr->size;
+ for (p = start; p < end; p += offset) {
+ if (charIndex == 0) {
+ indexPtr->byteIndex = index;
+ return indexPtr;
+ }
+ charIndex--;
+ offset = Tcl_UtfToUniChar(p, &ch);
+ index += offset;
+ }
+ } else {
+ if (charIndex < segPtr->size) {
+ indexPtr->byteIndex = index;
+ break;
+ }
+ charIndex -= segPtr->size;
+ index += segPtr->size;
+ }
+ }
+ return indexPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexToSeg --
+ *
+ * Given an index, this procedure returns the segment and offset
+ * within segment for the index.
+ *
+ * Results:
+ * The return value is a pointer to the segment referred to by
+ * indexPtr; this will always be a segment with non-zero size. The
+ * variable at *offsetPtr is set to hold the integer offset within
+ * the segment of the character given by indexPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkTextSegment *
+TkTextIndexToSeg(indexPtr, offsetPtr)
+ CONST TkTextIndex *indexPtr;/* Text index. */
+ int *offsetPtr; /* Where to store offset within segment, or
+ * NULL if offset isn't wanted. */
+{
+ TkTextSegment *segPtr;
+ int offset;
+
+ for (offset = indexPtr->byteIndex, segPtr = indexPtr->linePtr->segPtr;
+ offset >= segPtr->size;
+ offset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (offsetPtr != NULL) {
+ *offsetPtr = offset;
+ }
+ return segPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextSegToOffset --
+ *
+ * Given a segment pointer and the line containing it, this procedure
+ * returns the offset of the segment within its line.
+ *
+ * Results:
+ * The return value is the offset (within its line) of the first
+ * character in segPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextSegToOffset(segPtr, linePtr)
+ CONST TkTextSegment *segPtr;/* Segment whose offset is desired. */
+ CONST TkTextLine *linePtr; /* Line containing segPtr. */
+{
+ CONST TkTextSegment *segPtr2;
+ int offset;
+
+ offset = 0;
+ for (segPtr2 = linePtr->segPtr; segPtr2 != segPtr;
+ segPtr2 = segPtr2->nextPtr) {
+ offset += segPtr2->size;
+ }
+ return offset;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextGetIndex --
+ *
+ * Given a string, return the index that is described.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the index at *indexPtr is
+ * filled in; otherwise TCL_ERROR is returned and an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextGetIndex(interp, textPtr, string, indexPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ TkText *textPtr; /* Information about text widget. */
+ CONST char *string; /* Textual description of position. */
+ TkTextIndex *indexPtr; /* Index structure to fill in. */
+{
+ char *p, *end, *endOfBase;
+ Tcl_HashEntry *hPtr;
+ TkTextTag *tagPtr;
+ TkTextSearch search;
+ TkTextIndex first, last;
+ int wantLast, result;
+ char c;
+ CONST char *cp;
+ Tcl_DString copy;
+
+ /*
+ *---------------------------------------------------------------------
+ * 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".
+ */
+
+ Tcl_DStringInit(&copy);
+ p = strrchr(Tcl_DStringAppend(&copy, string, -1), '.');
+ 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, Tcl_DStringValue(&copy));
+ *p = '.';
+ if (hPtr == NULL) {
+ goto tryxy;
+ }
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0,
+ &last);
+ TkBTreeStartSearch(&first, &last, tagPtr, &search);
+ if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "text doesn't contain any characters tagged with \"",
+ Tcl_GetHashKey(&textPtr->tagTable, hPtr), "\"",
+ (char *) NULL);
+ Tcl_DStringFree(&copy);
+ 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;
+
+ cp = string+1;
+ x = strtol(cp, &end, 0);
+ if ((end == cp) || (*end != ',')) {
+ goto error;
+ }
+ cp = end+1;
+ y = strtol(cp, &end, 0);
+ if (end == cp) {
+ 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;
+ }
+ TkTextMakeCharIndex(textPtr->tree, lineIndex, charIndex, indexPtr);
+ goto gotBase;
+ }
+
+ for (p = Tcl_DStringValue(&copy); *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, Tcl_DStringValue(&copy), indexPtr);
+ *endOfBase = c;
+ if (result != 0) {
+ goto gotBase;
+ }
+ }
+ if ((string[0] == 'e')
+ && (strncmp(string, "end",
+ (size_t) (endOfBase-Tcl_DStringValue(&copy))) == 0)) {
+ /*
+ * Base position is end of text.
+ */
+
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, indexPtr);
+ goto gotBase;
+ } else {
+ /*
+ * See if the base position is the name of a mark.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextMarkNameToIndex(textPtr, Tcl_DStringValue(&copy),
+ 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, Tcl_DStringValue(&copy), 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:
+ cp = endOfBase;
+ while (1) {
+ while (isspace(UCHAR(*cp))) {
+ cp++;
+ }
+ if (*cp == 0) {
+ break;
+ }
+
+ if ((*cp == '+') || (*cp == '-')) {
+ cp = ForwBack(cp, indexPtr);
+ } else {
+ cp = StartEnd(cp, indexPtr);
+ }
+ if (cp == NULL) {
+ goto error;
+ }
+ }
+ Tcl_DStringFree(&copy);
+ return TCL_OK;
+
+ error:
+ Tcl_DStringFree(&copy);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad text index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextPrintIndex --
+ *
+ * This procedure generates a string description of an index, suitable
+ * for reading in again later.
+ *
+ * Results:
+ * The characters pointed to by string are modified.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextPrintIndex(indexPtr, string)
+ CONST TkTextIndex *indexPtr;/* Pointer to index. */
+ char *string; /* Place to store the position. Must have
+ * at least TK_POS_CHARS characters. */
+{
+ TkTextSegment *segPtr;
+ int numBytes, charIndex;
+
+ numBytes = indexPtr->byteIndex;
+ charIndex = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (numBytes <= segPtr->size) {
+ break;
+ }
+ if (segPtr->typePtr == &tkTextCharType) {
+ charIndex += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size);
+ } else {
+ charIndex += segPtr->size;
+ }
+ numBytes -= segPtr->size;
+ }
+ if (segPtr->typePtr == &tkTextCharType) {
+ charIndex += Tcl_NumUtfChars(segPtr->body.chars, numBytes);
+ } else {
+ charIndex += numBytes;
+ }
+ sprintf(string, "%d.%d", TkBTreeLineIndex(indexPtr->linePtr) + 1,
+ charIndex);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexCmp --
+ *
+ * Compare two indices to see which one is earlier in the text.
+ *
+ * Results:
+ * The return value is 0 if index1Ptr and index2Ptr refer to the same
+ * position in the file, -1 if index1Ptr refers to an earlier position
+ * than index2Ptr, and 1 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextIndexCmp(index1Ptr, index2Ptr)
+ CONST TkTextIndex *index1Ptr; /* First index. */
+ CONST TkTextIndex *index2Ptr; /* Second index. */
+{
+ int line1, line2;
+
+ if (index1Ptr->linePtr == index2Ptr->linePtr) {
+ if (index1Ptr->byteIndex < index2Ptr->byteIndex) {
+ return -1;
+ } else if (index1Ptr->byteIndex > index2Ptr->byteIndex) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+ line1 = TkBTreeLineIndex(index1Ptr->linePtr);
+ line2 = TkBTreeLineIndex(index2Ptr->linePtr);
+ if (line1 < line2) {
+ return -1;
+ }
+ if (line1 > line2) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ForwBack --
+ *
+ * This procedure handles +/- modifiers for indices to adjust the
+ * index forwards or backwards.
+ *
+ * Results:
+ * If the modifier in string is successfully parsed then the return
+ * value is the address of the first character after the modifier,
+ * and *indexPtr is updated to reflect the modifier. If there is a
+ * syntax error in the modifier then NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static CONST char *
+ForwBack(string, indexPtr)
+ CONST 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 CONST char *p, *units;
+ char *end;
+ 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;
+ }
+ }
+ /*
+ * This doesn't work quite right if using a proportional font or
+ * UTF-8 characters with varying numbers of bytes. The cursor will
+ * bop around, keeping a constant number of bytes (not characters)
+ * from the left edge (but making sure not to split any UTF-8
+ * characters), regardless of the x-position the index corresponds
+ * to. The proper way to do this is to get the x-position of the
+ * index and then pick the character at the same x-position in the
+ * new line.
+ */
+
+ TkTextMakeByteIndex(indexPtr->tree, lineIndex, indexPtr->byteIndex,
+ indexPtr);
+ } else {
+ return NULL;
+ }
+ return p;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexForwBytes --
+ *
+ * Given an index for a text widget, this procedure creates a new
+ * index that points "count" bytes ahead of the source index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" bytes after
+ * srcPtr, or to the last character in the TkText if there aren't
+ * "count" bytes left.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextIndexForwBytes(srcPtr, byteCount, dstPtr)
+ CONST TkTextIndex *srcPtr; /* Source index. */
+ int byteCount; /* How many bytes forward to move. May be
+ * negative. */
+ TkTextIndex *dstPtr; /* Destination index: gets modified. */
+{
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+ int lineLength;
+
+ if (byteCount < 0) {
+ TkTextIndexBackBytes(srcPtr, -byteCount, dstPtr);
+ return;
+ }
+
+ *dstPtr = *srcPtr;
+ dstPtr->byteIndex += byteCount;
+ while (1) {
+ /*
+ * Compute the length of the current line.
+ */
+
+ lineLength = 0;
+ for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ lineLength += segPtr->size;
+ }
+
+ /*
+ * If the new index is in the same line then we're done.
+ * Otherwise go on to the next line.
+ */
+
+ if (dstPtr->byteIndex < lineLength) {
+ return;
+ }
+ dstPtr->byteIndex -= lineLength;
+ linePtr = TkBTreeNextLine(dstPtr->linePtr);
+ if (linePtr == NULL) {
+ dstPtr->byteIndex = lineLength - 1;
+ return;
+ }
+ dstPtr->linePtr = linePtr;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexForwChars --
+ *
+ * Given an index for a text widget, this procedure creates a new
+ * index that points "count" characters ahead of the source index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" characters
+ * after srcPtr, or to the last character in the TkText if there
+ * aren't "count" characters left in the file.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextIndexForwChars(srcPtr, charCount, dstPtr)
+ CONST TkTextIndex *srcPtr; /* Source index. */
+ int charCount; /* How many characters forward to move.
+ * May be negative. */
+ TkTextIndex *dstPtr; /* Destination index: gets modified. */
+{
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+ int byteOffset;
+ char *start, *end, *p;
+ Tcl_UniChar ch;
+
+ if (charCount < 0) {
+ TkTextIndexBackChars(srcPtr, -charCount, dstPtr);
+ return;
+ }
+
+ *dstPtr = *srcPtr;
+
+ /*
+ * Find seg that contains src byteIndex.
+ * Move forward specified number of chars.
+ */
+
+ segPtr = TkTextIndexToSeg(dstPtr, &byteOffset);
+ while (1) {
+ /*
+ * Go through each segment in line looking for specified character
+ * index.
+ */
+
+ for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ start = segPtr->body.chars + byteOffset;
+ end = segPtr->body.chars + segPtr->size;
+ for (p = start; p < end; p += Tcl_UtfToUniChar(p, &ch)) {
+ if (charCount == 0) {
+ dstPtr->byteIndex += (p - start);
+ return;
+ }
+ charCount--;
+ }
+ } else {
+ if (charCount < segPtr->size - byteOffset) {
+ dstPtr->byteIndex += charCount;
+ return;
+ }
+ charCount -= segPtr->size - byteOffset;
+ }
+ dstPtr->byteIndex += segPtr->size - byteOffset;
+ byteOffset = 0;
+ }
+
+ /*
+ * Go to the next line. If we are at the end of the text item,
+ * back up one byte (for the terminal '\n' character) and return
+ * that index.
+ */
+
+ linePtr = TkBTreeNextLine(dstPtr->linePtr);
+ if (linePtr == NULL) {
+ dstPtr->byteIndex -= sizeof(char);
+ return;
+ }
+ dstPtr->linePtr = linePtr;
+ dstPtr->byteIndex = 0;
+ segPtr = dstPtr->linePtr->segPtr;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexBackBytes --
+ *
+ * Given an index for a text widget, this procedure creates a new
+ * index that points "count" bytes earlier than the source index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" bytes before
+ * srcPtr, or to the first character in the TkText if there aren't
+ * "count" bytes earlier than srcPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextIndexBackBytes(srcPtr, byteCount, dstPtr)
+ CONST TkTextIndex *srcPtr; /* Source index. */
+ int byteCount; /* How many bytes backward to move. May be
+ * negative. */
+ TkTextIndex *dstPtr; /* Destination index: gets modified. */
+{
+ TkTextSegment *segPtr;
+ int lineIndex;
+
+ if (byteCount < 0) {
+ TkTextIndexForwBytes(srcPtr, -byteCount, dstPtr);
+ return;
+ }
+
+ *dstPtr = *srcPtr;
+ dstPtr->byteIndex -= byteCount;
+ lineIndex = -1;
+ while (dstPtr->byteIndex < 0) {
+ /*
+ * Move back one line in the text. If we run off the beginning
+ * of the file then just return the first character in the text.
+ */
+
+ if (lineIndex < 0) {
+ lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
+ }
+ if (lineIndex == 0) {
+ dstPtr->byteIndex = 0;
+ return;
+ }
+ lineIndex--;
+ dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex);
+
+ /*
+ * Compute the length of the line and add that to dstPtr->charIndex.
+ */
+
+ for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ dstPtr->byteIndex += segPtr->size;
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexBackChars --
+ *
+ * Given an index for a text widget, this procedure creates a new
+ * index that points "count" characters earlier than the source index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" characters
+ * before srcPtr, or to the first character in the file if there
+ * aren't "count" characters earlier than srcPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextIndexBackChars(srcPtr, charCount, dstPtr)
+ CONST TkTextIndex *srcPtr; /* Source index. */
+ int charCount; /* How many characters backward to move.
+ * May be negative. */
+ TkTextIndex *dstPtr; /* Destination index: gets modified. */
+{
+ TkTextSegment *segPtr, *oldPtr;
+ int lineIndex, segSize;
+ CONST char *p, *start, *end;
+
+ if (charCount <= 0) {
+ TkTextIndexForwChars(srcPtr, -charCount, dstPtr);
+ return;
+ }
+
+ *dstPtr = *srcPtr;
+
+ /*
+ * Find offset within seg that contains byteIndex.
+ * Move backward specified number of chars.
+ */
+
+ lineIndex = -1;
+
+ segSize = dstPtr->byteIndex;
+ for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segSize <= segPtr->size) {
+ break;
+ }
+ segSize -= segPtr->size;
+ }
+ while (1) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ start = segPtr->body.chars;
+ end = segPtr->body.chars + segSize;
+ for (p = end; ; p = Tcl_UtfPrev(p, start)) {
+ if (charCount == 0) {
+ dstPtr->byteIndex -= (end - p);
+ return;
+ }
+ if (p == start) {
+ break;
+ }
+ charCount--;
+ }
+ } else {
+ if (charCount <= segSize) {
+ dstPtr->byteIndex -= charCount;
+ return;
+ }
+ charCount -= segSize;
+ }
+ dstPtr->byteIndex -= segSize;
+
+ /*
+ * Move back into previous segment.
+ */
+
+ oldPtr = segPtr;
+ segPtr = dstPtr->linePtr->segPtr;
+ if (segPtr != oldPtr) {
+ for ( ; segPtr->nextPtr != oldPtr; segPtr = segPtr->nextPtr) {
+ /* Empty body. */
+ }
+ segSize = segPtr->size;
+ continue;
+ }
+
+ /*
+ * Move back to previous line.
+ */
+
+ if (lineIndex < 0) {
+ lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
+ }
+ if (lineIndex == 0) {
+ dstPtr->byteIndex = 0;
+ return;
+ }
+ lineIndex--;
+ dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex);
+
+ /*
+ * Compute the length of the line and add that to dstPtr->byteIndex.
+ */
+
+ oldPtr = dstPtr->linePtr->segPtr;
+ for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ dstPtr->byteIndex += segPtr->size;
+ oldPtr = segPtr;
+ }
+ segPtr = oldPtr;
+ segSize = segPtr->size;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StartEnd --
+ *
+ * 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 CONST char *
+StartEnd(string, indexPtr)
+ CONST 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. */
+{
+ CONST 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->byteIndex = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ indexPtr->byteIndex += segPtr->size;
+ }
+ indexPtr->byteIndex -= sizeof(char);
+ } else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0)
+ && (length >= 5)) {
+ indexPtr->byteIndex = 0;
+ } else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0)
+ && (length >= 5)) {
+ int firstChar = 1;
+
+ /*
+ * If the current character isn't part of a word then just move
+ * forward one character. Otherwise move forward until finding
+ * a character that isn't part of a word and stop there.
+ */
+
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ while (1) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ c = segPtr->body.chars[offset];
+ if (!isalnum(UCHAR(c)) && (c != '_')) {
+ break;
+ }
+ firstChar = 0;
+ }
+ offset += 1;
+ indexPtr->byteIndex += sizeof(char);
+ if (offset >= segPtr->size) {
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ }
+ }
+ if (firstChar) {
+ TkTextIndexForwChars(indexPtr, 1, indexPtr);
+ }
+ } 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->byteIndex -= sizeof(char);
+ if (offset < 0) {
+ if (indexPtr->byteIndex < 0) {
+ indexPtr->byteIndex = 0;
+ goto done;
+ }
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ }
+ }
+ if (!firstChar) {
+ TkTextIndexForwChars(indexPtr, 1, indexPtr);
+ }
+ } else {
+ return NULL;
+ }
+ done:
+ return p;
+}
diff --git a/tcl/generic/tkTextMark.c b/tcl/generic/tkTextMark.c
new file mode 100644
index 00000000000..e11a58f62b2
--- /dev/null
+++ b/tcl/generic/tkTextMark.c
@@ -0,0 +1,779 @@
+/*
+ * 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, TkWrapMode wrapMode,
+ TkTextDispChunk *chunkPtr));
+static int MarkFindNext _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, CONST char *markName));
+static int MarkFindPrev _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, CONST 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. */
+ CONST 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) {
+ Tcl_SetResult(interp, "right", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "left", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ length = strlen(argv[4]);
+ c = argv[4][0];
+ if ((c == 'l') && (strncmp(argv[4], "left", length) == 0)) {
+ newTypePtr = &tkTextLeftMarkType;
+ } 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. */
+ CONST 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->byteIndex = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr;
+ segPtr = segPtr->nextPtr) {
+ indexPtr->byteIndex += 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. */
+ CONST 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. */
+ TkWrapMode 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->numBytes = 0;
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ chunkPtr->minHeight = 0;
+ chunkPtr->width = 0;
+
+ /*
+ * Note: can't break a line after the insertion cursor: this
+ * 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.
+ * Indicate caret at 0,0 and return.
+ */
+
+ Tk_SetCaretPos(textPtr->tkwin, 0, 0, height);
+ return;
+ }
+
+ Tk_SetCaretPos(textPtr->tkwin, x - halfWidth, screenY, height);
+
+ /*
+ * 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 - halfWidth, y, textPtr->insertWidth, height,
+ textPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->selBorder == textPtr->insertBorder) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->border,
+ x - halfWidth, 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 */
+ CONST 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.byteIndex;
+ 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.byteIndex = 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 */
+ CONST 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.byteIndex;
+ 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/tcl/generic/tkTextTag.c b/tcl/generic/tkTextTag.c
new file mode 100644
index 00000000000..b35390c393c
--- /dev/null
+++ b/tcl/generic/tkTextTag.c
@@ -0,0 +1,1423 @@
+/*
+ * tkTextTag.c --
+ *
+ * This module implements the "tag" subcommand of the widget command
+ * for text widgets, plus most of the other high-level functions
+ * related to tags.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkText.h"
+
+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_STRING, "-elide", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextTag, elideString),
+ 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_CUSTOM, "-wrap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, wrapMode),
+ TK_CONFIG_NULL_OK, &textWrapModeOption},
+ {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, CONST 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. */
+ CONST 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) {
+ XEvent event;
+ /*
+ * Send an event that the selection changed.
+ * This is equivalent to
+ * "event generate $textWidget <<Selection>>"
+ */
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = VirtualEvent;
+ event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
+ event.xany.send_event = False;
+ event.xany.window = Tk_WindowId(textPtr->tkwin);
+ event.xany.display = Tk_Display(textPtr->tkwin);
+ ((XVirtualEvent *) &event)->name = Tk_GetUid("Selection");
+ Tk_HandleEvent(&event);
+
+ 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) {
+ CONST char *command;
+
+ command = Tk_GetBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4]);
+ if (command == NULL) {
+ CONST char *string = Tcl_GetStringResult(interp);
+
+ /*
+ * Ignore missing binding errors. This is a special hack
+ * that relies on the error message returned by FindSequence
+ * in tkBind.c.
+ */
+
+ if (string[0] != '\0') {
+ return TCL_ERROR;
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ } else {
+ Tcl_SetResult(interp, (char *) command, TCL_STATIC);
+ }
+ } else {
+ Tk_GetAllBindings(interp, textPtr->bindingTable,
+ (ClientData) tagPtr);
+ }
+ } else if ((c == 'c') && (strncmp(argv[2], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 5) {
+ 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->elideString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->elideString,
+ &tagPtr->elide) != TCL_OK) {
+ 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->elideString != NULL)
+ || (tagPtr->wrapMode != TEXT_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);
+ }
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last),
+ TkBTreeTag(&first, &last, tagPtr, 0);
+
+ if (tagPtr == textPtr->selTagPtr) {
+ XEvent event;
+ /*
+ * Send an event that the selection changed.
+ * This is equivalent to
+ * "event generate $textWidget <<Selection>>"
+ */
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = VirtualEvent;
+ event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
+ event.xany.send_event = False;
+ event.xany.window = Tk_WindowId(textPtr->tkwin);
+ event.xany.display = Tk_Display(textPtr->tkwin);
+ ((XVirtualEvent *) &event)->name = Tk_GetUid("Selection");
+ Tk_HandleEvent(&event);
+ }
+
+ 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;
+ }
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last);
+ if (argc == 5) {
+ index2 = last;
+ } else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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.byteIndex;
+ 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) {
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &index2);
+ } else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The search below is a bit weird. The previous toggle can be
+ * either an on or off toggle. If it is an on toggle, then we
+ * need to turn around and search forward for the end toggle.
+ * Otherwise we keep searching backwards.
+ */
+
+ TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch);
+
+ if (!TkBTreePrevTag(&tSearch)) {
+ return TCL_OK;
+ }
+ if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
+ TkTextPrintIndex(&tSearch.curIndex, position1);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last);
+ TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
+ TkBTreeNextTag(&tSearch);
+ TkTextPrintIndex(&tSearch.curIndex, position2);
+ } else {
+ TkTextPrintIndex(&tSearch.curIndex, position2);
+ TkBTreePrevTag(&tSearch);
+ 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;
+ }
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last);
+ TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
+ if (TkBTreeCharTagged(&first, tagPtr)) {
+ TkTextPrintIndex(&first, position);
+ Tcl_AppendElement(interp, position);
+ }
+ while (TkBTreeNextTag(&tSearch)) {
+ 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. */
+ CONST 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->elideString = NULL;
+ tagPtr->elide = 0;
+ tagPtr->wrapMode = TEXT_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 the interp's 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. */
+ CONST 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/tcl/generic/tkTextWind.c b/tcl/generic/tkTextWind.c
new file mode 100644
index 00000000000..d3fb22c9fa3
--- /dev/null
+++ b/tcl/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-1997 Sun Microsystems, 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,
+ CONST 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, CONST 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, TkWrapMode 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. */
+ CONST 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--;
+ TkTextMakeByteIndex(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 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(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. */
+ CONST 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_TopWinHierarchy(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_TopWinHierarchy(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. */
+ CONST 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.byteIndex = 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.byteIndex = 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.byteIndex = 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. */
+ TkWrapMode wrapMode; /* Wrap mode to use for line: TEXT_WRAPMODE_CHAR,
+ * TEXT_WRAPMODE_NONE, or TEXT_WRAPMODE_WORD. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ int width, height;
+
+ 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, Tcl_GetStringResult(textPtr->interp), -1);
+ Tcl_ResetResult(textPtr->interp);
+ ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp,
+ Tcl_DStringValue(&name), textPtr->tkwin);
+ if (ewPtr->body.ew.tkwin == NULL) {
+ goto createError;
+ }
+ for (ancestor = textPtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) {
+ break;
+ }
+ if (Tk_TopWinHierarchy(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_TopWinHierarchy(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 != TEXT_WRAPMODE_NONE)) {
+ return 0;
+ }
+
+ /*
+ * Fill in the chunk structure.
+ */
+
+ chunkPtr->displayProc = EmbWinDisplayProc;
+ chunkPtr->undisplayProc = EmbWinUndisplayProc;
+ chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
+ chunkPtr->bboxProc = EmbWinBboxProc;
+ chunkPtr->numBytes = 1;
+ if (ewPtr->body.ew.align == ALIGN_BASELINE) {
+ chunkPtr->minAscent = height - ewPtr->body.ew.padY;
+ chunkPtr->minDescent = ewPtr->body.ew.padY;
+ chunkPtr->minHeight = 0;
+ } else {
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ 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. */
+ CONST 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->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr);
+ return 1;
+}
diff --git a/tcl/generic/tkTrig.c b/tcl/generic/tkTrig.c
new file mode 100644
index 00000000000..549982130b0
--- /dev/null
+++ b/tcl/generic/tkTrig.c
@@ -0,0 +1,1475 @@
+/*
+ * tkTrig.c --
+ *
+ * This file contains a collection of trigonometry utility
+ * routines that are used by Tk and in particular by the
+ * canvas code. It also has miscellaneous geometry functions
+ * used by canvases.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ */
+
+ if (!pointPtr) {
+ /* Of pointPtr == NULL, this function returns an upper limit.
+ * of the array size to store the coordinates. This can be
+ * used to allocate storage, before the actual coordinates
+ * are calculated. */
+ return 1 + numPoints * numSteps;
+ }
+
+ 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 the interp's 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/tcl/generic/tkUndo.c b/tcl/generic/tkUndo.c
new file mode 100644
index 00000000000..e2271ee3775
--- /dev/null
+++ b/tcl/generic/tkUndo.c
@@ -0,0 +1,400 @@
+/*
+ * tkUndo.c --
+ *
+ * This module provides the implementation of an undo stack.
+ *
+ * Copyright (c) 2002 by Ludwig Callewaert.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkUndo.h"
+
+
+/*
+ * TkUndoPushStack
+ * Push elem on the stack identified by stack.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+void TkUndoPushStack ( stack, elem )
+ TkUndoAtom ** stack;
+ TkUndoAtom * elem;
+{
+ elem->next = *stack;
+ *stack = elem;
+}
+
+/*
+ * TkUndoPopStack --
+ * Remove and return the top element from the stack identified by
+ * stack.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+TkUndoAtom * TkUndoPopStack ( stack )
+ TkUndoAtom ** stack ;
+{
+ TkUndoAtom * elem = NULL;
+ if (*stack != NULL ) {
+ elem = *stack;
+ *stack = elem->next;
+ }
+ return elem;
+}
+
+/*
+ * TkUndoInsertSeparator --
+ * insert a separator on the stack, indicating a border for
+ * an undo/redo chunk.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+int TkUndoInsertSeparator ( stack )
+ TkUndoAtom ** stack;
+{
+ TkUndoAtom * separator;
+
+ if ( *stack != NULL && (*stack)->type != TK_UNDO_SEPARATOR ) {
+ separator = (TkUndoAtom *) ckalloc(sizeof(TkUndoAtom));
+ separator->type = TK_UNDO_SEPARATOR;
+ TkUndoPushStack(stack,separator);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*
+ * TkUndoClearStack --
+ * Clear an entire undo or redo stack and destroy all elements in it.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+void TkUndoClearStack ( stack )
+ TkUndoAtom ** stack; /* An Undo or Redo stack */
+{
+ TkUndoAtom * elem;
+
+ while ( (elem = TkUndoPopStack(stack)) ) {
+ if ( elem->type != TK_UNDO_SEPARATOR ) {
+ Tcl_DecrRefCount(elem->apply);
+ Tcl_DecrRefCount(elem->revert);
+ }
+ ckfree((char *)elem);
+ }
+ *stack = NULL;
+}
+
+/*
+ * TkUndoPushAction
+ * Push a new elem on the stack identified by stack.
+ * action and revert are given through Tcl_DStrings
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+void TkUndoPushAction ( stack, actionScript, revertScript )
+ TkUndoRedoStack * stack; /* An Undo or Redo stack */
+ Tcl_DString * actionScript; /* The script to get the action (redo) */
+ Tcl_DString * revertScript; /* The script to revert the action (undo) */
+{
+ TkUndoAtom * atom;
+
+ atom = (TkUndoAtom *) ckalloc(sizeof(TkUndoAtom));
+ atom->type = TK_UNDO_ACTION;
+
+ atom->apply = Tcl_NewStringObj(Tcl_DStringValue(actionScript),Tcl_DStringLength(actionScript));
+ Tcl_IncrRefCount(atom->apply);
+
+ atom->revert = Tcl_NewStringObj(Tcl_DStringValue(revertScript),Tcl_DStringLength(revertScript));
+ Tcl_IncrRefCount(atom->revert);
+
+ TkUndoPushStack(&(stack->undoStack), atom);
+ TkUndoClearStack(&(stack->redoStack));
+}
+
+
+/*
+ * TkUndoInitStack
+ * Initialize a new undo/redo stack
+ *
+ * Results:
+ * un Undo/Redo stack pointer
+ *
+ * Side effects:
+ * None.
+ */
+
+TkUndoRedoStack * TkUndoInitStack ( interp, maxdepth )
+ Tcl_Interp * interp; /* The interpreter */
+ int maxdepth; /* The maximum stack depth */
+{
+ TkUndoRedoStack * stack; /* An Undo/Redo stack */
+ stack = (TkUndoRedoStack *) ckalloc(sizeof(TkUndoRedoStack));
+ stack->undoStack = NULL;
+ stack->redoStack = NULL;
+ stack->interp = interp;
+ stack->maxdepth = maxdepth;
+ stack->depth = 0;
+ return stack;
+}
+
+
+/*
+ * TkUndoInitStack
+ * Initialize a new undo/redo stack
+ *
+ * Results:
+ * un Undo/Redo stack pointer
+ *
+ * Side effects:
+ * None.
+ */
+
+void TkUndoSetDepth ( stack, maxdepth )
+ TkUndoRedoStack * stack; /* An Undo/Redo stack */
+ int maxdepth; /* The maximum stack depth */
+{
+ TkUndoAtom * elem;
+ TkUndoAtom * prevelem;
+ int sepNumber = 0;
+
+ stack->maxdepth = maxdepth;
+
+ if ((stack->maxdepth > 0) && (stack->depth > stack->maxdepth)) {
+ /* Maximum stack depth exceeded. We have to remove the last compound
+ elements on the stack */
+ elem = stack->undoStack;
+ prevelem = NULL;
+ while ( sepNumber <= stack->maxdepth ) {
+ if (elem != NULL && (elem->type == TK_UNDO_SEPARATOR) ) {
+ sepNumber++;
+ }
+ prevelem = elem;
+ elem = elem->next;
+ }
+ prevelem->next = NULL;
+ while ( elem ) {
+ prevelem = elem;
+ elem = elem->next;
+ ckfree((char *) elem);
+ }
+ stack->depth = stack->maxdepth;
+ }
+}
+
+
+/*
+ * TkUndoClearStacks
+ * Clear both the undo and redo stack
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+void TkUndoClearStacks ( stack )
+ TkUndoRedoStack * stack; /* An Undo/Redo stack */
+{
+ TkUndoClearStack(&(stack->undoStack));
+ TkUndoClearStack(&(stack->redoStack));
+ stack->depth = 0;
+}
+
+
+/*
+ * TkUndoFreeStack
+ * Clear both the undo and redo stack
+ * also free the memory allocated to the u/r stack pointer
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+void TkUndoFreeStack ( stack )
+ TkUndoRedoStack * stack; /* An Undo/Redo stack */
+{
+ TkUndoClearStacks(stack);
+/* ckfree((TkUndoRedoStack *) stack); */
+ ckfree((char *) stack);
+}
+
+
+/*
+ * TkUndoInsertUndoSeparator --
+ * insert a separator on the undo stack, indicating a border for
+ * an undo/redo chunk.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ */
+
+void TkUndoInsertUndoSeparator ( stack )
+ TkUndoRedoStack * stack;
+{
+/* TkUndoAtom * elem;
+ TkUndoAtom * prevelem;
+ int sepNumber = 0;
+*/
+
+ if ( TkUndoInsertSeparator(&(stack->undoStack)) ) {
+ ++(stack->depth);
+ TkUndoSetDepth(stack,stack->maxdepth);
+/* if ((stack->maxdepth > 0) && (stack->depth > stack->maxdepth)) {
+ elem = stack->undoStack;
+ prevelem = NULL;
+ while ( sepNumber < stack->depth ) {
+ if (elem != NULL && (elem->type == TK_UNDO_SEPARATOR) ) {
+ sepNumber++;
+ }
+ prevelem = elem;
+ elem = elem->next;
+ }
+ prevelem->next = NULL;
+ while ( elem ) {
+ prevelem = elem;
+ elem = elem->next;
+ ckfree((char *) elem);
+ }
+ stack->depth;
+ } */
+ }
+}
+
+
+/*
+ * TkUndoRevert --
+ * Undo a compound action on the stack.
+ *
+ * Results:
+ * A TCL status code
+ *
+ * Side effects:
+ * None.
+ */
+
+int TkUndoRevert ( stack )
+ TkUndoRedoStack * stack;
+{
+ TkUndoAtom * elem;
+
+ /* insert a separator on the undo and the redo stack */
+
+ TkUndoInsertUndoSeparator(stack);
+ TkUndoInsertSeparator(&(stack->redoStack));
+
+ /* Pop and skip the first separator if there is one*/
+
+ elem = TkUndoPopStack(&(stack->undoStack));
+
+ if ( elem == NULL ) {
+ return TCL_ERROR;
+ }
+
+ if ( ( elem != NULL ) && ( elem->type == TK_UNDO_SEPARATOR ) ) {
+ ckfree((char *) elem);
+ elem = TkUndoPopStack(&(stack->undoStack));
+ }
+
+ while ( elem && (elem->type != TK_UNDO_SEPARATOR) ) {
+ Tcl_EvalObjEx(stack->interp,elem->revert,TCL_EVAL_GLOBAL);
+
+ TkUndoPushStack(&(stack->redoStack),elem);
+ elem = TkUndoPopStack(&(stack->undoStack));
+ }
+
+ /* insert a separator on the redo stack */
+
+ TkUndoInsertSeparator(&(stack->redoStack));
+
+ --(stack->depth);
+
+ return TCL_OK;
+}
+
+
+/*
+ * TkUndoApply --
+ * Redo a compound action on the stack.
+ *
+ * Results:
+ * A TCL status code
+ *
+ * Side effects:
+ * None.
+ */
+
+int TkUndoApply ( stack )
+ TkUndoRedoStack * stack;
+{
+ TkUndoAtom *elem;
+
+ /* insert a separator on the undo stack */
+
+ TkUndoInsertSeparator(&(stack->undoStack));
+
+ /* Pop and skip the first separator if there is one*/
+
+ elem = TkUndoPopStack(&(stack->redoStack));
+
+ if ( elem == NULL ) {
+ return TCL_ERROR;
+ }
+
+ if ( ( elem != NULL ) && ( elem->type == TK_UNDO_SEPARATOR ) ) {
+ ckfree((char *) elem);
+ elem = TkUndoPopStack(&(stack->redoStack));
+ }
+
+ while ( elem && (elem->type != TK_UNDO_SEPARATOR) ) {
+ Tcl_EvalObjEx(stack->interp,elem->apply,TCL_EVAL_GLOBAL);
+
+ TkUndoPushStack(&(stack->undoStack), elem);
+ elem = TkUndoPopStack(&(stack->redoStack));
+ }
+
+ /* insert a separator on the undo stack */
+
+ TkUndoInsertSeparator(&(stack->undoStack));
+
+ ++(stack->depth);
+
+ return TCL_OK;
+}
+
diff --git a/tcl/generic/tkUndo.h b/tcl/generic/tkUndo.h
new file mode 100644
index 00000000000..2775cce86f8
--- /dev/null
+++ b/tcl/generic/tkUndo.h
@@ -0,0 +1,90 @@
+/*
+ * tkUndo.h --
+ *
+ * Declarations shared among the files that implement an undo
+ * stack.
+ *
+ * Copyright (c) 2002 Ludwig Callewaert.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKUNDO
+#define _TKUNDO
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/* enum definining the types used in an undo stack */
+
+typedef enum {
+ TK_UNDO_SEPARATOR, /* Marker */
+ TK_UNDO_ACTION /* Command */
+} TkUndoAtomType;
+
+/* struct defining the basic undo/redo stack element */
+
+typedef struct TkUndoAtom {
+ TkUndoAtomType type; /* The type that will trigger the
+ * required action*/
+ Tcl_Obj * apply; /* Command to apply the action that was taken */
+ Tcl_Obj * revert; /* The command to undo the action */
+ struct TkUndoAtom * next; /* Pointer to the next element in the
+ * stack */
+} TkUndoAtom;
+
+/* struct defining the basic undo/redo stack element */
+
+typedef struct TkUndoRedoStack {
+ TkUndoAtom * undoStack; /* The undo stack */
+ TkUndoAtom * redoStack; /* The redo stack */
+ Tcl_Interp * interp ; /* The interpreter in which to execute the revert and apply scripts */
+ int maxdepth;
+ int depth;
+} TkUndoRedoStack;
+
+/* basic functions */
+
+EXTERN void TkUndoPushStack _ANSI_ARGS_((TkUndoAtom ** stack,
+ TkUndoAtom * elem));
+
+EXTERN TkUndoAtom * TkUndoPopStack _ANSI_ARGS_((TkUndoAtom ** stack));
+
+EXTERN int TkUndoInsertSeparator _ANSI_ARGS_((TkUndoAtom ** stack));
+
+EXTERN void TkUndoClearStack _ANSI_ARGS_((TkUndoAtom ** stack));
+
+/* functions working on an undo/redo stack */
+
+EXTERN TkUndoRedoStack * TkUndoInitStack _ANSI_ARGS_((Tcl_Interp * interp,
+ int maxdepth));
+
+EXTERN void TkUndoSetDepth _ANSI_ARGS_((TkUndoRedoStack * stack,
+ int maxdepth));
+
+EXTERN void TkUndoClearStacks _ANSI_ARGS_((TkUndoRedoStack * stack));
+
+EXTERN void TkUndoFreeStack _ANSI_ARGS_((TkUndoRedoStack * stack));
+
+EXTERN void TkUndoInsertUndoSeparator _ANSI_ARGS_((TkUndoRedoStack * stack));
+
+EXTERN void TkUndoPushAction _ANSI_ARGS_((TkUndoRedoStack * stack,
+ Tcl_DString * actionScript, Tcl_DString * revertScript));
+
+EXTERN int TkUndoRevert _ANSI_ARGS_((TkUndoRedoStack * stack));
+
+EXTERN int TkUndoApply _ANSI_ARGS_((TkUndoRedoStack * stack));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKUNDO */
diff --git a/tcl/generic/tkUtil.c b/tcl/generic/tkUtil.c
new file mode 100644
index 00000000000..dcf0de29300
--- /dev/null
+++ b/tcl/generic/tkUtil.c
@@ -0,0 +1,953 @@
+/*
+ * tkUtil.c --
+ *
+ * This file contains miscellaneous utility procedures that
+ * are used by the rest of Tk, such as a procedure for drawing
+ * a focus highlight.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The structure below defines the implementation of the "statekey"
+ * Tcl object, used for quickly finding a mapping in a TkStateMap.
+ */
+
+Tcl_ObjType tkStateKeyObjType = {
+ "statekey", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ (Tcl_SetFromAnyProc *) NULL /* setFromAnyProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkStateParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-state" and "-default" options.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The state for a given item gets replaced by the state
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkStateParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ int c;
+ int flags = (int)clientData;
+ size_t length;
+
+ register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
+
+ if(value == NULL || *value == 0) {
+ *statePtr = TK_STATE_NULL;
+ return TCL_OK;
+ }
+
+ c = value[0];
+ length = strlen(value);
+
+ if ((c == 'n') && (strncmp(value, "normal", length) == 0)) {
+ *statePtr = TK_STATE_NORMAL;
+ return TCL_OK;
+ }
+ if ((c == 'd') && (strncmp(value, "disabled", length) == 0)) {
+ *statePtr = TK_STATE_DISABLED;
+ return TCL_OK;
+ }
+ if ((c == 'a') && (flags&1) && (strncmp(value, "active", length) == 0)) {
+ *statePtr = TK_STATE_ACTIVE;
+ return TCL_OK;
+ }
+ if ((c == 'h') && (flags&2) && (strncmp(value, "hidden", length) == 0)) {
+ *statePtr = TK_STATE_HIDDEN;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state",
+ " value \"", value, "\": must be normal",
+ (char *) NULL);
+ if (flags&1) {
+ Tcl_AppendResult(interp, ", active",(char *) NULL);
+ }
+ if (flags&2) {
+ Tcl_AppendResult(interp, ", hidden",(char *) NULL);
+ }
+ if (flags&3) {
+ Tcl_AppendResult(interp, ",",(char *) NULL);
+ }
+ Tcl_AppendResult(interp, " or disabled",(char *) NULL);
+ *statePtr = TK_STATE_NORMAL;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkStatePrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-state"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the state 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 *
+TkStatePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
+
+ if (*statePtr==TK_STATE_NORMAL) {
+ return "normal";
+ } else if (*statePtr==TK_STATE_DISABLED) {
+ return "disabled";
+ } else if (*statePtr==TK_STATE_HIDDEN) {
+ return "hidden";
+ } else if (*statePtr==TK_STATE_ACTIVE) {
+ return "active";
+ } else {
+ return "";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOrientParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * the "-orient" option.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The orientation for a given item gets replaced by the orientation
+ * indicated in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkOrientParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* some flags.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ CONST char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ int c;
+ size_t length;
+
+ register int *orientPtr = (int *) (widgRec + offset);
+
+ if(value == NULL || *value == 0) {
+ *orientPtr = 0;
+ return TCL_OK;
+ }
+
+ c = value[0];
+ length = strlen(value);
+
+ if ((c == 'h') && (strncmp(value, "horizontal", length) == 0)) {
+ *orientPtr = 0;
+ return TCL_OK;
+ }
+ if ((c == 'v') && (strncmp(value, "vertical", length) == 0)) {
+ *orientPtr = 1;
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "bad orientation \"", value,
+ "\": must be vertical or horizontal",
+ (char *) NULL);
+ *orientPtr = 0;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOrientPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-orient"
+ * configuration option.
+ *
+ * Results:
+ * The return value is a string describing the orientation 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 *
+TkOrientPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register int *statePtr = (int *) (widgRec + offset);
+
+ if (*statePtr) {
+ return "vertical";
+ } else {
+ return "horizontal";
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOffsetParseProc --
+ *
+ * Converts the offset of a stipple or tile into the Tk_TSOffset structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkOffsetParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* not used */
+ Tcl_Interp *interp; /* Interpreter to send results back to */
+ Tk_Window tkwin; /* Window on same display as tile */
+ CONST char *value; /* Name of image */
+ char *widgRec; /* Widget structure record */
+ int offset; /* Offset of tile in record */
+{
+ Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset);
+ Tk_TSOffset tsoffset;
+ CONST char *q, *p;
+ int result;
+
+ if ((value == NULL) || (*value == 0)) {
+ tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
+ goto goodTSOffset;
+ }
+ tsoffset.flags = 0;
+ p = value;
+
+ switch(value[0]) {
+ case '#':
+ if (((int)clientData) & TK_OFFSET_RELATIVE) {
+ tsoffset.flags = TK_OFFSET_RELATIVE;
+ p++; break;
+ }
+ goto badTSOffset;
+ case 'e':
+ switch(value[1]) {
+ case '\0':
+ tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_MIDDLE;
+ goto goodTSOffset;
+ case 'n':
+ if (value[2]!='d' || value[3]!='\0') {goto badTSOffset;}
+ tsoffset.flags = INT_MAX;
+ goto goodTSOffset;
+ }
+ case 'w':
+ if (value[1] != '\0') {goto badTSOffset;}
+ tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_MIDDLE;
+ goto goodTSOffset;
+ case 'n':
+ if ((value[1] != '\0') && (value[2] != '\0')) {
+ goto badTSOffset;
+ }
+ switch(value[1]) {
+ case '\0': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_TOP;
+ goto goodTSOffset;
+ case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_TOP;
+ goto goodTSOffset;
+ case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_TOP;
+ goto goodTSOffset;
+ }
+ goto badTSOffset;
+ case 's':
+ if ((value[1] != '\0') && (value[2] != '\0')) {
+ goto badTSOffset;
+ }
+ switch(value[1]) {
+ case '\0': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_BOTTOM;
+ goto goodTSOffset;
+ case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_BOTTOM;
+ goto goodTSOffset;
+ case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_BOTTOM;
+ goto goodTSOffset;
+ }
+ goto badTSOffset;
+ case 'c':
+ if (strncmp(value, "center", strlen(value)) != 0) {
+ goto badTSOffset;
+ }
+ tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
+ goto goodTSOffset;
+ }
+ if ((q = strchr(p,',')) == NULL) {
+ if (((int)clientData) & TK_OFFSET_INDEX) {
+ if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ goto badTSOffset;
+ }
+ tsoffset.flags |= TK_OFFSET_INDEX;
+ goto goodTSOffset;
+ }
+ goto badTSOffset;
+ }
+ *((char *) q) = 0;
+ result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset);
+ *((char *) q) = ',';
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_GetPixels(interp, tkwin, (char *) q+1, &tsoffset.yoffset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+
+goodTSOffset:
+ /* below is a hack to allow the stipple/tile offset to be stored
+ * in the internal tile structure. Most of the times, offsetPtr
+ * is a pointer to an already existing tile structure. However
+ * if this structure is not already created, we must do it
+ * with Tk_GetTile()!!!!;
+ */
+
+ memcpy(offsetPtr,&tsoffset, sizeof(Tk_TSOffset));
+ return TCL_OK;
+
+badTSOffset:
+ Tcl_AppendResult(interp, "bad offset \"", value,
+ "\": expected \"x,y\"", (char *) NULL);
+ if (((int) clientData) & TK_OFFSET_RELATIVE) {
+ Tcl_AppendResult(interp, ", \"#x,y\"", (char *) NULL);
+ }
+ if (((int) clientData) & TK_OFFSET_INDEX) {
+ Tcl_AppendResult(interp, ", <index>", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOffsetPrintProc --
+ *
+ * Returns the offset of the tile.
+ *
+ * Results:
+ * The offset of the tile is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkOffsetPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* not used */
+ Tk_Window tkwin; /* not used */
+ char *widgRec; /* Widget structure record */
+ int offset; /* Offset of tile in record */
+ Tcl_FreeProc **freeProcPtr; /* not used */
+{
+ Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset);
+ char *p, *q;
+
+ if ((offsetPtr->flags) & TK_OFFSET_INDEX) {
+ if ((offsetPtr->flags) >= INT_MAX) {
+ return "end";
+ }
+ p = (char *) ckalloc(32);
+ sprintf(p, "%d",(offsetPtr->flags & (~TK_OFFSET_INDEX)));
+ *freeProcPtr = TCL_DYNAMIC;
+ return p;
+ }
+ if ((offsetPtr->flags) & TK_OFFSET_TOP) {
+ if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
+ return "nw";
+ } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
+ return "n";
+ } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
+ return "ne";
+ }
+ } else if ((offsetPtr->flags) & TK_OFFSET_MIDDLE) {
+ if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
+ return "w";
+ } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
+ return "center";
+ } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
+ return "e";
+ }
+ } else if ((offsetPtr->flags) & TK_OFFSET_BOTTOM) {
+ if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
+ return "sw";
+ } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
+ return "s";
+ } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
+ return "se";
+ }
+ }
+ q = p = (char *) ckalloc(32);
+ if ((offsetPtr->flags) & TK_OFFSET_RELATIVE) {
+ *q++ = '#';
+ }
+ sprintf(q, "%d,%d",offsetPtr->xoffset, offsetPtr->yoffset);
+ *freeProcPtr = TCL_DYNAMIC;
+ return p;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPixelParseProc --
+ *
+ * Converts the name of an image into a tile.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPixelParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* if non-NULL, negative values are
+ * allowed as well */
+ Tcl_Interp *interp; /* Interpreter to send results back to */
+ Tk_Window tkwin; /* Window on same display as tile */
+ CONST char *value; /* Name of image */
+ char *widgRec; /* Widget structure record */
+ int offset; /* Offset of tile in record */
+{
+ double *doublePtr = (double *)(widgRec + offset);
+ int result;
+
+ result = TkGetDoublePixels(interp, tkwin, value, doublePtr);
+
+ if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) {
+ Tcl_AppendResult(interp, "bad screen distance \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPixelPrintProc --
+ *
+ * Returns the name of the tile.
+ *
+ * Results:
+ * The name of the tile is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkPixelPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* not used */
+ Tk_Window tkwin; /* not used */
+ char *widgRec; /* Widget structure record */
+ int offset; /* Offset of tile in record */
+ Tcl_FreeProc **freeProcPtr; /* not used */
+{
+ double *doublePtr = (double *)(widgRec + offset);
+ char *p;
+
+ p = (char *) ckalloc(24);
+ Tcl_PrintDouble((Tcl_Interp *) NULL, *doublePtr, p);
+ *freeProcPtr = TCL_DYNAMIC;
+ return p;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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];
+
+ 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.
+ *
+ * This function is now deprecated. Use TkpDrawHighlightBorder instead,
+ * since this function does not handle drawing the Focus ring properly
+ * on the Macintosh - you need to know the background GC as well
+ * as the foreground since the Mac focus ring separated from the widget
+ * by a 1 pixel border.
+ *
+ * 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, the interp's 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. */
+ CONST 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetScrollInfoObj --
+ *
+ * This procedure is invoked to parse "xview" and "yview"
+ * scrolling commands for widgets using the new scrolling
+ * command syntax ("moveto" or "scroll" options).
+ *
+ * Results:
+ * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
+ * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether
+ * the command was successfully parsed and what form the command
+ * took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the
+ * desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
+ * *intPtr is filled in with the number of lines to move (may be
+ * negative); if TK_SCROLL_ERROR, the interp's result contains an
+ * error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetScrollInfoObj(interp, objc, objv, dblPtr, intPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ int objc; /* # arguments for command. */
+ Tcl_Obj *CONST objv[]; /* Arguments for command. */
+ double *dblPtr; /* Filled in with argument "moveto"
+ * option, if any. */
+ int *intPtr; /* Filled in with number of pages
+ * or lines to scroll, if any. */
+{
+ int c;
+ size_t length;
+ char *arg2, *arg4;
+
+ arg2 = Tcl_GetString(objv[2]);
+ length = strlen(arg2);
+ c = arg2[0];
+ if ((c == 'm') && (strncmp(arg2, "moveto", length) == 0)) {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction");
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ return TK_SCROLL_MOVETO;
+ } else if ((c == 's')
+ && (strncmp(arg2, "scroll", length) == 0)) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages");
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ arg4 = Tcl_GetString(objv[4]);
+ length = (strlen(arg4));
+ c = arg4[0];
+ if ((c == 'p') && (strncmp(arg4, "pages", length) == 0)) {
+ return TK_SCROLL_PAGES;
+ } else if ((c == 'u')
+ && (strncmp(arg4, "units", length) == 0)) {
+ return TK_SCROLL_UNITS;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", arg4,
+ "\": must be units or pages", (char *) NULL);
+ return TK_SCROLL_ERROR;
+ }
+ }
+ Tcl_AppendResult(interp, "unknown option \"", arg2,
+ "\": must be moveto or scroll", (char *) NULL);
+ return TK_SCROLL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkComputeAnchor --
+ *
+ * Determine where to place a rectangle so that it will be properly
+ * 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_InternalBorderLeft(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_InternalBorderRight(tkwin) + padX)
+ - innerWidth;
+ break;
+ }
+
+ switch (anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ *yPtr = Tk_InternalBorderTop(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_InternalBorderBottom(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 the interp's result (if interp is not NULL).
+ *
+ * Side effects.
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFindStateNum(interp, option, mapPtr, strKey)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ CONST char *option; /* String to use when constructing error. */
+ CONST TkStateMap *mapPtr; /* Lookup table. */
+ CONST char *strKey; /* String to try to find in lookup table. */
+{
+ CONST TkStateMap *mPtr;
+
+ for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
+ if (strcmp(strKey, mPtr->strKey) == 0) {
+ return mPtr->numKey;
+ }
+ }
+ if (interp != NULL) {
+ mPtr = mapPtr;
+ Tcl_AppendResult(interp, "bad ", option, " value \"", strKey,
+ "\": must be ", mPtr->strKey, (char *) NULL);
+ for (mPtr++; mPtr->strKey != NULL; mPtr++) {
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, (char *) NULL);
+ }
+ }
+ return mPtr->numKey;
+}
+
+int
+TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ Tcl_Obj *optionPtr; /* String to use when constructing error. */
+ CONST TkStateMap *mapPtr; /* Lookup table. */
+ Tcl_Obj *keyPtr; /* String key to find in lookup table. */
+{
+ CONST TkStateMap *mPtr;
+ CONST char *key;
+ CONST Tcl_ObjType *typePtr;
+
+ if ((keyPtr->typePtr == &tkStateKeyObjType)
+ && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) {
+ return (int) keyPtr->internalRep.twoPtrValue.ptr2;
+ }
+
+ key = Tcl_GetStringFromObj(keyPtr, NULL);
+ for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
+ if (strcmp(key, mPtr->strKey) == 0) {
+ typePtr = keyPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(keyPtr);
+ }
+ keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr;
+ keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey;
+ keyPtr->typePtr = &tkStateKeyObjType;
+ return mPtr->numKey;
+ }
+ }
+ if (interp != NULL) {
+ mPtr = mapPtr;
+ Tcl_AppendResult(interp, "bad ",
+ Tcl_GetStringFromObj(optionPtr, NULL), " value \"", key,
+ "\": must be ", mPtr->strKey, (char *) NULL);
+ for (mPtr++; mPtr->strKey != NULL; mPtr++) {
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, (char *) NULL);
+ }
+ }
+ return mPtr->numKey;
+}
diff --git a/tcl/generic/tkVisual.c b/tcl/generic/tkVisual.c
new file mode 100644
index 00000000000..e60e5a23240
--- /dev/null
+++ b/tcl/generic/tkVisual.c
@@ -0,0 +1,541 @@
+/*
+ * tkVisual.c --
+ *
+ * This file contains library procedures for allocating and
+ * freeing visuals and colormaps. This code is based on a
+ * prototype implementation by Paul Mackerras.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 the interp's result. The depth of the
+ * visual is returned to *depthPtr under normal returns. If
+ * colormapPtr is non-NULL, then this procedure also finds a
+ * suitable colormap for use with the visual in tkwin, and it
+ * returns that colormap in *colormapPtr unless an error occurs.
+ *
+ * Side effects:
+ * A new colormap may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ CONST 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;
+ CONST 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) {
+ Tcl_SetResult(interp, "couldn't find an appropriate visual",
+ TCL_STATIC);
+ return NULL;
+ }
+
+ /*
+ * Search through the visuals that were returned to find the best
+ * one. The choice is based on the following criteria, in decreasing
+ * order of importance:
+ *
+ * 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 the interp's result.
+ *
+ * Side effects:
+ * A reference count is incremented for the colormap, so
+ * Tk_FreeColormap must eventually be called exactly once for
+ * each call to Tk_GetColormap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Colormap
+Tk_GetColormap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tk_Window tkwin; /* Window where colormap will be
+ * used. */
+ CONST 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/tcl/generic/tkWindow.c b/tcl/generic/tkWindow.c
new file mode 100644
index 00000000000..47e2a472e71
--- /dev/null
+++ b/tcl/generic/tkWindow.c
@@ -0,0 +1,3076 @@
+/*
+ * 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"
+
+#if !( defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+#include "tkUnixInt.h"
+#endif
+
+
+typedef struct ThreadSpecificData {
+ int numMainWindows; /* Count of numver of main windows currently
+ * open in this thread. */
+ TkMainInfo *mainWindowList;
+ /* First in list of all main windows managed
+ * by this thread. */
+ TkDisplay *displayList;
+ /* List of all displays currently in use by
+ * the current thread. */
+ int initialized; /* 0 means the structures above need
+ * initializing. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The Mutex below is used to lock access to the Tk_Uid structs above.
+ */
+
+TCL_DECLARE_MUTEX(windowMutex)
+
+/*
+ * Default values for "changes" and "atts" fields of TkWindows. Note
+ * that Tk always requests all events for all windows, except StructureNotify
+ * events on internal windows: these events are generated internally.
+ */
+
+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. */
+ int passMainWindow; /* 0 means provide NULL clientData to
+ * command procedure; 1 means pass main
+ * window as clientData to command
+ * procedure. */
+} TkCmd;
+
+static TkCmd commands[] = {
+ /*
+ * Commands that are part of the intrinsics:
+ */
+
+ {"bell", NULL, Tk_BellObjCmd, 0, 1},
+ {"bind", NULL, Tk_BindObjCmd, 1, 1},
+ {"bindtags", NULL, Tk_BindtagsObjCmd, 1, 1},
+ {"clipboard", NULL, Tk_ClipboardObjCmd, 0, 1},
+ {"destroy", NULL, Tk_DestroyObjCmd, 1, 1},
+ {"event", NULL, Tk_EventObjCmd, 1, 1},
+ {"focus", NULL, Tk_FocusObjCmd, 1, 1},
+ {"font", NULL, Tk_FontObjCmd, 1, 1},
+ {"grab", NULL, Tk_GrabObjCmd, 0, 1},
+ {"grid", NULL, Tk_GridObjCmd, 1, 1},
+ {"image", NULL, Tk_ImageObjCmd, 1, 1},
+ {"lower", NULL, Tk_LowerObjCmd, 1, 1},
+ {"option", NULL, Tk_OptionObjCmd, 1, 1},
+ {"pack", NULL, Tk_PackObjCmd, 1, 1},
+ {"place", NULL, Tk_PlaceObjCmd, 1, 0},
+ {"raise", NULL, Tk_RaiseObjCmd, 1, 1},
+ {"selection", NULL, Tk_SelectionObjCmd, 0, 1},
+ {"tk", NULL, Tk_TkObjCmd, 1, 1},
+ {"tkwait", NULL, Tk_TkwaitObjCmd, 1, 1},
+#if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)
+ {"tk_chooseColor", NULL, Tk_ChooseColorObjCmd, 0, 1},
+ {"tk_chooseDirectory", NULL, Tk_ChooseDirectoryObjCmd, 0, 1},
+ {"tk_getOpenFile", NULL, Tk_GetOpenFileObjCmd, 0, 1},
+ {"tk_getSaveFile", NULL, Tk_GetSaveFileObjCmd, 0, 1},
+#endif
+#ifdef __WIN32__
+ {"tk_messageBox", NULL, Tk_MessageBoxObjCmd, 0, 1},
+#endif
+ {"update", NULL, Tk_UpdateObjCmd, 1, 1},
+ {"winfo", NULL, Tk_WinfoObjCmd, 1, 1},
+ {"wm", NULL, Tk_WmObjCmd, 0, 1},
+
+ /*
+ * Widget class commands.
+ */
+
+ {"button", NULL, Tk_ButtonObjCmd, 1, 0},
+ {"canvas", NULL, Tk_CanvasObjCmd, 1, 1},
+ {"checkbutton", NULL, Tk_CheckbuttonObjCmd, 1, 0},
+ {"entry", NULL, Tk_EntryObjCmd, 1, 0},
+ {"frame", NULL, Tk_FrameObjCmd, 1, 0},
+ {"label", NULL, Tk_LabelObjCmd, 1, 0},
+ {"labelframe", NULL, Tk_LabelframeObjCmd, 1, 0},
+ {"listbox", NULL, Tk_ListboxObjCmd, 1, 0},
+ {"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0},
+ {"message", NULL, Tk_MessageObjCmd, 1, 0},
+ {"panedwindow", NULL, Tk_PanedWindowObjCmd, 1, 0},
+ {"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0},
+ {"scale", NULL, Tk_ScaleObjCmd, 1, 0},
+ {"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1},
+ {"spinbox", NULL, Tk_SpinboxObjCmd, 1, 0},
+ {"text", Tk_TextCmd, NULL, 1, 1},
+ {"toplevel", NULL, Tk_ToplevelObjCmd, 0, 0},
+
+ /*
+ * Misc.
+ */
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+ {"::tk::unsupported::MacWindowStyle",
+ TkUnsupported1Cmd, NULL, 1, 1},
+#endif
+ {(char *) NULL, (int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, CONST 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, CONST char *name,
+ CONST char *screenName, unsigned int flags));
+static void DeleteWindowsExitProc _ANSI_ARGS_((
+ ClientData clientData));
+static TkDisplay * GetScreen _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *screenName, int *screenPtr));
+static int Initialize _ANSI_ARGS_((Tcl_Interp *interp));
+static int NameWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr, TkWindow *parentPtr,
+ CONST char *name));
+static void UnlinkWindow _ANSI_ARGS_((TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCloseDisplay --
+ * Closing the display can lead to order of deletion problems.
+ * We defer it until exit handling for Mac/Win, but since Unix can
+ * use many displays, try and clean it up as best as possible.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the display will be free.
+ * The display may not be referenced at all after this.
+ *----------------------------------------------------------------------
+ */
+
+static void
+TkCloseDisplay(TkDisplay *dispPtr)
+{
+ TkClipCleanup(dispPtr);
+
+ if (dispPtr->name != NULL) {
+ ckfree(dispPtr->name);
+ }
+
+ if (dispPtr->atomInit) {
+ Tcl_DeleteHashTable(&dispPtr->nameTable);
+ Tcl_DeleteHashTable(&dispPtr->atomTable);
+ dispPtr->atomInit = 0;
+ }
+
+ if (dispPtr->errorPtr != NULL) {
+ TkErrorHandler *errorPtr;
+ for (errorPtr = dispPtr->errorPtr;
+ errorPtr != NULL;
+ errorPtr = dispPtr->errorPtr) {
+ dispPtr->errorPtr = errorPtr->nextPtr;
+ ckfree((char *) errorPtr);
+ }
+ }
+
+ TkGCCleanup(dispPtr);
+
+ TkpCloseDisplay(dispPtr);
+
+ /*
+ * Delete winTable after TkpCloseDisplay since special windows
+ * may need call Tk_DestroyWindow and it checks the winTable.
+ */
+
+ Tcl_DeleteHashTable(&dispPtr->winTable);
+
+ ckfree((char *) dispPtr);
+
+ /*
+ * There is more to clean up, we leave it at this for the time being.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ * the interp's result.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X
+ * window is NOT initially created, but will be created
+ * the first time the window is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Window
+CreateTopLevelWindow(interp, parent, name, screenName, flags)
+ 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. */
+ CONST char *name; /* Name for new window; if parent is
+ * non-NULL, must be unique among parent's
+ * children. */
+ CONST 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. */
+ unsigned int flags; /* Additional flags to set on the window. */
+{
+ register TkWindow *winPtr;
+ register TkDisplay *dispPtr;
+ int screenId;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+
+ /*
+ * Create built-in image types.
+ */
+
+ Tk_CreateImageType(&tkBitmapImageType);
+ Tk_CreateImageType(&tkPhotoImageType);
+
+ /*
+ * Create built-in photo image formats.
+ */
+
+ Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
+ Tk_CreateOldPhotoImageFormat(&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);
+
+ /*
+ * Set the flags specified in the call.
+ */
+ winPtr->flags |= flags;
+
+ /*
+ * 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_HIERARCHY flag immediately here; otherwise
+ * Tk_DestroyWindow will core dump if it is called before the flag
+ * has been set.)
+ */
+
+ winPtr->flags |= TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED;
+
+ 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 the interp's result. The location at
+ * *screenPtr is overwritten with the screen number parsed from
+ * screenName.
+ *
+ * Side effects:
+ * A new connection is opened to the display if there is no
+ * connection already. A new TkDisplay data structure is also
+ * setup, if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkDisplay *
+GetScreen(interp, screenName, screenPtr)
+ Tcl_Interp *interp; /* Place to leave error message. */
+ CONST char *screenName; /* Name for screen. NULL or empty means
+ * use DISPLAY envariable. */
+ int *screenPtr; /* Where to store screen number. */
+{
+ register TkDisplay *dispPtr;
+ CONST char *p;
+ int screenId;
+ size_t length;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Separate the screen number from the rest of the display
+ * name. ScreenName is assumed to have the syntax
+ * <display>.<screen> with the dot and the screen being
+ * optional.
+ */
+
+ screenName = TkGetDefaultScreenName(interp, screenName);
+ if (screenName == NULL) {
+ Tcl_SetResult(interp,
+ "no display name and no $DISPLAY environment variable",
+ TCL_STATIC);
+ return (TkDisplay *) NULL;
+ }
+ length = strlen(screenName);
+ screenId = 0;
+ p = screenName+length-1;
+ while (isdigit(UCHAR(*p)) && (p != screenName)) {
+ p--;
+ }
+ if ((*p == '.') && (p[1] != '\0')) {
+ length = p - screenName;
+ screenId = strtoul(p+1, (char **) NULL, 10);
+ }
+
+ /*
+ * See if we already have a connection to this display. If not,
+ * then open a new connection.
+ */
+
+ for (dispPtr = tsdPtr->displayList; ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ /*
+ * The private function zeros out dispPtr when it is created,
+ * so we only need to initialize the non-zero items.
+ */
+ dispPtr = TkpOpenDisplay(screenName);
+ if (dispPtr == NULL) {
+ Tcl_AppendResult(interp, "couldn't connect to display \"",
+ screenName, "\"", (char *) NULL);
+ return (TkDisplay *) NULL;
+ }
+ dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */
+ tsdPtr->displayList = dispPtr;
+
+ dispPtr->lastEventTime = CurrentTime;
+ dispPtr->bindInfoStale = 1;
+ dispPtr->cursorFont = None;
+ dispPtr->warpWindow = None;
+ dispPtr->multipleAtom = None;
+ /*
+ * By default we do want to collapse motion events in
+ * Tk_QueueWindowEvent.
+ */
+ dispPtr->flags |= TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+
+ Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);
+
+ dispPtr->name = (char *) ckalloc((unsigned) (length+1));
+ strncpy(dispPtr->name, screenName, length);
+ dispPtr->name[length] = '\0';
+
+ TkInitXId(dispPtr);
+ break;
+ }
+ if ((strncmp(dispPtr->name, screenName, length) == 0)
+ && (dispPtr->name[length] == '\0')) {
+ break;
+ }
+ }
+ if (screenId >= ScreenCount(dispPtr->display)) {
+ char buf[32 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "bad screen number \"%d\"", screenId);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return (TkDisplay *) NULL;
+ }
+ *screenPtr = screenId;
+ return dispPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->display == display) {
+ break;
+ }
+ }
+ return dispPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetDisplayList --
+ *
+ * This procedure returns a pointer to the thread-local
+ * list of TkDisplays corresponding to the open displays.
+ *
+ * Results:
+ * The return value is a pointer to the first TkDisplay
+ * structure in thread-local-storage.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+TkDisplay *
+TkGetDisplayList()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->displayList;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMainInfoList --
+ *
+ * This procedure returns a pointer to the list of structures
+ * containing information about all main windows for the
+ * current thread.
+ *
+ * Results:
+ * The return value is a pointer to the first TkMainInfo
+ * structure in thread local storage.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+TkMainInfo *
+TkGetMainInfoList()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->mainWindowList;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkAllocWindow --
+ *
+ * This procedure creates and initializes a TkWindow structure.
+ *
+ * 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->internalBorderLeft = 0;
+ winPtr->wmInfoPtr = NULL;
+ winPtr->classProcsPtr = NULL;
+ winPtr->instanceData = NULL;
+ winPtr->privatePtr = NULL;
+ winPtr->internalBorderRight = 0;
+ winPtr->internalBorderTop = 0;
+ winPtr->internalBorderBottom = 0;
+ winPtr->minReqWidth = 0;
+ winPtr->minReqHeight = 0;
+
+ 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.). */
+ CONST 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++;
+
+ /*
+ * If this is an anonymous window (ie, it has no name), just return OK
+ * now.
+ */
+ if (winPtr->flags & TK_ANONYMOUS_WINDOW) {
+ return TCL_OK;
+ }
+
+ /*
+ * For non-anonymous windows, set up the window name.
+ */
+
+ 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
+ * the interp's result.
+ *
+ * Side effects:
+ * A new window structure is allocated locally; "interp" is
+ * associated with the window and registered for "send" commands
+ * under "baseName". BaseName may be extended with an instance
+ * number in the form "#2" if necessary to make it globally
+ * unique. Tk-related commands are bound into interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+TkCreateMainWindow(interp, screenName, baseName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ CONST 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;
+ ClientData clientData;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Panic if someone updated the TkWindow structure without
+ * also updating the Tk_FakeWin structure (or vice versa).
+ */
+
+ if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
+ panic("TkWindow and Tk_FakeWin are not the same size");
+ }
+
+ /*
+ * Create the basic TkWindow structure.
+ */
+
+ tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName,
+ screenName, /* flags */ 0);
+ 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);
+ TkEventInit();
+ TkBindInit(mainPtr);
+ TkFontPkgInit(mainPtr);
+ TkStylePkgInit(mainPtr);
+ mainPtr->tlFocusPtr = NULL;
+ mainPtr->displayFocusPtr = NULL;
+ mainPtr->optionRootPtr = NULL;
+ Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
+ mainPtr->strictMotif = 0;
+ if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
+ TCL_LINK_BOOLEAN) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+ mainPtr->nextPtr = tsdPtr->mainWindowList;
+ tsdPtr->mainWindowList = mainPtr;
+ winPtr->mainPtr = mainPtr;
+ hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);
+
+ /*
+ * We have just created another Tk application; increment the refcount
+ * 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->passMainWindow) {
+ clientData = (ClientData) tkwin;
+ } else {
+ clientData = (ClientData) NULL;
+ }
+ if (cmdPtr->cmdProc != NULL) {
+ Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc,
+ clientData, (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ } else {
+ Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
+ clientData, NULL);
+ }
+ if (isSafe) {
+ if (!(cmdPtr->isSafe)) {
+ Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
+ }
+ }
+ }
+
+ TkCreateMenuCmd(interp);
+
+ /*
+ * Set variables for the intepreter.
+ */
+
+ Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);
+
+ tsdPtr->numMainWindows++;
+ return tkwin;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateWindow --
+ *
+ * Create a new internal or top-level window as a child of an
+ * existing window.
+ *
+ * Results:
+ * The return value is a token for the new window. This
+ * is not the same as X's token for the window. If an error
+ * occurred in creating the window (e.g. no such display or
+ * screen), then an error message is left in the interp's result and
+ * NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X
+ * window is not initially created, but will be created
+ * the first time the window is mapped.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateWindow(interp, parent, name, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * the interp's result is assumed to be
+ * initialized by the caller. */
+ Tk_Window parent; /* Token for parent of new window. */
+ CONST char *name; /* Name for new window. Must be unique
+ * among parent's children. */
+ CONST 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,
+ /* flags */ 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateAnonymousWindow --
+ *
+ * Create a new internal or top-level window as a child of an
+ * existing window; this window will be anonymous (unnamed), so
+ * it will not be visible at the Tcl level.
+ *
+ * Results:
+ * The return value is a token for the new window. This
+ * is not the same as X's token for the window. If an error
+ * occurred in creating the window (e.g. no such display or
+ * screen), then an error message is left in the interp's result and
+ * NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X
+ * window is not initially created, but will be created
+ * the first time the window is mapped.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateAnonymousWindow(interp, parent, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * the interp's result is assumed to be
+ * initialized by the caller. */
+ Tk_Window parent; /* Token for parent of new window. */
+ CONST 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);
+ /*
+ * Add the anonymous window flag now, so that NameWindow will behave
+ * correctly.
+ */
+
+ winPtr->flags |= TK_ANONYMOUS_WINDOW;
+ if (NameWindow(interp, winPtr, parentPtr, (char *)NULL) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ }
+ return (Tk_Window) winPtr;
+ } else {
+ return CreateTopLevelWindow(interp, parent, (char *)NULL, screenName,
+ TK_ANONYMOUS_WINDOW);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 the interp's result and
+ * NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X
+ * window is not initially created, but will be created
+ * the first time the window is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * the interp's result is assumed to be
+ * initialized by the caller. */
+ Tk_Window tkwin; /* Token for any window in application
+ * that is to contain new window. */
+ CONST 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. */
+ CONST 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 = (int) (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, /* flags */ 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->flags & TK_ALREADY_DEAD) {
+ /*
+ * A destroy event binding caused the window to be destroyed
+ * again. Ignore the request.
+ */
+
+ 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 != NULL && winPtr->mainPtr->winPtr == winPtr) {
+ dispPtr->refCount--;
+ if (tsdPtr->mainWindowList == winPtr->mainPtr) {
+ tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr;
+ } else {
+ TkMainInfo *prevPtr;
+
+ for (prevPtr = tsdPtr->mainWindowList;
+ prevPtr->nextPtr != winPtr->mainPtr;
+ prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
+ }
+ tsdPtr->numMainWindows--;
+ }
+
+ /*
+ * Recursively destroy children.
+ */
+
+ dispPtr->destroyCount++;
+ 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 and the window is not an
+ * anonymous window, 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 && !(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
+ 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_WIN_MANAGED) {
+ TkWmDeadWindow(winPtr);
+ } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) {
+ TkWmRemoveFromColormapWindows(winPtr);
+ }
+ if (winPtr->window != None) {
+#if defined(MAC_TCL) || defined(MAC_OSX_TK) || defined(__WIN32__)
+ XDestroyWindow(winPtr->display, winPtr->window);
+#else
+ if ((winPtr->flags & TK_TOP_HIERARCHY)
+ || !(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);
+ winPtr->inputContext = NULL;
+ }
+#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));
+ /*
+ * The memory pointed to by pathName has been deallocated.
+ * Keep users from accessing it after the window has been
+ * destroyed by setting it to NULL.
+ */
+ winPtr->pathName = NULL;
+
+ /*
+ * Invalidate all objects referring to windows on this display.
+ */
+ dispPtr->deletionEpoch++;
+ }
+ 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);
+ TkDeleteAllImages(winPtr->mainPtr);
+ TkFontPkgFree(winPtr->mainPtr);
+ TkFocusFree(winPtr->mainPtr);
+ TkStylePkgFree(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 !defined(WIN32) && !defined(MAC_TCL) && defined(NOT_YET)
+ if (dispPtr->refCount <= 0) {
+ /*
+ * 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. -- jyl
+ */
+ /*
+ * Ideally this should be enabled, as unix Tk can use multiple
+ * displays. However, there are order issues still, as well
+ * as the handling of queued events and such that must be
+ * addressed before this can be enabled. The current cleanup
+ * works except for send event issues. -- hobbs 04/2002
+ */
+
+ TkDisplay *theDispPtr, *backDispPtr;
+
+ /*
+ * Splice this display out of the list of displays.
+ */
+
+ for (theDispPtr = tsdPtr->displayList, backDispPtr = NULL;
+ (theDispPtr != winPtr->dispPtr) &&
+ (theDispPtr != NULL);
+ theDispPtr = theDispPtr->nextPtr) {
+ backDispPtr = theDispPtr;
+ }
+ if (theDispPtr == NULL) {
+ panic("could not find display to close!");
+ }
+ if (backDispPtr == NULL) {
+ tsdPtr->displayList = theDispPtr->nextPtr;
+ } else {
+ backDispPtr->nextPtr = theDispPtr->nextPtr;
+ }
+
+ /*
+ * Calling XSync creates X server traffic, but addresses a
+ * focus issue on close (but not the send issue). -- hobbs
+ XSync(dispPtr->display, True);
+ */
+
+ /*
+ * Found and spliced it out, now actually do the cleanup.
+ */
+
+ TkCloseDisplay(dispPtr);
+ }
+#endif
+ }
+ }
+ Tcl_EventuallyFree((ClientData) winPtr, TCL_DYNAMIC);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ XEvent event;
+
+ if (winPtr->flags & TK_MAPPED) {
+ return;
+ }
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ /*
+ * 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;
+ Tk_ClassCreateProc *createProc;
+ int new;
+
+ if (winPtr->window != None) {
+ return;
+ }
+
+ if ((winPtr->parentPtr == NULL) || (winPtr->flags & TK_TOP_HIERARCHY)) {
+ parent = XRootWindow(winPtr->display, winPtr->screenNum);
+ } else {
+ if (winPtr->parentPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr);
+ }
+ parent = winPtr->parentPtr->window;
+ }
+
+ createProc = Tk_GetClassProc(winPtr->classProcsPtr, createProc);
+ if (createProc != NULL) {
+ winPtr->window = (*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;
+
+ if (!(winPtr->flags & TK_TOP_HIERARCHY)) {
+ /*
+ * 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_HIERARCHY|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_WIN_MANAGED) {
+ /*
+ * 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_HIERARCHY)) {
+ 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;
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+ 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_WIN_MANAGED)) {
+ 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. */
+ CONST char *className; /* New class for tkwin. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classUid = Tk_GetUid(className);
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ TkWmSetClass(winPtr);
+ }
+ TkOptionClassChanged(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetClassProcs --
+ *
+ * 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
+Tk_SetClassProcs(tkwin, procs, instanceData)
+ Tk_Window tkwin; /* Token for window to modify. */
+ Tk_ClassProcs *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 the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_NameToWindow(interp, pathName, tkwin)
+ Tcl_Interp *interp; /* Where to report errors. */
+ CONST 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;
+
+ if (tkwin == NULL) {
+ /*
+ * Either we're not really in Tk, or the main window was destroyed and
+ * we're on our way out of the application
+ */
+ Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
+ return NULL;
+ }
+
+ 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 = TkGetDisplayList(); ; 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST 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;
+
+ /*
+ * 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.
+ */
+
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_HIERARCHY)) {
+ 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_HIERARCHY)) {
+ 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) {
+ XWindowChanges changes;
+ unsigned int mask;
+
+ mask = CWStackMode;
+ changes.stack_mode = Above;
+ for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
+ otherPtr = otherPtr->nextPtr) {
+ if ((otherPtr->window != None)
+ && !(otherPtr->flags & (TK_TOP_HIERARCHY|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 the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_MainWindow(interp)
+ Tcl_Interp *interp; /* Interpreter that embodies the
+ * application. Used for error
+ * reporting also. */
+{
+ TkMainInfo *mainPtr;
+ ThreadSpecificData *tsdPtr;
+
+ if (interp == NULL) {
+ return NULL;
+ }
+#ifdef USE_TCL_STUBS
+ if (tclStubsPtr == NULL) {
+ return NULL;
+ }
+#endif
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
+ mainPtr = mainPtr->nextPtr) {
+ if (mainPtr->interp == interp) {
+ return (Tk_Window) mainPtr->winPtr;
+ }
+ }
+ Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_StrictMotif --
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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()
+{
+ ThreadSpecificData *tsdPtr;
+
+#ifdef USE_TCL_STUBS
+ if (tclStubsPtr == NULL) {
+ return 0;
+ }
+#endif
+
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->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 *dispPtr, *nextPtr;
+ Tcl_Interp *interp;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ while (tsdPtr->mainWindowList != NULL) {
+ /*
+ * We must protect the interpreter while deleting the window,
+ * because of <Destroy> bindings which could destroy the interpreter
+ * while the window is being deleted. This would leave frames on
+ * the call stack pointing at deleted memory, causing core dumps.
+ */
+
+ interp = tsdPtr->mainWindowList->winPtr->mainPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
+ Tcl_Release((ClientData) interp);
+ }
+
+ /*
+ * 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 (dispPtr = tsdPtr->displayList;
+ dispPtr != NULL;
+ dispPtr = tsdPtr->displayList) {
+ /*
+ * Now iterate over the current list of open displays, and first
+ * set the global pointer to NULL so we will be able to notice if
+ * any new displays got created during deletion of the current set.
+ * We must also do this to ensure that Tk_IdToWindow does not find
+ * the old display as it is being destroyed, when it wants to see
+ * if it needs to dispatch a message.
+ */
+
+ for (tsdPtr->displayList = NULL; dispPtr != NULL;
+ dispPtr = nextPtr) {
+ nextPtr = dispPtr->nextPtr;
+ TkCloseDisplay(dispPtr);
+ }
+ }
+
+ tsdPtr->numMainWindows = 0;
+ tsdPtr->mainWindowList = NULL;
+ tsdPtr->initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Init --
+ *
+ * This procedure is invoked to add Tk to an interpreter. It
+ * incorporates all of Tk's commands into the interpreter and
+ * creates the main window for a new Tk application. If the
+ * interpreter contains a variable "argv", this procedure
+ * extracts several arguments from that variable, uses them
+ * to configure the main window, and modifies argv to exclude
+ * the arguments (see the "wish" documentation for a list of
+ * the arguments that are extracted).
+ *
+ * Results:
+ * Returns a standard Tcl completion code and sets the interp's result
+ * if there is an error.
+ *
+ * Side effects:
+ * Depends on various initialization scripts that get invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 the interp's 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. Similarly,
+ * the selection command is blocked.
+ * - 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);
+}
+
+
+extern TkStubs tkStubs;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Initialize --
+ *
+ *
+ * Results:
+ * A standard Tcl result. Also leaves an error message in the interp's
+ * result if there was an error.
+ *
+ * Side effects:
+ * Depends on the initialization scripts that are invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Initialize(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ char *p;
+ int argc, code;
+ CONST char **argv;
+ char *args[20];
+ CONST char *argString = NULL;
+ Tcl_DString class;
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Ensure that we are getting the matching version of Tcl. This is
+ * really only an issue when Tk is loaded dynamically.
+ */
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Ensure that our obj-types are registered with the Tcl runtime.
+ */
+ TkRegisterObjTypes();
+
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Start by initializing all the static variables to default acceptable
+ * values so that no information is leaked from a previous run of this
+ * code.
+ */
+
+ Tcl_MutexLock(&windowMutex);
+ synchronize = 0;
+ name = NULL;
+ display = NULL;
+ geometry = NULL;
+ colormap = NULL;
+ use = NULL;
+ visual = NULL;
+ rest = 0;
+
+ /*
+ * We start by resetting the result because it might not be clean
+ */
+ Tcl_ResetResult(interp);
+
+ if (Tcl_IsSafe(interp)) {
+ /*
+ * Get the clearance to start Tk and the "argv" parameters
+ * from the master.
+ */
+ Tcl_DString ds;
+
+ /*
+ * Step 1 : find the master and construct the interp name
+ * (could be a function if new APIs were ok).
+ * We could also construct the path while walking, but there
+ * is no API to get the name of an interp either.
+ */
+ Tcl_Interp *master = interp;
+
+ while (1) {
+ master = Tcl_GetMaster(master);
+ if (master == NULL) {
+ Tcl_DStringFree(&ds);
+ Tcl_AppendResult(interp, "NULL master", (char *) NULL);
+ Tcl_MutexUnlock(&windowMutex);
+ return TCL_ERROR;
+ }
+ if (!Tcl_IsSafe(master)) {
+ /* Found the trusted master. */
+ break;
+ }
+ }
+ /*
+ * Construct the name (rewalk...)
+ */
+ if (Tcl_GetInterpPath(master, interp) != TCL_OK) {
+ Tcl_AppendResult(interp, "error in Tcl_GetInterpPath",
+ (char *) NULL);
+ Tcl_MutexUnlock(&windowMutex);
+ return TCL_ERROR;
+ }
+ /*
+ * Build the string to eval.
+ */
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppendElement(&ds, "::safe::TkInit");
+ Tcl_DStringAppendElement(&ds, Tcl_GetStringResult(master));
+
+ /*
+ * Step 2 : Eval in the master. The argument is the *reversed*
+ * interp path of the slave.
+ */
+
+ if (Tcl_Eval(master, Tcl_DStringValue(&ds)) != TCL_OK) {
+ /*
+ * We might want to transfer the error message or not.
+ * We don't. (no API to do it and maybe security reasons).
+ */
+ Tcl_DStringFree(&ds);
+ Tcl_AppendResult(interp,
+ "not allowed to start Tk by master's safe::TkInit",
+ (char *) NULL);
+ Tcl_MutexUnlock(&windowMutex);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
+ /*
+ * Use the master's result as argv.
+ * Note: We don't use the Obj interfaces to avoid dealing with
+ * cross interp refcounting and changing the code below.
+ */
+
+ argString = 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.
+ */
+
+ argString = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);
+ }
+ argv = NULL;
+ if (argString != NULL) {
+ char buffer[TCL_INTEGER_SPACE];
+
+ if (Tcl_SplitList(interp, argString, &argc, &argv) != TCL_OK) {
+ argError:
+ Tcl_AddErrorInfo(interp,
+ "\n (processing arguments in argv variable)");
+ Tcl_MutexUnlock(&windowMutex);
+ return TCL_ERROR;
+ }
+ if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
+ argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS)
+ != TCL_OK) {
+ ckfree((char *) argv);
+ goto argError;
+ }
+ 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 (*p) {
+ Tcl_UtfToTitle(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 (tsdPtr->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;
+ }
+ Tcl_MutexUnlock(&windowMutex);
+
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Provide Tk and its stub table.
+ */
+
+ code = Tcl_PkgProvideEx(interp, "Tk", TK_VERSION, (ClientData) &tkStubs);
+ if (code != TCL_OK) {
+ goto done;
+ } else {
+ /*
+ * If we were able to provide ourselves as a package, then set
+ * the main loop procedure in Tcl to our main loop proc. This
+ * will cause tclsh to be event-aware when Tk is dynamically
+ * loaded. This will have no effect in wish, which already is
+ * prepared to run the event loop.
+ */
+
+ Tcl_SetMainLoop(Tk_MainLoop);
+ }
+
+#ifdef Tk_InitStubs
+#undef Tk_InitStubs
+#endif
+
+ Tk_InitStubs(interp, TK_VERSION, 1);
+
+ /*
+ * Invoke platform-specific initialization.
+ */
+
+ code = TkpInit(interp);
+
+ done:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return code;
+}
diff --git a/tcl/library/bgerror.tcl b/tcl/library/bgerror.tcl
new file mode 100644
index 00000000000..1407b55c4bf
--- /dev/null
+++ b/tcl/library/bgerror.tcl
@@ -0,0 +1,292 @@
+# bgerror.tcl --
+#
+# Implementation 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, and possible do something more interesting with that
+# trace (like save it to a log). This is adapted from work done by
+# Donal K. Fellows.
+#
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+# $Id$
+
+namespace eval ::tk {
+ namespace eval dialog {
+ namespace eval error {
+ namespace import ::tk::msgcat::*
+ namespace export bgerror
+ option add *ErrorDialog.function.text [mc "Save To Log"] \
+ widgetDefault
+ option add *ErrorDialog.function.command [namespace code SaveToLog]
+ }
+ }
+}
+
+proc ::tk::dialog::error::Return {} {
+ variable button
+
+ .bgerrorDialog.ok configure -state active -relief sunken
+ update idletasks
+ after 100
+ set button 0
+}
+
+proc ::tk::dialog::error::Details {} {
+ set w .bgerrorDialog
+ set caption [option get $w.function text {}]
+ set command [option get $w.function command {}]
+ if { ($caption eq "") || ($command eq "") } {
+ grid forget $w.function
+ }
+ $w.function configure -text $caption -command \
+ "$command [list [.bgerrorDialog.top.info.text get 1.0 end]]"
+ grid $w.top.info - -sticky nsew -padx 3m -pady 3m
+}
+
+proc ::tk::dialog::error::SaveToLog {text} {
+ if { $::tcl_platform(platform) eq "windows" } {
+ set allFiles *.*
+ } else {
+ set allFiles *
+ }
+ set types [list \
+ [list [mc "Log Files"] .log] \
+ [list [mc "Text Files"] .txt] \
+ [list [mc "All Files"] $allFiles] \
+ ]
+ set filename [tk_getSaveFile -title [mc "Select Log File"] \
+ -filetypes $types -defaultextension .log -parent .bgerrorDialog]
+ if {![string length $filename]} {
+ return
+ }
+ set f [open $filename w]
+ puts -nonewline $f $text
+ close $f
+}
+
+proc ::tk::dialog::error::Destroy {w} {
+ if {$w eq ".bgerrorDialog"} {
+ variable button
+ set button -1
+ }
+}
+
+# ::tk::dialog::error::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 ::tk::dialog::error::bgerror err {
+ global errorInfo tcl_platform
+ variable button
+
+ set info $errorInfo
+
+ 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) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
+ set ok [mc Ok]
+ set messageFont system
+ set textRelief flat
+ set textHilight 0
+ } else {
+ set ok [mc OK]
+ set messageFont {Times -18}
+ set textRelief sunken
+ set textHilight 1
+ }
+
+
+ # Truncate the message if it is too wide (longer than 30 characacters) or
+ # too tall (more than 4 newlines). Truncation occurs at the first point at
+ # which one of those conditions is met.
+ set displayedErr ""
+ set lines 0
+ foreach line [split $err \n] {
+ if { [string length $line] > 30 } {
+ append displayedErr "[string range $line 0 29]..."
+ break
+ }
+ if { $lines > 4 } {
+ append displayedErr "..."
+ break
+ } else {
+ append displayedErr "${line}\n"
+ }
+ incr lines
+ }
+
+ set w .bgerrorDialog
+ set title [mc "Application Error"]
+ set text [mc {Error: %1$s} $err]
+ set buttons [list ok $ok dismiss [mc "Skip Messages"] \
+ function [mc "Details >>"]]
+
+ # 1. Create the top-level window and divide it into top
+ # and bottom parts.
+
+ catch {destroy .bgerrorDialog}
+ toplevel .bgerrorDialog -class ErrorDialog
+ wm title .bgerrorDialog $title
+ wm iconname .bgerrorDialog ErrorDialog
+ wm protocol .bgerrorDialog WM_DELETE_WINDOW { }
+
+ if {($tcl_platform(platform) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
+ ::tk::unsupported::MacWindowStyle style .bgerrorDialog dBoxProc
+ }
+
+ frame .bgerrorDialog.bot
+ frame .bgerrorDialog.top
+ if {[tk windowingsystem] eq "x11"} {
+ .bgerrorDialog.bot configure -relief raised -bd 1
+ .bgerrorDialog.top configure -relief raised -bd 1
+ }
+ pack .bgerrorDialog.bot -side bottom -fill both
+ pack .bgerrorDialog.top -side top -fill both -expand 1
+
+ set W [frame $w.top.info]
+ text $W.text \
+ -bd 2 \
+ -yscrollcommand [list $W.scroll set]\
+ -setgrid true \
+ -width 40 \
+ -height 10 \
+ -state normal \
+ -relief $textRelief \
+ -highlightthickness $textHilight \
+ -wrap char
+
+ scrollbar $W.scroll -relief sunken -command [list $W.text yview]
+ pack $W.scroll -side right -fill y
+ pack $W.text -side left -expand yes -fill both
+ $W.text insert 0.0 "$err\n$info"
+ $W.text mark set insert 0.0
+ bind $W.text <ButtonPress-1> { focus %W }
+ $W.text configure -state disabled
+
+ # 2. Fill the top part with bitmap and message
+
+ # Max-width of message is the width of the screen...
+ set wrapwidth [winfo screenwidth .bgerrorDialog]
+ # ...minus the width of the icon, padding and a fudge factor for
+ # the window manager decorations and aesthetics.
+ set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]
+ label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
+ -wraplength $wrapwidth
+ if {($tcl_platform(platform) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
+ # On the Macintosh, use the stop bitmap
+ label .bgerrorDialog.bitmap -bitmap stop
+ } else {
+ # On other platforms, make the error icon
+ canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0
+ .bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
+ .bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4
+ .bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4
+ }
+ grid .bgerrorDialog.bitmap .bgerrorDialog.msg \
+ -in .bgerrorDialog.top \
+ -row 0 \
+ -padx 3m \
+ -pady 3m
+ grid configure .bgerrorDialog.msg -sticky nsw -padx {0 3m}
+ grid rowconfigure .bgerrorDialog.top 1 -weight 1
+ grid columnconfigure .bgerrorDialog.top 1 -weight 1
+
+ # 3. Create a row of buttons at the bottom of the dialog.
+
+ set i 0
+ foreach {name caption} $buttons {
+ button .bgerrorDialog.$name \
+ -text $caption \
+ -default normal \
+ -command [namespace code "set button $i"]
+ grid .bgerrorDialog.$name \
+ -in .bgerrorDialog.bot \
+ -column $i \
+ -row 0 \
+ -sticky ew \
+ -padx 10
+ grid columnconfigure .bgerrorDialog.bot $i -weight 1
+ # We boost the size of some Mac buttons for l&f
+ if {($tcl_platform(platform) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
+ if {($name eq "ok") || ($name eq "dismiss")} {
+ grid columnconfigure .bgerrorDialog.bot $i -minsize 79
+ }
+ }
+ incr i
+ }
+ # The "OK" button is the default for this dialog.
+ .bgerrorDialog.ok configure -default active
+
+ bind .bgerrorDialog <Return> [namespace code Return]
+ bind .bgerrorDialog <Destroy> [namespace code [list Destroy %W]]
+ .bgerrorDialog.function configure -command [namespace code Details]
+
+ # 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 .bgerrorDialog
+ update idletasks
+ set parent [winfo parent .bgerrorDialog]
+ set width [winfo reqwidth .bgerrorDialog]
+ set height [winfo reqheight .bgerrorDialog]
+ set x [expr {([winfo screenwidth .bgerrorDialog] - $width )/2 - \
+ [winfo vrootx $parent]}]
+ set y [expr {([winfo screenheight .bgerrorDialog] - $height)/2 - \
+ [winfo vrooty $parent]}]
+ .bgerrorDialog configure -width $width
+ wm geometry .bgerrorDialog +$x+$y
+ wm deiconify .bgerrorDialog
+
+ # 7. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current .bgerrorDialog]
+ if {$oldGrab != ""} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab .bgerrorDialog
+ focus .bgerrorDialog.ok
+
+ # 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.
+
+ vwait [namespace which -variable button]
+ set copy $button; # Save a copy...
+ catch {focus $oldFocus}
+ catch {destroy .bgerrorDialog}
+ if {$oldGrab ne ""} {
+ if {$grabStatus eq "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+
+ if {$copy == 1} {
+ return -code break
+ }
+}
+
+namespace eval :: {
+ # Fool the indexer
+ proc bgerror err {}
+ rename bgerror {}
+ namespace import ::tk::dialog::error::bgerror
+}
diff --git a/tcl/library/button.tcl b/tcl/library/button.tcl
new file mode 100644
index 00000000000..d92facfa902
--- /dev/null
+++ b/tcl/library/button.tcl
@@ -0,0 +1,639 @@
+# button.tcl --
+#
+# This file defines the default bindings for Tk label, button,
+# checkbutton, and radiobutton widgets and provides procedures
+# that help in implementing those bindings.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 2002 ActiveState Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for buttons.
+#-------------------------------------------------------------------------
+
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ bind Radiobutton <Enter> {
+ tk::ButtonEnter %W
+ }
+ bind Radiobutton <1> {
+ tk::ButtonDown %W
+ }
+ bind Radiobutton <ButtonRelease-1> {
+ tk::ButtonUp %W
+ }
+ bind Checkbutton <Enter> {
+ tk::ButtonEnter %W
+ }
+ bind Checkbutton <1> {
+ tk::ButtonDown %W
+ }
+ bind Checkbutton <ButtonRelease-1> {
+ tk::ButtonUp %W
+ }
+}
+if {[string equal "windows" $tcl_platform(platform)]} {
+ bind Checkbutton <equal> {
+ tk::CheckRadioInvoke %W select
+ }
+ bind Checkbutton <plus> {
+ tk::CheckRadioInvoke %W select
+ }
+ bind Checkbutton <minus> {
+ tk::CheckRadioInvoke %W deselect
+ }
+ bind Checkbutton <1> {
+ tk::CheckRadioDown %W
+ }
+ bind Checkbutton <ButtonRelease-1> {
+ tk::ButtonUp %W
+ }
+ bind Checkbutton <Enter> {
+ tk::CheckRadioEnter %W
+ }
+
+ bind Radiobutton <1> {
+ tk::CheckRadioDown %W
+ }
+ bind Radiobutton <ButtonRelease-1> {
+ tk::ButtonUp %W
+ }
+ bind Radiobutton <Enter> {
+ tk::CheckRadioEnter %W
+ }
+}
+if {[string equal "x11" [tk windowingsystem]]} {
+ bind Checkbutton <Return> {
+ if {!$tk_strictMotif} {
+ tk::CheckRadioInvoke %W
+ }
+ }
+ bind Radiobutton <Return> {
+ if {!$tk_strictMotif} {
+ tk::CheckRadioInvoke %W
+ }
+ }
+ bind Checkbutton <1> {
+ tk::CheckRadioInvoke %W
+ }
+ bind Radiobutton <1> {
+ tk::CheckRadioInvoke %W
+ }
+ bind Checkbutton <Enter> {
+ tk::ButtonEnter %W
+ }
+ bind Radiobutton <Enter> {
+ tk::ButtonEnter %W
+ }
+}
+
+bind Button <space> {
+ tk::ButtonInvoke %W
+}
+bind Checkbutton <space> {
+ tk::CheckRadioInvoke %W
+}
+bind Radiobutton <space> {
+ tk::CheckRadioInvoke %W
+}
+
+bind Button <FocusIn> {}
+bind Button <Enter> {
+ tk::ButtonEnter %W
+}
+bind Button <Leave> {
+ tk::ButtonLeave %W
+}
+bind Button <1> {
+ tk::ButtonDown %W
+}
+bind Button <ButtonRelease-1> {
+ tk::ButtonUp %W
+}
+
+bind Checkbutton <FocusIn> {}
+bind Checkbutton <Leave> {
+ tk::ButtonLeave %W
+}
+
+bind Radiobutton <FocusIn> {}
+bind Radiobutton <Leave> {
+ tk::ButtonLeave %W
+}
+
+if {[string equal "windows" $tcl_platform(platform)]} {
+
+#########################
+# Windows implementation
+#########################
+
+# ::tk::ButtonEnter --
+# 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 ::tk::ButtonEnter w {
+ variable ::tk::Priv
+ if {[$w cget -state] ne "disabled"} {
+
+ # If the mouse button is down, set the relief to sunken on entry.
+ # Overwise, if there's an -overrelief value, set the relief to that.
+
+ set Priv($w,relief) [$w cget -relief]
+ if {$Priv(buttonWindow) eq $w} {
+ $w configure -relief sunken -state active
+ set Priv($w,prelief) sunken
+ } elseif {[set over [$w cget -overrelief]] ne ""} {
+ $w configure -relief $over
+ set Priv($w,prelief) $over
+ }
+ }
+ set Priv(window) $w
+}
+
+# ::tk::ButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to inactive.
+# Restore any modified relief too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc ::tk::ButtonLeave w {
+ variable ::tk::Priv
+ if {[$w cget -state] ne "disabled"} {
+ $w configure -state normal
+ }
+
+ # Restore the original button relief if it was changed by Tk.
+ # That is signaled by the existence of Priv($w,prelief).
+
+ if {[info exists Priv($w,relief)]} {
+ if {[info exists Priv($w,prelief)] && \
+ $Priv($w,prelief) eq [$w cget -relief]} {
+ $w configure -relief $Priv($w,relief)
+ }
+ unset -nocomplain Priv($w,relief) Priv($w,prelief)
+ }
+
+ set Priv(window) ""
+}
+
+# ::tk::ButtonDown --
+# 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 ::tk::ButtonDown w {
+ variable ::tk::Priv
+
+ # Only save the button's relief if it does not yet exist. If there
+ # is an overrelief setting, Priv($w,relief) will already have been set,
+ # and the current value of the -relief option will be incorrect.
+
+ if {![info exists Priv($w,relief)]} {
+ set Priv($w,relief) [$w cget -relief]
+ }
+
+ if {[$w cget -state] ne "disabled"} {
+ set Priv(buttonWindow) $w
+ $w configure -relief sunken -state active
+ set Priv($w,prelief) sunken
+
+ # If this button has a repeatdelay set up, get it going with an after
+ after cancel $Priv(afterId)
+ set delay [$w cget -repeatdelay]
+ set Priv(repeated) 0
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
+ }
+ }
+}
+
+# ::tk::ButtonUp --
+# 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 ::tk::ButtonUp w {
+ variable ::tk::Priv
+ if {$Priv(buttonWindow) eq $w} {
+ set Priv(buttonWindow) ""
+
+ # Restore the button's relief if it was cached.
+
+ if {[info exists Priv($w,relief)]} {
+ if {[info exists Priv($w,prelief)] && \
+ $Priv($w,prelief) eq [$w cget -relief]} {
+ $w configure -relief $Priv($w,relief)
+ }
+ unset -nocomplain Priv($w,relief) Priv($w,prelief)
+ }
+
+ # Clean up the after event from the auto-repeater
+ after cancel $Priv(afterId)
+
+ if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
+ $w configure -state normal
+
+ # Only invoke the command if it wasn't already invoked by the
+ # auto-repeater functionality
+ if { $Priv(repeated) == 0 } {
+ uplevel #0 [list $w invoke]
+ }
+ }
+ }
+}
+
+# ::tk::CheckRadioEnter --
+# 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 ::tk::CheckRadioEnter w {
+ variable ::tk::Priv
+ if {[$w cget -state] ne "disabled"} {
+ if {$Priv(buttonWindow) eq $w} {
+ $w configure -state active
+ }
+ if {[set over [$w cget -overrelief]] ne ""} {
+ set Priv($w,relief) [$w cget -relief]
+ set Priv($w,prelief) $over
+ $w configure -relief $over
+ }
+ }
+ set Priv(window) $w
+}
+
+# ::tk::CheckRadioDown --
+# 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 ::tk::CheckRadioDown w {
+ variable ::tk::Priv
+ if {![info exists Priv($w,relief)]} {
+ set Priv($w,relief) [$w cget -relief]
+ }
+ if {[$w cget -state] ne "disabled"} {
+ set Priv(buttonWindow) $w
+ set Priv(repeated) 0
+ $w configure -state active
+ }
+}
+
+}
+
+if {[string equal "x11" [tk windowingsystem]]} {
+
+#####################
+# Unix implementation
+#####################
+
+# ::tk::ButtonEnter --
+# 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 ::tk::ButtonEnter {w} {
+ variable ::tk::Priv
+ if {[$w cget -state] ne "disabled"} {
+ # On unix the state is active just with mouse-over
+ $w configure -state active
+
+ # If the mouse button is down, set the relief to sunken on entry.
+ # Overwise, if there's an -overrelief value, set the relief to that.
+
+ set Priv($w,relief) [$w cget -relief]
+ if {$Priv(buttonWindow) eq $w} {
+ $w configure -relief sunken
+ set Priv($w,prelief) sunken
+ } elseif {[set over [$w cget -overrelief]] ne ""} {
+ $w configure -relief $over
+ set Priv($w,prelief) $over
+ }
+ }
+ set Priv(window) $w
+}
+
+# ::tk::ButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to inactive.
+# Restore any modified relief too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc ::tk::ButtonLeave w {
+ variable ::tk::Priv
+ if {[$w cget -state] ne "disabled"} {
+ $w configure -state normal
+ }
+
+ # Restore the original button relief if it was changed by Tk.
+ # That is signaled by the existence of Priv($w,prelief).
+
+ if {[info exists Priv($w,relief)]} {
+ if {[info exists Priv($w,prelief)] && \
+ $Priv($w,prelief) eq [$w cget -relief]} {
+ $w configure -relief $Priv($w,relief)
+ }
+ unset -nocomplain Priv($w,relief) Priv($w,prelief)
+ }
+
+ set Priv(window) ""
+}
+
+# ::tk::ButtonDown --
+# 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 ::tk::ButtonDown w {
+ variable ::tk::Priv
+
+ # Only save the button's relief if it does not yet exist. If there
+ # is an overrelief setting, Priv($w,relief) will already have been set,
+ # and the current value of the -relief option will be incorrect.
+
+ if {![info exists Priv($w,relief)]} {
+ set Priv($w,relief) [$w cget -relief]
+ }
+
+ if {[$w cget -state] ne "disabled"} {
+ set Priv(buttonWindow) $w
+ $w configure -relief sunken
+ set Priv($w,prelief) sunken
+
+ # If this button has a repeatdelay set up, get it going with an after
+ after cancel $Priv(afterId)
+ set delay [$w cget -repeatdelay]
+ set Priv(repeated) 0
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
+ }
+ }
+}
+
+# ::tk::ButtonUp --
+# 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 ::tk::ButtonUp w {
+ variable ::tk::Priv
+ if {[string equal $w $Priv(buttonWindow)]} {
+ set Priv(buttonWindow) ""
+
+ # Restore the button's relief if it was cached.
+
+ if {[info exists Priv($w,relief)]} {
+ if {[info exists Priv($w,prelief)] && \
+ $Priv($w,prelief) eq [$w cget -relief]} {
+ $w configure -relief $Priv($w,relief)
+ }
+ unset -nocomplain Priv($w,relief) Priv($w,prelief)
+ }
+
+ # Clean up the after event from the auto-repeater
+ after cancel $Priv(afterId)
+
+ if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
+ # Only invoke the command if it wasn't already invoked by the
+ # auto-repeater functionality
+ if { $Priv(repeated) == 0 } {
+ uplevel #0 [list $w invoke]
+ }
+ }
+ }
+}
+
+}
+
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+
+####################
+# Mac implementation
+####################
+
+# ::tk::ButtonEnter --
+# 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 ::tk::ButtonEnter {w} {
+ variable ::tk::Priv
+ if {[$w cget -state] ne "disabled"} {
+
+ # If there's an -overrelief value, set the relief to that.
+
+ if {$Priv(buttonWindow) eq $w} {
+ $w configure -state active
+ } elseif {[set over [$w cget -overrelief]] ne ""} {
+ set Priv($w,relief) [$w cget -relief]
+ set Priv($w,prelief) $over
+ $w configure -relief $over
+ }
+ }
+ set Priv(window) $w
+}
+
+# ::tk::ButtonLeave --
+# 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 (Priv(buttonWindow) == $w), restore the relief of the
+# button too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc ::tk::ButtonLeave w {
+ variable ::tk::Priv
+ if {$w eq $Priv(buttonWindow)} {
+ $w configure -state normal
+ }
+
+ # Restore the original button relief if it was changed by Tk.
+ # That is signaled by the existence of Priv($w,prelief).
+
+ if {[info exists Priv($w,relief)]} {
+ if {[info exists Priv($w,prelief)] && \
+ $Priv($w,prelief) eq [$w cget -relief]} {
+ $w configure -relief $Priv($w,relief)
+ }
+ unset -nocomplain Priv($w,relief) Priv($w,prelief)
+ }
+
+ set Priv(window) ""
+}
+
+# ::tk::ButtonDown --
+# 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 ::tk::ButtonDown w {
+ variable ::tk::Priv
+
+ if {[$w cget -state] ne "disabled"} {
+ set Priv(buttonWindow) $w
+ $w configure -state active
+
+ # If this button has a repeatdelay set up, get it going with an after
+ after cancel $Priv(afterId)
+ set Priv(repeated) 0
+ if { ![catch {$w cget -repeatdelay} delay] } {
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
+ }
+ }
+ }
+}
+
+# ::tk::ButtonUp --
+# 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 ::tk::ButtonUp w {
+ variable ::tk::Priv
+ if {$Priv(buttonWindow) eq $w} {
+ set Priv(buttonWindow) ""
+ $w configure -state normal
+
+ # Restore the button's relief if it was cached.
+
+ if {[info exists Priv($w,relief)]} {
+ if {[info exists Priv($w,prelief)] && \
+ $Priv($w,prelief) eq [$w cget -relief]} {
+ $w configure -relief $Priv($w,relief)
+ }
+ unset -nocomplain Priv($w,relief) Priv($w,prelief)
+ }
+
+ # Clean up the after event from the auto-repeater
+ after cancel $Priv(afterId)
+
+ if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
+ # Only invoke the command if it wasn't already invoked by the
+ # auto-repeater functionality
+ if { $Priv(repeated) == 0 } {
+ uplevel #0 [list $w invoke]
+ }
+ }
+ }
+}
+
+}
+
+##################
+# Shared routines
+##################
+
+# ::tk::ButtonInvoke --
+# 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 ::tk::ButtonInvoke w {
+ if {[$w cget -state] ne "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]
+ }
+}
+
+# ::tk::ButtonAutoInvoke --
+#
+# Invoke an auto-repeating button, and set it up to continue to repeat.
+#
+# Arguments:
+# w button to invoke.
+#
+# Results:
+# None.
+#
+# Side effects:
+# May create an after event to call ::tk::ButtonAutoInvoke.
+
+proc ::tk::ButtonAutoInvoke {w} {
+ variable ::tk::Priv
+ after cancel $Priv(afterId)
+ set delay [$w cget -repeatinterval]
+ if {$Priv(window) eq $w} {
+ incr Priv(repeated)
+ uplevel #0 [list $w invoke]
+ }
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
+ }
+}
+
+# ::tk::CheckRadioInvoke --
+# 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 ::tk::CheckRadioInvoke {w {cmd invoke}} {
+ if {[$w cget -state] ne "disabled"} {
+ uplevel #0 [list $w $cmd]
+ }
+}
diff --git a/tcl/library/choosedir.tcl b/tcl/library/choosedir.tcl
new file mode 100644
index 00000000000..12fd7447009
--- /dev/null
+++ b/tcl/library/choosedir.tcl
@@ -0,0 +1,283 @@
+# choosedir.tcl --
+#
+# Choose directory dialog implementation for Unix/Mac.
+#
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+# Make sure the tk::dialog namespace, in which all dialogs should live, exists
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::file {}
+
+# Make the chooseDir namespace inside the dialog namespace
+namespace eval ::tk::dialog::file::chooseDir {
+ namespace import ::tk::msgcat::*
+}
+
+# ::tk::dialog::file::chooseDir:: --
+#
+# Implements the TK directory selection dialog.
+#
+# Arguments:
+# args Options parsed by the procedure.
+#
+proc ::tk::dialog::file::chooseDir:: {args} {
+ variable ::tk::Priv
+ set dataName __tk_choosedir
+ upvar ::tk::dialog::file::$dataName data
+ ::tk::dialog::file::chooseDir::Config $dataName $args
+
+ if {[string equal $data(-parent) .]} {
+ set w .$dataName
+ } else {
+ set w $data(-parent).$dataName
+ }
+
+ # (re)create the dialog box if necessary
+ #
+ if {![winfo exists $w]} {
+ ::tk::dialog::file::Create $w TkChooseDir
+ } elseif {[string compare [winfo class $w] TkChooseDir]} {
+ destroy $w
+ ::tk::dialog::file::Create $w TkChooseDir
+ } 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(okBtn) $w.f2.ok
+ set data(cancelBtn) $w.f3.cancel
+ }
+
+ # Dialog boxes should be transient with respect to their parent,
+ # so that they will always stay on top of their parent window. However,
+ # some window managers will create the window as withdrawn if the parent
+ # window is withdrawn or iconified. Combined with the grab we put on the
+ # window, this can hang the entire application. Therefore we only make
+ # the dialog transient if the parent is viewable.
+
+ if {[winfo viewable [winfo toplevel $data(-parent)]] } {
+ wm transient $w $data(-parent)
+ }
+
+ trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
+ $data(dirMenuBtn) configure \
+ -textvariable ::tk::dialog::file::${dataName}(selectPath)
+
+ set data(filter) "*"
+ set data(previousEntryText) ""
+ ::tk::dialog::file::UpdateWhenIdle $w
+
+ # Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ ::tk::PlaceWindow $w widget $data(-parent)
+ wm title $w $data(-title)
+
+ # Set a grab and claim the focus too.
+
+ ::tk::SetFocusGrab $w $data(ent)
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $data(selectPath)
+ $data(ent) selection range 0 end
+ $data(ent) icursor end
+
+ # Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ vwait ::tk::Priv(selectFilePath)
+
+ ::tk::RestoreFocusGrab $w $data(ent) withdraw
+
+ # Cleanup traces on selectPath variable
+ #
+
+ foreach trace [trace vinfo data(selectPath)] {
+ trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
+ }
+ $data(dirMenuBtn) configure -textvariable {}
+
+ # Return value to user
+ #
+
+ return $Priv(selectFilePath)
+}
+
+# ::tk::dialog::file::chooseDir::Config --
+#
+# Configures the Tk choosedir dialog according to the argument list
+#
+proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
+ upvar ::tk::dialog::file::$dataName data
+
+ # 0: Delete all variable that were set on data(selectPath) the
+ # last time the file dialog is used. The traces may cause troubles
+ # if the dialog is now used with a different -parent option.
+ #
+ foreach trace [trace vinfo data(selectPath)] {
+ trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
+ }
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-mustexist "" "" 0}
+ {-initialdir "" "" ""}
+ {-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]
+ }
+
+ # 3: parse the arguments
+ #
+ tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
+
+ if {$data(-title) == ""} {
+ set data(-title) "[mc "Choose Directory"]"
+ }
+
+ # Stub out the -multiple value for the dialog; it doesn't make sense for
+ # choose directory dialogs, but we have to have something there because we
+ # share so much code with the file dialogs.
+ set data(-multiple) 0
+
+ # 4: set the default directory and selection according to the -initial
+ # settings
+ #
+ if {$data(-initialdir) != ""} {
+ # Ensure that initialdir is an absolute path name.
+ if {[file isdirectory $data(-initialdir)]} {
+ set old [pwd]
+ cd $data(-initialdir)
+ set data(selectPath) [pwd]
+ cd $old
+ } else {
+ set data(selectPath) [pwd]
+ }
+ }
+
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+}
+
+# Gets called when user presses Return in the "Selection" entry or presses OK.
+#
+proc ::tk::dialog::file::chooseDir::OkCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ # This is the brains behind selecting non-existant directories. Here's
+ # the flowchart:
+ # 1. If the icon list has a selection, join it with the current dir,
+ # and return that value.
+ # 1a. If the icon list does not have a selection ...
+ # 2. If the entry is empty, do nothing.
+ # 3. If the entry contains an invalid directory, then...
+ # 3a. If the value is the same as last time through here, end dialog.
+ # 3b. If the value is different than last time, save it and return.
+ # 4. If entry contains a valid directory, then...
+ # 4a. If the value is the same as the current directory, end dialog.
+ # 4b. If the value is different from the current directory, change to
+ # that directory.
+
+ set selection [tk::IconList_Curselection $data(icons)]
+ if { [llength $selection] != 0 } {
+ set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]]
+ set iconText [file join $data(selectPath) $iconText]
+ ::tk::dialog::file::chooseDir::Done $w $iconText
+ } else {
+ set text [$data(ent) get]
+ if { [string equal $text ""] } {
+ return
+ }
+ set text [eval file join [file split [string trim $text]]]
+ if { ![file exists $text] || ![file isdirectory $text] } {
+ # Entry contains an invalid directory. If it's the same as the
+ # last time they came through here, reset the saved value and end
+ # the dialog. Otherwise, save the value (so we can do this test
+ # next time).
+ if { [string equal $text $data(previousEntryText)] } {
+ set data(previousEntryText) ""
+ ::tk::dialog::file::chooseDir::Done $w $text
+ } else {
+ set data(previousEntryText) $text
+ }
+ } else {
+ # Entry contains a valid directory. If it is the same as the
+ # current directory, end the dialog. Otherwise, change to that
+ # directory.
+ if { [string equal $text $data(selectPath)] } {
+ ::tk::dialog::file::chooseDir::Done $w $text
+ } else {
+ set data(selectPath) $text
+ }
+ }
+ }
+ return
+}
+
+proc ::tk::dialog::file::chooseDir::DblClick {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+ set selection [tk::IconList_Curselection $data(icons)]
+ if { [llength $selection] != 0 } {
+ set filenameFragment \
+ [tk::IconList_Get $data(icons) [lindex $selection 0]]
+ set file $data(selectPath)
+ if {[file isdirectory $file]} {
+ ::tk::dialog::file::ListInvoke $w [list $filenameFragment]
+ return
+ }
+ }
+}
+
+# Gets called when user browses the IconList widget (dragging mouse, arrow
+# keys, etc)
+#
+proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {[string equal $text ""]} {
+ return
+ }
+
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $file
+}
+
+# ::tk::dialog::file::chooseDir::Done --
+#
+# Gets called when user has input a valid filename. Pops up a
+# dialog box to confirm selection when necessary. Sets the
+# Priv(selectFilePath) variable, which will break the "vwait"
+# loop in tk_chooseDirectory and return the selected filename to the
+# script that calls tk_getOpenFile or tk_getSaveFile
+#
+proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+ variable ::tk::Priv
+
+ if {[string equal $selectFilePath ""]} {
+ set selectFilePath $data(selectPath)
+ }
+ if { $data(-mustexist) } {
+ if { ![file exists $selectFilePath] || \
+ ![file isdir $selectFilePath] } {
+ return
+ }
+ }
+ set Priv(selectFilePath) $selectFilePath
+}
diff --git a/tcl/library/clrpick.tcl b/tcl/library/clrpick.tcl
new file mode 100644
index 00000000000..da174863be9
--- /dev/null
+++ b/tcl/library/clrpick.tcl
@@ -0,0 +1,697 @@
+# clrpick.tcl --
+#
+# Color selection dialog for platforms that do not support a
+# standard color selection dialog.
+#
+# RCS: @(#) $Id$
+#
+# 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.
+#
+
+# Make sure namespaces exist
+namespace eval ::tk {}
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::color {
+ namespace import ::tk::msgcat::*
+}
+
+# ::tk::dialog::color:: --
+#
+# 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 ::tk::dialog::color:: {args} {
+ variable ::tk::Priv
+ set dataName __tk__color
+ upvar ::tk::dialog::color::$dataName data
+ set w .$dataName
+
+ # 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) 16
+
+ # 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) 160
+
+ # 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
+
+ Config $dataName $args
+ InitValues $dataName
+
+ set sc [winfo screen $data(-parent)]
+ set winExists [winfo exists $w]
+ if {!$winExists || [string compare $sc [winfo screen $w]]} {
+ if {$winExists} {
+ destroy $w
+ }
+ toplevel $w -class TkColorDialog -screen $sc
+ BuildDialog $w
+ }
+
+ # Dialog boxes should be transient with respect to their parent,
+ # so that they will always stay on top of their parent window. However,
+ # some window managers will create the window as withdrawn if the parent
+ # window is withdrawn or iconified. Combined with the grab we put on the
+ # window, this can hang the entire application. Therefore we only make
+ # the dialog transient if the parent is viewable.
+
+ if {[winfo viewable [winfo toplevel $data(-parent)]] } {
+ 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.
+
+ ::tk::PlaceWindow $w widget $data(-parent)
+ wm title $w $data(-title)
+
+ # 6. Set a grab and claim the focus too.
+
+ ::tk::SetFocusGrab $w $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.
+
+ vwait ::tk::Priv(selectColor)
+ ::tk::RestoreFocusGrab $w $data(okBtn)
+ unset data
+
+ return $Priv(selectColor)
+}
+
+# ::tk::dialog::color::InitValues --
+#
+# Get called during initialization or when user resets NUM_COLORBARS
+#
+proc ::tk::dialog::color::InitValues {dataName} {
+ upvar ::tk::dialog::color::$dataName 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}]
+}
+
+# ::tk::dialog::color::Config --
+#
+# Parses the command line arguments to tk_chooseColor
+#
+proc ::tk::dialog::color::Config {dataName argList} {
+ variable ::tk::Priv
+ upvar ::tk::dialog::color::$dataName data
+
+ # 1: the configuration specs
+ #
+ if {[info exists Priv(selectColor)] && \
+ [string compare $Priv(selectColor) ""]} {
+ set defaultColor $Priv(selectColor)
+ } else {
+ set defaultColor [. cget -background]
+ }
+
+ set specs [list \
+ [list -initialcolor "" "" $defaultColor] \
+ [list -parent "" "" "."] \
+ [list -title "" "" [mc "Color"]] \
+ ]
+
+ # 2: parse the arguments
+ #
+ tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList
+
+ if {[string equal $data(-title) ""]} {
+ set data(-title) " "
+ }
+ if {[catch {winfo rgb . $data(-initialcolor)} err]} {
+ error $err
+ }
+
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+}
+
+# ::tk::dialog::color::BuildDialog --
+#
+# Build the dialog.
+#
+proc ::tk::dialog::color::BuildDialog {w} {
+ upvar ::tk::dialog::color::[winfo name $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]
+
+ set maxWidth [::tk::mcmaxamp &Red &Green &Blue]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
+ set colorList [list \
+ red [mc "&Red"] \
+ green [mc "&Green"] \
+ blue [mc "&Blue"] \
+ ]
+ foreach {color l} $colorList {
+ # 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]
+
+ bind [::tk::AmpWidget label $box.label -text $l: -width $maxWidth \
+ -anchor ne] <<AltUnderlined>> [list focus $box.entry]
+
+ entry $box.entry -textvariable \
+ ::tk::dialog::color::[winfo name $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> \
+ [list tk::dialog::color::DrawColorScale $w $color 1]
+ bind $data($color,col) <Enter> \
+ [list tk::dialog::color::EnterColorBar $w $color]
+ bind $data($color,col) <Leave> \
+ [list tk::dialog::color::LeaveColorBar $w $color]
+
+ bind $data($color,sel) <Enter> \
+ [list tk::dialog::color::EnterColorBar $w $color]
+ bind $data($color,sel) <Leave> \
+ [list tk::dialog::color::LeaveColorBar $w $color]
+
+ bind $box.entry <Return> [list tk::dialog::color::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 [::tk::AmpWidget label $selFrame.lab -text [mc "&Selection:"] \
+ -anchor sw]
+ set ent [entry $selFrame.ent \
+ -textvariable ::tk::dialog::color::[winfo name $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> [list tk::dialog::color::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]
+ set maxWidth [::tk::mcmaxamp &OK &Cancel]
+ set maxWidth [expr {$maxWidth<8?8:$maxWidth}]
+ ::tk::AmpWidget button $botFrame.ok -text [mc "&OK"] \
+ -width $maxWidth \
+ -command [list tk::dialog::color::OkCmd $w]
+ ::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"] \
+ -width $maxWidth \
+ -command [list tk::dialog::color::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 $lab <<AltUnderlined>> [list focus $ent]
+ bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
+
+ wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
+}
+
+# ::tk::dialog::color::SetRGBValue --
+#
+# Sets the current selection of the dialog box
+#
+proc ::tk::dialog::color::SetRGBValue {w color} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ set data(red,intensity) [lindex $color 0]
+ set data(green,intensity) [lindex $color 1]
+ set data(blue,intensity) [lindex $color 2]
+
+ RedrawColorBars $w all
+
+ # Now compute the new x value of each colorbars pointer polygon
+ foreach color [list red green blue ] {
+ set x [RgbToX $w $data($color,intensity)]
+ MoveSelector $w $data($color,sel) $color $x 0
+ }
+}
+
+# ::tk::dialog::color::XToRgb --
+#
+# Converts a screen coordinate to intensity
+#
+proc ::tk::dialog::color::XToRgb {w x} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
+ if {$x > 255} { set x 255 }
+ return $x
+}
+
+# ::tk::dialog::color::RgbToX
+#
+# Converts an intensity to screen coordinate.
+#
+proc ::tk::dialog::color::RgbToX {w color} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
+}
+
+
+# ::tk::dialog::color::DrawColorScale --
+#
+# Draw color scale is called whenever the size of one of the color
+# scale canvases is changed.
+#
+proc ::tk::dialog::color::DrawColorScale {w c {create 0}} {
+ upvar ::tk::dialog::color::[winfo name $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
+ CreateSelector $w $sel $c
+ $sel bind $data($c,index) <ButtonPress-1> \
+ [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]
+ $sel bind $data($c,index) <B1-Motion> \
+ [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
+ $sel bind $data($c,index) <ButtonRelease-1> \
+ [list tk::dialog::color::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> \
+ [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]
+ bind $col <B1-Motion> \
+ [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]
+ bind $col <ButtonRelease-1> \
+ [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]
+
+ $sel bind $data($c,clickRegion) <ButtonPress-1> \
+ [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]
+ $sel bind $data($c,clickRegion) <B1-Motion> \
+ [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
+ $sel bind $data($c,clickRegion) <ButtonRelease-1> \
+ [list tk::dialog::color::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 {[string equal $c "red"]} {
+ set color [format "#%02x%02x%02x" \
+ $intensity \
+ $data(green,intensity) \
+ $data(blue,intensity)]
+ } elseif {[string equal $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 itemconfigure $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}]
+ }
+
+ RedrawFinalColor $w
+}
+
+# ::tk::dialog::color::CreateSelector --
+#
+# Creates and draws the selector polygon at the position
+# $data($c,intensity).
+#
+proc ::tk::dialog::color::CreateSelector {w sel c } {
+ upvar ::tk::dialog::color::[winfo name $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) [RgbToX $w $data($c,intensity)]
+ $sel move $data($c,index) $data($c,x) 0
+}
+
+# ::tk::dialog::color::RedrawFinalColor
+#
+# Combines the intensities of the three colors into the final color
+#
+proc ::tk::dialog::color::RedrawFinalColor {w} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ set color [format "#%02x%02x%02x" $data(red,intensity) \
+ $data(green,intensity) $data(blue,intensity)]
+
+ $data(finalCanvas) configure -bg $color
+ set data(finalColor) $color
+ set data(selection) $color
+ set data(finalRGB) [list \
+ $data(red,intensity) \
+ $data(green,intensity) \
+ $data(blue,intensity)]
+}
+
+# ::tk::dialog::color::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 ::tk::dialog::color::RedrawColorBars {w colorChanged} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ switch $colorChanged {
+ red {
+ DrawColorScale $w green
+ DrawColorScale $w blue
+ }
+ green {
+ DrawColorScale $w red
+ DrawColorScale $w blue
+ }
+ blue {
+ DrawColorScale $w red
+ DrawColorScale $w green
+ }
+ default {
+ DrawColorScale $w red
+ DrawColorScale $w green
+ DrawColorScale $w blue
+ }
+ }
+ RedrawFinalColor $w
+}
+
+#----------------------------------------------------------------------
+# Event handlers
+#----------------------------------------------------------------------
+
+# ::tk::dialog::color::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 ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ if {!$dontMove} {
+ MoveSelector $w $sel $color $x $delta
+ }
+}
+
+# ::tk::dialog::color::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 ::tk::dialog::color::MoveSelector {w sel color x delta} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ incr x -$delta
+
+ if { $x < 0 } {
+ set x 0
+ } elseif { $x > $data(BARS_WIDTH)} {
+ set x $data(BARS_WIDTH)
+ }
+ 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
+}
+
+# ::tk::dialog::color::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 ::tk::dialog::color::ReleaseMouse {w sel color x delta} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ set x [MoveSelector $w $sel $color $x $delta]
+
+ # Determine exactly what color we are looking at.
+ set data($color,intensity) [XToRgb $w $x]
+
+ RedrawColorBars $w $color
+}
+
+# ::tk::dialog::color::ResizeColorbars --
+#
+# Completely redraws the colorbars, including resizing the
+# colorstrips
+#
+proc ::tk::dialog::color::ResizeColorBars {w} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) ||
+ (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
+ set data(BARS_WIDTH) $data(NUM_COLORBARS)
+ }
+ InitValues [winfo name $w]
+ foreach color [list red green blue ] {
+ $data($color,col) configure -width $data(canvasWidth)
+ DrawColorScale $w $color 1
+ }
+}
+
+# ::tk::dialog::color::HandleSelEntry --
+#
+# Handles the return keypress event in the "Selection:" entry
+#
+proc ::tk::dialog::color::HandleSelEntry {w} {
+ upvar ::tk::dialog::color::[winfo name $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}]
+
+ SetRGBValue $w "$R $G $B"
+ set data(selection) $text
+}
+
+# ::tk::dialog::color::HandleRGBEntry --
+#
+# Handles the return keypress event in the R, G or B entry
+#
+proc ::tk::dialog::color::HandleRGBEntry {w} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ foreach c [list 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
+ }
+ }
+
+ SetRGBValue $w "$data(red,intensity) \
+ $data(green,intensity) $data(blue,intensity)"
+}
+
+# mouse cursor enters a color bar
+#
+proc ::tk::dialog::color::EnterColorBar {w color} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ $data($color,sel) itemconfig $data($color,index) -fill red
+}
+
+# mouse leaves enters a color bar
+#
+proc ::tk::dialog::color::LeaveColorBar {w color} {
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ $data($color,sel) itemconfig $data($color,index) -fill black
+}
+
+# user hits OK button
+#
+proc ::tk::dialog::color::OkCmd {w} {
+ variable ::tk::Priv
+ upvar ::tk::dialog::color::[winfo name $w] data
+
+ set Priv(selectColor) $data(finalColor)
+}
+
+# user hits Cancel button
+#
+proc ::tk::dialog::color::CancelCmd {w} {
+ variable ::tk::Priv
+ set Priv(selectColor) ""
+}
+
diff --git a/tcl/library/comdlg.tcl b/tcl/library/comdlg.tcl
new file mode 100644
index 00000000000..7be38743984
--- /dev/null
+++ b/tcl/library/comdlg.tcl
@@ -0,0 +1,303 @@
+# comdlg.tcl --
+#
+# Some functions needed for the common dialog boxes. Probably need to go
+# in a different file.
+#
+# RCS: @(#) $Id$
+#
+# 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] & 1} {
+ set cmdsw [lindex $argList end]
+ if {![info exists cmd($cmdsw)]} {
+ error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
+ }
+ error "value for \"$cmdsw\" missing"
+ }
+
+ # 2: set the default values
+ #
+ foreach cmdsw [array names cmd] {
+ set data($cmdsw) $def($cmdsw)
+ }
+
+ # 3: parse the argument list
+ #
+ foreach {cmdsw value} $argList {
+ if {![info exists cmd($cmdsw)]} {
+ error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
+ }
+ set data($cmdsw) $value
+ }
+
+ # Done!
+}
+
+proc tclListValidFlags {v} {
+ upvar $v cmd
+
+ set len [llength [array names cmd]]
+ set i 1
+ set separator ""
+ set errormsg ""
+ foreach cmdsw [lsort [array names cmd]] {
+ append errormsg "$separator$cmdsw"
+ incr i
+ if {$i == $len} {
+ set separator ", or "
+ } else {
+ set separator ", "
+ }
+ }
+ return $errormsg
+}
+
+#----------------------------------------------------------------------
+#
+# 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.
+#
+#----------------------------------------------------------------------
+
+
+# ::tk::FocusGroup_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 ::tk::FocusGroup_Create {t} {
+ variable ::tk::Priv
+ if {[string compare [winfo toplevel $t] $t]} {
+ error "$t is not a toplevel window"
+ }
+ if {![info exists Priv(fg,$t)]} {
+ set Priv(fg,$t) 1
+ set Priv(focus,$t) ""
+ bind $t <FocusIn> [list tk::FocusGroup_In $t %W %d]
+ bind $t <FocusOut> [list tk::FocusGroup_Out $t %W %d]
+ bind $t <Destroy> [list tk::FocusGroup_Destroy $t %W]
+ }
+}
+
+# ::tk::FocusGroup_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 ::tk::FocusGroup_BindIn {t w cmd} {
+ variable FocusIn
+ variable ::tk::Priv
+ if {![info exists Priv(fg,$t)]} {
+ error "focus group \"$t\" doesn't exist"
+ }
+ set FocusIn($t,$w) $cmd
+}
+
+
+# ::tk::FocusGroup_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 ::tk::FocusGroup_BindOut {t w cmd} {
+ variable FocusOut
+ variable ::tk::Priv
+ if {![info exists Priv(fg,$t)]} {
+ error "focus group \"$t\" doesn't exist"
+ }
+ set FocusOut($t,$w) $cmd
+}
+
+# ::tk::FocusGroup_Destroy --
+#
+# Cleans up when members of the focus group is deleted, or when the
+# toplevel itself gets deleted.
+#
+proc ::tk::FocusGroup_Destroy {t w} {
+ variable FocusIn
+ variable FocusOut
+ variable ::tk::Priv
+
+ if {[string equal $t $w]} {
+ unset Priv(fg,$t)
+ unset Priv(focus,$t)
+
+ foreach name [array names FocusIn $t,*] {
+ unset FocusIn($name)
+ }
+ foreach name [array names FocusOut $t,*] {
+ unset FocusOut($name)
+ }
+ } else {
+ if {[info exists Priv(focus,$t)] && \
+ [string equal $Priv(focus,$t) $w]} {
+ set Priv(focus,$t) ""
+ }
+ catch {
+ unset FocusIn($t,$w)
+ }
+ catch {
+ unset FocusOut($t,$w)
+ }
+ }
+}
+
+# ::tk::FocusGroup_In --
+#
+# Handles the <FocusIn> event. Calls the FocusIn command for the newly
+# focused widget in the focus group.
+#
+proc ::tk::FocusGroup_In {t w detail} {
+ variable FocusIn
+ variable ::tk::Priv
+
+ if {[string compare $detail NotifyNonlinear] && \
+ [string compare $detail NotifyNonlinearVirtual]} {
+ # This is caused by mouse moving out&in of the window *or*
+ # ordinary keypresses some window managers (ie: CDE [Bug: 2960]).
+ return
+ }
+ if {![info exists FocusIn($t,$w)]} {
+ set FocusIn($t,$w) ""
+ return
+ }
+ if {![info exists Priv(focus,$t)]} {
+ return
+ }
+ if {[string equal $Priv(focus,$t) $w]} {
+ # This is already in focus
+ #
+ return
+ } else {
+ set Priv(focus,$t) $w
+ eval $FocusIn($t,$w)
+ }
+}
+
+# ::tk::FocusGroup_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 ::tk::FocusGroup_Out {t w detail} {
+ variable FocusOut
+ variable ::tk::Priv
+
+ if {[string compare $detail NotifyNonlinear] && \
+ [string compare $detail NotifyNonlinearVirtual]} {
+ # This is caused by mouse moving out of the window
+ return
+ }
+ if {![info exists Priv(focus,$t)]} {
+ return
+ }
+ if {![info exists FocusOut($t,$w)]} {
+ return
+ } else {
+ eval $FocusOut($t,$w)
+ set Priv(focus,$t) ""
+ }
+}
+
+# ::tk::FDGetFileTypes --
+#
+# 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 ::tk::FDGetFileTypes {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 equal $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/tcl/library/console.tcl b/tcl/library/console.tcl
new file mode 100644
index 00000000000..cc5e3adb8bf
--- /dev/null
+++ b/tcl/library/console.tcl
@@ -0,0 +1,934 @@
+# console.tcl --
+#
+# This code constructs the console window for an application. It
+# can be used by non-unix systems that do not have built-in support
+# for shells.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
+#
+# 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
+
+namespace eval ::tk::console {
+ variable blinkTime 500 ; # msecs to blink braced range for
+ variable blinkRange 1 ; # enable blinking of the entire braced range
+ variable magicKeys 1 ; # enable brace matching and proc/var recognition
+ variable maxLines 600 ; # maximum # of lines buffered in console
+ variable showMatches 1 ; # show multiple expand matches
+
+ variable inPlugin [info exists embed_args]
+ variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used
+
+
+ if {$inPlugin} {
+ set defaultPrompt {subst {[history nextid] % }}
+ } else {
+ set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
+ }
+}
+
+# simple compat function for tkcon code added for this console
+interp alias {} EvalAttached {} consoleinterp eval
+
+# ::tk::ConsoleInit --
+# This procedure constructs and configures the console windows.
+#
+# Arguments:
+# None.
+
+proc ::tk::ConsoleInit {} {
+ global tcl_platform
+
+ if {![consoleinterp eval {set tcl_interactive}]} {
+ wm withdraw .
+ }
+
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ set mod "Cmd"
+ } else {
+ set mod "Ctrl"
+ }
+
+ if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
+ .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 [mc "Source..."] \
+ -underline 0 -command tk::ConsoleSource
+ .menubar.file add command -label [mc "Hide Console"] \
+ -underline 0 -command {wm withdraw .}
+ .menubar.file add command -label [mc "Clear Console"] \
+ -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ .menubar.file add command -label [mc "Quit"] \
+ -command exit -accel Cmd-Q
+ } else {
+ .menubar.file add command -label [mc "Exit"] \
+ -underline 1 -command exit
+ }
+
+ menu .menubar.edit -tearoff 0
+ .menubar.edit add command -label [mc "Cut"] -underline 2 \
+ -command { event generate .console <<Cut>> } -accel "$mod+X"
+ .menubar.edit add command -label [mc "Copy"] -underline 0 \
+ -command { event generate .console <<Copy>> } -accel "$mod+C"
+ .menubar.edit add command -label [mc "Paste"] -underline 1 \
+ -command { event generate .console <<Paste>> } -accel "$mod+V"
+
+ if {[string compare $tcl_platform(platform) "windows"]} {
+ .menubar.edit add command -label [mc "Clear"] -underline 2 \
+ -command { event generate .console <<Clear>> }
+ } else {
+ .menubar.edit add command -label [mc "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 [mc "About..."] \
+ -underline 0 -command tk::ConsoleAbout
+ }
+
+ . configure -menu .menubar
+
+ set con [text .console -yscrollcommand [list .sb set] -setgrid true]
+ scrollbar .sb -command [list $con yview]
+ pack .sb -side right -fill both
+ pack $con -fill both -expand 1 -side left
+ switch -exact $tcl_platform(platform) {
+ "macintosh" {
+ $con configure -font {Monaco 9 normal} -highlightthickness 0
+ }
+ "windows" {
+ $con configure -font systemfixed
+ }
+ "unix" {
+ if {[string equal [tk windowingsystem] "aqua"]} {
+ $con configure -font {Monaco 9 normal} -highlightthickness 0
+ }
+ }
+ }
+
+ ConsoleBind $con
+
+ $con tag configure stderr -foreground red
+ $con tag configure stdin -foreground blue
+ $con tag configure prompt -foreground \#8F4433
+ $con tag configure proc -foreground \#008800
+ $con tag configure var -background \#FFC0D0
+ $con tag raise sel
+ $con tag configure blink -background \#FFFF00
+ $con tag configure find -background \#FFFF00
+
+ focus $con
+
+ wm protocol . WM_DELETE_WINDOW { wm withdraw . }
+ wm title . [mc "Console"]
+ flush stdout
+ $con mark set output [$con index "end - 1 char"]
+ tk::TextSetCursor $con end
+ $con mark set promptEnd insert
+ $con mark gravity promptEnd left
+}
+
+# ::tk::ConsoleSource --
+#
+# Prompts the user for a file to source in the main interpreter.
+#
+# Arguments:
+# None.
+
+proc ::tk::ConsoleSource {} {
+ set filename [tk_getOpenFile -defaultextension .tcl -parent . \
+ -title [mc "Select a file to source"] \
+ -filetypes [list \
+ [list [mc "Tcl Scripts"] .tcl] \
+ [list [mc "All Files"] *]]]
+ if {[string compare $filename ""]} {
+ set cmd [list source $filename]
+ if {[catch {consoleinterp eval $cmd} result]} {
+ ConsoleOutput stderr "$result\n"
+ }
+ }
+}
+
+# ::tk::ConsoleInvoke --
+# 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 ::tk::ConsoleInvoke {args} {
+ set ranges [.console tag ranges input]
+ set cmd ""
+ if {[llength $ranges]} {
+ set pos 0
+ while {[string compare [lindex $ranges $pos] ""]} {
+ set start [lindex $ranges $pos]
+ set end [lindex $ranges [incr pos]]
+ append cmd [.console get $start $end]
+ incr pos
+ }
+ }
+ if {[string equal $cmd ""]} {
+ ConsolePrompt
+ } elseif {[info complete $cmd]} {
+ .console mark set output end
+ .console tag delete input
+ set result [consoleinterp record $cmd]
+ if {[string compare $result ""]} {
+ puts $result
+ }
+ ConsoleHistory reset
+ ConsolePrompt
+ } else {
+ ConsolePrompt partial
+ }
+ .console yview -pickplace insert
+}
+
+# ::tk::ConsoleHistory --
+# 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 variable
+# ::tk::HistNum is used to store the current location in the history.
+#
+# Arguments:
+# cmd - Which action to take: prev, next, reset.
+
+set ::tk::HistNum 1
+proc ::tk::ConsoleHistory {cmd} {
+ variable HistNum
+
+ switch $cmd {
+ prev {
+ incr HistNum -1
+ if {$HistNum == 0} {
+ set cmd {history event [expr {[history nextid] -1}]}
+ } else {
+ set cmd "history event $HistNum"
+ }
+ if {[catch {consoleinterp eval $cmd} cmd]} {
+ incr HistNum
+ return
+ }
+ .console delete promptEnd end
+ .console insert promptEnd $cmd {input stdin}
+ }
+ next {
+ incr HistNum
+ if {$HistNum == 0} {
+ set cmd {history event [expr {[history nextid] -1}]}
+ } elseif {$HistNum > 0} {
+ set cmd ""
+ set HistNum 1
+ } else {
+ set cmd "history event $HistNum"
+ }
+ if {[string compare $cmd ""]} {
+ catch {consoleinterp eval $cmd} cmd
+ }
+ .console delete promptEnd end
+ .console insert promptEnd $cmd {input stdin}
+ }
+ reset {
+ set HistNum 1
+ }
+ }
+}
+
+# ::tk::ConsolePrompt --
+# 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 ::tk::ConsolePrompt {{partial normal}} {
+ set w .console
+ if {[string equal $partial "normal"]} {
+ set temp [$w index "end - 1 char"]
+ $w mark set output end
+ if {[consoleinterp eval "info exists tcl_prompt1"]} {
+ consoleinterp eval "eval \[set tcl_prompt1\]"
+ } else {
+ puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
+ }
+ } else {
+ set temp [$w index output]
+ $w mark set output end
+ if {[consoleinterp eval "info exists tcl_prompt2"]} {
+ consoleinterp eval "eval \[set tcl_prompt2\]"
+ } else {
+ puts -nonewline "> "
+ }
+ }
+ flush stdout
+ $w mark set output $temp
+ ::tk::TextSetCursor $w end
+ $w mark set promptEnd insert
+ $w mark gravity promptEnd left
+ ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
+ $w see end
+}
+
+# ::tk::ConsoleBind --
+# 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 ::tk::ConsoleBind {w} {
+ bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]
+
+ ## Get all Text bindings into Console
+ foreach ev [bind Text] { bind Console $ev [bind Text $ev] }
+ ## We really didn't want the newline insertion...
+ bind Console <Control-Key-o> {}
+ ## ...or any Control-v binding (would block <<Paste>>)
+ bind Console <Control-Key-v> {}
+
+ # For the moment, transpose isn't enabled until the console
+ # gets and overhaul of how it handles input -- hobbs
+ bind Console <Control-Key-t> {}
+
+ # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
+ # Otherwise, if a widget binding for one of these is defined, the
+
+ bind Console <Alt-KeyPress> {# nothing }
+ bind Console <Meta-KeyPress> {# nothing}
+ bind Console <Control-KeyPress> {# nothing}
+
+ foreach {ev key} {
+ <<Console_Prev>> <Key-Up>
+ <<Console_Next>> <Key-Down>
+ <<Console_NextImmediate>> <Control-Key-n>
+ <<Console_PrevImmediate>> <Control-Key-p>
+ <<Console_PrevSearch>> <Control-Key-r>
+ <<Console_NextSearch>> <Control-Key-s>
+
+ <<Console_Expand>> <Key-Tab>
+ <<Console_Expand>> <Key-Escape>
+ <<Console_ExpandFile>> <Control-Shift-Key-F>
+ <<Console_ExpandProc>> <Control-Shift-Key-P>
+ <<Console_ExpandVar>> <Control-Shift-Key-V>
+ <<Console_Tab>> <Control-Key-i>
+ <<Console_Tab>> <Meta-Key-i>
+ <<Console_Eval>> <Key-Return>
+ <<Console_Eval>> <Key-KP_Enter>
+
+ <<Console_Clear>> <Control-Key-l>
+ <<Console_KillLine>> <Control-Key-k>
+ <<Console_Transpose>> <Control-Key-t>
+ <<Console_ClearLine>> <Control-Key-u>
+ <<Console_SaveCommand>> <Control-Key-z>
+ } {
+ event add $ev $key
+ bind Console $key {}
+ }
+
+ bind Console <<Console_Expand>> {
+ if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
+ }
+ bind Console <<Console_ExpandFile>> {
+ if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
+ }
+ bind Console <<Console_ExpandProc>> {
+ if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
+ }
+ bind Console <<Console_ExpandVar>> {
+ if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
+ }
+ bind Console <<Console_Eval>> {
+ %W mark set insert {end - 1c}
+ tk::ConsoleInsert %W "\n"
+ tk::ConsoleInvoke
+ break
+ }
+ bind Console <Delete> {
+ if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+ && [%W compare sel.first >= promptEnd]} {
+ %W delete sel.first sel.last
+ } elseif {[%W compare insert >= promptEnd]} {
+ %W delete insert
+ %W see insert
+ }
+ }
+ bind Console <BackSpace> {
+ if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+ && [%W compare sel.first >= promptEnd]} {
+ %W delete sel.first sel.last
+ } elseif {[%W compare insert != 1.0] && \
+ [%W compare insert > promptEnd]} {
+ %W delete insert-1c
+ %W see insert
+ }
+ }
+ bind Console <Control-h> [bind Console <BackSpace>]
+
+ bind Console <Home> {
+ if {[%W compare insert < promptEnd]} {
+ tk::TextSetCursor %W {insert linestart}
+ } else {
+ tk::TextSetCursor %W promptEnd
+ }
+ }
+ bind Console <Control-a> [bind Console <Home>]
+ bind Console <End> {
+ tk::TextSetCursor %W {insert lineend}
+ }
+ bind Console <Control-e> [bind Console <End>]
+ bind Console <Control-d> {
+ if {[%W compare insert < promptEnd]} break
+ %W delete insert
+ }
+ bind Console <<Console_KillLine>> {
+ if {[%W compare insert < promptEnd]} break
+ if {[%W compare insert == {insert lineend}]} {
+ %W delete insert
+ } else {
+ %W delete insert {insert lineend}
+ }
+ }
+ bind Console <<Console_Clear>> {
+ ## Clear console display
+ %W delete 1.0 "promptEnd linestart"
+ }
+ bind Console <<Console_ClearLine>> {
+ ## Clear command line (Unix shell staple)
+ %W delete promptEnd end
+ }
+ bind Console <Meta-d> {
+ if {[%W compare insert >= promptEnd]} {
+ %W delete insert {insert wordend}
+ }
+ }
+ bind Console <Meta-BackSpace> {
+ if {[%W compare {insert -1c wordstart} >= promptEnd]} {
+ %W delete {insert -1c wordstart} insert
+ }
+ }
+ bind Console <Meta-d> {
+ if {[%W compare insert >= promptEnd]} {
+ %W delete insert {insert wordend}
+ }
+ }
+ bind Console <Meta-BackSpace> {
+ if {[%W compare {insert -1c wordstart} >= promptEnd]} {
+ %W delete {insert -1c wordstart} insert
+ }
+ }
+ bind Console <Meta-Delete> {
+ if {[%W compare insert >= promptEnd]} {
+ %W delete insert {insert wordend}
+ }
+ }
+ bind Console <<Console_Prev>> {
+ tk::ConsoleHistory prev
+ }
+ bind Console <<Console_Next>> {
+ tk::ConsoleHistory next
+ }
+ bind Console <Insert> {
+ catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
+ }
+ bind Console <KeyPress> {
+ tk::ConsoleInsert %W %A
+ }
+ bind Console <F9> {
+ eval destroy [winfo child .]
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
+ if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}
+ } else {
+ source [file join $tk_library console.tcl]
+ }
+ }
+ bind Console <<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
+ }
+ }
+ bind Console <<Copy>> {
+ if {![catch {set data [%W get sel.first sel.last]}]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $data
+ }
+ }
+ bind Console <<Paste>> {
+ catch {
+ set clip [::tk::GetSelection %W CLIPBOARD]
+ set list [split $clip \n\r]
+ tk::ConsoleInsert %W [lindex $list 0]
+ foreach x [lrange $list 1 end] {
+ %W mark set insert {end - 1c}
+ tk::ConsoleInsert %W "\n"
+ tk::ConsoleInvoke
+ tk::ConsoleInsert %W $x
+ }
+ }
+ }
+
+ ##
+ ## Bindings for doing special things based on certain keys
+ ##
+ bind PostConsole <Key-parenright> {
+ if {[string compare \\ [%W get insert-2c]]} {
+ ::tk::console::MatchPair %W \( \) promptEnd
+ }
+ }
+ bind PostConsole <Key-bracketright> {
+ if {[string compare \\ [%W get insert-2c]]} {
+ ::tk::console::MatchPair %W \[ \] promptEnd
+ }
+ }
+ bind PostConsole <Key-braceright> {
+ if {[string compare \\ [%W get insert-2c]]} {
+ ::tk::console::MatchPair %W \{ \} promptEnd
+ }
+ }
+ bind PostConsole <Key-quotedbl> {
+ if {[string compare \\ [%W get insert-2c]]} {
+ ::tk::console::MatchQuote %W promptEnd
+ }
+ }
+
+ bind PostConsole <KeyPress> {
+ if {"%A" != ""} {
+ ::tk::console::TagProc %W
+ }
+ break
+ }
+}
+
+# ::tk::ConsoleInsert --
+# 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 ::tk::ConsoleInsert {w s} {
+ if {[string equal $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
+}
+
+# ::tk::ConsoleOutput --
+#
+# 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 ::tk::ConsoleOutput {dest string} {
+ set w .console
+ $w insert output $string $dest
+ ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
+ $w see insert
+}
+
+# ::tk::ConsoleExit --
+#
+# 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 ::tk::ConsoleExit {} {
+ destroy .
+}
+
+# ::tk::ConsoleAbout --
+#
+# This routine displays an About box to show Tcl/Tk version info.
+#
+# Arguments:
+# None.
+
+proc ::tk::ConsoleAbout {} {
+ tk_messageBox -type ok -message "[mc {Tcl for Windows}]
+
+Tcl $::tcl_patchLevel
+Tk $::tk_patchLevel"
+}
+
+# ::tk::console::TagProc --
+#
+# Tags a procedure in the console if it's recognized
+# This procedure is not perfect. However, making it perfect wastes
+# too much CPU time...
+#
+# Arguments:
+# w - console text widget
+
+proc ::tk::console::TagProc w {
+ if {!$::tk::console::magicKeys} { return }
+ set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
+ set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
+ if {$i == ""} {set i promptEnd} else {append i +2c}
+ regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
+ if {[llength [EvalAttached [list info commands $c]]]} {
+ $w tag add proc $i "insert-1c wordend"
+ } else {
+ $w tag remove proc $i "insert-1c wordend"
+ }
+ if {[llength [EvalAttached [list info vars $c]]]} {
+ $w tag add var $i "insert-1c wordend"
+ } else {
+ $w tag remove var $i "insert-1c wordend"
+ }
+}
+
+# ::tk::console::MatchPair --
+#
+# Blinks a matching pair of characters
+# c2 is assumed to be at the text index 'insert'.
+# This proc is really loopy and took me an hour to figure out given
+# all possible combinations with escaping except for escaped \'s.
+# It doesn't take into account possible commenting... Oh well. If
+# anyone has something better, I'd like to see/use it. This is really
+# only efficient for small contexts.
+#
+# Arguments:
+# w - console text widget
+# c1 - first char of pair
+# c2 - second char of pair
+#
+# Calls: ::tk::console::Blink
+
+proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
+ if {!$::tk::console::magicKeys} { return }
+ if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
+ while {
+ [string match {\\} [$w get $ix-1c]] &&
+ [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
+ } {}
+ set i1 insert-1c
+ while {[string compare {} $ix]} {
+ set i0 $ix
+ set j 0
+ while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
+ append i0 +1c
+ if {[string match {\\} [$w get $i0-2c]]} continue
+ incr j
+ }
+ if {!$j} break
+ set i1 $ix
+ while {$j && [string compare {} \
+ [set ix [$w search -back $c1 $ix $lim]]]} {
+ if {[string match {\\} [$w get $ix-1c]]} continue
+ incr j -1
+ }
+ }
+ if {[string match {} $ix]} { set ix [$w index $lim] }
+ } else { set ix [$w index $lim] }
+ if {$::tk::console::blinkRange} {
+ Blink $w $ix [$w index insert]
+ } else {
+ Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
+ }
+}
+
+# ::tk::console::MatchQuote --
+#
+# Blinks between matching quotes.
+# Blinks just the quote if it's unmatched, otherwise blinks quoted string
+# The quote to match is assumed to be at the text index 'insert'.
+#
+# Arguments:
+# w - console text widget
+#
+# Calls: ::tk::console::Blink
+
+proc ::tk::console::MatchQuote {w {lim 1.0}} {
+ if {!$::tk::console::magicKeys} { return }
+ set i insert-1c
+ set j 0
+ while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
+ if {[string match {\\} [$w get $i-1c]]} continue
+ if {!$j} {set i0 $i}
+ incr j
+ }
+ if {$j&1} {
+ if {$::tk::console::blinkRange} {
+ Blink $w $i0 [$w index insert]
+ } else {
+ Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
+ }
+ } else {
+ Blink $w [$w index insert-1c] [$w index insert]
+ }
+}
+
+# ::tk::console::Blink --
+#
+# Blinks between n index pairs for a specified duration.
+#
+# Arguments:
+# w - console text widget
+# i1 - start index to blink region
+# i2 - end index of blink region
+# dur - duration in usecs to blink for
+#
+# Outputs:
+# blinks selected characters in $w
+
+proc ::tk::console::Blink {w args} {
+ eval [list $w tag add blink] $args
+ after $::tk::console::blinkTime [list $w] tag remove blink $args
+}
+
+# ::tk::console::ConstrainBuffer --
+#
+# This limits the amount of data in the text widget
+# Called by Prompt and ConsoleOutput
+#
+# Arguments:
+# w - console text widget
+# size - # of lines to constrain to
+#
+# Outputs:
+# may delete data in console widget
+
+proc ::tk::console::ConstrainBuffer {w size} {
+ if {[$w index end] > $size} {
+ $w delete 1.0 [expr {int([$w index end])-$size}].0
+ }
+}
+
+# ::tk::console::Expand --
+#
+# Arguments:
+# ARGS: w - text widget in which to expand str
+# type - type of expansion (path / proc / variable)
+#
+# Calls: ::tk::console::Expand(Pathname|Procname|Variable)
+#
+# Outputs: The string to match is expanded to the longest possible match.
+# If ::tk::console::showMatches is non-zero and the longest match
+# equaled the string to expand, then all possible matches are
+# output to stdout. Triggers bell if no matches are found.
+#
+# Returns: number of matches found
+
+proc ::tk::console::Expand {w {type ""}} {
+ set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
+ set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
+ if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
+ if {[$w compare $tmp >= insert]} { return }
+ set str [$w get $tmp insert]
+ switch -glob $type {
+ path* { set res [ExpandPathname $str] }
+ proc* { set res [ExpandProcname $str] }
+ var* { set res [ExpandVariable $str] }
+ default {
+ set res {}
+ foreach t {Pathname Procname Variable} {
+ if {![catch {Expand$t $str} res] && ($res != "")} { break }
+ }
+ }
+ }
+ set len [llength $res]
+ if {$len} {
+ set repl [lindex $res 0]
+ $w delete $tmp insert
+ $w insert $tmp $repl {input stdin}
+ if {($len > 1) && $::tk::console::showMatches \
+ && [string equal $repl $str]} {
+ puts stdout [lsort [lreplace $res 0 0]]
+ }
+ } else { bell }
+ return [incr len -1]
+}
+
+# ::tk::console::ExpandPathname --
+#
+# Expand a file pathname based on $str
+# This is based on UNIX file name conventions
+#
+# Arguments:
+# str - partial file pathname to expand
+#
+# Calls: ::tk::console::ExpandBestMatch
+#
+# Returns: list containing longest unique match followed by all the
+# possible further matches
+
+proc ::tk::console::ExpandPathname str {
+ set pwd [EvalAttached pwd]
+ if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
+ return -code error $err
+ }
+ set dir [file tail $str]
+ ## Check to see if it was known to be a directory and keep the trailing
+ ## slash if so (file tail cuts it off)
+ if {[string match */ $str]} { append dir / }
+ if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
+ set match {}
+ } else {
+ if {[llength $m] > 1} {
+ global tcl_platform
+ if {[string match windows $tcl_platform(platform)]} {
+ ## Windows is screwy because it's case insensitive
+ set tmp [ExpandBestMatch [string tolower $m] \
+ [string tolower $dir]]
+ ## Don't change case if we haven't changed the word
+ if {[string length $dir]==[string length $tmp]} {
+ set tmp $dir
+ }
+ } else {
+ set tmp [ExpandBestMatch $m $dir]
+ }
+ if {[string match ?*/* $str]} {
+ set tmp [file dirname $str]/$tmp
+ } elseif {[string match /* $str]} {
+ set tmp /$tmp
+ }
+ regsub -all { } $tmp {\\ } tmp
+ set match [linsert $m 0 $tmp]
+ } else {
+ ## This may look goofy, but it handles spaces in path names
+ eval append match $m
+ if {[file isdir $match]} {append match /}
+ if {[string match ?*/* $str]} {
+ set match [file dirname $str]/$match
+ } elseif {[string match /* $str]} {
+ set match /$match
+ }
+ regsub -all { } $match {\\ } match
+ ## Why is this one needed and the ones below aren't!!
+ set match [list $match]
+ }
+ }
+ EvalAttached [list cd $pwd]
+ return $match
+}
+
+# ::tk::console::ExpandProcname --
+#
+# Expand a tcl proc name based on $str
+#
+# Arguments:
+# str - partial proc name to expand
+#
+# Calls: ::tk::console::ExpandBestMatch
+#
+# Returns: list containing longest unique match followed by all the
+# possible further matches
+
+proc ::tk::console::ExpandProcname str {
+ set match [EvalAttached [list info commands $str*]]
+ if {[llength $match] == 0} {
+ set ns [EvalAttached \
+ "namespace children \[namespace current\] [list $str*]"]
+ if {[llength $ns]==1} {
+ set match [EvalAttached [list info commands ${ns}::*]]
+ } else {
+ set match $ns
+ }
+ }
+ if {[llength $match] > 1} {
+ regsub -all { } [ExpandBestMatch $match $str] {\\ } str
+ set match [linsert $match 0 $str]
+ } else {
+ regsub -all { } $match {\\ } match
+ }
+ return $match
+}
+
+# ::tk::console::ExpandVariable --
+#
+# Expand a tcl variable name based on $str
+#
+# Arguments:
+# str - partial tcl var name to expand
+#
+# Calls: ::tk::console::ExpandBestMatch
+#
+# Returns: list containing longest unique match followed by all the
+# possible further matches
+
+proc ::tk::console::ExpandVariable str {
+ if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
+ ## Looks like they're trying to expand an array.
+ set match [EvalAttached [list array names $ary $str*]]
+ if {[llength $match] > 1} {
+ set vars $ary\([ExpandBestMatch $match $str]
+ foreach var $match {lappend vars $ary\($var\)}
+ return $vars
+ } else {set match $ary\($match\)}
+ ## Space transformation avoided for array names.
+ } else {
+ set match [EvalAttached [list info vars $str*]]
+ if {[llength $match] > 1} {
+ regsub -all { } [ExpandBestMatch $match $str] {\\ } str
+ set match [linsert $match 0 $str]
+ } else {
+ regsub -all { } $match {\\ } match
+ }
+ }
+ return $match
+}
+
+# ::tk::console::ExpandBestMatch --
+#
+# Finds the best unique match in a list of names.
+# The extra $e in this argument allows us to limit the innermost loop a little
+# further. This improves speed as $l becomes large or $e becomes long.
+#
+# Arguments:
+# l - list to find best unique match in
+# e - currently best known unique match
+#
+# Returns: longest unique match in the list
+
+proc ::tk::console::ExpandBestMatch {l {e {}}} {
+ set ec [lindex $l 0]
+ if {[llength $l]>1} {
+ set e [string length $e]; incr e -1
+ set ei [string length $ec]; incr ei -1
+ foreach l $l {
+ while {$ei>=$e && [string first $ec $l]} {
+ set ec [string range $ec 0 [incr ei -1]]
+ }
+ }
+ }
+ return $ec
+}
+
+# now initialize the console
+::tk::ConsoleInit
diff --git a/tcl/library/demos/README b/tcl/library/demos/README
new file mode 100644
index 00000000000..b8dd11f60fa
--- /dev/null
+++ b/tcl/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.
+
+RCS: @(#) $Id$
diff --git a/tcl/library/demos/arrow.tcl b/tcl/library/demos/arrow.tcl
new file mode 100644
index 00000000000..c2d0d4b7e9e
--- /dev/null
+++ b/tcl/library/demos/arrow.tcl
@@ -0,0 +1,239 @@
+# arrow.tcl --
+#
+# This demonstration script creates a canvas widget that displays a
+# large line with an arrowhead whose shape can be edited interactively.
+#
+# RCS: @(#) $Id$
+
+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) -arrow last \
+ -width [expr {10*$v(width)}] -arrowshape [list \
+ [expr {10*$v(a)}] [expr {10*$v(b)}] [expr {10*$v(c)}]]} \
+ $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}] \
+ -tags {box1 box}} $v(boxStyle)
+ eval {$c create rect [expr {$xtip-5}] [expr {$v(y)-$deltaY-5}] \
+ [expr {$xtip+5}] [expr {$v(y)-$deltaY+5}] \
+ -tags {box2 box}} $v(boxStyle)
+ 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}] \
+ -tags {box3 box}} $v(boxStyle)
+ 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/tcl/library/demos/bind.tcl b/tcl/library/demos/bind.tcl
new file mode 100644
index 00000000000..c2b2a2eb462
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/bitmap.tcl b/tcl/library/demos/bitmap.tcl
new file mode 100644
index 00000000000..e69187eb40d
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/browse b/tcl/library/demos/browse
new file mode 100644
index 00000000000..3ec0366d588
--- /dev/null
+++ b/tcl/library/demos/browse
@@ -0,0 +1,66 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" ${1+"$@"}
+
+# browse --
+# This script generates a directory browser, which lists the working
+# directory and allows you to open files or subdirectories by
+# double-clicking.
+#
+# RCS: @(#) $Id$
+
+# 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.
+
+set browseScript [file join [pwd] $argv0]
+proc browse {dir file} {
+ global env browseScript
+ if {[string compare $dir "."] != 0} {set file $dir/$file}
+ switch [file type $file] {
+ directory {
+ exec [info nameofexecutable] $browseScript $file &
+ }
+ file {
+ if {[info exists env(EDITOR)]} {
+ eval exec $env(EDITOR) $file &
+ } else {
+ exec xedit $file &
+ }
+ }
+ default {
+ puts stdout "\"$file\" isn't a directory or regular file"
+ }
+ }
+}
+
+# Fill the listbox with a list of all the files in the directory.
+
+if {$argc>0} {set dir [lindex $argv 0]} else {set dir "."}
+foreach i [lsort [glob * .* *.*]] {
+ if {[file type $i] eq "directory"} {
+ # Safe to do since it is still a directory.
+ append i /
+ }
+ .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}}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tcl/library/demos/button.tcl b/tcl/library/demos/button.tcl
new file mode 100644
index 00000000000..fe00a1c99cb
--- /dev/null
+++ b/tcl/library/demos/button.tcl
@@ -0,0 +1,36 @@
+# button.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several button widgets.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/check.tcl b/tcl/library/demos/check.tcl
new file mode 100644
index 00000000000..f863b5796c7
--- /dev/null
+++ b/tcl/library/demos/check.tcl
@@ -0,0 +1,33 @@
+# check.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several checkbuttons.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/clrpick.tcl b/tcl/library/demos/clrpick.tcl
new file mode 100644
index 00000000000..983cbe1deb4
--- /dev/null
+++ b/tcl/library/demos/clrpick.tcl
@@ -0,0 +1,56 @@
+# clrpick.tcl --
+#
+# This demonstration script prompts the user to select a color.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/colors.tcl b/tcl/library/demos/colors.tcl
new file mode 100644
index 00000000000..aad1d1dde45
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/cscroll.tcl b/tcl/library/demos/cscroll.tcl
new file mode 100644
index 00000000000..aeabc181662
--- /dev/null
+++ b/tcl/library/demos/cscroll.tcl
@@ -0,0 +1,96 @@
+# cscroll.tcl --
+#
+# This demonstration script creates a simple canvas that can be
+# scrolled in two dimensions.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/ctext.tcl b/tcl/library/demos/ctext.tcl
new file mode 100644
index 00000000000..d5efcc3da23
--- /dev/null
+++ b/tcl/library/demos/ctext.tcl
@@ -0,0 +1,147 @@
+# ctext.tcl --
+#
+# This demonstration script creates a canvas widget with a text
+# item that can be edited and reconfigured in various ways.
+#
+# RCS: @(#) $Id$
+
+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 $x $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}] $y -justify center $color
+mkTextConfig $c [expr {$x+60}] $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/tcl/library/demos/dialog1.tcl b/tcl/library/demos/dialog1.tcl
new file mode 100644
index 00000000000..0a1b48d4974
--- /dev/null
+++ b/tcl/library/demos/dialog1.tcl
@@ -0,0 +1,15 @@
+# dialog1.tcl --
+#
+# This demonstration script creates a dialog box with a local grab.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/dialog2.tcl b/tcl/library/demos/dialog2.tcl
new file mode 100644
index 00000000000..bc074455b21
--- /dev/null
+++ b/tcl/library/demos/dialog2.tcl
@@ -0,0 +1,19 @@
+# dialog2.tcl --
+#
+# This demonstration script creates a dialog box with a global grab.
+#
+# RCS: @(#) $Id$
+
+after idle {
+ .dialog2.msg configure -wraplength 4i
+}
+after 100 {
+ grab -global .dialog2
+}
+set i [tk_dialog .dialog2 "Dialog with global 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/tcl/library/demos/entry1.tcl b/tcl/library/demos/entry1.tcl
new file mode 100644
index 00000000000..062eb45f489
--- /dev/null
+++ b/tcl/library/demos/entry1.tcl
@@ -0,0 +1,36 @@
+# entry1.tcl --
+#
+# This demonstration script creates several entry widgets without
+# scrollbars.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/entry2.tcl b/tcl/library/demos/entry2.tcl
new file mode 100644
index 00000000000..87a91cb34d7
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/entry3.tcl b/tcl/library/demos/entry3.tcl
new file mode 100644
index 00000000000..54ad80fd1a6
--- /dev/null
+++ b/tcl/library/demos/entry3.tcl
@@ -0,0 +1,187 @@
+# entry2.tcl --
+#
+# This demonstration script creates several entry widgets whose
+# permitted input is constrained in some way. It also shows off a
+# password entry.
+#
+# RCS: @(#) $Id$
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .entry3
+catch {destroy $w}
+toplevel $w
+wm title $w "Constrained Entry Demonstration"
+wm iconname $w "entry3"
+positionWindow $w
+
+
+label $w.msg -font $font -wraplength 5i -justify left -text "Four different\
+ entries are displayed below. You can add characters by pointing,\
+ clicking and typing, though each is constrained in what it will\
+ accept. The first only accepts integers or the empty string\
+ (checking when focus leaves it) and will flash to indicate any\
+ problem. The second only accepts strings with fewer than ten\
+ characters and sounds the bell when an attempt to go over the limit\
+ is made. The third accepts US phone numbers, mapping letters to\
+ their digit equivalent and sounding the bell on encountering an\
+ illegal character or if trying to type over a character that is not\
+ a digit. The fourth is a password field that accepts up to eight\
+ characters (silently ignoring further ones), and displaying them as\
+ asterisk characters."
+
+frame $w.buttons
+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
+
+
+# focusAndFlash --
+# Error handler for entry widgets that forces the focus onto the
+# widget and makes the widget flash by exchanging the foreground and
+# background colours at intervals of 200ms (i.e. at approximately
+# 2.5Hz).
+#
+# Arguments:
+# W - Name of entry widget to flash
+# fg - Initial foreground colour
+# bg - Initial background colour
+# count - Counter to control the number of times flashed
+
+proc focusAndFlash {W fg bg {count 9}} {
+ focus -force $W
+ if {$count<1} {
+ $W configure -foreground $fg -background $bg
+ } else {
+ if {$count%2} {
+ $W configure -foreground $bg -background $fg
+ } else {
+ $W configure -foreground $fg -background $bg
+ }
+ after 200 [list focusAndFlash $W $fg $bg [expr {$count-1}]]
+ }
+}
+
+labelframe $w.l1 -text "Integer Entry"
+entry $w.l1.e -validate focus -vcmd {string is integer %P}
+$w.l1.e configure -invalidcommand \
+ "focusAndFlash %W [$w.l1.e cget -fg] [$w.l1.e cget -bg]"
+pack $w.l1.e -fill x -expand 1 -padx 1m -pady 1m
+
+labelframe $w.l2 -text "Length-Constrained Entry"
+entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P]<10}}
+pack $w.l2.e -fill x -expand 1 -padx 1m -pady 1m
+
+### PHONE NUMBER ENTRY ###
+# Note that the source to this is quite a bit longer as the behaviour
+# demonstrated is a lot more ambitious than with the others.
+
+# Initial content for the third entry widget
+set entry3content "1-(000)-000-0000"
+# Mapping from alphabetic characters to numbers. This is probably
+# wrong, but it is the only mapping I have; the UK doesn't really go
+# for associating letters with digits for some reason.
+set phoneNumberMap {}
+foreach {chars digit} {abc 2 def 3 ghi 4 jkl 5 mno 6 pqrs 7 tuv 8 wxyz 9} {
+ foreach char [split $chars ""] {
+ lappend phoneNumberMap $char $digit [string toupper $char] $digit
+ }
+}
+
+# validatePhoneChange --
+# Checks that the replacement (mapped to a digit) of the given
+# character in an entry widget at the given position will leave a
+# valid phone number in the widget.
+#
+# W - The entry widget to validate
+# vmode - The widget's validation mode
+# idx - The index where replacement is to occur
+# char - The character (or string, though that will always be
+# refused) to be overwritten at that point.
+
+proc validatePhoneChange {W vmode idx char} {
+ global phoneNumberMap entry3content
+ if {$idx == -1} {return 1}
+ after idle [list $W configure -validate $vmode -invcmd bell]
+ if {
+ !($idx<3 || $idx==6 || $idx==7 || $idx==11 || $idx>15) &&
+ [string match {[0-9A-Za-z]} $char]
+ } then {
+ $W delete $idx
+ $W insert $idx [string map $phoneNumberMap $char]
+ after idle [list phoneSkipRight $W -1]
+ return 1
+ }
+ return 0
+}
+
+# phoneSkipLeft --
+# Skip over fixed characters in a phone-number string when moving left.
+#
+# Arguments:
+# W - The entry widget containing the phone-number.
+
+proc phoneSkipLeft {W} {
+ set idx [$W index insert]
+ if {$idx == 8} {
+ # Skip back two extra characters
+ $W icursor [incr idx -2]
+ } elseif {$idx == 7 || $idx == 12} {
+ # Skip back one extra character
+ $W icursor [incr idx -1]
+ } elseif {$idx <= 3} {
+ # Can't move any further
+ bell
+ return -code break
+ }
+}
+
+# phoneSkipRight --
+# Skip over fixed characters in a phone-number string when moving right.
+#
+# Arguments:
+# W - The entry widget containing the phone-number.
+# add - Offset to add to index before calculation (used by validation.)
+
+proc phoneSkipRight {W {add 0}} {
+ set idx [$W index insert]
+ if {$idx+$add == 5} {
+ # Skip forward two extra characters
+ $W icursor [incr idx 2]
+ } elseif {$idx+$add == 6 || $idx+$add == 10} {
+ # Skip forward one extra character
+ $W icursor [incr idx]
+ } elseif {$idx+$add == 15 && !$add} {
+ # Can't move any further
+ bell
+ return -code break
+ }
+}
+
+labelframe $w.l3 -text "US Phone-Number Entry"
+entry $w.l3.e -validate key -invcmd bell -textvariable entry3content \
+ -vcmd {validatePhoneChange %W %v %i %S}
+# Click to focus goes to the first editable character...
+bind $w.l3.e <FocusIn> {
+ if {"%d" ne "NotifyAncestor"} {
+ %W icursor 3
+ after idle {%W selection clear}
+ }
+}
+bind $w.l3.e <Left> {phoneSkipLeft %W}
+bind $w.l3.e <Right> {phoneSkipRight %W}
+pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m
+
+labelframe $w.l4 -text "Password Entry"
+entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P]<=8}}
+pack $w.l4.e -fill x -expand 1 -padx 1m -pady 1m
+
+lower [frame $w.mid]
+grid $w.l1 $w.l2 -in $w.mid -padx 3m -pady 1m -sticky ew
+grid $w.l3 $w.l4 -in $w.mid -padx 3m -pady 1m -sticky ew
+grid columnconfigure $w.mid {0 1} -uniform 1
+pack $w.msg -side top
+pack $w.buttons -side bottom -fill x -pady 2m
+pack $w.mid -fill both -expand 1
diff --git a/tcl/library/demos/filebox.tcl b/tcl/library/demos/filebox.tcl
new file mode 100644
index 00000000000..a0c32a585b7
--- /dev/null
+++ b/tcl/library/demos/filebox.tcl
@@ -0,0 +1,70 @@
+# filebox.tcl --
+#
+# This demonstration script prompts the user to select a file.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/floor.tcl b/tcl/library/demos/floor.tcl
new file mode 100644
index 00000000000..d488eacea17
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/form.tcl b/tcl/library/demos/form.tcl
new file mode 100644
index 00000000000..082cbf3d31f
--- /dev/null
+++ b/tcl/library/demos/form.tcl
@@ -0,0 +1,40 @@
+# form.tcl --
+#
+# This demonstration script creates a simple form with a bunch
+# of entry widgets.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/hello b/tcl/library/demos/hello
new file mode 100644
index 00000000000..b163175fb93
--- /dev/null
+++ b/tcl/library/demos/hello
@@ -0,0 +1,22 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# hello --
+# Simple Tk script to create a button that prints "Hello, world".
+# Click on the button to terminate the program.
+#
+# RCS: @(#) $Id$
+#
+# 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
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tcl/library/demos/hscale.tcl b/tcl/library/demos/hscale.tcl
new file mode 100644
index 00000000000..25ae7794a4d
--- /dev/null
+++ b/tcl/library/demos/hscale.tcl
@@ -0,0 +1,47 @@
+# hscale.tcl --
+#
+# This demonstration script shows an example with a horizontal scale.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/icon.tcl b/tcl/library/demos/icon.tcl
new file mode 100644
index 00000000000..06cdc1fd63a
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/image1.tcl b/tcl/library/demos/image1.tcl
new file mode 100644
index 00000000000..820c9c1f10e
--- /dev/null
+++ b/tcl/library/demos/image1.tcl
@@ -0,0 +1,36 @@
+# image1.tcl --
+#
+# This demonstration script displays two image widgets.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/image2.tcl b/tcl/library/demos/image2.tcl
new file mode 100644
index 00000000000..226202461d7
--- /dev/null
+++ b/tcl/library/demos/image2.tcl
@@ -0,0 +1,104 @@
+# image2.tcl --
+#
+# This demonstration script creates a simple collection of widgets
+# that allow you to select and view images in a Tk label.
+#
+# RCS: @(#) $Id$
+
+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 -directory $dirName *]] {
+ $w.f.list insert end [file tail $i]
+ }
+}
+
+# selectAndLoadDir --
+# This procedure pops up a dialog to ask for a directory to load into
+# the listobx and (if the user presses OK) reloads the directory
+# listbox from the directory named in the demo's entry.
+#
+# Arguments:
+# w - Name of the toplevel window of the demo.
+
+proc selectAndLoadDir w {
+ global dirName
+ set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1]
+ if {[string length $dir] != 0} {
+ set dirName $dir
+ loadDir $w
+ }
+}
+
+# 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
+
+frame $w.mid
+pack $w.mid -fill both -expand 1
+
+labelframe $w.dir -text "Directory:"
+set dirName [file join $tk_library demos images]
+entry $w.dir.e -width 30 -textvariable dirName
+button $w.dir.b -pady 0 -padx 2m -text "Select Dir." \
+ -command "selectAndLoadDir $w"
+bind $w.dir.e <Return> "loadDir $w"
+pack $w.dir.e -side left -fill both -padx 2m -pady 2m -expand true
+pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m
+labelframe $w.f -text "File:" -padx 2m -pady 2m
+
+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
+labelframe $w.image -text "Image:"
+label $w.image.image -image image2a
+pack $w.image.image -padx 2m -pady 2m
+
+grid $w.dir - -sticky ew -padx 1m -pady 1m -in $w.mid
+grid $w.f $w.image -sticky nw -padx 1m -pady 1m -in $w.mid
+grid columnconfigure $w.mid 1 -weight 1
diff --git a/tcl/library/demos/images/earth.gif b/tcl/library/demos/images/earth.gif
new file mode 100644
index 00000000000..2c229eb1101
--- /dev/null
+++ b/tcl/library/demos/images/earth.gif
Binary files differ
diff --git a/tcl/library/demos/images/earthris.gif b/tcl/library/demos/images/earthris.gif
new file mode 100644
index 00000000000..c4ee4737279
--- /dev/null
+++ b/tcl/library/demos/images/earthris.gif
Binary files differ
diff --git a/tcl/library/demos/images/face.bmp b/tcl/library/demos/images/face.bmp
new file mode 100644
index 00000000000..03d829f4d1f
--- /dev/null
+++ b/tcl/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/tcl/library/demos/images/flagdown.bmp b/tcl/library/demos/images/flagdown.bmp
new file mode 100644
index 00000000000..55abc51825b
--- /dev/null
+++ b/tcl/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/tcl/library/demos/images/flagup.bmp b/tcl/library/demos/images/flagup.bmp
new file mode 100644
index 00000000000..6eb0d846a32
--- /dev/null
+++ b/tcl/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/tcl/library/demos/images/gray25.bmp b/tcl/library/demos/images/gray25.bmp
new file mode 100644
index 00000000000..b234b3cb0be
--- /dev/null
+++ b/tcl/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/tcl/library/demos/images/letters.bmp b/tcl/library/demos/images/letters.bmp
new file mode 100644
index 00000000000..0f12568d1a0
--- /dev/null
+++ b/tcl/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/tcl/library/demos/images/noletter.bmp b/tcl/library/demos/images/noletter.bmp
new file mode 100644
index 00000000000..5774124efe9
--- /dev/null
+++ b/tcl/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/tcl/library/demos/images/pattern.bmp b/tcl/library/demos/images/pattern.bmp
new file mode 100644
index 00000000000..df31baf7895
--- /dev/null
+++ b/tcl/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/tcl/library/demos/images/tcllogo.gif b/tcl/library/demos/images/tcllogo.gif
new file mode 100644
index 00000000000..4603d4ff417
--- /dev/null
+++ b/tcl/library/demos/images/tcllogo.gif
Binary files differ
diff --git a/tcl/library/demos/images/teapot.ppm b/tcl/library/demos/images/teapot.ppm
new file mode 100644
index 00000000000..b8ab85f3a5d
--- /dev/null
+++ b/tcl/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/tcl/library/demos/items.tcl b/tcl/library/demos/items.tcl
new file mode 100644
index 00000000000..fea5e8b1a5e
--- /dev/null
+++ b/tcl/library/demos/items.tcl
@@ -0,0 +1,285 @@
+# items.tcl --
+#
+# This demonstration script creates a canvas that displays the
+# canvas item types.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/ixset b/tcl/library/demos/ixset
new file mode 100644
index 00000000000..76319cc0bb6
--- /dev/null
+++ b/tcl/library/demos/ixset
@@ -0,0 +1,335 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" ${1+"$@"}
+
+# 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
+#
+# RCS: @(#) $Id$
+
+#
+# Button actions
+#
+
+proc quit {} {
+ destroy .
+}
+
+proc ok {} {
+ writesettings
+ quit
+}
+
+proc cancel {} {
+ readsettings
+ dispsettings
+ .buttons.apply configure -state disabled
+ .buttons.cancel configure -state disabled
+}
+
+proc apply {} {
+ writesettings
+ .buttons.apply configure -state disabled
+ .buttons.cancel configure -state disabled
+}
+
+#
+# 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.tim.entry get]
+ set screencyc [.screen.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.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"]
+ .screen.pat [expr "{$screenbla}!={blank} ? {select} : {deselect}"]
+ .screen.tim.entry delete 0 end
+ .screen.tim.entry insert 0 $screentim
+ .screen.cyc.entry delete 0 end
+ .screen.cyc.entry insert 0 $screencyc
+}
+
+
+#
+# Create all windows, and pack them
+#
+
+proc labelentry {path text length {range {}}} {
+ frame $path
+ label $path.label -text $text
+ if {[llength $range]} {
+ spinbox $path.entry -width $length -relief sunken \
+ -from [lindex $range 0] -to [lindex $range 1]
+ } else {
+ entry $path.entry -width $length -relief sunken
+ }
+ pack $path.label -side left
+ pack $path.entry -side right -expand y -fill x
+}
+
+proc createwindows {} {
+ #
+ # Buttons
+ #
+
+ frame .buttons
+ button .buttons.ok -default active -command ok -text "Ok"
+ button .buttons.apply -default normal -command apply -text "Apply" \
+ -state disabled
+ button .buttons.cancel -default normal -command cancel -text "Cancel" \
+ -state disabled
+ button .buttons.quit -default normal -command quit -text "Quit"
+
+ pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \
+ -side left -expand yes -pady 5
+
+ bind . <Return> {.buttons.ok flash; .buttons.ok invoke}
+ bind . <Escape> {.buttons.quit flash; .buttons.quit invoke}
+ bind . <1> {
+ if {![string match .buttons* %W]} {
+ .buttons.apply configure -state normal
+ .buttons.cancel configure -state normal
+ }
+ }
+ bind . <Key> {
+ if {![string match .buttons* %W]} {
+ switch -glob %K {
+ Return - Escape - Tab - *Shift* {}
+ default {
+ .buttons.apply configure -state normal
+ .buttons.cancel configure -state normal
+ }
+ }
+ }
+ }
+
+ #
+ # Bell settings
+ #
+
+ labelframe .bell -text "Bell Settings" -padx 1.5m -pady 1.5m
+ 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 {25 20000}
+ labelentry .bell.val.dur "Duration (ms)" 6 {1 10000}
+ pack .bell.val.pit -side left -padx 5
+ pack .bell.val.dur -side right -padx 5
+ pack .bell.vol .bell.val -side top -expand yes
+
+ #
+ # Keyboard settings
+ #
+
+ labelframe .kbd -text "Keyboard Repeat Settings" -padx 1.5m -pady 1.5m
+
+ 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 -fill x -expand yes -padx {0 1m}
+ pack .kbd.val.cli -side left -expand yes -fill x -padx {1m 0}
+
+ pack .kbd.val -side top -expand yes -pady 2 -fill x
+
+ #
+ # Mouse settings
+ #
+
+ labelframe .mouse -text "Mouse Settings" -padx 1.5m -pady 1.5m
+
+ frame .mouse.hor
+ labelentry .mouse.hor.acc "Acceleration" 5
+ labelentry .mouse.hor.thr "Threshold (pixels)" 3 {1 2000}
+
+ pack .mouse.hor.acc -side left -padx {0 1m}
+ pack .mouse.hor.thr -side right -padx {1m 0}
+
+ pack .mouse.hor -side top -expand yes
+
+ #
+ # Screen Saver settings
+ #
+
+ labelframe .screen -text "Screen-saver Settings" -padx 1.5m -pady 1.5m
+
+ radiobutton .screen.blank \
+ -variable screenblank -text "Blank" -relief flat \
+ -value "blank" -variable screenbla -anchor w
+ radiobutton .screen.pat \
+ -variable screenblank -text "Pattern" -relief flat \
+ -value "noblank" -variable screenbla -anchor w
+ labelentry .screen.tim "Timeout (s)" 5 {1 100000}
+ labelentry .screen.cyc "Cycle (s)" 5 {1 100000}
+
+ grid .screen.blank .screen.tim -sticky e
+ grid .screen.pat .screen.cyc -sticky e
+ grid configure .screen.blank .screen.pat -sticky ew
+
+ #
+ # Main window
+ #
+
+ pack .buttons -side top -fill both
+ pack .bell .kbd .mouse .screen -side top -fill both -expand yes \
+ -padx 1m -pady 1m
+
+ #
+ # 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...
+#
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tcl/library/demos/label.tcl b/tcl/library/demos/label.tcl
new file mode 100644
index 00000000000..86ff4d61b5f
--- /dev/null
+++ b/tcl/library/demos/label.tcl
@@ -0,0 +1,40 @@
+# label.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several label widgets.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/labelframe.tcl b/tcl/library/demos/labelframe.tcl
new file mode 100644
index 00000000000..7688368025f
--- /dev/null
+++ b/tcl/library/demos/labelframe.tcl
@@ -0,0 +1,80 @@
+# labelframe.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several labelframe widgets.
+#
+# RCS: @(#) $Id$
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .labelframe
+catch {destroy $w}
+toplevel $w
+wm title $w "Labelframe Demonstration"
+wm iconname $w "labelframe"
+positionWindow $w
+
+# Some information
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Labelframes are\
+ used to group related widgets together. The label may be either \
+ plain text or another widget."
+pack $w.msg -side top
+
+# The bottom buttons
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w" -width 15
+button $w.buttons.code -text "See Code" -command "showCode $w" -width 15
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+# Demo area
+
+frame $w.f
+pack $w.f -side bottom -fill both -expand 1
+set w $w.f
+
+# A group of radiobuttons in a labelframe
+
+labelframe $w.f -text "Value" -padx 2 -pady 2
+grid $w.f -row 0 -column 0 -pady 2m -padx 2m
+
+foreach value {1 2 3 4} {
+ radiobutton $w.f.b$value -text "This is value $value" \
+ -variable lfdummy -value $value
+ pack $w.f.b$value -side top -fill x -pady 2
+}
+
+
+# Using a label window to control a group of options.
+
+proc lfEnableButtons {w} {
+ foreach child [winfo children $w] {
+ if {$child == "$w.cb"} continue
+ if {$::lfdummy2} {
+ $child configure -state normal
+ } else {
+ $child configure -state disabled
+ }
+ }
+}
+
+labelframe $w.f2 -pady 2 -padx 2
+checkbutton $w.f2.cb -text "Use this option." -variable lfdummy2 \
+ -command "lfEnableButtons $w.f2" -padx 0
+$w.f2 configure -labelwidget $w.f2.cb
+grid $w.f2 -row 0 -column 1 -pady 2m -padx 2m
+
+set t 0
+foreach str {Option1 Option2 Option3} {
+ checkbutton $w.f2.b$t -text $str
+ pack $w.f2.b$t -side top -fill x -pady 2
+ incr t
+}
+lfEnableButtons $w.f2
+
+
+grid columnconfigure $w {0 1} -weight 1
diff --git a/tcl/library/demos/license.terms b/tcl/library/demos/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tcl/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/tcl/library/demos/menu.tcl b/tcl/library/demos/menu.tcl
new file mode 100644
index 00000000000..9b0f6bb4fe1
--- /dev/null
+++ b/tcl/library/demos/menu.tcl
@@ -0,0 +1,160 @@
+# menu.tcl --
+#
+# This demonstration script creates a window with a bunch of menus
+# and cascaded menus using menubars.
+#
+# RCS: @(#) $Id$
+
+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 {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ $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 {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ 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\""]
+}
+$m entryconfigure "Does almost nothing" \
+ -bitmap questhead -compound left -command {
+ tk_dialog .compound {Compound Menu Entry} {The menu entry you invoked\
+ displays both a bitmap and a text string. Other than this, it\
+ is just like any other menu entry.} {} 0 OK
+}
+
+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/tcl/library/demos/menubu.tcl b/tcl/library/demos/menubu.tcl
new file mode 100644
index 00000000000..2f9fea930b0
--- /dev/null
+++ b/tcl/library/demos/menubu.tcl
@@ -0,0 +1,94 @@
+# menubutton.tcl --
+#
+# This demonstration script creates a window with a bunch of menus
+# and cascaded menus using menubuttons.
+#
+# # RCS: @(#) $Id$
+
+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 {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ 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/tcl/library/demos/msgbox.tcl b/tcl/library/demos/msgbox.tcl
new file mode 100644
index 00000000000..bc286c16c50
--- /dev/null
+++ b/tcl/library/demos/msgbox.tcl
@@ -0,0 +1,65 @@
+# msgbox.tcl --
+#
+# This demonstration script creates message boxes of various type
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/paned1.tcl b/tcl/library/demos/paned1.tcl
new file mode 100644
index 00000000000..5adc2550c75
--- /dev/null
+++ b/tcl/library/demos/paned1.tcl
@@ -0,0 +1,34 @@
+# paned1.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# a paned window that separates two windows horizontally.
+#
+# RCS: @(#) $Id$
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .paned1
+catch {destroy $w}
+toplevel $w
+wm title $w "Horizontal Paned Window Demonstration"
+wm iconname $w "paned1"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two coloured windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
+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
+
+panedwindow $w.pane
+pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
+
+label $w.pane.left -text "This is the\nleft side" -bg yellow
+label $w.pane.right -text "This is the\nright side" -bg cyan
+
+$w.pane add $w.pane.left $w.pane.right
diff --git a/tcl/library/demos/paned2.tcl b/tcl/library/demos/paned2.tcl
new file mode 100644
index 00000000000..5bfcf06f837
--- /dev/null
+++ b/tcl/library/demos/paned2.tcl
@@ -0,0 +1,76 @@
+# paned2.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# a paned window that separates two windows vertically.
+#
+# RCS: @(#) $Id$
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .paned2
+catch {destroy $w}
+toplevel $w
+wm title $w "Vertical Paned Window Demonstration"
+wm iconname $w "paned2"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two scrolled windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
+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
+
+# Create the pane itself
+panedwindow $w.pane -orient vertical
+pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
+
+# The top window is a listbox with scrollbar
+set paneList {
+ {List of Tk Widgets}
+ button
+ canvas
+ checkbutton
+ entry
+ frame
+ label
+ labelframe
+ listbox
+ menu
+ menubutton
+ message
+ panedwindow
+ radiobutton
+ scale
+ scrollbar
+ spinbox
+ text
+ toplevel
+}
+set f [frame $w.pane.top]
+listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set"
+# Invert the first item to highlight it
+$f.list itemconfigure 0 \
+ -background [$f.list cget -fg] -foreground [$f.list cget -bg]
+scrollbar $f.scr -orient vertical -command "$f.list yview"
+pack $f.scr -side right -fill y
+pack $f.list -fill both -expand 1
+
+# The bottom window is a text widget with scrollbar
+set f [frame $w.pane.bottom]
+text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \
+ -width 30 -wrap none
+scrollbar $f.xscr -orient horizontal -command "$f.text xview"
+scrollbar $f.yscr -orient vertical -command "$f.text yview"
+grid $f.text $f.yscr -sticky nsew
+grid $f.xscr -sticky nsew
+grid columnconfigure $f 0 -weight 1
+grid rowconfigure $f 0 -weight 1
+$f.text insert 1.0 "This is just a normal text widget"
+
+# Now add our contents to the paned window
+$w.pane add $w.pane.top $w.pane.bottom
diff --git a/tcl/library/demos/plot.tcl b/tcl/library/demos/plot.tcl
new file mode 100644
index 00000000000..dadf6158c4d
--- /dev/null
+++ b/tcl/library/demos/plot.tcl
@@ -0,0 +1,99 @@
+# plot.tcl --
+#
+# This demonstration script creates a canvas widget showing a 2-D
+# plot with data points that can be dragged with the mouse.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/puzzle.tcl b/tcl/library/demos/puzzle.tcl
new file mode 100644
index 00000000000..31f13facd52
--- /dev/null
+++ b/tcl/library/demos/puzzle.tcl
@@ -0,0 +1,84 @@
+# puzzle.tcl --
+#
+# This demonstration script creates a 15-puzzle game using a collection
+# of buttons.
+#
+# RCS: @(#) $Id$
+
+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
+
+# The button metrics are a bit bigger in Aqua, and since we are
+# using place which doesn't autosize, then we need to have a
+# slightly larger frame here...
+
+if {[string equal [tk windowingsystem] aqua]} {
+ set frameSize 160
+} else {
+ set frameSize 120
+}
+
+frame $w.frame -width $frameSize -height $frameSize -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/tcl/library/demos/radio.tcl b/tcl/library/demos/radio.tcl
new file mode 100644
index 00000000000..80bfd37dc65
--- /dev/null
+++ b/tcl/library/demos/radio.tcl
@@ -0,0 +1,59 @@
+# radio.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several radiobutton widgets.
+#
+# RCS: @(#) $Id$
+
+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 "Three 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 align"
+pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
+
+labelframe $w.left -pady 2 -text "Point Size" -padx 2
+labelframe $w.mid -pady 2 -text "Color" -padx 2
+labelframe $w.right -pady 2 -text "Alignment" -padx 2
+pack $w.left $w.mid $w.right -side left -expand yes -pady .5c -padx .5c
+
+foreach i {10 12 14 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 -fill x
+}
+
+foreach c {Red Green Blue Yellow Orange Purple} {
+ set lower [string tolower $c]
+ radiobutton $w.mid.$lower -text $c -variable color \
+ -relief flat -value $lower -anchor w \
+ -command "$w.mid configure -fg \$color"
+ pack $w.mid.$lower -side top -pady 2 -fill x
+}
+
+label $w.right.l -text "Label" -bitmap questhead -compound left
+$w.right.l configure -width [winfo reqwidth $w.right.l] -compound top
+$w.right.l configure -height [winfo reqheight $w.right.l]
+foreach a {Top Left Right Bottom} {
+ set lower [string tolower $a]
+ radiobutton $w.right.$lower -text $a -variable align \
+ -relief flat -value $lower -indicatoron 0 -width 7 \
+ -command "$w.right.l configure -compound \$align"
+}
+grid x $w.right.top
+grid $w.right.left $w.right.l $w.right.right
+grid x $w.right.bottom
diff --git a/tcl/library/demos/rmt b/tcl/library/demos/rmt
new file mode 100644
index 00000000000..d0df5e25107
--- /dev/null
+++ b/tcl/library/demos/rmt
@@ -0,0 +1,210 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# rmt --
+# This script implements a simple remote-control mechanism for
+# Tk applications. It allows you to select an application and
+# then type commands to that application.
+#
+# RCS: @(#) $Id$
+
+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.
+
+. configure -menu [menu .menu]
+menu .menu.file
+menu .menu.file.apps -postcommand fillAppsMenu
+.menu add cascade -label "File" -underline 0 -menu .menu.file
+.menu.file add cascade -label "Select Application" -underline 0 \
+ -menu .menu.file.apps
+.menu.file add command -label "Quit" -command "destroy ." -underline 0
+
+# Create text window and scrollbar.
+
+text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
+scrollbar .s -command ".t yview"
+grid .t .s -sticky nsew
+grid rowconfigure . 0 -weight 1
+grid columnconfigure . 0 -weight 1
+
+# 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 configure -font {Courier 12}
+.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 {} {
+ set m .menu.file.apps
+ catch {$m delete 0 last}
+ foreach i [lsort [winfo interps]] {
+ $m add command -label $i -command [list newApp $i]
+ }
+ $m add command -label local -command {newApp local}
+}
+
+set app [winfo name .]
+prompt
+focus .t
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tcl/library/demos/rolodex b/tcl/library/demos/rolodex
new file mode 100644
index 00000000000..58bb0520b7a
--- /dev/null
+++ b/tcl/library/demos/rolodex
@@ -0,0 +1,196 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" ${1+"$@"}
+
+# rolodex --
+# This script was written as an entry in Tom LaStrange's rolodex
+# benchmark. It creates something that has some of the look and
+# feel of a rolodex program, although it's lifeless and doesn't
+# actually do the rolodex application.
+#
+# RCS: @(#) $Id$
+
+foreach i [winfo child .] {
+ catch {destroy $i}
+}
+
+set version 1.2
+
+#------------------------------------------
+# 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} {
+ label .frame.label$i -text [lindex $names $i] -anchor e
+ entry .frame.entry$i -width 35
+ grid .frame.label$i .frame.entry$i -sticky ew -pady 2 -padx 1
+}
+
+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.entry$i get]]
+ }
+}
+.buttons.add config -command addAction
+
+#------------------------------------------
+# Phase 4: Miscellaneous other actions
+#------------------------------------------
+
+proc clearAction {} {
+ foreach i {1 2 3 4 5 6 7} {
+ .frame.entry$i delete 0 end
+ }
+}
+.buttons.clear config -command clearAction
+
+proc fillCard {} {
+ clearAction
+ .frame.entry1 insert 0 "John Ousterhout"
+ .frame.entry2 insert 0 "CS Division, Department of EECS"
+ .frame.entry3 insert 0 "University of California"
+ .frame.entry4 insert 0 "Berkeley, CA 94720"
+ .frame.entry5 insert 0 "private"
+ .frame.entry6 insert 0 "510-642-0865"
+ .frame.entry7 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.entry1
+
+#----------------------------------------------------
+# 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]}]]
+}
+
+event add <<Help>> <F1> <Help>
+bind . <<Help>> {Help [winfo containing %X %Y] %X %Y}
+bind Menu <<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.1) {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.2) {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.entry1) {In this field of the rolodex entry you should type the person's name}
+set helpTopics(.frame.entry2) {In this field of the rolodex entry you should type the first line of the person's address}
+set helpTopics(.frame.entry3) {In this field of the rolodex entry you should type the second line of the person's address}
+set helpTopics(.frame.entry4) {In this field of the rolodex entry you should type the third line of the person's address}
+set helpTopics(.frame.entry5) {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.entry6) {In this field of the rolodex entry you should type the person's work phone number}
+set helpTopics(.frame.entry7) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
+
+set helpCmds(.frame.label1) {set topic .frame.entry1}
+set helpCmds(.frame.label2) {set topic .frame.entry2}
+set helpCmds(.frame.label3) {set topic .frame.entry3}
+set helpCmds(.frame.label4) {set topic .frame.entry4}
+set helpCmds(.frame.label5) {set topic .frame.entry5}
+set helpCmds(.frame.label6) {set topic .frame.entry6}
+set helpCmds(.frame.label7) {set topic .frame.entry7}
+
+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 $version."
+
+# 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/tcl/library/demos/ruler.tcl b/tcl/library/demos/ruler.tcl
new file mode 100644
index 00000000000..38b7170b9b4
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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) != $v(top)+2} {
+ $c delete active
+ } else {
+ eval "$c itemconf active $v(normalStyle)"
+ $c dtag active
+ }
+}
diff --git a/tcl/library/demos/sayings.tcl b/tcl/library/demos/sayings.tcl
new file mode 100644
index 00000000000..872e5d26095
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/search.tcl b/tcl/library/demos/search.tcl
new file mode 100644
index 00000000000..c8b267101eb
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/spin.tcl b/tcl/library/demos/spin.tcl
new file mode 100644
index 00000000000..4ba158b9b8d
--- /dev/null
+++ b/tcl/library/demos/spin.tcl
@@ -0,0 +1,55 @@
+# spin.tcl --
+#
+# This demonstration script creates several spinbox widgets.
+#
+# RCS: @(#) $Id$
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .spin
+catch {destroy $w}
+toplevel $w
+wm title $w "Spinbox Demonstration"
+wm iconname $w "spin"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 5i -justify left -text "Three different\
+ spin-boxes 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 values that are too large to fit in the\
+ window all at once, you can scan through the value by dragging with\
+ mouse button2 pressed. Note that the first spin-box will only permit\
+ you to type in integers, and the third selects from a list of\
+ Australian cities."
+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 australianCities {
+ Canberra Sydney Melbourne Perth Adelaide Brisbane
+ Hobart Darwin "Alice Springs"
+}
+
+spinbox $w.s1 -from 1 -to 10 -width 10 -validate key \
+ -vcmd {string is integer %P}
+spinbox $w.s2 -from 0 -to 3 -increment .5 -format %05.2f -width 10
+spinbox $w.s3 -values $australianCities -width 10
+
+#entry $w.e1
+#entry $w.e2
+#entry $w.e3
+pack $w.s1 $w.s2 $w.s3 -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/tcl/library/demos/square b/tcl/library/demos/square
new file mode 100644
index 00000000000..2ea0722f924
--- /dev/null
+++ b/tcl/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
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/states.tcl b/tcl/library/demos/states.tcl
new file mode 100644
index 00000000000..08834eea470
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/style.tcl b/tcl/library/demos/style.tcl
new file mode 100644
index 00000000000..136d4e22898
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/tclIndex b/tcl/library/demos/tclIndex
new file mode 100644
index 00000000000..86a72e2443e
--- /dev/null
+++ b/tcl/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/tcl/library/demos/tcolor b/tcl/library/demos/tcolor
new file mode 100644
index 00000000000..27b931fc73e
--- /dev/null
+++ b/tcl/library/demos/tcolor
@@ -0,0 +1,366 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# tcolor --
+# This script implements a simple color editor, where you can
+# create colors using either the RGB, HSB, or CYM color spaces
+# and apply the color to existing applications.
+#
+# RCS: @(#) $Id$
+
+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 ""
+
+if {$tcl_platform(platform) eq "unix"} {
+ option add *Entry.background white
+}
+
+# Create the menu bar at the top of the window.
+
+. configure -menu [menu .menu]
+menu .menu.file
+.menu add cascade -menu .menu.file -label File -underline 0
+.menu.file add radio -label "RGB color space" -variable colorSpace \
+ -value rgb -underline 0 -command {changeColorSpace rgb}
+.menu.file add radio -label "CMY color space" -variable colorSpace \
+ -value cmy -underline 0 -command {changeColorSpace cmy}
+.menu.file add radio -label "HSB color space" -variable colorSpace \
+ -value hsb -underline 0 -command {changeColorSpace hsb}
+.menu.file add separator
+.menu.file add radio -label "Automatic updates" -variable autoUpdate \
+ -value 1 -underline 0
+.menu.file add radio -label "Manual updates" -variable autoUpdate \
+ -value 0 -underline 0
+.menu.file add separator
+.menu.file add command -label "Exit program" -underline 0 -command {exit}
+
+# Create the command entry window at the bottom of the window, along
+# with the update button.
+
+labelframe .command -text "Command:" -padx {1m 0}
+entry .command.e -relief sunken -borderwidth 2 -textvariable command \
+ -font {Courier 12}
+button .command.update -text Update -command doUpdate
+pack .command.update -side right -pady .1c -padx {.25c 0}
+pack .command.e -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.
+
+grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}
+
+grid columnconfigure . {1 2} -weight 1
+grid rowconfigure . 0 -weight 1
+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]
+ labelframe .names -text "Select:" -padx .1c -pady .1c
+ grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
+ grid columnconfigure . 0 -weight 1
+ listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
+ -relief sunken -borderwidth 2 -exportselection false
+ bind .names.lb <Double-1> {
+ tc_loadNamedColor [.names.lb get [.names.lb curselection]]
+ }
+ scrollbar .names.s -orient vertical -command ".names.lb yview" \
+ -relief sunken -borderwidth 2
+ pack .names.lb .names.s -side left -fill y -expand 1
+ while {[gets $f line] >= 0} {
+ if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
+ .names.lb insert end $col
+ }
+ }
+ close $f
+ break
+}
+
+# Create the three scales for editing the color, and the entry for
+# typing in a color value.
+
+frame .adjust
+foreach i {1 2 3} {
+ label .adjust.l$i -textvariable label$i -pady 0
+ labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
+ scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
+ -command tc_scaleChanged
+ pack .scale$i -in .adjust.$i
+ pack .adjust.$i
+}
+grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c
+
+labelframe .name -text "Name:" -padx 1m -pady 1m
+entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \
+ -font {Courier 12}
+pack .name.e -side right -expand 1 -fill x
+bind .name.e <Return> {tc_loadNamedColor $name}
+grid .name -column 1 -row 1 -sticky nsew -padx .15c -pady .15c
+
+# Create the color display swatch on the right side of the window.
+
+labelframe .sample -text "Color:" -padx 1m -pady 1m
+frame .sample.swatch -width 2c -height 5c -background $color
+label .sample.value -textvariable color -width 13 -font {Courier 12}
+pack .sample.swatch -side top -expand yes -fill both
+pack .sample.value -side bottom -pady .25c
+grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2
+
+
+# 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
+ }
+ switch $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}]]
+ }
+ 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}]]
+ }
+ hsb {
+ 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]
+ .sample.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
+ switch $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}]]
+ }
+ 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}]]
+ }
+ hsb {
+ 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 .sample.swatch $name]
+ set red [lindex $list 0]
+ set green [lindex $list 1]
+ set blue [lindex $list 2]
+ } else {
+ switch [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]
+ .sample.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
+ switch $space {
+ rgb {
+ set label1 "Adjust Red:"
+ set label2 "Adjust Green:"
+ set label3 "Adjust Blue:"
+ tc_setScales
+ return
+ }
+ cmy {
+ set label1 "Adjust Cyan:"
+ set label2 "Adjust Magenta:"
+ set label3 "Adjust Yellow:"
+ tc_setScales
+ return
+ }
+ hsb {
+ set label1 "Adjust Hue:"
+ set label2 "Adjust Saturation:"
+ set label3 "Adjust 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 [expr {double($red)}]
+ set min [expr {double($green)}]
+ } else {
+ set max [expr {double($green)}]
+ set min [expr {double($red)}]
+ }
+ if {$blue > $max} {
+ set max [expr {double($blue)}]
+ } elseif {$blue < $min} {
+ set min [expr {double($blue)}]
+ }
+ 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 {($bc - $gc)/6.0}]
+ } elseif {$green == $max} {
+ set hue [expr {(2 + $rc - $bc)/6.0}]
+ } else {
+ set hue [expr {(4 + $gc - $rc)/6.0}]
+ }
+ 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)))}]]
+ switch $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"}
+ default {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
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tcl/library/demos/text.tcl b/tcl/library/demos/text.tcl
new file mode 100644
index 00000000000..555b095413d
--- /dev/null
+++ b/tcl/library/demos/text.tcl
@@ -0,0 +1,88 @@
+# text.tcl --
+#
+# This demonstration script creates a text widget that describes
+# the basic editing functions.
+#
+# RCS: @(#) $Id$
+
+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 -undo 1 -autosep 1
+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. Control-z undoes the last editing action performed,
+and }
+
+switch $tcl_platform(platform) {
+ "unix" - "macintosh" {
+ $w.text insert end "Control-Shift-z"
+ }
+ "windows" {
+ $w.text insert end "Control-y"
+ }
+}
+
+$w.text insert end { redoes undone edits.
+
+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/tcl/library/demos/timer b/tcl/library/demos/timer
new file mode 100644
index 00000000000..5241331f839
--- /dev/null
+++ b/tcl/library/demos/timer
@@ -0,0 +1,47 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# timer --
+# This script generates a counter with start and stop buttons.
+#
+# RCS: @(#) $Id$
+
+label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m
+button .start -text Start -command {
+ if {$stopped} {
+ set stopped 0
+ set startMoment [clock clicks -milliseconds]
+ tick
+ .stop configure -state normal
+ .start configure -state disabled
+ }
+}
+button .stop -text Stop -state disabled -command {
+ set stopped 1
+ .stop configure -state disabled
+ .start configure -state normal
+}
+pack .counter -side bottom -fill both
+pack .start -side left -fill both -expand yes
+pack .stop -side right -fill both -expand yes
+
+set startMoment {}
+
+set stopped 1
+
+proc tick {} {
+ global startMoment stopped
+ if {$stopped} {return}
+ after 50 tick
+ set elapsedMS [expr {[clock clicks -milliseconds] - $startMoment}]
+ .counter config -text [format "%.2f" [expr {double($elapsedMS)/1000}]]
+}
+
+bind . <Control-c> {destroy .}
+bind . <Control-q> {destroy .}
+focus .
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tcl/library/demos/twind.tcl b/tcl/library/demos/twind.tcl
new file mode 100644
index 00000000000..0a41c0d1e49
--- /dev/null
+++ b/tcl/library/demos/twind.tcl
@@ -0,0 +1,197 @@
+# twind.tcl --
+#
+# This demonstration script creates a text widget with a bunch of
+# embedded windows.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/vscale.tcl b/tcl/library/demos/vscale.tcl
new file mode 100644
index 00000000000..278e7d0a659
--- /dev/null
+++ b/tcl/library/demos/vscale.tcl
@@ -0,0 +1,48 @@
+# vscale.tcl --
+#
+# This demonstration script shows an example with a vertical scale.
+#
+# RCS: @(#) $Id$
+
+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/tcl/library/demos/widget b/tcl/library/demos/widget
new file mode 100644
index 00000000000..8414aab3471
--- /dev/null
+++ b/tcl/library/demos/widget
@@ -0,0 +1,393 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# widget --
+# This script demonstrates the various widgets provided by Tk,
+# along with many of the features of the Tk toolkit. This file
+# only contains code to generate the main window for the
+# application, which invokes individual demonstrations. The
+# code for the actual demonstrations is contained in separate
+# ".tcl" files is this directory, which are sourced by this script
+# as needed.
+#
+# RCS: @(#) $Id$
+
+eval destroy [winfo child .]
+wm title . "Widget Demonstration"
+if {$tcl_platform(platform) eq "unix"} {
+ # This won't work everywhere, but there's no other way in core Tk
+ # at the moment to display a coloured icon.
+ image create photo TclPowered \
+ -file [file join $tk_library images logo64.gif]
+ wm iconwindow . [toplevel ._iconWindow]
+ pack [label ._iconWindow.i -image TclPowered]
+ wm iconname . "tkWidgetDemo"
+}
+
+array set widgetFont {
+ main {Helvetica 12}
+ bold {Helvetica 12 bold}
+ title {Helvetica 18 bold}
+ status {Helvetica 10}
+ vars {Helvetica 14}
+}
+
+set widgetDemo 1
+set font $widgetFont(main)
+
+#----------------------------------------------------------------
+# 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.
+#----------------------------------------------------------------
+
+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 {[string equal [tk windowingsystem] "classic"]} {
+ .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 $widgetFont(status) -anchor w
+label .statusBar.foo -width 8 -relief sunken -bd 1 \
+ -font $widgetFont(status) -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 70 -height 30 \
+ -font $widgetFont(main) -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 $widgetFont(title)
+.t tag configure bold -font $widgetFont(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.
+
+proc addDemoSection {title demos} {
+ .t insert end "\n" {} $title title " \n " demospace
+ set num 0
+ foreach {name description} $demos {
+ .t insert end "[incr num]. $description." [list demo demo-$name]
+ .t insert end " \n " demospace
+ }
+}
+
+.t insert end "Tk Widget Demonstrations\n" title
+.t insert end "\nThis 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" bold " button to see the\
+ Tcl/Tk code that created the demonstration. If you wish, you can\
+ edit the code and click the " {} "Rerun Demo" bold " button in the\
+ code window to reinvoke the demonstration with the modified code.\n"
+
+addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" {
+ label "Labels (text and bitmaps)"
+ button "Buttons"
+ check "Check-buttons (select any of a group)"
+ radio "Radio-buttons (select one of a group)"
+ puzzle "A 15-puzzle game made out of buttons"
+ icon "Iconic buttons that use bitmaps"
+ image1 "Two labels displaying images"
+ image2 "A simple user interface for viewing images"
+ labelframe "Labelled frames"
+}
+addDemoSection "Listboxes" {
+ states "The 50 states"
+ colors "Colors: change the color scheme for the application"
+ sayings "A collection of famous and infamous sayings"
+}
+addDemoSection "Entries and Spin-boxes" {
+ entry1 "Entries without scrollbars"
+ entry2 "Entries with scrollbars"
+ entry3 "Validated entries and password fields"
+ spin "Spin-boxes"
+ form "Simple Rolodex-like form"
+}
+addDemoSection "Text" {
+ text "Basic editable text"
+ style "Text display styles"
+ bind "Hypertext (tag bindings)"
+ twind "A text widget with embedded windows"
+ search "A search tool built with a text widget"
+}
+addDemoSection "Canvases" {
+ items "The canvas item types"
+ plot "A simple 2-D plot"
+ ctext "Text items in canvases"
+ arrow "An editor for arrowheads on canvas lines"
+ ruler "A ruler with adjustable tab stops"
+ floor "A building floor plan"
+ cscroll "A simple scrollable canvas"
+}
+addDemoSection "Scales" {
+ hscale "Horizontal scale"
+ vscale "Vertical scale"
+}
+addDemoSection "Paned Windows" {
+ paned1 "Horizontal paned window"
+ paned2 "Vertical paned window"
+}
+addDemoSection "Menus" {
+ menu "Menus and cascades (sub-menus)"
+ menubu "Menu-buttons"
+}
+addDemoSection "Common Dialogs" {
+ msgbox "Message boxes"
+ filebox "File selection dialog"
+ clrpick "Color picker"
+}
+addDemoSection "Miscellaneous" {
+ bitmap "The built-in bitmaps"
+ dialog1 "A dialog box with a local grab"
+ dialog2 "A dialog box with a global grab"
+}
+
+.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} {
+ global widgetFont
+ catch {destroy $w}
+ toplevel $w
+ wm title $w "Variable values"
+ label $w.title -text "Variable values:" -width 20 -anchor center \
+ -font $widgetFont(vars)
+ 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
+
+Copyright (c) 1996-1997 Sun Microsystems, Inc.
+
+Copyright (c) 1997-2000 Ajuba Solutions, Inc.
+
+Copyright (c) 2001-2002 Donal K. Fellows"
+}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tcl/library/dialog.tcl b/tcl/library/dialog.tcl
new file mode 100644
index 00000000000..2d5036a66be
--- /dev/null
+++ b/tcl/library/dialog.tcl
@@ -0,0 +1,199 @@
+# dialog.tcl --
+#
+# This file defines the procedure tk_dialog, which creates a dialog
+# box containing a bitmap, a message, and one or more buttons.
+#
+# RCS: @(#) $Id$
+#
+# 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 tcl_platform
+ variable ::tk::Priv
+
+ # Check that $default was properly given
+ if {[string is int $default]} {
+ if {$default >= [llength $args]} {
+ return -code error "default button index greater than number of\
+ buttons specified for tk_dialog"
+ }
+ } elseif {[string equal {} $default]} {
+ set default -1
+ } else {
+ set default [lsearch -exact $args $default]
+ }
+
+ # 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 { }
+
+ # Dialog boxes should be transient with respect to their parent,
+ # so that they will always stay on top of their parent window. However,
+ # some window managers will create the window as withdrawn if the parent
+ # window is withdrawn or iconified. Combined with the grab we put on the
+ # window, this can hang the entire application. Therefore we only make
+ # the dialog transient if the parent is viewable.
+ #
+ if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {
+ wm transient $w [winfo toplevel [winfo parent $w]]
+ }
+
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ ::tk::unsupported::MacWindowStyle style $w dBoxProc
+ }
+
+ frame $w.bot
+ frame $w.top
+ if {[string equal [tk windowingsystem] "x11"]} {
+ $w.bot configure -relief raised -bd 1
+ $w.top configure -relief raised -bd 1
+ }
+ pack $w.bot -side bottom -fill both
+ pack $w.top -side top -fill both -expand 1
+
+ # 2. Fill the top part with bitmap and message (use the option
+ # database for -wraplength and -font so that they can be
+ # overridden by the caller).
+
+ option add *Dialog.msg.wrapLength 3i widgetDefault
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ option add *Dialog.msg.font system widgetDefault
+ } else {
+ option add *Dialog.msg.font {Times 12} widgetDefault
+ }
+
+ label $w.msg -justify left -text $text
+ pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
+ if {[string compare $bitmap ""]} {
+ if {([string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]) &&\
+ [string equal $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 [list set ::tk::Priv(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 -pady 4
+ grid columnconfigure $w.bot $i
+ # We boost the size of some Mac buttons for l&f
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ set tmp [string tolower $but]
+ if {[string equal $tmp "ok"] || [string equal $tmp "cancel"]} {
+ grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]
+ }
+ }
+ incr i
+ }
+
+ # 4. Create a binding for <Return> on the dialog if there is a
+ # default button.
+
+ if {$default >= 0} {
+ bind $w <Return> "
+ [list $w.button$default] configure -state active -relief sunken
+ update idletasks
+ after 100
+ set ::tk::Priv(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 ::tk::Priv(button) -1}
+
+ # 6. Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w +$x+$y
+ wm deiconify $w
+
+ # 7. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current $w]
+ if {[string compare $oldGrab ""]} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab $w
+ if {$default >= 0} {
+ focus $w.button$default
+ } else {
+ focus $w
+ }
+
+ # 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.
+
+ vwait ::tk::Priv(button)
+ catch {focus $oldFocus}
+ catch {
+ # It's possible that the window has already been destroyed,
+ # hence this "catch". Delete the Destroy handler so that
+ # Priv(button) doesn't get reset by it.
+
+ bind $w <Destroy> {}
+ destroy $w
+ }
+ if {[string compare $oldGrab ""]} {
+ if {[string compare $grabStatus "global"]} {
+ grab $oldGrab
+ } else {
+ grab -global $oldGrab
+ }
+ }
+ return $Priv(button)
+}
diff --git a/tcl/library/entry.tcl b/tcl/library/entry.tcl
new file mode 100644
index 00000000000..5bc2ed381b0
--- /dev/null
+++ b/tcl/library/entry.tcl
@@ -0,0 +1,652 @@
+# entry.tcl --
+#
+# This file defines the default bindings for Tk entry widgets and provides
+# procedures that help in implementing those bindings.
+#
+# RCS: @(#) $Id$
+#
+# 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 tk::Priv 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.
+# data - Used for Cut and Copy
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+bind Entry <<Cut>> {
+ if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tk::Priv(data)
+ %W delete sel.first sel.last
+ unset tk::Priv(data)
+ }
+}
+bind Entry <<Copy>> {
+ if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tk::Priv(data)
+ unset tk::Priv(data)
+ }
+}
+bind Entry <<Paste>> {
+ global tcl_platform
+ catch {
+ if {[string compare [tk windowingsystem] "x11"]} {
+ catch {
+ %W delete sel.first sel.last
+ }
+ }
+ %W insert insert [::tk::GetSelection %W CLIPBOARD]
+ tk::EntrySeeInsert %W
+ }
+}
+bind Entry <<Clear>> {
+ %W delete sel.first sel.last
+}
+bind Entry <<PasteSelection>> {
+ if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
+ || !$tk::Priv(mouseMoved)} {
+ tk::EntryPaste %W %x
+ }
+}
+
+# Standard Motif bindings:
+
+bind Entry <1> {
+ tk::EntryButton1 %W %x
+ %W selection clear
+}
+bind Entry <B1-Motion> {
+ set tk::Priv(x) %x
+ tk::EntryMouseSelect %W %x
+}
+bind Entry <Double-1> {
+ set tk::Priv(selectMode) word
+ tk::EntryMouseSelect %W %x
+ catch {%W icursor sel.last}
+}
+bind Entry <Triple-1> {
+ set tk::Priv(selectMode) line
+ tk::EntryMouseSelect %W %x
+ catch {%W icursor sel.last}
+}
+bind Entry <Shift-1> {
+ set tk::Priv(selectMode) char
+ %W selection adjust @%x
+}
+bind Entry <Double-Shift-1> {
+ set tk::Priv(selectMode) word
+ tk::EntryMouseSelect %W %x
+}
+bind Entry <Triple-Shift-1> {
+ set tk::Priv(selectMode) line
+ tk::EntryMouseSelect %W %x
+}
+bind Entry <B1-Leave> {
+ set tk::Priv(x) %x
+ tk::EntryAutoScan %W
+}
+bind Entry <B1-Enter> {
+ tk::CancelRepeat
+}
+bind Entry <ButtonRelease-1> {
+ tk::CancelRepeat
+}
+bind Entry <Control-1> {
+ %W icursor @%x
+}
+
+bind Entry <Left> {
+ tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
+}
+bind Entry <Right> {
+ tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
+}
+bind Entry <Shift-Left> {
+ tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
+ tk::EntrySeeInsert %W
+}
+bind Entry <Shift-Right> {
+ tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
+ tk::EntrySeeInsert %W
+}
+bind Entry <Control-Left> {
+ tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
+}
+bind Entry <Control-Right> {
+ tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
+}
+bind Entry <Shift-Control-Left> {
+ tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
+ tk::EntrySeeInsert %W
+}
+bind Entry <Shift-Control-Right> {
+ tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
+ tk::EntrySeeInsert %W
+}
+bind Entry <Home> {
+ tk::EntrySetCursor %W 0
+}
+bind Entry <Shift-Home> {
+ tk::EntryKeySelect %W 0
+ tk::EntrySeeInsert %W
+}
+bind Entry <End> {
+ tk::EntrySetCursor %W end
+}
+bind Entry <Shift-End> {
+ tk::EntryKeySelect %W end
+ tk::EntrySeeInsert %W
+}
+
+bind Entry <Delete> {
+ if {[%W selection present]} {
+ %W delete sel.first sel.last
+ } else {
+ %W delete insert
+ }
+}
+bind Entry <BackSpace> {
+ tk::EntryBackspace %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> {
+ tk::EntryInsert %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 {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ bind Entry <Command-KeyPress> {# nothing}
+}
+
+# On Windows, paste is done using Shift-Insert. Shift-Insert already
+# generates the <<Paste>> event, so we don't need to do anything here.
+if {[string compare $tcl_platform(platform) "windows"]} {
+ bind Entry <Insert> {
+ catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
+ }
+}
+
+# Additional emacs-like bindings:
+
+bind Entry <Control-a> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W 0
+ }
+}
+bind Entry <Control-b> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
+ }
+}
+bind Entry <Control-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert
+ }
+}
+bind Entry <Control-e> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W end
+ }
+}
+bind Entry <Control-f> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
+ }
+}
+bind Entry <Control-h> {
+ if {!$tk_strictMotif} {
+ tk::EntryBackspace %W
+ }
+}
+bind Entry <Control-k> {
+ if {!$tk_strictMotif} {
+ %W delete insert end
+ }
+}
+bind Entry <Control-t> {
+ if {!$tk_strictMotif} {
+ tk::EntryTranspose %W
+ }
+}
+bind Entry <Meta-b> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
+ }
+}
+bind Entry <Meta-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert [tk::EntryNextWord %W insert]
+ }
+}
+bind Entry <Meta-f> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
+ }
+}
+bind Entry <Meta-BackSpace> {
+ if {!$tk_strictMotif} {
+ %W delete [tk::EntryPreviousWord %W insert] insert
+ }
+}
+bind Entry <Meta-Delete> {
+ if {!$tk_strictMotif} {
+ %W delete [tk::EntryPreviousWord %W insert] insert
+ }
+}
+
+# A few additional bindings of my own.
+
+bind Entry <2> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanMark %W %x
+ }
+}
+bind Entry <B2-Motion> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanDrag %W %x
+ }
+}
+
+# ::tk::EntryClosestGap --
+# 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 ::tk::EntryClosestGap {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
+}
+
+# ::tk::EntryButton1 --
+# 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 ::tk::EntryButton1 {w x} {
+ variable ::tk::Priv
+
+ set Priv(selectMode) char
+ set Priv(mouseMoved) 0
+ set Priv(pressX) $x
+ $w icursor [EntryClosestGap $w $x]
+ $w selection from insert
+ if {[string compare "disabled" [$w cget -state]]} {focus $w}
+}
+
+# ::tk::EntryMouseSelect --
+# 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 ::tk::EntryMouseSelect {w x} {
+ variable ::tk::Priv
+
+ set cur [EntryClosestGap $w $x]
+ set anchor [$w index anchor]
+ if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
+ set Priv(mouseMoved) 1
+ }
+ switch $Priv(selectMode) {
+ char {
+ if {$Priv(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
+ }
+ }
+ if {$Priv(mouseMoved)} {
+ $w icursor $cur
+ }
+ update idletasks
+}
+
+# ::tk::EntryPaste --
+# 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 ::tk::EntryPaste {w x} {
+ $w icursor [EntryClosestGap $w $x]
+ catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
+ if {[string compare "disabled" [$w cget -state]]} {focus $w}
+}
+
+# ::tk::EntryAutoScan --
+# 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 ::tk::EntryAutoScan {w} {
+ variable ::tk::Priv
+ set x $Priv(x)
+ if {![winfo exists $w]} return
+ if {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ EntryMouseSelect $w $x
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ EntryMouseSelect $w $x
+ }
+ set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
+}
+
+# ::tk::EntryKeySelect --
+# 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 ::tk::EntryKeySelect {w new} {
+ if {![$w selection present]} {
+ $w selection from insert
+ $w selection to $new
+ } else {
+ $w selection adjust $new
+ }
+ $w icursor $new
+}
+
+# ::tk::EntryInsert --
+# 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 ::tk::EntryInsert {w s} {
+ if {[string equal $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
+ EntrySeeInsert $w
+}
+
+# ::tk::EntryBackspace --
+# 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 ::tk::EntryBackspace 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}]
+ }
+ }
+}
+
+# ::tk::EntrySeeInsert --
+# 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 ::tk::EntrySeeInsert w {
+ set c [$w index insert]
+ if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
+ $w xview $c
+ }
+}
+
+# ::tk::EntrySetCursor -
+# 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 ::tk::EntrySetCursor {w pos} {
+ $w icursor $pos
+ $w selection clear
+ EntrySeeInsert $w
+}
+
+# ::tk::EntryTranspose -
+# 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 ::tk::EntryTranspose w {
+ set i [$w index insert]
+ if {$i < [$w index end]} {
+ incr i
+ }
+ set first [expr {$i-2}]
+ if {$first < 0} {
+ return
+ }
+ set data [$w get]
+ set new [string index $data [expr {$i-1}]][string index $data $first]
+ $w delete $first $i
+ $w insert insert $new
+ EntrySeeInsert $w
+}
+
+# ::tk::EntryNextWord --
+# Returns the index of the next word position after a given position in the
+# entry. The next word is platform dependent and may be either the next
+# end-of-word position or the next start-of-word position after the next
+# end-of-word position.
+#
+# Arguments:
+# w - The entry window in which the cursor is to move.
+# start - Position at which to start search.
+
+if {[string equal $tcl_platform(platform) "windows"]} {
+ proc ::tk::EntryNextWord {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 ::tk::EntryNextWord {w start} {
+ set pos [tcl_endOfWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return end
+ }
+ return $pos
+ }
+}
+
+# ::tk::EntryPreviousWord --
+#
+# 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 ::tk::EntryPreviousWord {w start} {
+ set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return 0
+ }
+ return $pos
+}
+
+# ::tk::EntryScanMark --
+#
+# Marks the start of a possible scan drag operation
+#
+# Arguments:
+# w - The entry window from which the text to get
+# x - x location on screen
+
+proc ::tk::EntryScanMark {w x} {
+ $w scan mark $x
+ set ::tk::Priv(x) $x
+ set ::tk::Priv(y) 0 ; # not used
+ set ::tk::Priv(mouseMoved) 0
+}
+
+# ::tk::EntryScanDrag --
+#
+# Marks the start of a possible scan drag operation
+#
+# Arguments:
+# w - The entry window from which the text to get
+# x - x location on screen
+
+proc ::tk::EntryScanDrag {w x} {
+ # Make sure these exist, as some weird situations can trigger the
+ # motion binding without the initial press. [Bug #220269]
+ if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
+ # allow for a delta
+ if {abs($x-$::tk::Priv(x)) > 2} {
+ set ::tk::Priv(mouseMoved) 1
+ }
+ $w scan dragto $x
+}
+
+# ::tk::EntryGetSelection --
+#
+# Returns the selected text of the entry with respect to the -show option.
+#
+# Arguments:
+# w - The entry window from which the text to get
+
+proc ::tk::EntryGetSelection {w} {
+ set entryString [string range [$w get] [$w index sel.first] \
+ [expr {[$w index sel.last] - 1}]]
+ if {[string compare [$w cget -show] ""]} {
+ return [string repeat [string index [$w cget -show] 0] \
+ [string length $entryString]]
+ }
+ return $entryString
+}
diff --git a/tcl/library/focus.tcl b/tcl/library/focus.tcl
new file mode 100644
index 00000000000..ea0f64de269
--- /dev/null
+++ b/tcl/library/focus.tcl
@@ -0,0 +1,181 @@
+# focus.tcl --
+#
+# This file defines several procedures for managing the input
+# focus.
+#
+# RCS: @(#) $Id$
+#
+# 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 {[string equal [winfo toplevel $cur] $cur]} {
+ continue
+ } else {
+ break
+ }
+ }
+
+ # No more siblings, so go to the current widget's parent.
+ # If it's a top-level, break out of the loop, otherwise
+ # look for its next sibling.
+
+ set cur $parent
+ if {[string equal [winfo toplevel $cur] $cur]} {
+ break
+ }
+ set parent [winfo parent $parent]
+ set children [winfo children $parent]
+ set i [lsearch -exact $children $cur]
+ }
+ if {[string equal $w $cur] || [tk::FocusOK $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 {[string equal [winfo toplevel $cur] $cur]} {
+ set parent $cur
+ set children [winfo children $cur]
+ set i [llength $children]
+ } else {
+ set parent [winfo parent $cur]
+ set children [winfo children $parent]
+ set i [lsearch -exact $children $cur]
+ }
+
+ # Go to the previous sibling, then descend to its last descendant
+ # (highest in stacking order. While doing this, ignore top-levels
+ # and their descendants. When we run out of descendants, go up
+ # one level to the parent.
+
+ while {$i > 0} {
+ incr i -1
+ set cur [lindex $children $i]
+ if {[string equal [winfo toplevel $cur] $cur]} {
+ continue
+ }
+ set parent $cur
+ set children [winfo children $parent]
+ set i [llength $children]
+ }
+ set cur $parent
+ if {[string equal $w $cur] || [tk::FocusOK $cur]} {
+ return $cur
+ }
+ }
+}
+
+# ::tk::FocusOK --
+#
+# 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 ::tk::FocusOK 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 [list $w]]
+ if {$value != ""} {
+ return $value
+ }
+ }
+ }
+ if {![winfo viewable $w]} {
+ return 0
+ }
+ set code [catch {$w cget -state} value]
+ if {($code == 0) && [string equal $value "disabled"]} {
+ return 0
+ }
+ regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
+}
+
+# ::tk_focusFollowsMouse --
+#
+# If this procedure is invoked, Tk will enter "focus-follows-mouse"
+# mode, where the focus is always on whatever window contains the
+# mouse. If this procedure isn't invoked, then the user typically
+# has to click on a window to give it the focus.
+#
+# Arguments:
+# None.
+
+proc ::tk_focusFollowsMouse {} {
+ set old [bind all <Enter>]
+ set script {
+ if {[string equal "%d" "NotifyAncestor"] \
+ || [string equal "%d" "NotifyNonlinear"] \
+ || [string equal "%d" "NotifyInferior"]} {
+ if {[tk::FocusOK %W]} {
+ focus %W
+ }
+ }
+ }
+ if {[string compare $old ""]} {
+ bind all <Enter> "$old; $script"
+ } else {
+ bind all <Enter> $script
+ }
+}
diff --git a/tcl/library/images/README b/tcl/library/images/README
new file mode 100644
index 00000000000..65101cd3797
--- /dev/null
+++ b/tcl/library/images/README
@@ -0,0 +1,12 @@
+README - images directory
+
+RCS: @(#) $Id$
+
+
+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/tcl/library/images/logo.eps b/tcl/library/images/logo.eps
new file mode 100644
index 00000000000..0d05d3404bd
--- /dev/null
+++ b/tcl/library/images/logo.eps
@@ -0,0 +1,2091 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%Creator: Adobe Illustrator(TM) 5.5
+%%For: (Bud Northern) (Mark Anderson Design)
+%%Title: (TCL/TK LOGO.ILLUS)
+%%CreationDate: (8/1/96) (4:58 PM)
+%%BoundingBox: 251 331 371 512
+%%HiResBoundingBox: 251.3386 331.5616 370.5213 511.775
+%%DocumentProcessColors: Cyan Magenta Yellow
+%%DocumentSuppliedResources: procset Adobe_level2_AI5 1.0 0
+%%+ procset Adobe_IllustratorA_AI5 1.0 0
+%AI5_FileFormat 1.2
+%AI3_ColorUsage: Color
+%%DocumentCustomColors: (TCL RED)
+%%CMYKCustomColor: 0 0.45 1 0 (Orange)
+%%+ 0 0.25 1 0 (Orange Yellow)
+%%+ 0 0.79 0.91 0 (TCL RED)
+%AI3_TemplateBox: 306 396 306 396
+%AI3_TileBox: 12 12 600 780
+%AI3_DocumentPreview: Macintosh_ColorPic
+%AI5_ArtSize: 612 792
+%AI5_RulerUnits: 0
+%AI5_ArtFlags: 1 0 0 1 0 0 1 1 0
+%AI5_TargetResolution: 800
+%AI5_NumLayers: 1
+%AI5_OpenToView: 90 576 2 938 673 18 1 1 2 40
+%AI5_OpenViewLayers: 7
+%%EndComments
+%%BeginProlog
+%%BeginResource: procset Adobe_level2_AI5 1.0 0
+%%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation)
+%%Version: 1.0
+%%CreationDate: (04/10/93) ()
+%%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved)
+userdict /Adobe_level2_AI5 21 dict dup begin
+ put
+ /packedarray where not
+ {
+ userdict begin
+ /packedarray
+ {
+ array astore readonly
+ } bind def
+ /setpacking /pop load def
+ /currentpacking false def
+ end
+ 0
+ } if
+ pop
+ userdict /defaultpacking currentpacking put true setpacking
+ /initialize
+ {
+ Adobe_level2_AI5 begin
+ } bind def
+ /terminate
+ {
+ currentdict Adobe_level2_AI5 eq
+ {
+ end
+ } if
+ } bind def
+ mark
+ /setcustomcolor where not
+ {
+ /findcmykcustomcolor
+ {
+ 5 packedarray
+ } bind def
+ /setcustomcolor
+ {
+ exch aload pop pop
+ 4
+ {
+ 4 index mul 4 1 roll
+ } repeat
+ 5 -1 roll pop
+ setcmykcolor
+ }
+ def
+ } if
+
+ /gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def
+ userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put
+ userdict /level2?
+ systemdict /languagelevel known dup
+ {
+ pop systemdict /languagelevel get 2 ge
+ } if
+ put
+ level2? not
+ {
+ /setcmykcolor where not
+ {
+ /setcmykcolor
+ {
+ exch .11 mul add exch .59 mul add exch .3 mul add
+ 1 exch sub setgray
+ } def
+ } if
+ /currentcmykcolor where not
+ {
+ /currentcmykcolor
+ {
+ 0 0 0 1 currentgray sub
+ } def
+ } if
+ /setoverprint where not
+ {
+ /setoverprint /pop load def
+ } if
+ /selectfont where not
+ {
+ /selectfont
+ {
+ exch findfont exch
+ dup type /arraytype eq
+ {
+ makefont
+ }
+ {
+ scalefont
+ } ifelse
+ setfont
+ } bind def
+ } if
+ /cshow where not
+ {
+ /cshow
+ {
+ [
+ 0 0 5 -1 roll aload pop
+ ] cvx bind forall
+ } bind def
+ } if
+ } if
+ cleartomark
+ /anyColor?
+ {
+ add add add 0 ne
+ } bind def
+ /testColor
+ {
+ gsave
+ setcmykcolor currentcmykcolor
+ grestore
+ } bind def
+ /testCMYKColorThrough
+ {
+ testColor anyColor?
+ } bind def
+ userdict /composite?
+ level2?
+ {
+ gsave 1 1 1 1 setcmykcolor currentcmykcolor grestore
+ add add add 4 eq
+ }
+ {
+ 1 0 0 0 testCMYKColorThrough
+ 0 1 0 0 testCMYKColorThrough
+ 0 0 1 0 testCMYKColorThrough
+ 0 0 0 1 testCMYKColorThrough
+ and and and
+ } ifelse
+ put
+ composite? not
+ {
+ userdict begin
+ gsave
+ /cyan? 1 0 0 0 testCMYKColorThrough def
+ /magenta? 0 1 0 0 testCMYKColorThrough def
+ /yellow? 0 0 1 0 testCMYKColorThrough def
+ /black? 0 0 0 1 testCMYKColorThrough def
+ grestore
+ /isCMYKSep? cyan? magenta? yellow? black? or or or def
+ /customColor? isCMYKSep? not def
+ end
+ } if
+ end defaultpacking setpacking
+%%EndResource
+%%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0
+%%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog)
+%%Version: 1.1
+%%CreationDate: (3/7/1994) ()
+%%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved)
+currentpacking true setpacking
+userdict /Adobe_IllustratorA_AI5_vars 70 dict dup begin
+put
+/_lp /none def
+/_pf
+{
+} def
+/_ps
+{
+} def
+/_psf
+{
+} def
+/_pss
+{
+} def
+/_pjsf
+{
+} def
+/_pjss
+{
+} def
+/_pola 0 def
+/_doClip 0 def
+/cf currentflat def
+/_tm matrix def
+/_renderStart
+[
+/e0 /r0 /a0 /o0 /e1 /r1 /a1 /i0
+] def
+/_renderEnd
+[
+null null null null /i1 /i1 /i1 /i1
+] def
+/_render -1 def
+/_rise 0 def
+/_ax 0 def
+/_ay 0 def
+/_cx 0 def
+/_cy 0 def
+/_leading
+[
+0 0
+] def
+/_ctm matrix def
+/_mtx matrix def
+/_sp 16#020 def
+/_hyphen (-) def
+/_fScl 0 def
+/_cnt 0 def
+/_hs 1 def
+/_nativeEncoding 0 def
+/_useNativeEncoding 0 def
+/_tempEncode 0 def
+/_pntr 0 def
+/_tDict 2 dict def
+/_wv 0 def
+/Tx
+{
+} def
+/Tj
+{
+} def
+/CRender
+{
+} def
+/_AI3_savepage
+{
+} def
+/_gf null def
+/_cf 4 array def
+/_if null def
+/_of false def
+/_fc
+{
+} def
+/_gs null def
+/_cs 4 array def
+/_is null def
+/_os false def
+/_sc
+{
+} def
+/discardSave null def
+/buffer 256 string def
+/beginString null def
+/endString null def
+/endStringLength null def
+/layerCnt 1 def
+/layerCount 1 def
+/perCent (%) 0 get def
+/perCentSeen? false def
+/newBuff null def
+/newBuffButFirst null def
+/newBuffLast null def
+/clipForward? false def
+end
+userdict /Adobe_IllustratorA_AI5 74 dict dup begin
+put
+/initialize
+{
+ Adobe_IllustratorA_AI5 dup begin
+ Adobe_IllustratorA_AI5_vars begin
+ discardDict
+ {
+ bind pop pop
+ } forall
+ dup /nc get begin
+ {
+ dup xcheck 1 index type /operatortype ne and
+ {
+ bind
+ } if
+ pop pop
+ } forall
+ end
+ newpath
+} def
+/terminate
+{
+ end
+ end
+} def
+/_
+null def
+/ddef
+{
+ Adobe_IllustratorA_AI5_vars 3 1 roll put
+} def
+/xput
+{
+ dup load dup length exch maxlength eq
+ {
+ dup dup load dup
+ length 2 mul dict copy def
+ } if
+ load begin
+ def
+ end
+} def
+/npop
+{
+ {
+ pop
+ } repeat
+} def
+/sw
+{
+ dup length exch stringwidth
+ exch 5 -1 roll 3 index mul add
+ 4 1 roll 3 1 roll mul add
+} def
+/swj
+{
+ dup 4 1 roll
+ dup length exch stringwidth
+ exch 5 -1 roll 3 index mul add
+ 4 1 roll 3 1 roll mul add
+ 6 2 roll /_cnt 0 ddef
+ {
+ 1 index eq
+ {
+ /_cnt _cnt 1 add ddef
+ } if
+ } forall
+ pop
+ exch _cnt mul exch _cnt mul 2 index add 4 1 roll 2 index add 4 1 roll pop pop
+} def
+/ss
+{
+ 4 1 roll
+ {
+ 2 npop
+ (0) exch 2 copy 0 exch put pop
+ gsave
+ false charpath currentpoint
+ 4 index setmatrix
+ stroke
+ grestore
+ moveto
+ 2 copy rmoveto
+ } exch cshow
+ 3 npop
+} def
+/jss
+{
+ 4 1 roll
+ {
+ 2 npop
+ (0) exch 2 copy 0 exch put
+ gsave
+ _sp eq
+ {
+ exch 6 index 6 index 6 index 5 -1 roll widthshow
+ currentpoint
+ }
+ {
+ false charpath currentpoint
+ 4 index setmatrix stroke
+ } ifelse
+ grestore
+ moveto
+ 2 copy rmoveto
+ } exch cshow
+ 6 npop
+} def
+/sp
+{
+ {
+ 2 npop (0) exch
+ 2 copy 0 exch put pop
+ false charpath
+ 2 copy rmoveto
+ } exch cshow
+ 2 npop
+} def
+/jsp
+{
+ {
+ 2 npop
+ (0) exch 2 copy 0 exch put
+ _sp eq
+ {
+ exch 5 index 5 index 5 index 5 -1 roll widthshow
+ }
+ {
+ false charpath
+ } ifelse
+ 2 copy rmoveto
+ } exch cshow
+ 5 npop
+} def
+/pl
+{
+ transform
+ 0.25 sub round 0.25 add exch
+ 0.25 sub round 0.25 add exch
+ itransform
+} def
+/setstrokeadjust where
+{
+ pop true setstrokeadjust
+ /c
+ {
+ curveto
+ } def
+ /C
+ /c load def
+ /v
+ {
+ currentpoint 6 2 roll curveto
+ } def
+ /V
+ /v load def
+ /y
+ {
+ 2 copy curveto
+ } def
+ /Y
+ /y load def
+ /l
+ {
+ lineto
+ } def
+ /L
+ /l load def
+ /m
+ {
+ moveto
+ } def
+}
+{
+ /c
+ {
+ pl curveto
+ } def
+ /C
+ /c load def
+ /v
+ {
+ currentpoint 6 2 roll pl curveto
+ } def
+ /V
+ /v load def
+ /y
+ {
+ pl 2 copy curveto
+ } def
+ /Y
+ /y load def
+ /l
+ {
+ pl lineto
+ } def
+ /L
+ /l load def
+ /m
+ {
+ pl moveto
+ } def
+} ifelse
+/d
+{
+ setdash
+} def
+/cf
+{
+} def
+/i
+{
+ dup 0 eq
+ {
+ pop cf
+ } if
+ setflat
+} def
+/j
+{
+ setlinejoin
+} def
+/J
+{
+ setlinecap
+} def
+/M
+{
+ setmiterlimit
+} def
+/w
+{
+ setlinewidth
+} def
+/H
+{
+} def
+/h
+{
+ closepath
+} def
+/N
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ {
+ clip /_doClip 0 ddef
+ } if
+ newpath
+ }
+ {
+ /CRender
+ {
+ N
+ } ddef
+ } ifelse
+} def
+/n
+{
+ N
+} def
+/F
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ {
+ gsave _pf grestore clip newpath /_lp /none ddef _fc
+ /_doClip 0 ddef
+ }
+ {
+ _pf
+ } ifelse
+ }
+ {
+ /CRender
+ {
+ F
+ } ddef
+ } ifelse
+} def
+/f
+{
+ closepath
+ F
+} def
+/S
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ {
+ gsave _ps grestore clip newpath /_lp /none ddef _sc
+ /_doClip 0 ddef
+ }
+ {
+ _ps
+ } ifelse
+ }
+ {
+ /CRender
+ {
+ S
+ } ddef
+ } ifelse
+} def
+/s
+{
+ closepath
+ S
+} def
+/B
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ gsave F grestore
+ {
+ gsave S grestore clip newpath /_lp /none ddef _sc
+ /_doClip 0 ddef
+ }
+ {
+ S
+ } ifelse
+ }
+ {
+ /CRender
+ {
+ B
+ } ddef
+ } ifelse
+} def
+/b
+{
+ closepath
+ B
+} def
+/W
+{
+ /_doClip 1 ddef
+} def
+/*
+{
+ count 0 ne
+ {
+ dup type /stringtype eq
+ {
+ pop
+ } if
+ } if
+ newpath
+} def
+/u
+{
+} def
+/U
+{
+} def
+/q
+{
+ _pola 0 eq
+ {
+ gsave
+ } if
+} def
+/Q
+{
+ _pola 0 eq
+ {
+ grestore
+ } if
+} def
+/*u
+{
+ _pola 1 add /_pola exch ddef
+} def
+/*U
+{
+ _pola 1 sub /_pola exch ddef
+ _pola 0 eq
+ {
+ CRender
+ } if
+} def
+/D
+{
+ pop
+} def
+/*w
+{
+} def
+/*W
+{
+} def
+/`
+{
+ /_i save ddef
+ clipForward?
+ {
+ nulldevice
+ } if
+ 6 1 roll 4 npop
+ concat pop
+ userdict begin
+ /showpage
+ {
+ } def
+ 0 setgray
+ 0 setlinecap
+ 1 setlinewidth
+ 0 setlinejoin
+ 10 setmiterlimit
+ [] 0 setdash
+ /setstrokeadjust where {pop false setstrokeadjust} if
+ newpath
+ 0 setgray
+ false setoverprint
+} def
+/~
+{
+ end
+ _i restore
+} def
+/O
+{
+ 0 ne
+ /_of exch ddef
+ /_lp /none ddef
+} def
+/R
+{
+ 0 ne
+ /_os exch ddef
+ /_lp /none ddef
+} def
+/g
+{
+ /_gf exch ddef
+ /_fc
+ {
+ _lp /fill ne
+ {
+ _of setoverprint
+ _gf setgray
+ /_lp /fill ddef
+ } if
+ } ddef
+ /_pf
+ {
+ _fc
+ fill
+ } ddef
+ /_psf
+ {
+ _fc
+ ashow
+ } ddef
+ /_pjsf
+ {
+ _fc
+ awidthshow
+ } ddef
+ /_lp /none ddef
+} def
+/G
+{
+ /_gs exch ddef
+ /_sc
+ {
+ _lp /stroke ne
+ {
+ _os setoverprint
+ _gs setgray
+ /_lp /stroke ddef
+ } if
+ } ddef
+ /_ps
+ {
+ _sc
+ stroke
+ } ddef
+ /_pss
+ {
+ _sc
+ ss
+ } ddef
+ /_pjss
+ {
+ _sc
+ jss
+ } ddef
+ /_lp /none ddef
+} def
+/k
+{
+ _cf astore pop
+ /_fc
+ {
+ _lp /fill ne
+ {
+ _of setoverprint
+ _cf aload pop setcmykcolor
+ /_lp /fill ddef
+ } if
+ } ddef
+ /_pf
+ {
+ _fc
+ fill
+ } ddef
+ /_psf
+ {
+ _fc
+ ashow
+ } ddef
+ /_pjsf
+ {
+ _fc
+ awidthshow
+ } ddef
+ /_lp /none ddef
+} def
+/K
+{
+ _cs astore pop
+ /_sc
+ {
+ _lp /stroke ne
+ {
+ _os setoverprint
+ _cs aload pop setcmykcolor
+ /_lp /stroke ddef
+ } if
+ } ddef
+ /_ps
+ {
+ _sc
+ stroke
+ } ddef
+ /_pss
+ {
+ _sc
+ ss
+ } ddef
+ /_pjss
+ {
+ _sc
+ jss
+ } ddef
+ /_lp /none ddef
+} def
+/x
+{
+ /_gf exch ddef
+ findcmykcustomcolor
+ /_if exch ddef
+ /_fc
+ {
+ _lp /fill ne
+ {
+ _of setoverprint
+ _if _gf 1 exch sub setcustomcolor
+ /_lp /fill ddef
+ } if
+ } ddef
+ /_pf
+ {
+ _fc
+ fill
+ } ddef
+ /_psf
+ {
+ _fc
+ ashow
+ } ddef
+ /_pjsf
+ {
+ _fc
+ awidthshow
+ } ddef
+ /_lp /none ddef
+} def
+/X
+{
+ /_gs exch ddef
+ findcmykcustomcolor
+ /_is exch ddef
+ /_sc
+ {
+ _lp /stroke ne
+ {
+ _os setoverprint
+ _is _gs 1 exch sub setcustomcolor
+ /_lp /stroke ddef
+ } if
+ } ddef
+ /_ps
+ {
+ _sc
+ stroke
+ } ddef
+ /_pss
+ {
+ _sc
+ ss
+ } ddef
+ /_pjss
+ {
+ _sc
+ jss
+ } ddef
+ /_lp /none ddef
+} def
+/A
+{
+ pop
+} def
+/annotatepage
+{
+userdict /annotatepage 2 copy known {get exec} {pop pop} ifelse
+} def
+/discard
+{
+ save /discardSave exch store
+ discardDict begin
+ /endString exch store
+ gt38?
+ {
+ 2 add
+ } if
+ load
+ stopped
+ pop
+ end
+ discardSave restore
+} bind def
+userdict /discardDict 7 dict dup begin
+put
+/pre38Initialize
+{
+ /endStringLength endString length store
+ /newBuff buffer 0 endStringLength getinterval store
+ /newBuffButFirst newBuff 1 endStringLength 1 sub getinterval store
+ /newBuffLast newBuff endStringLength 1 sub 1 getinterval store
+} def
+/shiftBuffer
+{
+ newBuff 0 newBuffButFirst putinterval
+ newBuffLast 0
+ currentfile read not
+ {
+ stop
+ } if
+ put
+} def
+0
+{
+ pre38Initialize
+ mark
+ currentfile newBuff readstring exch pop
+ {
+ {
+ newBuff endString eq
+ {
+ cleartomark stop
+ } if
+ shiftBuffer
+ } loop
+ }
+ {
+ stop
+ } ifelse
+} def
+1
+{
+ pre38Initialize
+ /beginString exch store
+ mark
+ currentfile newBuff readstring exch pop
+ {
+ {
+ newBuff beginString eq
+ {
+ /layerCount dup load 1 add store
+ }
+ {
+ newBuff endString eq
+ {
+ /layerCount dup load 1 sub store
+ layerCount 0 eq
+ {
+ cleartomark stop
+ } if
+ } if
+ } ifelse
+ shiftBuffer
+ } loop
+ }
+ {
+ stop
+ } ifelse
+} def
+2
+{
+ mark
+ {
+ currentfile buffer readline not
+ {
+ stop
+ } if
+ endString eq
+ {
+ cleartomark stop
+ } if
+ } loop
+} def
+3
+{
+ /beginString exch store
+ /layerCnt 1 store
+ mark
+ {
+ currentfile buffer readline not
+ {
+ stop
+ } if
+ dup beginString eq
+ {
+ pop /layerCnt dup load 1 add store
+ }
+ {
+ endString eq
+ {
+ layerCnt 1 eq
+ {
+ cleartomark stop
+ }
+ {
+ /layerCnt dup load 1 sub store
+ } ifelse
+ } if
+ } ifelse
+ } loop
+} def
+end
+userdict /clipRenderOff 15 dict dup begin
+put
+{
+ /n /N /s /S /f /F /b /B
+}
+{
+ {
+ _doClip 1 eq
+ {
+ /_doClip 0 ddef clip
+ } if
+ newpath
+ } def
+} forall
+/Tr /pop load def
+/Bb {} def
+/BB /pop load def
+/Bg {12 npop} def
+/Bm {6 npop} def
+/Bc /Bm load def
+/Bh {4 npop} def
+end
+/Lb
+{
+ 4 npop
+ 6 1 roll
+ pop
+ 4 1 roll
+ pop pop pop
+ 0 eq
+ {
+ 0 eq
+ {
+ (%AI5_BeginLayer) 1 (%AI5_EndLayer--) discard
+ }
+ {
+ /clipForward? true def
+
+ /Tx /pop load def
+ /Tj /pop load def
+ currentdict end clipRenderOff begin begin
+ } ifelse
+ }
+ {
+ 0 eq
+ {
+ save /discardSave exch store
+ } if
+ } ifelse
+} bind def
+/LB
+{
+ discardSave dup null ne
+ {
+ restore
+ }
+ {
+ pop
+ clipForward?
+ {
+ currentdict
+ end
+ end
+ begin
+
+ /clipForward? false ddef
+ } if
+ } ifelse
+} bind def
+/Pb
+{
+ pop pop
+ 0 (%AI5_EndPalette) discard
+} bind def
+/Np
+{
+ 0 (%AI5_End_NonPrinting--) discard
+} bind def
+/Ln /pop load def
+/Ap
+/pop load def
+/Ar
+{
+ 72 exch div
+ 0 dtransform dup mul exch dup mul add sqrt
+ dup 1 lt
+ {
+ pop 1
+ } if
+ setflat
+} def
+/Mb
+{
+ q
+} def
+/Md
+{
+} def
+/MB
+{
+ Q
+} def
+/nc 3 dict def
+nc begin
+/setgray
+{
+ pop
+} bind def
+/setcmykcolor
+{
+ 4 npop
+} bind def
+/setcustomcolor
+{
+ 2 npop
+} bind def
+currentdict readonly pop
+end
+currentdict readonly pop
+end
+setpacking
+%%EndResource
+%%EndProlog
+%%BeginSetup
+Adobe_level2_AI5 /initialize get exec
+Adobe_IllustratorA_AI5 /initialize get exec
+%AI5_Begin_NonPrinting
+Np
+%AI3_BeginPattern: (Yellow Stripe)
+(Yellow Stripe) 8.4499 4.6 80.4499 76.6 [
+%AI3_Tile
+(0 O 0 R 0 0.4 1 0 k 0 0.4 1 0 K) @
+(
+800 Ar
+0 J 0 j 3.6 w 4 M []0 d
+%AI3_Note:
+0 D
+8.1999 8.1999 m
+80.6999 8.1999 L
+S
+8.1999 22.6 m
+80.6999 22.6 L
+S
+8.1999 37.0001 m
+80.6999 37.0001 L
+S
+8.1999 51.3999 m
+80.6999 51.3999 L
+S
+8.1999 65.8 m
+80.6999 65.8 L
+S
+8.1999 15.3999 m
+80.6999 15.3999 L
+S
+8.1999 29.8 m
+80.6999 29.8 L
+S
+8.1999 44.1999 m
+80.6999 44.1999 L
+S
+8.1999 58.6 m
+80.6999 58.6 L
+S
+8.1999 73.0001 m
+80.6999 73.0001 L
+S
+) &
+] E
+%AI3_EndPattern
+%AI5_End_NonPrinting--
+%AI5_Begin_NonPrinting
+Np
+3 Bn
+%AI5_BeginGradient: (Black & White)
+(Black & White) 0 2 Bd
+[
+<
+FFFEFDFCFBFAF9F8F7F6F5F4F3F2F1F0EFEEEDECEBEAE9E8E7E6E5E4E3E2E1E0DFDEDDDCDBDAD9D8
+D7D6D5D4D3D2D1D0CFCECDCCCBCAC9C8C7C6C5C4C3C2C1C0BFBEBDBCBBBAB9B8B7B6B5B4B3B2B1B0
+AFAEADACABAAA9A8A7A6A5A4A3A2A1A09F9E9D9C9B9A999897969594939291908F8E8D8C8B8A8988
+87868584838281807F7E7D7C7B7A797877767574737271706F6E6D6C6B6A69686766656463626160
+5F5E5D5C5B5A595857565554535251504F4E4D4C4B4A494847464544434241403F3E3D3C3B3A3938
+37363534333231302F2E2D2C2B2A292827262524232221201F1E1D1C1B1A19181716151413121110
+0F0E0D0C0B0A09080706050403020100
+>
+0 %_Br
+[
+0 0 50 100 %_Bs
+1 0 50 0 %_Bs
+BD
+%AI5_EndGradient
+%AI5_BeginGradient: (Red & Yellow)
+(Red & Yellow) 0 2 Bd
+[
+0
+<
+000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
+28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
+505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
+78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
+A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
+C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
+F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
+>
+<
+FFFFFEFEFDFDFDFCFCFBFBFBFAFAF9F9F9F8F8F7F7F7F6F6F5F5F5F4F4F3F3F3F2F2F1F1F1F0F0EF
+EFEFEEEEEDEDEDECECEBEBEBEAEAE9E9E9E8E8E7E7E7E6E6E5E5E5E4E4E3E3E3E2E2E1E1E1E0E0DF
+DFDFDEDEDDDDDDDCDCDBDBDBDADAD9D9D9D8D8D7D7D7D6D6D5D5D5D4D4D3D3D3D2D2D1D1D1D0D0CF
+CFCFCECECDCDCDCCCCCBCBCBCACAC9C9C9C8C8C7C7C7C6C6C5C5C5C4C4C3C3C3C2C2C1C1C1C0C0BF
+BFBFBEBEBDBDBDBCBCBBBBBBBABAB9B9B9B8B8B7B7B7B6B6B5B5B5B4B4B3B3B3B2B2B1B1B1B0B0AF
+AFAFAEAEADADADACACABABABAAAAA9A9A9A8A8A7A7A7A6A6A5A5A5A4A4A3A3A3A2A2A1A1A1A0A09F
+9F9F9E9E9D9D9D9C9C9B9B9B9A9A9999
+>
+0
+1 %_Br
+[
+0 1 0.6 0 1 50 100 %_Bs
+0 0 1 0 1 50 0 %_Bs
+BD
+%AI5_EndGradient
+%AI5_BeginGradient: (Yellow & Blue Radial)
+(Yellow & Blue Radial) 1 2 Bd
+[
+<
+000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
+28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
+505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
+78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
+A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
+C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
+F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
+>
+<
+1415161718191A1B1C1D1E1F1F202122232425262728292A2A2B2C2D2E2F30313233343536363738
+393A3B3C3D3E3F40414142434445464748494A4B4C4D4D4E4F50515253545556575858595A5B5C5D
+5E5F60616263646465666768696A6B6C6D6E6F6F707172737475767778797A7B7B7C7D7E7F808182
+83848586868788898A8B8C8D8E8F90919292939495969798999A9B9C9D9D9E9FA0A1A2A3A4A5A6A7
+A8A9A9AAABACADAEAFB0B1B2B3B4B4B5B6B7B8B9BABBBCBDBEBFC0C0C1C2C3C4C5C6C7C8C9CACBCB
+CCCDCECFD0D1D2D3D4D5D6D7D7D8D9DADBDCDDDEDFE0E1E2E2E3E4E5E6E7E8E9EAEBECEDEEEEEFF0
+F1F2F3F4F5F6F7F8F9F9FAFBFCFDFEFF
+>
+<
+ABAAAAA9A8A7A7A6A5A5A4A3A3A2A1A1A09F9F9E9D9D9C9B9B9A9999989797969595949393929191
+908F8F8E8D8D8C8B8B8A8989888787868585848383828181807F7F7E7D7D7C7B7B7A797978777776
+7575747373727171706F6F6E6D6D6C6B6B6A6969686767666565646362626160605F5E5E5D5C5C5B
+5A5A5958585756565554545352525150504F4E4E4D4C4C4B4A4A4948484746464544444342424140
+403F3E3E3D3C3C3B3A3A3938383736363534343332323130302F2E2E2D2C2C2B2A2A292828272626
+25242423222121201F1F1E1D1D1C1B1B1A1919181717161515141313121111100F0F0E0D0D0C0B0B
+0A090908070706050504030302010100
+>
+0
+1 %_Br
+[
+0 0.08 0.67 0 1 50 14 %_Bs
+1 1 0 0 1 50 100 %_Bs
+BD
+%AI5_EndGradient
+%AI5_End_NonPrinting--
+%AI5_BeginPalette
+144 170 Pb
+Pn
+Pc
+1 g
+Pc
+0 g
+Pc
+0 0 0 0 k
+Pc
+0.75 g
+Pc
+0.5 g
+Pc
+0.25 g
+Pc
+0 g
+Pc
+Bb
+2 (Black & White) -4014 4716 0 0 1 0 0 1 0 0 Bg
+0 BB
+Pc
+0.25 0 0 0 k
+Pc
+0.5 0 0 0 k
+Pc
+0.75 0 0 0 k
+Pc
+1 0 0 0 k
+Pc
+0.25 0.25 0 0 k
+Pc
+0.5 0.5 0 0 k
+Pc
+0.75 0.75 0 0 k
+Pc
+1 1 0 0 k
+Pc
+Bb
+2 (Red & Yellow) -4014 4716 0 0 1 0 0 1 0 0 Bg
+0 BB
+Pc
+0 0.25 0 0 k
+Pc
+0 0.5 0 0 k
+Pc
+0 0.75 0 0 k
+Pc
+0 1 0 0 k
+Pc
+0 0.25 0.25 0 k
+Pc
+0 0.5 0.5 0 k
+Pc
+0 0.75 0.75 0 k
+Pc
+0 1 1 0 k
+Pc
+Bb
+0 0 0 0 Bh
+2 (Yellow & Blue Radial) -4014 4716 0 0 1 0 0 1 0 0 Bg
+0 BB
+Pc
+0 0 0.25 0 k
+Pc
+0 0 0.5 0 k
+Pc
+0 0 0.75 0 k
+Pc
+0 0 1 0 k
+Pc
+0.25 0 0.25 0 k
+Pc
+0.5 0 0.5 0 k
+Pc
+0.75 0 0.75 0 k
+Pc
+1 0 1 0 k
+Pc
+(Yellow Stripe) 0 0 1 1 0 0 0 0 0 [1 0 0 1 0 0] p
+Pc
+0.25 0.125 0 0 k
+Pc
+0.5 0.25 0 0 k
+Pc
+0.75 0.375 0 0 k
+Pc
+1 0.5 0 0 k
+Pc
+0.125 0.25 0 0 k
+Pc
+0.25 0.5 0 0 k
+Pc
+0.375 0.75 0 0 k
+Pc
+0.5 1 0 0 k
+Pc
+0.375 0.375 0.75 0 k
+Pc
+0 0.25 0.125 0 k
+Pc
+0 0.5 0.25 0 k
+Pc
+0 0.75 0.375 0 k
+Pc
+0 1 0.5 0 k
+Pc
+0 0.125 0.25 0 k
+Pc
+0 0.25 0.5 0 k
+Pc
+0 0.375 0.75 0 k
+Pc
+0 0.5 1 0 k
+Pc
+0 0.79 0.91 0 (TCL RED) 0 x
+Pc
+0.125 0 0.25 0 k
+Pc
+0.25 0 0.5 0 k
+Pc
+0.375 0 0.75 0 k
+Pc
+0.5 0 1 0 k
+Pc
+0.25 0 0.125 0 k
+Pc
+0.5 0 0.25 0 k
+Pc
+0.75 0 0.375 0 k
+Pc
+1 0 0.5 0 k
+Pc
+0.5 1 0 0 k
+Pc
+0.25 0.125 0.125 0 k
+Pc
+0.5 0.25 0.25 0 k
+Pc
+0.75 0.375 0.375 0 k
+Pc
+1 0.5 0.5 0 k
+Pc
+0.25 0.25 0.125 0 k
+Pc
+0.5 0.5 0.25 0 k
+Pc
+0.75 0.75 0.375 0 k
+Pc
+1 1 0.5 0 k
+Pc
+0 1 0.5 0 k
+Pc
+0.125 0.25 0.125 0 k
+Pc
+0.25 0.5 0.25 0 k
+Pc
+0.375 0.75 0.375 0 k
+Pc
+0.5 1 0.5 0 k
+Pc
+0.125 0.25 0.25 0 k
+Pc
+0.25 0.5 0.5 0 k
+Pc
+0.375 0.75 0.75 0 k
+Pc
+0.5 1 1 0 k
+Pc
+0.75 0.75 0.375 0 k
+Pc
+0.125 0.125 0.25 0 k
+Pc
+0.25 0.25 0.5 0 k
+Pc
+0.375 0.375 0.75 0 k
+Pc
+0.5 0.5 1 0 k
+Pc
+0.25 0.125 0.25 0 k
+Pc
+0.5 0.25 0.5 0 k
+Pc
+0.75 0.375 0.75 0 k
+Pc
+1 0.5 1 0 k
+Pc
+0 0.79 0.91 0 (TCL RED) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+1 0.5 0.5 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0.25 1 0 (Orange Yellow) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 1 0.5 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+1 0 0.5 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0.45 1 0 (Orange) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0.375 0.375 0.75 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0.79 0.91 0 (TCL RED) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+1 0.65 0 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0 1 0 k
+Pc
+PB
+%AI5_EndPalette
+%%EndSetup
+%AI5_BeginLayer
+1 1 1 1 0 0 0 79 128 255 Lb
+(Layer 1) Ln
+0 A
+u
+1 Ap
+0 O
+0 0.79 0.91 0 (TCL RED) 0 x
+800 Ar
+0 J 0 j 1.25 w 4 M []0 d
+%AI3_Note:
+0 D
+294.5207 335.3041 m
+368.2181 333.001 L
+363.6121 423.9713 L
+370.5213 507.1689 L
+336.5513 505.4417 L
+320.7179 511.775 L
+251.3386 508.0325 L
+254.7931 425.9866 L
+251.3386 331.5616 L
+294.5207 335.3041 L
+f
+u
+0 Ap
+1 0.65 0 0 k
+1 w
+318.1366 400.9627 m
+311.8663 399.2526 l
+315.2864 407.5177 l
+318.7064 430.6032 l
+314.4314 431.4581 l
+319.5616 438.5832 l
+325.9526 462.6014 l
+314.7164 460.2436 l
+320.6412 471.0911 326.9284 478.1557 v
+318.7064 484.469 l
+292.2183 472.8011 299.3434 434.8954 v
+293.8679 435.8542 l
+299.1189 396.1175 l
+294.6797 394.9775 l
+299.2277 385.6974 305.5963 381.2973 v
+306.1744 380.8979 297.6162 412.3629 306.7363 443.7133 c
+307.5914 441.7183 l
+300.3238 408.3015 307.5914 381.2973 v
+307.9261 380.656 311.5598 381.0836 v
+318.1366 393.4813 318.1366 400.9627 v
+f
+u
+*u
+1 g
+271.4311 372.5074 m
+272.7184 372.5074 L
+272.7184 375.1913 L
+273.2858 375.1913 273.8313 375.1913 274.3768 375.2786 c
+274.3768 372.5074 L
+276.2969 372.5074 L
+276.2969 372.0056 L
+274.3768 372.0056 L
+274.3768 365.3286 L
+274.3768 364.9359 274.3768 364.3467 275.2059 364.3467 c
+275.7733 364.3467 276.0787 364.7395 276.4279 365.1541 c
+276.777 364.9141 L
+276.3624 364.0849 275.2932 363.583 274.4204 363.583 c
+272.8494 363.583 272.6748 364.434 272.6748 365.4814 c
+272.6748 372.0056 L
+271.4311 372.0056 L
+271.4311 372.5074 l
+f
+*U
+*u
+290.5617 366.5724 m
+290.0598 365.0232 289.187 363.6703 286.9178 363.583 c
+283.5356 363.583 282.5101 366.3978 282.5101 367.9034 c
+282.5101 371.7874 285.6304 372.7256 286.8741 372.7256 c
+288.2924 372.7256 290.2999 372.071 290.2999 370.3909 c
+290.2999 369.8018 289.9289 369.2344 289.318 369.2344 c
+288.7288 369.2344 288.2924 369.6272 288.2924 370.26 c
+288.2924 371.111 288.9907 371.2201 288.9907 371.4601 c
+288.9907 372.0492 287.616 372.2892 287.136 372.2892 c
+285.0412 372.2892 284.4957 370.7618 284.4957 367.9034 c
+284.4957 366.5942 284.823 365.5905 284.9539 365.285 c
+285.2812 364.5649 285.9577 364.1067 287.0923 364.0413 c
+288.3579 363.9758 289.5798 365.0013 290.1035 366.5724 C
+290.5617 366.5724 l
+f
+*U
+*u
+296.6 363.8667 m
+296.6 364.3686 L
+298.2802 364.3686 L
+298.2802 378.3989 L
+296.6 378.3989 L
+296.6 378.9007 L
+297.5383 378.9007 L
+298.3457 378.9007 299.1966 378.9444 299.9822 379.0971 c
+299.9822 364.3686 L
+301.6623 364.3686 L
+301.6623 363.8667 L
+296.6 363.8667 l
+f
+*U
+*u
+317.4527 372.5074 m
+318.7401 372.5074 L
+318.7401 375.1913 L
+319.3074 375.1913 319.8529 375.1913 320.3984 375.2786 c
+320.3984 372.5074 L
+322.3186 372.5074 L
+322.3186 372.0056 L
+320.3984 372.0056 L
+320.3984 365.3286 L
+320.3984 364.9359 320.3984 364.3467 321.2276 364.3467 c
+321.7949 364.3467 322.1004 364.7395 322.4495 365.1541 c
+322.7986 364.9141 L
+322.384 364.0849 321.3148 363.583 320.442 363.583 c
+318.871 363.583 318.6964 364.434 318.6964 365.4814 c
+318.6964 372.0056 L
+317.4527 372.0056 L
+317.4527 372.5074 l
+f
+*U
+*u
+333.7467 372.0056 m
+333.7467 372.5074 L
+337.3252 372.5074 L
+337.3252 372.0056 L
+335.9942 372.0056 L
+332.983 369.3872 L
+337.1288 364.3686 L
+338.0453 364.3686 L
+338.0453 363.8667 L
+333.8995 363.8667 L
+333.8995 364.3686 L
+334.9905 364.3686 L
+331.3465 368.798 L
+335.0341 371.9401 L
+335.0341 372.0056 L
+333.7467 372.0056 l
+f
+328.4881 363.8667 m
+328.4881 364.3686 L
+329.6227 364.3686 L
+329.6227 378.3989 L
+328.4881 378.3989 L
+328.4881 378.9007 L
+328.8809 378.9007 L
+329.6882 378.9007 330.5392 378.9444 331.3247 379.0971 c
+331.3247 364.3686 L
+332.6339 364.3686 L
+332.6339 363.8667 L
+328.4881 363.8667 l
+f
+*U
+u
+309.5341 446.5364 m
+305.6878 429.3874 306.7947 401.5837 v
+307.1266 393.2441 308.0387 385.5779 309.1527 378.9301 C
+309.1587 378.9297 L
+309.8832 373.0923 310.3679 370.9791 312.2568 363.9454 C
+312.1466 359.4091 L
+297.0216 407.7015 309.5341 446.5364 V
+f
+318.8187 461.4058 m
+322.2203 463.1 327.0966 463.7165 v
+332.427 453.9463 319.3087 437.2655 v
+327.1346 454.735 325.2889 460.2079 v
+323.225 461.4903 318.8187 461.4058 v
+f
+317.2065 432.0795 m
+320.2613 431.3723 321.7279 432.5601 v
+318.8383 421.2839 319.5958 415.0813 v
+320.3533 408.8787 314.8881 404.9079 y
+319.5435 410.7982 318.0802 415.5959 v
+317.0657 418.9214 318.2006 427.4326 319.4809 430.1349 c
+318.2853 430.3025 317.2065 432.0795 v
+f
+314.1861 402.3703 m
+319.2343 402.9744 319.7646 405.5244 v
+320.3824 390.2725 313.3689 383.9873 v
+318.7204 392.3347 317.8807 400.9697 v
+314.1861 402.3703 l
+f
+299.9864 396.0219 m
+298.3586 394.1986 293.4739 398.2203 v
+295.0301 387.9694 304.6978 383.2767 v
+298.0444 388.2897 296.2519 393.7045 v
+298.6029 394.3966 299.9864 396.0219 v
+f
+298.4281 399.9096 m
+291.8229 416.6749 293.2382 439.3286 v
+294.7808 435.2261 299.738 433.7875 v
+297.4026 433.3101 296.0372 433.517 v
+292.5816 423.9535 298.4281 399.9096 v
+f
+326.1736 477.812 m
+323.6983 496.0028 308.2122 477.6066 v
+295.8813 462.9582 297.3508 450.5217 298.1072 443.5831 c
+298.3007 441.8079 295.8131 462.1138 309.3231 475.4768 c
+322.8328 488.8398 325.8846 478.5879 326.1736 477.812 c
+f
+U
+0 0 1 0 k
+303.3623 493.3274 m
+291.211 496.7978 287.3437 456.5222 v
+284.3599 468.9535 292.0777 486.5353 v
+299.7955 504.1172 303.3623 493.3274 y
+f
+288.2873 496.2718 m
+282.0897 486.9502 283.4958 477.0213 v
+278.7953 495.712 288.2873 496.2718 v
+f
+333.8987 470.1328 m
+341.2276 472.8361 330.7334 445.5571 v
+336.1654 453.5292 339.5844 466.0531 v
+341.7789 474.0903 333.8987 470.1328 y
+f
+345.752 472.2583 m
+350.9334 467.5681 347.2615 461.3636 v
+356.4779 471.0481 345.752 472.2583 v
+f
+U
+*u
+273.1765 354.3318 m
+273.1765 353.7507 273.1305 353.2908 272.5159 353.2908 c
+271.8846 353.2908 271.8554 353.7674 271.8554 354.3318 c
+271.8554 356.485 L
+272.148 356.485 L
+272.148 354.3486 L
+272.148 353.8259 272.1773 353.5751 272.5159 353.5751 c
+272.8504 353.5751 272.8839 353.8259 272.8839 354.3486 c
+272.8839 356.485 L
+273.1765 356.485 L
+273.1765 354.3318 l
+f
+*U
+*u
+277.1612 356.485 m
+276.9062 356.485 L
+276.9062 354.3862 l
+276.9062 354.2482 276.9271 354.1061 276.9355 353.9681 C
+276.9229 353.9681 l
+276.8937 354.0768 276.8644 354.1855 276.8268 354.2942 C
+276.1035 356.485 L
+275.8484 356.485 L
+275.8484 353.3326 L
+276.1035 353.3326 L
+276.1035 355.2474 l
+276.1035 355.4523 276.0826 355.653 276.07 355.8579 C
+276.0867 355.8579 l
+276.1244 355.7241 276.1495 355.5819 276.1954 355.4523 C
+276.9062 353.3326 L
+277.1612 353.3326 l
+277.1612 356.485 L
+f
+*U
+*u
+280.1421 353.3326 m
+279.8494 353.3326 L
+279.8494 356.485 L
+280.1421 356.485 L
+280.1421 353.3326 l
+f
+*U
+*u
+283.5141 353.3326 m
+283.2549 353.3326 L
+282.6194 356.485 L
+282.9205 356.485 L
+283.3344 354.1897 L
+283.3511 354.1102 283.3678 353.9054 283.3845 353.7632 c
+283.4013 353.7632 L
+283.4138 353.9054 283.4305 354.1144 283.4431 354.1897 c
+283.8528 356.485 L
+284.1496 356.485 L
+283.5141 353.3326 l
+f
+*U
+*u
+287.6238 356.2174 m
+286.9256 356.2174 L
+286.9256 355.1053 L
+287.6029 355.1053 L
+287.6029 354.8377 L
+286.9256 354.8377 L
+286.9256 353.6002 L
+287.6238 353.6002 L
+287.6238 353.3326 L
+286.6329 353.3326 L
+286.6329 356.485 L
+287.6238 356.485 L
+287.6238 356.2174 l
+f
+*U
+*u
+290.2278 353.3326 m
+290.2278 356.485 L
+290.5414 356.485 L
+290.9804 356.485 291.4026 356.4515 291.4026 355.6823 c
+291.4026 355.2809 291.3148 354.8879 290.8089 354.8712 c
+291.5072 353.3326 L
+291.1978 353.3326 L
+290.5288 354.8753 L
+290.5205 354.8753 L
+290.5205 353.3326 L
+290.2278 353.3326 l
+f
+290.5205 355.1137 m
+290.625 355.1137 L
+291.0347 355.1137 291.1016 355.2558 291.1016 355.6697 c
+291.1016 356.1672 290.9511 356.2174 290.579 356.2174 c
+290.5205 356.2174 L
+290.5205 355.1137 l
+f
+*U
+*u
+295.0981 355.9875 m
+294.9727 356.1296 294.8347 356.2425 294.634 356.2425 c
+294.3414 356.2425 294.1783 356 294.1783 355.7324 c
+294.1783 355.3645 294.4459 355.1931 294.7176 355.0091 c
+294.9852 354.821 295.2528 354.6203 295.2528 354.1855 c
+295.2528 353.7256 294.9559 353.2908 294.4626 353.2908 c
+294.287 353.2908 294.1072 353.341 293.9651 353.4497 c
+293.9651 353.8301 L
+294.0989 353.688 294.2745 353.5751 294.4751 353.5751 c
+294.7845 353.5751 294.9559 353.8468 294.9518 354.1311 c
+294.9559 354.4991 294.6842 354.6621 294.4166 354.8503 c
+294.149 355.0342 293.8773 355.2391 293.8773 355.6906 c
+293.8773 356.1129 294.1365 356.5268 294.6006 356.5268 c
+294.7887 356.5268 294.9476 356.4641 295.0981 356.3596 C
+295.0981 355.9875 l
+f
+*U
+*u
+299.0865 353.3326 m
+298.773 353.3326 L
+298.6559 353.9806 L
+297.9869 353.9806 L
+297.8741 353.3326 L
+297.5605 353.3326 L
+298.1793 356.485 L
+298.4552 356.485 L
+299.0865 353.3326 l
+f
+298.6099 354.2357 m
+298.4009 355.444 L
+298.3632 355.6572 298.3465 355.8746 298.3214 356.0878 c
+298.3047 356.0878 L
+298.2754 355.8746 298.2545 355.6572 298.2211 355.444 c
+298.0371 354.2357 L
+298.6099 354.2357 l
+f
+*U
+*u
+301.8124 353.6002 m
+302.4981 353.6002 L
+302.4981 353.3326 L
+301.5198 353.3326 L
+301.5198 356.485 L
+301.8124 356.485 L
+301.8124 353.6002 l
+f
+*U
+*u
+309.0754 355.9875 m
+308.95 356.1296 308.812 356.2425 308.6114 356.2425 c
+308.3187 356.2425 308.1556 356 308.1556 355.7324 c
+308.1556 355.3645 308.4232 355.1931 308.695 355.0091 c
+308.9626 354.821 309.2301 354.6203 309.2301 354.1855 c
+309.2301 353.7256 308.9333 353.2908 308.4399 353.2908 c
+308.2643 353.2908 308.0846 353.341 307.9424 353.4497 c
+307.9424 353.8301 L
+308.0762 353.688 308.2518 353.5751 308.4525 353.5751 c
+308.7619 353.5751 308.9333 353.8468 308.9291 354.1311 c
+308.9333 354.4991 308.6615 354.6621 308.3939 354.8503 c
+308.1264 355.0342 307.8546 355.2391 307.8546 355.6906 c
+307.8546 356.1129 308.1138 356.5268 308.5779 356.5268 c
+308.766 356.5268 308.9249 356.4641 309.0754 356.3596 C
+309.0754 355.9875 l
+f
+*U
+*u
+312.9468 353.7172 m
+312.8339 353.6378 312.7001 353.5751 312.558 353.5751 c
+311.9977 353.5751 311.9977 354.5492 311.9977 354.9172 c
+311.9977 355.5025 312.0688 356.2425 312.5789 356.2425 c
+312.7252 356.2425 312.8297 356.184 312.9468 356.1045 C
+312.9468 356.4265 l
+312.8506 356.4975 312.6918 356.5268 312.5747 356.5268 c
+311.7134 356.5268 311.6967 355.306 311.6967 354.7959 c
+311.6967 354.2566 311.8054 353.2908 312.5454 353.2908 c
+312.6834 353.2908 312.8381 353.3451 312.9468 353.4204 c
+312.9468 353.7172 L
+f
+*U
+*u
+315.5053 353.3326 m
+315.5053 356.485 L
+315.8188 356.485 L
+316.2578 356.485 316.6801 356.4515 316.6801 355.6823 c
+316.6801 355.2809 316.5923 354.8879 316.0864 354.8712 c
+316.7846 353.3326 L
+316.4752 353.3326 L
+315.8063 354.8753 L
+315.7979 354.8753 L
+315.7979 353.3326 L
+315.5053 353.3326 l
+f
+315.7979 355.1137 m
+315.9025 355.1137 L
+316.3122 355.1137 316.3791 355.2558 316.3791 355.6697 c
+316.3791 356.1672 316.2286 356.2174 315.8565 356.2174 c
+315.7979 356.2174 L
+315.7979 355.1137 l
+f
+*U
+*u
+319.5728 353.3326 m
+319.2802 353.3326 L
+319.2802 356.485 L
+319.5728 356.485 L
+319.5728 353.3326 l
+f
+*U
+*u
+322.2551 353.3326 m
+322.2551 356.485 L
+322.5812 356.485 L
+323.0327 356.485 323.4341 356.4432 323.4341 355.6655 c
+323.4341 355.0551 323.2209 354.8419 322.623 354.8419 c
+322.5477 354.8419 L
+322.5477 353.3326 L
+322.2551 353.3326 l
+f
+322.5477 355.1095 m
+322.6606 355.1095 L
+323.0703 355.1095 323.1205 355.26 323.1331 355.6655 c
+323.1331 356.1004 323.016 356.2174 322.6063 356.2174 c
+322.5477 356.2174 L
+322.5477 355.1095 l
+f
+*U
+*u
+326.9539 356.485 m
+325.7164 356.485 L
+325.7164 356.2174 L
+326.1888 356.2174 L
+326.1888 353.3326 L
+326.4815 353.3326 L
+326.4815 356.2174 L
+326.9539 356.2174 l
+326.9539 356.485 L
+f
+*U
+*u
+329.7077 353.3326 m
+329.4151 353.3326 L
+329.4151 356.485 L
+329.7077 356.485 L
+329.7077 353.3326 l
+f
+*U
+*u
+333.7028 353.3326 m
+333.4477 353.3326 L
+332.737 355.4523 L
+332.691 355.5819 332.6659 355.7241 332.6283 355.8579 c
+332.6116 355.8579 L
+332.6241 355.653 332.645 355.4523 332.645 355.2474 c
+332.645 353.3326 L
+332.39 353.3326 L
+332.39 356.485 L
+332.645 356.485 L
+333.3683 354.2942 L
+333.4059 354.1855 333.4352 354.0768 333.4645 353.9681 c
+333.477 353.9681 L
+333.4686 354.1061 333.4477 354.2482 333.4477 354.3862 c
+333.4477 356.485 L
+333.7028 356.485 L
+333.7028 353.3326 l
+f
+*U
+*u
+336.9846 354.9966 m
+337.7037 354.9966 L
+337.7037 354.4154 L
+337.7037 353.9179 337.6787 353.2908 337.0264 353.2908 c
+336.3617 353.2908 336.299 353.989 336.299 354.9841 c
+336.299 355.7283 336.3868 356.5268 337.0557 356.5268 c
+337.432 356.5268 337.6201 356.276 337.6996 355.9331 c
+337.4111 355.8202 L
+337.3776 356.0084 337.2982 356.2425 337.0682 356.2425 c
+336.6334 356.2383 336.6 355.5652 336.6 355.0091 c
+336.6 353.8427 336.7463 353.5751 337.0515 353.5751 c
+337.3818 353.5751 337.4111 353.8176 337.4111 354.4907 c
+337.4111 354.729 L
+336.9846 354.729 L
+336.9846 354.9966 l
+f
+*U
+U
+U
+337.6667 -3924 m
+(N) *
+337.6667 4716 m
+(N) *
+LB
+%AI5_EndLayer--
+%%PageTrailer
+gsave annotatepage grestore showpage
+%%Trailer
+Adobe_IllustratorA_AI5 /terminate get exec
+Adobe_level2_AI5 /terminate get exec
+%%EOF
diff --git a/tcl/library/images/logo100.gif b/tcl/library/images/logo100.gif
new file mode 100644
index 00000000000..4603d4ff417
--- /dev/null
+++ b/tcl/library/images/logo100.gif
Binary files differ
diff --git a/tcl/library/images/logo64.gif b/tcl/library/images/logo64.gif
new file mode 100644
index 00000000000..749d55bdd21
--- /dev/null
+++ b/tcl/library/images/logo64.gif
Binary files differ
diff --git a/tcl/library/images/logoLarge.gif b/tcl/library/images/logoLarge.gif
new file mode 100644
index 00000000000..bd7530a9e18
--- /dev/null
+++ b/tcl/library/images/logoLarge.gif
Binary files differ
diff --git a/tcl/library/images/logoMed.gif b/tcl/library/images/logoMed.gif
new file mode 100644
index 00000000000..d41801a41f4
--- /dev/null
+++ b/tcl/library/images/logoMed.gif
Binary files differ
diff --git a/tcl/library/images/pwrdLogo.eps b/tcl/library/images/pwrdLogo.eps
new file mode 100644
index 00000000000..e11d9e96451
--- /dev/null
+++ b/tcl/library/images/pwrdLogo.eps
@@ -0,0 +1,1897 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%Creator: Adobe Illustrator(TM) 5.5
+%%For: (Bud Northern) (Mark Anderson Design)
+%%Title: (TCL PWRD LOGO.ILLUS)
+%%CreationDate: (8/1/96) (4:59 PM)
+%%BoundingBox: 242 302 377 513
+%%HiResBoundingBox: 242.0523 302.5199 376.3322 512.5323
+%%DocumentProcessColors: Cyan Magenta Yellow
+%%DocumentSuppliedResources: procset Adobe_level2_AI5 1.0 0
+%%+ procset Adobe_IllustratorA_AI5 1.0 0
+%AI5_FileFormat 1.2
+%AI3_ColorUsage: Color
+%%CMYKCustomColor: 0 0.45 1 0 (Orange)
+%%+ 0 0.25 1 0 (Orange Yellow)
+%%+ 0 0.79 0.91 0 (PANTONE Warm Red CV)
+%%+ 0 0.79 0.91 0 (TCL RED)
+%AI3_TemplateBox: 306 396 306 396
+%AI3_TileBox: 12 12 600 780
+%AI3_DocumentPreview: Macintosh_ColorPic
+%AI5_ArtSize: 612 792
+%AI5_RulerUnits: 0
+%AI5_ArtFlags: 1 0 0 1 0 0 1 1 0
+%AI5_TargetResolution: 800
+%AI5_NumLayers: 1
+%AI5_OpenToView: 102 564 2 938 673 18 1 1 2 40
+%AI5_OpenViewLayers: 7
+%%EndComments
+%%BeginProlog
+%%BeginResource: procset Adobe_level2_AI5 1.0 0
+%%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation)
+%%Version: 1.0
+%%CreationDate: (04/10/93) ()
+%%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved)
+userdict /Adobe_level2_AI5 21 dict dup begin
+ put
+ /packedarray where not
+ {
+ userdict begin
+ /packedarray
+ {
+ array astore readonly
+ } bind def
+ /setpacking /pop load def
+ /currentpacking false def
+ end
+ 0
+ } if
+ pop
+ userdict /defaultpacking currentpacking put true setpacking
+ /initialize
+ {
+ Adobe_level2_AI5 begin
+ } bind def
+ /terminate
+ {
+ currentdict Adobe_level2_AI5 eq
+ {
+ end
+ } if
+ } bind def
+ mark
+ /setcustomcolor where not
+ {
+ /findcmykcustomcolor
+ {
+ 5 packedarray
+ } bind def
+ /setcustomcolor
+ {
+ exch aload pop pop
+ 4
+ {
+ 4 index mul 4 1 roll
+ } repeat
+ 5 -1 roll pop
+ setcmykcolor
+ }
+ def
+ } if
+
+ /gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def
+ userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put
+ userdict /level2?
+ systemdict /languagelevel known dup
+ {
+ pop systemdict /languagelevel get 2 ge
+ } if
+ put
+ level2? not
+ {
+ /setcmykcolor where not
+ {
+ /setcmykcolor
+ {
+ exch .11 mul add exch .59 mul add exch .3 mul add
+ 1 exch sub setgray
+ } def
+ } if
+ /currentcmykcolor where not
+ {
+ /currentcmykcolor
+ {
+ 0 0 0 1 currentgray sub
+ } def
+ } if
+ /setoverprint where not
+ {
+ /setoverprint /pop load def
+ } if
+ /selectfont where not
+ {
+ /selectfont
+ {
+ exch findfont exch
+ dup type /arraytype eq
+ {
+ makefont
+ }
+ {
+ scalefont
+ } ifelse
+ setfont
+ } bind def
+ } if
+ /cshow where not
+ {
+ /cshow
+ {
+ [
+ 0 0 5 -1 roll aload pop
+ ] cvx bind forall
+ } bind def
+ } if
+ } if
+ cleartomark
+ /anyColor?
+ {
+ add add add 0 ne
+ } bind def
+ /testColor
+ {
+ gsave
+ setcmykcolor currentcmykcolor
+ grestore
+ } bind def
+ /testCMYKColorThrough
+ {
+ testColor anyColor?
+ } bind def
+ userdict /composite?
+ level2?
+ {
+ gsave 1 1 1 1 setcmykcolor currentcmykcolor grestore
+ add add add 4 eq
+ }
+ {
+ 1 0 0 0 testCMYKColorThrough
+ 0 1 0 0 testCMYKColorThrough
+ 0 0 1 0 testCMYKColorThrough
+ 0 0 0 1 testCMYKColorThrough
+ and and and
+ } ifelse
+ put
+ composite? not
+ {
+ userdict begin
+ gsave
+ /cyan? 1 0 0 0 testCMYKColorThrough def
+ /magenta? 0 1 0 0 testCMYKColorThrough def
+ /yellow? 0 0 1 0 testCMYKColorThrough def
+ /black? 0 0 0 1 testCMYKColorThrough def
+ grestore
+ /isCMYKSep? cyan? magenta? yellow? black? or or or def
+ /customColor? isCMYKSep? not def
+ end
+ } if
+ end defaultpacking setpacking
+%%EndResource
+%%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0
+%%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog)
+%%Version: 1.1
+%%CreationDate: (3/7/1994) ()
+%%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved)
+currentpacking true setpacking
+userdict /Adobe_IllustratorA_AI5_vars 70 dict dup begin
+put
+/_lp /none def
+/_pf
+{
+} def
+/_ps
+{
+} def
+/_psf
+{
+} def
+/_pss
+{
+} def
+/_pjsf
+{
+} def
+/_pjss
+{
+} def
+/_pola 0 def
+/_doClip 0 def
+/cf currentflat def
+/_tm matrix def
+/_renderStart
+[
+/e0 /r0 /a0 /o0 /e1 /r1 /a1 /i0
+] def
+/_renderEnd
+[
+null null null null /i1 /i1 /i1 /i1
+] def
+/_render -1 def
+/_rise 0 def
+/_ax 0 def
+/_ay 0 def
+/_cx 0 def
+/_cy 0 def
+/_leading
+[
+0 0
+] def
+/_ctm matrix def
+/_mtx matrix def
+/_sp 16#020 def
+/_hyphen (-) def
+/_fScl 0 def
+/_cnt 0 def
+/_hs 1 def
+/_nativeEncoding 0 def
+/_useNativeEncoding 0 def
+/_tempEncode 0 def
+/_pntr 0 def
+/_tDict 2 dict def
+/_wv 0 def
+/Tx
+{
+} def
+/Tj
+{
+} def
+/CRender
+{
+} def
+/_AI3_savepage
+{
+} def
+/_gf null def
+/_cf 4 array def
+/_if null def
+/_of false def
+/_fc
+{
+} def
+/_gs null def
+/_cs 4 array def
+/_is null def
+/_os false def
+/_sc
+{
+} def
+/discardSave null def
+/buffer 256 string def
+/beginString null def
+/endString null def
+/endStringLength null def
+/layerCnt 1 def
+/layerCount 1 def
+/perCent (%) 0 get def
+/perCentSeen? false def
+/newBuff null def
+/newBuffButFirst null def
+/newBuffLast null def
+/clipForward? false def
+end
+userdict /Adobe_IllustratorA_AI5 74 dict dup begin
+put
+/initialize
+{
+ Adobe_IllustratorA_AI5 dup begin
+ Adobe_IllustratorA_AI5_vars begin
+ discardDict
+ {
+ bind pop pop
+ } forall
+ dup /nc get begin
+ {
+ dup xcheck 1 index type /operatortype ne and
+ {
+ bind
+ } if
+ pop pop
+ } forall
+ end
+ newpath
+} def
+/terminate
+{
+ end
+ end
+} def
+/_
+null def
+/ddef
+{
+ Adobe_IllustratorA_AI5_vars 3 1 roll put
+} def
+/xput
+{
+ dup load dup length exch maxlength eq
+ {
+ dup dup load dup
+ length 2 mul dict copy def
+ } if
+ load begin
+ def
+ end
+} def
+/npop
+{
+ {
+ pop
+ } repeat
+} def
+/sw
+{
+ dup length exch stringwidth
+ exch 5 -1 roll 3 index mul add
+ 4 1 roll 3 1 roll mul add
+} def
+/swj
+{
+ dup 4 1 roll
+ dup length exch stringwidth
+ exch 5 -1 roll 3 index mul add
+ 4 1 roll 3 1 roll mul add
+ 6 2 roll /_cnt 0 ddef
+ {
+ 1 index eq
+ {
+ /_cnt _cnt 1 add ddef
+ } if
+ } forall
+ pop
+ exch _cnt mul exch _cnt mul 2 index add 4 1 roll 2 index add 4 1 roll pop pop
+} def
+/ss
+{
+ 4 1 roll
+ {
+ 2 npop
+ (0) exch 2 copy 0 exch put pop
+ gsave
+ false charpath currentpoint
+ 4 index setmatrix
+ stroke
+ grestore
+ moveto
+ 2 copy rmoveto
+ } exch cshow
+ 3 npop
+} def
+/jss
+{
+ 4 1 roll
+ {
+ 2 npop
+ (0) exch 2 copy 0 exch put
+ gsave
+ _sp eq
+ {
+ exch 6 index 6 index 6 index 5 -1 roll widthshow
+ currentpoint
+ }
+ {
+ false charpath currentpoint
+ 4 index setmatrix stroke
+ } ifelse
+ grestore
+ moveto
+ 2 copy rmoveto
+ } exch cshow
+ 6 npop
+} def
+/sp
+{
+ {
+ 2 npop (0) exch
+ 2 copy 0 exch put pop
+ false charpath
+ 2 copy rmoveto
+ } exch cshow
+ 2 npop
+} def
+/jsp
+{
+ {
+ 2 npop
+ (0) exch 2 copy 0 exch put
+ _sp eq
+ {
+ exch 5 index 5 index 5 index 5 -1 roll widthshow
+ }
+ {
+ false charpath
+ } ifelse
+ 2 copy rmoveto
+ } exch cshow
+ 5 npop
+} def
+/pl
+{
+ transform
+ 0.25 sub round 0.25 add exch
+ 0.25 sub round 0.25 add exch
+ itransform
+} def
+/setstrokeadjust where
+{
+ pop true setstrokeadjust
+ /c
+ {
+ curveto
+ } def
+ /C
+ /c load def
+ /v
+ {
+ currentpoint 6 2 roll curveto
+ } def
+ /V
+ /v load def
+ /y
+ {
+ 2 copy curveto
+ } def
+ /Y
+ /y load def
+ /l
+ {
+ lineto
+ } def
+ /L
+ /l load def
+ /m
+ {
+ moveto
+ } def
+}
+{
+ /c
+ {
+ pl curveto
+ } def
+ /C
+ /c load def
+ /v
+ {
+ currentpoint 6 2 roll pl curveto
+ } def
+ /V
+ /v load def
+ /y
+ {
+ pl 2 copy curveto
+ } def
+ /Y
+ /y load def
+ /l
+ {
+ pl lineto
+ } def
+ /L
+ /l load def
+ /m
+ {
+ pl moveto
+ } def
+} ifelse
+/d
+{
+ setdash
+} def
+/cf
+{
+} def
+/i
+{
+ dup 0 eq
+ {
+ pop cf
+ } if
+ setflat
+} def
+/j
+{
+ setlinejoin
+} def
+/J
+{
+ setlinecap
+} def
+/M
+{
+ setmiterlimit
+} def
+/w
+{
+ setlinewidth
+} def
+/H
+{
+} def
+/h
+{
+ closepath
+} def
+/N
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ {
+ clip /_doClip 0 ddef
+ } if
+ newpath
+ }
+ {
+ /CRender
+ {
+ N
+ } ddef
+ } ifelse
+} def
+/n
+{
+ N
+} def
+/F
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ {
+ gsave _pf grestore clip newpath /_lp /none ddef _fc
+ /_doClip 0 ddef
+ }
+ {
+ _pf
+ } ifelse
+ }
+ {
+ /CRender
+ {
+ F
+ } ddef
+ } ifelse
+} def
+/f
+{
+ closepath
+ F
+} def
+/S
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ {
+ gsave _ps grestore clip newpath /_lp /none ddef _sc
+ /_doClip 0 ddef
+ }
+ {
+ _ps
+ } ifelse
+ }
+ {
+ /CRender
+ {
+ S
+ } ddef
+ } ifelse
+} def
+/s
+{
+ closepath
+ S
+} def
+/B
+{
+ _pola 0 eq
+ {
+ _doClip 1 eq
+ gsave F grestore
+ {
+ gsave S grestore clip newpath /_lp /none ddef _sc
+ /_doClip 0 ddef
+ }
+ {
+ S
+ } ifelse
+ }
+ {
+ /CRender
+ {
+ B
+ } ddef
+ } ifelse
+} def
+/b
+{
+ closepath
+ B
+} def
+/W
+{
+ /_doClip 1 ddef
+} def
+/*
+{
+ count 0 ne
+ {
+ dup type /stringtype eq
+ {
+ pop
+ } if
+ } if
+ newpath
+} def
+/u
+{
+} def
+/U
+{
+} def
+/q
+{
+ _pola 0 eq
+ {
+ gsave
+ } if
+} def
+/Q
+{
+ _pola 0 eq
+ {
+ grestore
+ } if
+} def
+/*u
+{
+ _pola 1 add /_pola exch ddef
+} def
+/*U
+{
+ _pola 1 sub /_pola exch ddef
+ _pola 0 eq
+ {
+ CRender
+ } if
+} def
+/D
+{
+ pop
+} def
+/*w
+{
+} def
+/*W
+{
+} def
+/`
+{
+ /_i save ddef
+ clipForward?
+ {
+ nulldevice
+ } if
+ 6 1 roll 4 npop
+ concat pop
+ userdict begin
+ /showpage
+ {
+ } def
+ 0 setgray
+ 0 setlinecap
+ 1 setlinewidth
+ 0 setlinejoin
+ 10 setmiterlimit
+ [] 0 setdash
+ /setstrokeadjust where {pop false setstrokeadjust} if
+ newpath
+ 0 setgray
+ false setoverprint
+} def
+/~
+{
+ end
+ _i restore
+} def
+/O
+{
+ 0 ne
+ /_of exch ddef
+ /_lp /none ddef
+} def
+/R
+{
+ 0 ne
+ /_os exch ddef
+ /_lp /none ddef
+} def
+/g
+{
+ /_gf exch ddef
+ /_fc
+ {
+ _lp /fill ne
+ {
+ _of setoverprint
+ _gf setgray
+ /_lp /fill ddef
+ } if
+ } ddef
+ /_pf
+ {
+ _fc
+ fill
+ } ddef
+ /_psf
+ {
+ _fc
+ ashow
+ } ddef
+ /_pjsf
+ {
+ _fc
+ awidthshow
+ } ddef
+ /_lp /none ddef
+} def
+/G
+{
+ /_gs exch ddef
+ /_sc
+ {
+ _lp /stroke ne
+ {
+ _os setoverprint
+ _gs setgray
+ /_lp /stroke ddef
+ } if
+ } ddef
+ /_ps
+ {
+ _sc
+ stroke
+ } ddef
+ /_pss
+ {
+ _sc
+ ss
+ } ddef
+ /_pjss
+ {
+ _sc
+ jss
+ } ddef
+ /_lp /none ddef
+} def
+/k
+{
+ _cf astore pop
+ /_fc
+ {
+ _lp /fill ne
+ {
+ _of setoverprint
+ _cf aload pop setcmykcolor
+ /_lp /fill ddef
+ } if
+ } ddef
+ /_pf
+ {
+ _fc
+ fill
+ } ddef
+ /_psf
+ {
+ _fc
+ ashow
+ } ddef
+ /_pjsf
+ {
+ _fc
+ awidthshow
+ } ddef
+ /_lp /none ddef
+} def
+/K
+{
+ _cs astore pop
+ /_sc
+ {
+ _lp /stroke ne
+ {
+ _os setoverprint
+ _cs aload pop setcmykcolor
+ /_lp /stroke ddef
+ } if
+ } ddef
+ /_ps
+ {
+ _sc
+ stroke
+ } ddef
+ /_pss
+ {
+ _sc
+ ss
+ } ddef
+ /_pjss
+ {
+ _sc
+ jss
+ } ddef
+ /_lp /none ddef
+} def
+/x
+{
+ /_gf exch ddef
+ findcmykcustomcolor
+ /_if exch ddef
+ /_fc
+ {
+ _lp /fill ne
+ {
+ _of setoverprint
+ _if _gf 1 exch sub setcustomcolor
+ /_lp /fill ddef
+ } if
+ } ddef
+ /_pf
+ {
+ _fc
+ fill
+ } ddef
+ /_psf
+ {
+ _fc
+ ashow
+ } ddef
+ /_pjsf
+ {
+ _fc
+ awidthshow
+ } ddef
+ /_lp /none ddef
+} def
+/X
+{
+ /_gs exch ddef
+ findcmykcustomcolor
+ /_is exch ddef
+ /_sc
+ {
+ _lp /stroke ne
+ {
+ _os setoverprint
+ _is _gs 1 exch sub setcustomcolor
+ /_lp /stroke ddef
+ } if
+ } ddef
+ /_ps
+ {
+ _sc
+ stroke
+ } ddef
+ /_pss
+ {
+ _sc
+ ss
+ } ddef
+ /_pjss
+ {
+ _sc
+ jss
+ } ddef
+ /_lp /none ddef
+} def
+/A
+{
+ pop
+} def
+/annotatepage
+{
+userdict /annotatepage 2 copy known {get exec} {pop pop} ifelse
+} def
+/discard
+{
+ save /discardSave exch store
+ discardDict begin
+ /endString exch store
+ gt38?
+ {
+ 2 add
+ } if
+ load
+ stopped
+ pop
+ end
+ discardSave restore
+} bind def
+userdict /discardDict 7 dict dup begin
+put
+/pre38Initialize
+{
+ /endStringLength endString length store
+ /newBuff buffer 0 endStringLength getinterval store
+ /newBuffButFirst newBuff 1 endStringLength 1 sub getinterval store
+ /newBuffLast newBuff endStringLength 1 sub 1 getinterval store
+} def
+/shiftBuffer
+{
+ newBuff 0 newBuffButFirst putinterval
+ newBuffLast 0
+ currentfile read not
+ {
+ stop
+ } if
+ put
+} def
+0
+{
+ pre38Initialize
+ mark
+ currentfile newBuff readstring exch pop
+ {
+ {
+ newBuff endString eq
+ {
+ cleartomark stop
+ } if
+ shiftBuffer
+ } loop
+ }
+ {
+ stop
+ } ifelse
+} def
+1
+{
+ pre38Initialize
+ /beginString exch store
+ mark
+ currentfile newBuff readstring exch pop
+ {
+ {
+ newBuff beginString eq
+ {
+ /layerCount dup load 1 add store
+ }
+ {
+ newBuff endString eq
+ {
+ /layerCount dup load 1 sub store
+ layerCount 0 eq
+ {
+ cleartomark stop
+ } if
+ } if
+ } ifelse
+ shiftBuffer
+ } loop
+ }
+ {
+ stop
+ } ifelse
+} def
+2
+{
+ mark
+ {
+ currentfile buffer readline not
+ {
+ stop
+ } if
+ endString eq
+ {
+ cleartomark stop
+ } if
+ } loop
+} def
+3
+{
+ /beginString exch store
+ /layerCnt 1 store
+ mark
+ {
+ currentfile buffer readline not
+ {
+ stop
+ } if
+ dup beginString eq
+ {
+ pop /layerCnt dup load 1 add store
+ }
+ {
+ endString eq
+ {
+ layerCnt 1 eq
+ {
+ cleartomark stop
+ }
+ {
+ /layerCnt dup load 1 sub store
+ } ifelse
+ } if
+ } ifelse
+ } loop
+} def
+end
+userdict /clipRenderOff 15 dict dup begin
+put
+{
+ /n /N /s /S /f /F /b /B
+}
+{
+ {
+ _doClip 1 eq
+ {
+ /_doClip 0 ddef clip
+ } if
+ newpath
+ } def
+} forall
+/Tr /pop load def
+/Bb {} def
+/BB /pop load def
+/Bg {12 npop} def
+/Bm {6 npop} def
+/Bc /Bm load def
+/Bh {4 npop} def
+end
+/Lb
+{
+ 4 npop
+ 6 1 roll
+ pop
+ 4 1 roll
+ pop pop pop
+ 0 eq
+ {
+ 0 eq
+ {
+ (%AI5_BeginLayer) 1 (%AI5_EndLayer--) discard
+ }
+ {
+ /clipForward? true def
+
+ /Tx /pop load def
+ /Tj /pop load def
+ currentdict end clipRenderOff begin begin
+ } ifelse
+ }
+ {
+ 0 eq
+ {
+ save /discardSave exch store
+ } if
+ } ifelse
+} bind def
+/LB
+{
+ discardSave dup null ne
+ {
+ restore
+ }
+ {
+ pop
+ clipForward?
+ {
+ currentdict
+ end
+ end
+ begin
+
+ /clipForward? false ddef
+ } if
+ } ifelse
+} bind def
+/Pb
+{
+ pop pop
+ 0 (%AI5_EndPalette) discard
+} bind def
+/Np
+{
+ 0 (%AI5_End_NonPrinting--) discard
+} bind def
+/Ln /pop load def
+/Ap
+/pop load def
+/Ar
+{
+ 72 exch div
+ 0 dtransform dup mul exch dup mul add sqrt
+ dup 1 lt
+ {
+ pop 1
+ } if
+ setflat
+} def
+/Mb
+{
+ q
+} def
+/Md
+{
+} def
+/MB
+{
+ Q
+} def
+/nc 3 dict def
+nc begin
+/setgray
+{
+ pop
+} bind def
+/setcmykcolor
+{
+ 4 npop
+} bind def
+/setcustomcolor
+{
+ 2 npop
+} bind def
+currentdict readonly pop
+end
+currentdict readonly pop
+end
+setpacking
+%%EndResource
+%%EndProlog
+%%BeginSetup
+Adobe_level2_AI5 /initialize get exec
+Adobe_IllustratorA_AI5 /initialize get exec
+%AI5_Begin_NonPrinting
+Np
+%AI3_BeginPattern: (Yellow Stripe)
+(Yellow Stripe) 8.4499 4.6 80.4499 76.6 [
+%AI3_Tile
+(0 O 0 R 0 0.4 1 0 k 0 0.4 1 0 K) @
+(
+800 Ar
+0 J 0 j 3.6 w 4 M []0 d
+%AI3_Note:
+0 D
+8.1999 8.1999 m
+80.6999 8.1999 L
+S
+8.1999 22.6 m
+80.6999 22.6 L
+S
+8.1999 37.0001 m
+80.6999 37.0001 L
+S
+8.1999 51.3999 m
+80.6999 51.3999 L
+S
+8.1999 65.8 m
+80.6999 65.8 L
+S
+8.1999 15.3999 m
+80.6999 15.3999 L
+S
+8.1999 29.8 m
+80.6999 29.8 L
+S
+8.1999 44.1999 m
+80.6999 44.1999 L
+S
+8.1999 58.6 m
+80.6999 58.6 L
+S
+8.1999 73.0001 m
+80.6999 73.0001 L
+S
+) &
+] E
+%AI3_EndPattern
+%AI5_End_NonPrinting--
+%AI5_Begin_NonPrinting
+Np
+3 Bn
+%AI5_BeginGradient: (Black & White)
+(Black & White) 0 2 Bd
+[
+<
+FFFEFDFCFBFAF9F8F7F6F5F4F3F2F1F0EFEEEDECEBEAE9E8E7E6E5E4E3E2E1E0DFDEDDDCDBDAD9D8
+D7D6D5D4D3D2D1D0CFCECDCCCBCAC9C8C7C6C5C4C3C2C1C0BFBEBDBCBBBAB9B8B7B6B5B4B3B2B1B0
+AFAEADACABAAA9A8A7A6A5A4A3A2A1A09F9E9D9C9B9A999897969594939291908F8E8D8C8B8A8988
+87868584838281807F7E7D7C7B7A797877767574737271706F6E6D6C6B6A69686766656463626160
+5F5E5D5C5B5A595857565554535251504F4E4D4C4B4A494847464544434241403F3E3D3C3B3A3938
+37363534333231302F2E2D2C2B2A292827262524232221201F1E1D1C1B1A19181716151413121110
+0F0E0D0C0B0A09080706050403020100
+>
+0 %_Br
+[
+0 0 50 100 %_Bs
+1 0 50 0 %_Bs
+BD
+%AI5_EndGradient
+%AI5_BeginGradient: (Red & Yellow)
+(Red & Yellow) 0 2 Bd
+[
+0
+<
+000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
+28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
+505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
+78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
+A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
+C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
+F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
+>
+<
+FFFFFEFEFDFDFDFCFCFBFBFBFAFAF9F9F9F8F8F7F7F7F6F6F5F5F5F4F4F3F3F3F2F2F1F1F1F0F0EF
+EFEFEEEEEDEDEDECECEBEBEBEAEAE9E9E9E8E8E7E7E7E6E6E5E5E5E4E4E3E3E3E2E2E1E1E1E0E0DF
+DFDFDEDEDDDDDDDCDCDBDBDBDADAD9D9D9D8D8D7D7D7D6D6D5D5D5D4D4D3D3D3D2D2D1D1D1D0D0CF
+CFCFCECECDCDCDCCCCCBCBCBCACAC9C9C9C8C8C7C7C7C6C6C5C5C5C4C4C3C3C3C2C2C1C1C1C0C0BF
+BFBFBEBEBDBDBDBCBCBBBBBBBABAB9B9B9B8B8B7B7B7B6B6B5B5B5B4B4B3B3B3B2B2B1B1B1B0B0AF
+AFAFAEAEADADADACACABABABAAAAA9A9A9A8A8A7A7A7A6A6A5A5A5A4A4A3A3A3A2A2A1A1A1A0A09F
+9F9F9E9E9D9D9D9C9C9B9B9B9A9A9999
+>
+0
+1 %_Br
+[
+0 1 0.6 0 1 50 100 %_Bs
+0 0 1 0 1 50 0 %_Bs
+BD
+%AI5_EndGradient
+%AI5_BeginGradient: (Yellow & Blue Radial)
+(Yellow & Blue Radial) 1 2 Bd
+[
+<
+000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
+28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
+505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
+78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
+A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
+C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
+F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
+>
+<
+1415161718191A1B1C1D1E1F1F202122232425262728292A2A2B2C2D2E2F30313233343536363738
+393A3B3C3D3E3F40414142434445464748494A4B4C4D4D4E4F50515253545556575858595A5B5C5D
+5E5F60616263646465666768696A6B6C6D6E6F6F707172737475767778797A7B7B7C7D7E7F808182
+83848586868788898A8B8C8D8E8F90919292939495969798999A9B9C9D9D9E9FA0A1A2A3A4A5A6A7
+A8A9A9AAABACADAEAFB0B1B2B3B4B4B5B6B7B8B9BABBBCBDBEBFC0C0C1C2C3C4C5C6C7C8C9CACBCB
+CCCDCECFD0D1D2D3D4D5D6D7D7D8D9DADBDCDDDEDFE0E1E2E2E3E4E5E6E7E8E9EAEBECEDEEEEEFF0
+F1F2F3F4F5F6F7F8F9F9FAFBFCFDFEFF
+>
+<
+ABAAAAA9A8A7A7A6A5A5A4A3A3A2A1A1A09F9F9E9D9D9C9B9B9A9999989797969595949393929191
+908F8F8E8D8D8C8B8B8A8989888787868585848383828181807F7F7E7D7D7C7B7B7A797978777776
+7575747373727171706F6F6E6D6D6C6B6B6A6969686767666565646362626160605F5E5E5D5C5C5B
+5A5A5958585756565554545352525150504F4E4E4D4C4C4B4A4A4948484746464544444342424140
+403F3E3E3D3C3C3B3A3A3938383736363534343332323130302F2E2E2D2C2C2B2A2A292828272626
+25242423222121201F1F1E1D1D1C1B1B1A1919181717161515141313121111100F0F0E0D0D0C0B0B
+0A090908070706050504030302010100
+>
+0
+1 %_Br
+[
+0 0.08 0.67 0 1 50 14 %_Bs
+1 1 0 0 1 50 100 %_Bs
+BD
+%AI5_EndGradient
+%AI5_End_NonPrinting--
+%AI5_BeginPalette
+144 161 Pb
+Pn
+Pc
+1 g
+Pc
+0 g
+Pc
+0 0 0 0 k
+Pc
+0.75 g
+Pc
+0.5 g
+Pc
+0.25 g
+Pc
+0 g
+Pc
+Bb
+2 (Black & White) -4014 4716 0 0 1 0 0 1 0 0 Bg
+0 BB
+Pc
+0.25 0 0 0 k
+Pc
+0.5 0 0 0 k
+Pc
+0.75 0 0 0 k
+Pc
+1 0 0 0 k
+Pc
+0.25 0.25 0 0 k
+Pc
+0.5 0.5 0 0 k
+Pc
+0.75 0.75 0 0 k
+Pc
+1 1 0 0 k
+Pc
+Bb
+2 (Red & Yellow) -4014 4716 0 0 1 0 0 1 0 0 Bg
+0 BB
+Pc
+0 0.25 0 0 k
+Pc
+0 0.5 0 0 k
+Pc
+0 0.75 0 0 k
+Pc
+0 1 0 0 k
+Pc
+0 0.25 0.25 0 k
+Pc
+0 0.5 0.5 0 k
+Pc
+0 0.75 0.75 0 k
+Pc
+0 1 1 0 k
+Pc
+Bb
+0 0 0 0 Bh
+2 (Yellow & Blue Radial) -4014 4716 0 0 1 0 0 1 0 0 Bg
+0 BB
+Pc
+0 0 0.25 0 k
+Pc
+0 0 0.5 0 k
+Pc
+0 0 0.75 0 k
+Pc
+0 0 1 0 k
+Pc
+0.25 0 0.25 0 k
+Pc
+0.5 0 0.5 0 k
+Pc
+0.75 0 0.75 0 k
+Pc
+1 0 1 0 k
+Pc
+(Yellow Stripe) 0 0 1 1 0 0 0 0 0 [1 0 0 1 0 0] p
+Pc
+0.25 0.125 0 0 k
+Pc
+0.5 0.25 0 0 k
+Pc
+0.75 0.375 0 0 k
+Pc
+1 0.5 0 0 k
+Pc
+0.125 0.25 0 0 k
+Pc
+0.25 0.5 0 0 k
+Pc
+0.375 0.75 0 0 k
+Pc
+0.5 1 0 0 k
+Pc
+0.375 0.375 0.75 0 k
+Pc
+0 0.25 0.125 0 k
+Pc
+0 0.5 0.25 0 k
+Pc
+0 0.75 0.375 0 k
+Pc
+0 1 0.5 0 k
+Pc
+0 0.125 0.25 0 k
+Pc
+0 0.25 0.5 0 k
+Pc
+0 0.375 0.75 0 k
+Pc
+0 0.5 1 0 k
+Pc
+0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x
+Pc
+0.125 0 0.25 0 k
+Pc
+0.25 0 0.5 0 k
+Pc
+0.375 0 0.75 0 k
+Pc
+0.5 0 1 0 k
+Pc
+0.25 0 0.125 0 k
+Pc
+0.5 0 0.25 0 k
+Pc
+0.75 0 0.375 0 k
+Pc
+1 0 0.5 0 k
+Pc
+0.5 1 0 0 k
+Pc
+0.25 0.125 0.125 0 k
+Pc
+0.5 0.25 0.25 0 k
+Pc
+0.75 0.375 0.375 0 k
+Pc
+1 0.5 0.5 0 k
+Pc
+0.25 0.25 0.125 0 k
+Pc
+0.5 0.5 0.25 0 k
+Pc
+0.75 0.75 0.375 0 k
+Pc
+1 1 0.5 0 k
+Pc
+0 1 0.5 0 k
+Pc
+0.125 0.25 0.125 0 k
+Pc
+0.25 0.5 0.25 0 k
+Pc
+0.375 0.75 0.375 0 k
+Pc
+0.5 1 0.5 0 k
+Pc
+0.125 0.25 0.25 0 k
+Pc
+0.25 0.5 0.5 0 k
+Pc
+0.375 0.75 0.75 0 k
+Pc
+0.5 1 1 0 k
+Pc
+0.75 0.75 0.375 0 k
+Pc
+0.125 0.125 0.25 0 k
+Pc
+0.25 0.25 0.5 0 k
+Pc
+0.375 0.375 0.75 0 k
+Pc
+0.5 0.5 1 0 k
+Pc
+0.25 0.125 0.25 0 k
+Pc
+0.5 0.25 0.5 0 k
+Pc
+0.75 0.375 0.75 0 k
+Pc
+1 0.5 1 0 k
+Pc
+0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+1 0.5 0.5 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0.25 1 0 (Orange Yellow) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 1 0.5 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+1 0 0.5 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0.45 1 0 (Orange) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0.375 0.375 0.75 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+1 0.65 0 0 k
+Pc
+0 0 0 0 k
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+Pc
+0 0 1 0 k
+Pc
+PB
+%AI5_EndPalette
+%%EndSetup
+%AI5_BeginLayer
+1 1 1 1 0 0 0 79 128 255 Lb
+(Layer 1) Ln
+0 A
+1 Ap
+0 O
+1 0.65 0 0 k
+800 Ar
+0 J 0 j 1 w 4 M []0 d
+%AI3_Note:
+0 D
+285.0121 311.7976 m
+357.5043 302.5199 L
+361.6071 392.7105 L
+376.3322 474.1377 L
+342.6527 475.6628 L
+327.6333 483.4165 L
+258.8269 486.3189 L
+254.4361 405.0427 L
+242.0523 312.2099 L
+285.0121 311.7976 L
+f
+0 0.79 0.91 0 k
+1.25 w
+295.4466 337.6172 m
+368.4943 335.3343 L
+363.9288 425.5026 L
+370.7771 507.9667 L
+337.1066 506.2547 L
+321.4128 512.5323 L
+252.6452 508.8228 L
+256.0692 427.5002 L
+252.6452 333.9077 L
+295.4466 337.6172 L
+f
+u
+0 Ap
+1 0.65 0 0 k
+1 w
+320.532 390.6149 m
+312.9017 388.534 l
+317.0637 398.5921 l
+321.2256 426.6854 l
+316.0232 427.7258 l
+322.2662 436.3965 l
+330.0436 465.6249 l
+316.3701 462.7557 l
+323.5798 475.9563 331.2311 484.5534 v
+321.2256 492.2363 l
+288.9913 478.0373 297.6622 431.9088 v
+290.9988 433.0755 l
+297.3888 384.7188 l
+291.9867 383.3315 l
+297.5214 372.0383 305.2714 366.6837 v
+305.9749 366.1976 295.5601 404.4882 306.6587 442.6395 c
+307.6992 440.2117 l
+298.855 399.5459 307.6992 366.6837 v
+308.1064 365.9033 312.5286 366.4235 v
+320.532 381.5106 320.532 390.6149 v
+f
+u
+*u
+1 g
+263.6948 355.9856 m
+265.2612 355.9856 L
+265.2612 359.2513 L
+265.9515 359.2513 266.6153 359.2513 267.2791 359.3575 c
+267.2791 355.9856 L
+269.6155 355.9856 L
+269.6155 355.3749 L
+267.2791 355.3749 L
+267.2791 347.2505 L
+267.2791 346.7726 267.2791 346.0558 268.288 346.0558 c
+268.9783 346.0558 269.35 346.5337 269.7748 347.0381 c
+270.1996 346.7461 L
+269.6951 345.7372 268.3942 345.1265 267.3322 345.1265 c
+265.4205 345.1265 265.2081 346.162 265.2081 347.4364 c
+265.2081 355.3749 L
+263.6948 355.3749 L
+263.6948 355.9856 l
+f
+*U
+*u
+285.7796 348.7639 m
+285.1689 346.8788 284.1069 345.2327 281.3457 345.1265 c
+277.2304 345.1265 275.9825 348.5515 275.9825 350.3835 c
+275.9825 355.1094 279.7792 356.2511 281.2926 356.2511 c
+283.0184 356.2511 285.461 355.4546 285.461 353.4102 c
+285.461 352.6934 285.0096 352.003 284.2662 352.003 c
+283.5494 352.003 283.0184 352.481 283.0184 353.2509 c
+283.0184 354.2864 283.868 354.4191 283.868 354.7112 c
+283.868 355.428 282.1953 355.7201 281.6112 355.7201 c
+279.0624 355.7201 278.3986 353.8616 278.3986 350.3835 c
+278.3986 348.7905 278.7969 347.5691 278.9562 347.1974 c
+279.3544 346.3213 280.1775 345.7637 281.5581 345.6841 c
+283.098 345.6044 284.5848 346.8523 285.222 348.7639 C
+285.7796 348.7639 l
+f
+*U
+*u
+291.9344 345.4717 m
+291.9344 346.0823 L
+293.9788 346.0823 L
+293.9788 363.1542 L
+291.9344 363.1542 L
+291.9344 363.7648 L
+293.0761 363.7648 L
+294.0585 363.7648 295.0939 363.8179 296.0497 364.0038 c
+296.0497 346.0823 L
+298.0941 346.0823 L
+298.0941 345.4717 L
+291.9344 345.4717 l
+f
+*U
+u
+310.0634 446.075 m
+305.3828 425.2059 306.7298 391.3708 v
+307.1338 381.222 308.2436 371.8929 309.5993 363.8029 C
+309.6066 363.8025 L
+310.4883 356.6987 311.0781 354.1272 313.3768 345.5676 C
+313.2426 340.0473 L
+294.8367 398.8155 310.0634 446.075 V
+f
+321.3622 464.1699 m
+325.5016 466.2317 331.4359 466.9819 v
+337.9224 455.0924 321.9584 434.793 v
+331.4821 456.0522 329.2358 462.7122 v
+326.7243 464.2727 321.3622 464.1699 v
+f
+319.4002 428.4819 m
+323.1177 427.6214 324.9024 429.0668 v
+321.386 415.3445 322.3077 407.7964 v
+323.2297 400.2483 316.5788 395.4159 y
+322.2441 402.584 320.4635 408.4226 v
+319.2289 412.4694 320.6101 422.8271 322.1681 426.1155 c
+320.7131 426.3196 319.4002 428.4819 v
+f
+315.7246 392.3281 m
+321.8677 393.0631 322.5131 396.1662 v
+323.265 377.6058 314.7299 369.9571 v
+321.2425 380.1152 320.2206 390.6235 v
+315.7246 392.3281 l
+f
+298.4445 384.6023 m
+296.4635 382.3836 290.5192 387.2778 v
+292.4131 374.803 304.1781 369.0924 v
+296.0814 375.1928 293.9 381.7824 v
+296.7611 382.6245 298.4445 384.6023 v
+f
+296.5483 389.3335 m
+288.5102 409.7356 290.2325 437.3036 v
+292.1098 432.3112 298.1424 430.5604 v
+295.3003 429.9794 293.6387 430.2313 v
+289.4335 418.5932 296.5483 389.3335 v
+f
+330.3126 484.1353 m
+327.3003 506.2722 308.4549 483.8853 v
+293.4491 466.0592 295.2373 450.9247 296.1578 442.4811 c
+296.3932 440.3206 293.366 465.0316 309.8067 481.2933 c
+326.2471 497.5553 329.9609 485.0794 330.3126 484.1353 c
+f
+U
+0 0 1 0 k
+302.5528 503.0164 m
+287.7656 507.2395 283.0593 458.227 v
+279.4282 473.3549 288.8204 494.7509 v
+298.2122 516.1468 302.5528 503.0164 y
+f
+284.2076 506.5994 m
+276.6655 495.2557 278.3767 483.1729 v
+272.6565 505.9183 284.2076 506.5994 v
+f
+339.7135 474.7902 m
+348.6321 478.0799 335.8615 444.8834 v
+342.4718 454.5848 346.6326 469.8253 v
+349.303 479.6062 339.7135 474.7902 y
+f
+354.1382 477.3767 m
+360.4435 471.669 355.9752 464.1187 v
+367.1908 475.904 354.1382 477.3767 v
+f
+U
+U
+*u
+1 g
+258.2029 317.4593 m
+256.6821 317.4593 L
+256.6821 325.2598 L
+258.7512 325.2598 L
+260.3858 325.2598 261.4514 324.608 261.4514 322.839 c
+261.4514 321.1837 260.5513 320.3767 258.9581 320.3767 c
+258.2029 320.3767 L
+258.2029 317.4593 l
+f
+1 D
+258.2029 321.6389 m
+258.5132 321.6389 L
+259.4133 321.6389 259.8995 321.8354 259.8995 322.8493 c
+259.8995 323.8528 259.3202 323.9976 258.4719 323.9976 c
+258.2029 323.9976 L
+258.2029 321.6389 l
+f
+*U
+*u
+0 D
+269.0694 321.3699 m
+269.0694 323.5528 270.6523 325.4667 272.9283 325.4667 c
+275.2043 325.4667 276.7871 323.5528 276.7871 321.3699 c
+276.7871 319.1353 275.2043 317.2524 272.9283 317.2524 c
+270.6523 317.2524 269.0694 319.1353 269.0694 321.3699 c
+f
+1 D
+270.6419 321.432 m
+270.6419 320.2526 271.6351 318.7525 272.9283 318.7525 c
+274.2215 318.7525 275.2146 320.2526 275.2146 321.432 c
+275.2146 322.6941 274.2628 323.9666 272.9283 323.9666 c
+271.5937 323.9666 270.6419 322.6941 270.6419 321.432 c
+f
+*U
+*u
+0 D
+287.2943 319.9422 m
+287.315 319.9422 L
+288.8668 325.3632 L
+289.7668 325.3632 L
+291.3807 319.9422 L
+291.4014 319.9422 L
+292.9326 325.2598 L
+294.5258 325.2598 L
+291.8877 317.3041 L
+290.7704 317.3041 L
+289.2185 322.4044 L
+289.1978 322.4044 L
+287.7288 317.3041 L
+286.6115 317.3041 L
+284.1286 325.2598 L
+285.7218 325.2598 L
+287.2943 319.9422 l
+f
+*U
+*u
+303.7595 323.9356 m
+303.7595 322.2182 L
+306.1803 322.2182 L
+306.1803 320.894 L
+303.7595 320.894 L
+303.7595 318.7835 L
+306.2734 318.7835 L
+306.2734 317.4593 L
+302.2387 317.4593 L
+302.2387 325.2598 L
+306.2734 325.2598 L
+306.2734 323.9356 L
+303.7595 323.9356 l
+f
+*U
+*u
+319.8602 317.4593 m
+318.0187 317.4593 L
+316.1255 320.6043 L
+316.1048 320.6043 L
+316.1048 317.4593 L
+314.5841 317.4593 L
+314.5841 325.2598 L
+316.6428 325.2598 L
+318.1843 325.2598 319.2499 324.577 319.2499 322.9114 c
+319.2499 321.9182 318.7015 320.925 317.6567 320.7492 C
+319.8602 317.4593 l
+f
+1 D
+316.1048 321.6699 m
+316.3014 321.6699 L
+317.1394 321.6699 317.7291 321.9182 317.7291 322.87 c
+317.7291 323.8321 317.1187 324.0183 316.3117 324.0183 c
+316.1048 324.0183 L
+316.1048 321.6699 l
+f
+*U
+*u
+0 D
+329.1754 323.9356 m
+329.1754 322.2182 L
+331.5962 322.2182 L
+331.5962 320.894 L
+329.1754 320.894 L
+329.1754 318.7835 L
+331.6894 318.7835 L
+331.6894 317.4593 L
+327.6546 317.4593 L
+327.6546 325.2598 L
+331.6894 325.2598 L
+331.6894 323.9356 L
+329.1754 323.9356 l
+f
+*U
+*u
+340 325.2598 m
+342.1725 325.2598 L
+344.4279 325.2598 345.9383 323.5735 345.9383 321.3492 c
+345.9383 319.156 344.3865 317.4593 342.1622 317.4593 c
+340 317.4593 L
+340 325.2598 l
+f
+1 D
+341.5208 318.7835 m
+341.7691 318.7835 L
+343.6416 318.7835 344.3658 319.8181 344.3658 321.3596 c
+344.3658 323.0562 343.4968 323.9356 341.7691 323.9356 c
+341.5208 323.9356 L
+341.5208 318.7835 l
+f
+*U
+LB
+%AI5_EndLayer--
+%%PageTrailer
+gsave annotatepage grestore showpage
+%%Trailer
+Adobe_IllustratorA_AI5 /terminate get exec
+Adobe_level2_AI5 /terminate get exec
+%%EOF
diff --git a/tcl/library/images/pwrdLogo100.gif b/tcl/library/images/pwrdLogo100.gif
new file mode 100644
index 00000000000..d2f8cbb65d2
--- /dev/null
+++ b/tcl/library/images/pwrdLogo100.gif
Binary files differ
diff --git a/tcl/library/images/pwrdLogo150.gif b/tcl/library/images/pwrdLogo150.gif
new file mode 100644
index 00000000000..89eec7ca7b3
--- /dev/null
+++ b/tcl/library/images/pwrdLogo150.gif
Binary files differ
diff --git a/tcl/library/images/pwrdLogo175.gif b/tcl/library/images/pwrdLogo175.gif
new file mode 100644
index 00000000000..02dcd92dca4
--- /dev/null
+++ b/tcl/library/images/pwrdLogo175.gif
Binary files differ
diff --git a/tcl/library/images/pwrdLogo200.gif b/tcl/library/images/pwrdLogo200.gif
new file mode 100644
index 00000000000..66426bfd846
--- /dev/null
+++ b/tcl/library/images/pwrdLogo200.gif
Binary files differ
diff --git a/tcl/library/images/pwrdLogo75.gif b/tcl/library/images/pwrdLogo75.gif
new file mode 100644
index 00000000000..e75925c1894
--- /dev/null
+++ b/tcl/library/images/pwrdLogo75.gif
Binary files differ
diff --git a/tcl/library/images/tai-ku.gif b/tcl/library/images/tai-ku.gif
new file mode 100644
index 00000000000..a5aea47599b
--- /dev/null
+++ b/tcl/library/images/tai-ku.gif
Binary files differ
diff --git a/tcl/library/license.terms b/tcl/library/license.terms
index f1dcaa5245c..03ca6fcb319 100644
--- a/tcl/library/license.terms
+++ b/tcl/library/license.terms
@@ -1,8 +1,7 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
+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
@@ -37,4 +36,4 @@ 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.
+terms specified in this license.
diff --git a/tcl/library/listbox.tcl b/tcl/library/listbox.tcl
new file mode 100644
index 00000000000..c48e9823743
--- /dev/null
+++ b/tcl/library/listbox.tcl
@@ -0,0 +1,505 @@
+# listbox.tcl --
+#
+# This file defines the default bindings for Tk listbox widgets
+# and provides procedures that help in implementing those bindings.
+#
+# RCS: @(#) $Id$
+#
+# 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.
+
+#--------------------------------------------------------------------------
+# tk::Priv 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]} {
+ tk::ListboxBeginSelect %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 tk::Priv(x) %x
+ set tk::Priv(y) %y
+ tk::ListboxMotion %W [%W index @%x,%y]
+}
+bind Listbox <ButtonRelease-1> {
+ tk::CancelRepeat
+ %W activate @%x,%y
+}
+bind Listbox <Shift-1> {
+ tk::ListboxBeginExtend %W [%W index @%x,%y]
+}
+bind Listbox <Control-1> {
+ tk::ListboxBeginToggle %W [%W index @%x,%y]
+}
+bind Listbox <B1-Leave> {
+ set tk::Priv(x) %x
+ set tk::Priv(y) %y
+ tk::ListboxAutoScan %W
+}
+bind Listbox <B1-Enter> {
+ tk::CancelRepeat
+}
+
+bind Listbox <Up> {
+ tk::ListboxUpDown %W -1
+}
+bind Listbox <Shift-Up> {
+ tk::ListboxExtendUpDown %W -1
+}
+bind Listbox <Down> {
+ tk::ListboxUpDown %W 1
+}
+bind Listbox <Shift-Down> {
+ tk::ListboxExtendUpDown %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
+ event generate %W <<ListboxSelect>>
+}
+bind Listbox <Shift-Control-Home> {
+ tk::ListboxDataExtend %W 0
+}
+bind Listbox <Control-End> {
+ %W activate end
+ %W see end
+ %W selection clear 0 end
+ %W selection set end
+ event generate %W <<ListboxSelect>>
+}
+bind Listbox <Shift-Control-End> {
+ tk::ListboxDataExtend %W [%W index end]
+}
+bind Listbox <<Copy>> {
+ if {[string equal [selection own -displayof %W] "%W"]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W [selection get -displayof %W]
+ }
+}
+bind Listbox <space> {
+ tk::ListboxBeginSelect %W [%W index active]
+}
+bind Listbox <Select> {
+ tk::ListboxBeginSelect %W [%W index active]
+}
+bind Listbox <Control-Shift-space> {
+ tk::ListboxBeginExtend %W [%W index active]
+}
+bind Listbox <Shift-Select> {
+ tk::ListboxBeginExtend %W [%W index active]
+}
+bind Listbox <Escape> {
+ tk::ListboxCancel %W
+}
+bind Listbox <Control-slash> {
+ tk::ListboxSelectAll %W
+}
+bind Listbox <Control-backslash> {
+ if {[string compare [%W cget -selectmode] "browse"]} {
+ %W selection clear 0 end
+ event generate %W <<ListboxSelect>>
+ }
+}
+
+# Additional Tk bindings that aren't part of the Motif look and feel:
+
+bind Listbox <2> {
+ %W scan mark %x %y
+}
+bind Listbox <B2-Motion> {
+ %W scan dragto %x %y
+}
+
+# The MouseWheel will typically only fire on Windows. However,
+# someone could use the "event generate" command to produce one
+# on other platforms.
+
+bind Listbox <MouseWheel> {
+ %W yview scroll [expr {- (%D / 120) * 4}] units
+}
+
+if {[string equal "x11" [tk windowingsystem]]} {
+ # Support for mousewheels on Linux/Unix commonly comes through mapping
+ # the wheel to the extended buttons. If you have a mousewheel, find
+ # Linux configuration info at:
+ # http://www.inria.fr/koala/colas/mouse-wheel-scroll/
+ bind Listbox <4> {
+ if {!$tk_strictMotif} {
+ %W yview scroll -5 units
+ }
+ }
+ bind Listbox <5> {
+ if {!$tk_strictMotif} {
+ %W yview scroll 5 units
+ }
+ }
+}
+
+# ::tk::ListboxBeginSelect --
+#
+# 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 ::tk::ListboxBeginSelect {w el} {
+ variable ::tk::Priv
+ if {[string equal [$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 Priv(listboxSelection) {}
+ set Priv(listboxPrev) $el
+ }
+ event generate $w <<ListboxSelect>>
+}
+
+# ::tk::ListboxMotion --
+#
+# 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 ::tk::ListboxMotion {w el} {
+ variable ::tk::Priv
+ if {$el == $Priv(listboxPrev)} {
+ return
+ }
+ set anchor [$w index anchor]
+ switch [$w cget -selectmode] {
+ browse {
+ $w selection clear 0 end
+ $w selection set $el
+ set Priv(listboxPrev) $el
+ event generate $w <<ListboxSelect>>
+ }
+ extended {
+ set i $Priv(listboxPrev)
+ if {[string equal {} $i]} {
+ set i $el
+ $w selection set $el
+ }
+ 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
+ }
+ if {![info exists Priv(listboxSelection)]} {
+ set Priv(listboxSelection) [$w curselection]
+ }
+ while {($i < $el) && ($i < $anchor)} {
+ if {[lsearch $Priv(listboxSelection) $i] >= 0} {
+ $w selection set $i
+ }
+ incr i
+ }
+ while {($i > $el) && ($i > $anchor)} {
+ if {[lsearch $Priv(listboxSelection) $i] >= 0} {
+ $w selection set $i
+ }
+ incr i -1
+ }
+ set Priv(listboxPrev) $el
+ event generate $w <<ListboxSelect>>
+ }
+ }
+}
+
+# ::tk::ListboxBeginExtend --
+#
+# 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 ::tk::ListboxBeginExtend {w el} {
+ if {[string equal [$w cget -selectmode] "extended"]} {
+ if {[$w selection includes anchor]} {
+ ListboxMotion $w $el
+ } else {
+ # No selection yet; simulate the begin-select operation.
+ ListboxBeginSelect $w $el
+ }
+ }
+}
+
+# ::tk::ListboxBeginToggle --
+#
+# 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 ::tk::ListboxBeginToggle {w el} {
+ variable ::tk::Priv
+ if {[string equal [$w cget -selectmode] "extended"]} {
+ set Priv(listboxSelection) [$w curselection]
+ set Priv(listboxPrev) $el
+ $w selection anchor $el
+ if {[$w selection includes $el]} {
+ $w selection clear $el
+ } else {
+ $w selection set $el
+ }
+ event generate $w <<ListboxSelect>>
+ }
+}
+
+# ::tk::ListboxAutoScan --
+# 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 ::tk::ListboxAutoScan {w} {
+ variable ::tk::Priv
+ if {![winfo exists $w]} return
+ set x $Priv(x)
+ set y $Priv(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
+ }
+ ListboxMotion $w [$w index @$x,$y]
+ set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]]
+}
+
+# ::tk::ListboxUpDown --
+#
+# 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 ::tk::ListboxUpDown {w amount} {
+ variable ::tk::Priv
+ $w activate [expr {[$w index active] + $amount}]
+ $w see active
+ switch [$w cget -selectmode] {
+ browse {
+ $w selection clear 0 end
+ $w selection set active
+ event generate $w <<ListboxSelect>>
+ }
+ extended {
+ $w selection clear 0 end
+ $w selection set active
+ $w selection anchor active
+ set Priv(listboxPrev) [$w index active]
+ set Priv(listboxSelection) {}
+ event generate $w <<ListboxSelect>>
+ }
+ }
+}
+
+# ::tk::ListboxExtendUpDown --
+#
+# 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 ::tk::ListboxExtendUpDown {w amount} {
+ variable ::tk::Priv
+ if {[string compare [$w cget -selectmode] "extended"]} {
+ return
+ }
+ set active [$w index active]
+ if {![info exists Priv(listboxSelection)]} {
+ $w selection set $active
+ set Priv(listboxSelection) [$w curselection]
+ }
+ $w activate [expr {$active + $amount}]
+ $w see active
+ ListboxMotion $w [$w index active]
+}
+
+# ::tk::ListboxDataExtend
+#
+# 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 ::tk::ListboxDataExtend {w el} {
+ set mode [$w cget -selectmode]
+ if {[string equal $mode "extended"]} {
+ $w activate $el
+ $w see $el
+ if {[$w selection includes anchor]} {
+ ListboxMotion $w $el
+ }
+ } elseif {[string equal $mode "multiple"]} {
+ $w activate $el
+ $w see $el
+ }
+}
+
+# ::tk::ListboxCancel
+#
+# 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 ::tk::ListboxCancel w {
+ variable ::tk::Priv
+ if {[string compare [$w cget -selectmode] "extended"]} {
+ return
+ }
+ set first [$w index anchor]
+ set last $Priv(listboxPrev)
+ if { [string equal $last ""] } {
+ # Not actually doing any selection right now
+ return
+ }
+ if {$first > $last} {
+ set tmp $first
+ set first $last
+ set last $tmp
+ }
+ $w selection clear $first $last
+ while {$first <= $last} {
+ if {[lsearch $Priv(listboxSelection) $first] >= 0} {
+ $w selection set $first
+ }
+ incr first
+ }
+ event generate $w <<ListboxSelect>>
+}
+
+# ::tk::ListboxSelectAll
+#
+# 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 ::tk::ListboxSelectAll w {
+ set mode [$w cget -selectmode]
+ if {[string equal $mode "single"] || [string equal $mode "browse"]} {
+ $w selection clear 0 end
+ $w selection set active
+ } else {
+ $w selection set 0 end
+ }
+ event generate $w <<ListboxSelect>>
+}
diff --git a/tcl/library/menu.tcl b/tcl/library/menu.tcl
new file mode 100644
index 00000000000..1fe2710b7ab
--- /dev/null
+++ b/tcl/library/menu.tcl
@@ -0,0 +1,1295 @@
+# menu.tcl --
+#
+# This file defines the default bindings for Tk menus and menubuttons.
+# It also implements keyboard traversal of menus and implements a few
+# other utility procedures related to menus.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tk::Priv 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 tk::Priv(oldGrab): if
+# tk::Priv(oldGrab) is non-empty, then tk::Priv(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
+# tk::Priv(postedMb) identifies the posted menubutton.
+# 2. As a torn-off menu copied from some other menu. In this style
+# tk::Priv(postedMb) is empty, and menu's type is "tearoff".
+# 3. As an option menu, triggered from an option menubutton. In this
+# style tk::Priv(postedMb) identifies the posted menubutton.
+# 4. As a popup menu. In this style tk::Priv(postedMb) is empty and
+# the top-level menu's type is "normal".
+# 5. As a pulldown from a menubar. The variable tk::Priv(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> {
+ tk::MbEnter %W
+}
+bind Menubutton <Leave> {
+ tk::MbLeave %W
+}
+bind Menubutton <1> {
+ if {$tk::Priv(inMenubutton) ne ""} {
+ tk::MbPost $tk::Priv(inMenubutton) %X %Y
+ }
+}
+bind Menubutton <Motion> {
+ tk::MbMotion %W up %X %Y
+}
+bind Menubutton <B1-Motion> {
+ tk::MbMotion %W down %X %Y
+}
+bind Menubutton <ButtonRelease-1> {
+ tk::MbButtonUp %W
+}
+bind Menubutton <space> {
+ tk::MbPost %W
+ tk::MenuFirstEntry [%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 tk::Priv(window) %W
+ if {[%W cget -type] eq "tearoff"} {
+ if {"%m" ne "NotifyUngrab"} {
+ if {[tk windowingsystem] eq "x11"} {
+ tk_menuSetFocus %W
+ }
+ }
+ }
+ tk::MenuMotion %W %x %y %s
+}
+
+bind Menu <Leave> {
+ tk::MenuLeave %W %X %Y %s
+}
+bind Menu <Motion> {
+ tk::MenuMotion %W %x %y %s
+}
+bind Menu <ButtonPress> {
+ tk::MenuButtonDown %W
+}
+bind Menu <ButtonRelease> {
+ tk::MenuInvoke %W 1
+}
+bind Menu <space> {
+ tk::MenuInvoke %W 0
+}
+bind Menu <Return> {
+ tk::MenuInvoke %W 0
+}
+bind Menu <Escape> {
+ tk::MenuEscape %W
+}
+bind Menu <Left> {
+ tk::MenuLeftArrow %W
+}
+bind Menu <Right> {
+ tk::MenuRightArrow %W
+}
+bind Menu <Up> {
+ tk::MenuUpArrow %W
+}
+bind Menu <Down> {
+ tk::MenuDownArrow %W
+}
+bind Menu <KeyPress> {
+ tk::TraverseWithinMenu %W %A
+}
+
+# The following bindings apply to all windows, and are used to
+# implement keyboard menu traversal.
+
+if {[string equal [tk windowingsystem] "x11"]} {
+ bind all <Alt-KeyPress> {
+ tk::TraverseToMenu %W %A
+ }
+
+ bind all <F10> {
+ tk::FirstMenu %W
+ }
+} else {
+ bind Menubutton <Alt-KeyPress> {
+ tk::TraverseToMenu %W %A
+ }
+
+ bind Menubutton <F10> {
+ tk::FirstMenu %W
+ }
+}
+
+# ::tk::MbEnter --
+# 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 ::tk::MbB1Enter is invoked if the button is down.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc ::tk::MbEnter w {
+ variable ::tk::Priv
+
+ if {[string compare $Priv(inMenubutton) ""]} {
+ MbLeave $Priv(inMenubutton)
+ }
+ set Priv(inMenubutton) $w
+ if {[string compare [$w cget -state] "disabled"]} {
+ $w configure -state active
+ }
+}
+
+# ::tk::MbLeave --
+# 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 ::tk::MbLeave w {
+ variable ::tk::Priv
+
+ set Priv(inMenubutton) {}
+ if {![winfo exists $w]} {
+ return
+ }
+ if {[string equal [$w cget -state] "active"]} {
+ $w configure -state normal
+ }
+}
+
+# ::tk::MbPost --
+# 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 ::tk::MbPost {w {x {}} {y {}}} {
+ global errorInfo
+ variable ::tk::Priv
+ global tcl_platform
+
+ if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} {
+ return
+ }
+ set menu [$w cget -menu]
+ if {[string equal $menu ""]} {
+ return
+ }
+ set tearoff [expr {[tk windowingsystem] eq "x11" \
+ || [$menu cget -type] eq "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 $Priv(postedMb)
+ if {[string compare $cur ""]} {
+ MenuUnpost {}
+ }
+ set Priv(cursor) [$w cget -cursor]
+ set Priv(relief) [$w cget -relief]
+ $w configure -cursor arrow
+ $w configure -relief raised
+
+ set Priv(postedMb) $w
+ set Priv(focus) [focus]
+ $menu activate none
+ GenerateMenuSelect $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]}]
+ PostOverPoint $menu $x $y
+ }
+ below {
+ set x [winfo rootx $w]
+ set y [expr {[winfo rooty $w] + [winfo height $w]}]
+ PostOverPoint $menu $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 [MenuFindName $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}]
+ }
+ }
+ PostOverPoint $menu $x $y
+ if {$entry ne "" \
+ && [$menu entrycget $entry -state] ne "disabled"} {
+ $menu activate $entry
+ GenerateMenuSelect $menu
+ }
+ }
+ right {
+ set x [expr {[winfo rootx $w] + [winfo width $w]}]
+ set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
+ set entry [MenuFindName $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}]
+ }
+ }
+ PostOverPoint $menu $x $y
+ if {$entry ne "" \
+ && [$menu entrycget $entry -state] ne "disabled"} {
+ $menu activate $entry
+ GenerateMenuSelect $menu
+ }
+ }
+ default {
+ if {[$w cget -indicatoron]} {
+ if {[string equal $y {}]} {
+ set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
+ set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
+ }
+ PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]
+ } else {
+ PostOverPoint $menu [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
+ MenuUnpost {}
+ error $msg $savedInfo
+
+ }
+
+ set Priv(tearoff) $tearoff
+ if {$tearoff != 0} {
+ focus $menu
+ if {[winfo viewable $w]} {
+ SaveGrabInfo $w
+ grab -global $w
+ }
+ }
+}
+
+# ::tk::MenuUnpost --
+# 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 ::tk::MenuUnpost menu {
+ global tcl_platform
+ variable ::tk::Priv
+ set mb $Priv(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 $Priv(focus)}
+ set Priv(focus) ""
+
+ # Unpost menu(s) and restore some stuff that's dependent on
+ # what was posted.
+
+ catch {
+ if {[string compare $mb ""]} {
+ set menu [$mb cget -menu]
+ $menu unpost
+ set Priv(postedMb) {}
+ $mb configure -cursor $Priv(cursor)
+ $mb configure -relief $Priv(relief)
+ } elseif {[string compare $Priv(popup) ""]} {
+ $Priv(popup) unpost
+ set Priv(popup) {}
+ } elseif {[string compare [$menu cget -type] "menubar"] \
+ && [string compare [$menu cget -type] "tearoff"]} {
+ # We're in a cascaded sub-menu from a torn-off menu or popup.
+ # Unpost all the menus up to the toplevel one (but not
+ # including the top-level torn-off one) and deactivate the
+ # top-level torn off menu if there is one.
+
+ while {1} {
+ set parent [winfo parent $menu]
+ if {[string compare [winfo class $parent] "Menu"] \
+ || ![winfo ismapped $parent]} {
+ break
+ }
+ $parent activate none
+ $parent postcascade none
+ GenerateMenuSelect $parent
+ set type [$parent cget -type]
+ if {[string equal $type "menubar"] || \
+ [string equal $type "tearoff"]} {
+ break
+ }
+ set menu $parent
+ }
+ if {[string compare [$menu cget -type] "menubar"]} {
+ $menu unpost
+ }
+ }
+ }
+
+ if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
+ # Release grab, if any, and restore the previous grab, if there
+ # was one.
+ if {[string compare $menu ""]} {
+ set grab [grab current $menu]
+ if {[string compare $grab ""]} {
+ grab release $grab
+ }
+ }
+ RestoreOldGrab
+ if {$Priv(menuBar) ne ""} {
+ $Priv(menuBar) configure -cursor $Priv(cursor)
+ set Priv(menuBar) {}
+ }
+ if {[tk windowingsystem] ne "x11"} {
+ set Priv(tearoff) 0
+ }
+ }
+}
+
+# ::tk::MbMotion --
+# 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 ::tk::MbMotion {w upDown rootx rooty} {
+ variable ::tk::Priv
+
+ if {[string equal $Priv(inMenubutton) $w]} {
+ return
+ }
+ set new [winfo containing $rootx $rooty]
+ if {[string compare $new $Priv(inMenubutton)] \
+ && ([string equal $new ""] \
+ || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
+ if {[string compare $Priv(inMenubutton) ""]} {
+ MbLeave $Priv(inMenubutton)
+ }
+ if {[string compare $new ""] \
+ && [string equal [winfo class $new] "Menubutton"] \
+ && ([$new cget -indicatoron] == 0) \
+ && ([$w cget -indicatoron] == 0)} {
+ if {[string equal $upDown "down"]} {
+ MbPost $new $rootx $rooty
+ } else {
+ MbEnter $new
+ }
+ }
+ }
+}
+
+# ::tk::MbButtonUp --
+# 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 ::tk::MbButtonUp w {
+ variable ::tk::Priv
+ global tcl_platform
+
+ set menu [$w cget -menu]
+ set tearoff [expr {[tk windowingsystem] eq "x11" || \
+ ($menu ne "" && [$menu cget -type] eq "tearoff")}]
+ if {($tearoff != 0) && $Priv(postedMb) eq $w \
+ && $Priv(inMenubutton) eq $w} {
+ MenuFirstEntry [$Priv(postedMb) cget -menu]
+ } else {
+ MenuUnpost {}
+ }
+}
+
+# ::tk::MenuMotion --
+# 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 ::tk::MenuMotion {menu x y state} {
+ variable ::tk::Priv
+ if {[string equal $menu $Priv(window)]} {
+ if {[string equal [$menu cget -type] "menubar"]} {
+ if {[info exists Priv(focus)] && \
+ [string compare $menu $Priv(focus)]} {
+ $menu activate @$x,$y
+ GenerateMenuSelect $menu
+ }
+ } else {
+ $menu activate @$x,$y
+ GenerateMenuSelect $menu
+ }
+ }
+ if {($state & 0x1f00) != 0} {
+ $menu postcascade active
+ }
+}
+
+# ::tk::MenuButtonDown --
+# 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 ::tk::MenuButtonDown menu {
+ variable ::tk::Priv
+ global tcl_platform
+
+ if {![winfo viewable $menu]} {
+ return
+ }
+ $menu postcascade active
+ if {[string compare $Priv(postedMb) ""] && \
+ [winfo viewable $Priv(postedMb)]} {
+ grab -global $Priv(postedMb)
+ } else {
+ while {[string equal [$menu cget -type] "normal"] \
+ && [string equal [winfo class [winfo parent $menu]] "Menu"] \
+ && [winfo ismapped [winfo parent $menu]]} {
+ set menu [winfo parent $menu]
+ }
+
+ if {[string equal $Priv(menuBar) {}]} {
+ set Priv(menuBar) $menu
+ set Priv(cursor) [$menu cget -cursor]
+ $menu configure -cursor arrow
+ }
+
+ # Don't update grab information if the grab window isn't changing.
+ # Otherwise, we'll get an error when we unpost the menus and
+ # restore the grab, since the old grab window will not be viewable
+ # anymore.
+
+ if {[string compare $menu [grab current $menu]]} {
+ SaveGrabInfo $menu
+ }
+
+ # Must re-grab even if the grab window hasn't changed, in order
+ # to release the implicit grab from the button press.
+
+ if {[string equal [tk windowingsystem] "x11"]} {
+ grab -global $menu
+ }
+ }
+}
+
+# ::tk::MenuLeave --
+# 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 ::tk::MenuLeave {menu rootx rooty state} {
+ variable ::tk::Priv
+ set Priv(window) {}
+ if {[string equal [$menu index active] "none"]} {
+ return
+ }
+ if {[string equal [$menu type active] "cascade"]
+ && [string equal [winfo containing $rootx $rooty] \
+ [$menu entrycget active -menu]]} {
+ return
+ }
+ $menu activate none
+ GenerateMenuSelect $menu
+}
+
+# ::tk::MenuInvoke --
+# 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 ::tk::MenuInvoke {w buttonRelease} {
+ variable ::tk::Priv
+
+ if {$buttonRelease && [string equal $Priv(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>>
+ MenuUnpost $w
+ return
+ }
+ if {[string equal [$w type active] "cascade"]} {
+ $w postcascade active
+ set menu [$w entrycget active -menu]
+ MenuFirstEntry $menu
+ } elseif {[string equal [$w type active] "tearoff"]} {
+ ::tk::TearOffMenu $w
+ MenuUnpost $w
+ } elseif {[string equal [$w cget -type] "menubar"]} {
+ $w postcascade none
+ set active [$w index active]
+ set isCascade [string equal [$w type $active] "cascade"]
+
+ # Only de-activate the active item if it's a cascade; this prevents
+ # the annoying "activation flicker" you otherwise get with
+ # checkbuttons/commands/etc. on menubars
+
+ if { $isCascade } {
+ $w activate none
+ event generate $w <<MenuSelect>>
+ }
+
+ MenuUnpost $w
+
+ # If the active item is not a cascade, invoke it. This enables
+ # the use of checkbuttons/commands/etc. on menubars (which is legal,
+ # but not recommended)
+
+ if { !$isCascade } {
+ uplevel #0 [list $w invoke $active]
+ }
+ } else {
+ MenuUnpost $w
+ uplevel #0 [list $w invoke active]
+ }
+}
+
+# ::tk::MenuEscape --
+# 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 ::tk::MenuEscape menu {
+ set parent [winfo parent $menu]
+ if {[string compare [winfo class $parent] "Menu"]} {
+ MenuUnpost $menu
+ } elseif {[string equal [$parent cget -type] "menubar"]} {
+ MenuUnpost $menu
+ RestoreOldGrab
+ } else {
+ MenuNextMenu $menu left
+ }
+}
+
+# The following routines handle arrow keys. Arrow keys behave
+# differently depending on whether the menu is a menu bar or not.
+
+proc ::tk::MenuUpArrow {menu} {
+ if {[string equal [$menu cget -type] "menubar"]} {
+ MenuNextMenu $menu left
+ } else {
+ MenuNextEntry $menu -1
+ }
+}
+
+proc ::tk::MenuDownArrow {menu} {
+ if {[string equal [$menu cget -type] "menubar"]} {
+ MenuNextMenu $menu right
+ } else {
+ MenuNextEntry $menu 1
+ }
+}
+
+proc ::tk::MenuLeftArrow {menu} {
+ if {[string equal [$menu cget -type] "menubar"]} {
+ MenuNextEntry $menu -1
+ } else {
+ MenuNextMenu $menu left
+ }
+}
+
+proc ::tk::MenuRightArrow {menu} {
+ if {[string equal [$menu cget -type] "menubar"]} {
+ MenuNextEntry $menu 1
+ } else {
+ MenuNextMenu $menu right
+ }
+}
+
+# ::tk::MenuNextMenu --
+# 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 ::tk::MenuNextMenu {menu direction} {
+ variable ::tk::Priv
+
+ # First handle traversals into and out of cascaded menus.
+
+ if {[string equal $direction "right"]} {
+ set count 1
+ set parent [winfo parent $menu]
+ set class [winfo class $parent]
+ if {[string equal [$menu type active] "cascade"]} {
+ $menu postcascade active
+ set m2 [$menu entrycget active -menu]
+ if {[string compare $m2 ""]} {
+ MenuFirstEntry $m2
+ }
+ return
+ } else {
+ set parent [winfo parent $menu]
+ while {[string compare $parent "."]} {
+ if {[string equal [winfo class $parent] "Menu"] \
+ && [string equal [$parent cget -type] "menubar"]} {
+ tk_menuSetFocus $parent
+ MenuNextEntry $parent 1
+ return
+ }
+ set parent [winfo parent $parent]
+ }
+ }
+ } else {
+ set count -1
+ set m2 [winfo parent $menu]
+ if {[string equal [winfo class $m2] "Menu"]} {
+ $menu activate none
+ GenerateMenuSelect $menu
+ tk_menuSetFocus $m2
+
+ $m2 postcascade none
+
+ if {[string compare [$m2 cget -type] "menubar"]} {
+ return
+ }
+ }
+ }
+
+ # Can't traverse into or out of a cascaded menu. Go to the next
+ # or previous menubutton, if that makes sense.
+
+ set m2 [winfo parent $menu]
+ if {[string equal [winfo class $m2] "Menu"]} {
+ if {[string equal [$m2 cget -type] "menubar"]} {
+ tk_menuSetFocus $m2
+ MenuNextEntry $m2 -1
+ return
+ }
+ }
+
+ set w $Priv(postedMb)
+ if {[string equal $w ""]} {
+ return
+ }
+ set buttons [winfo children [winfo parent $w]]
+ set length [llength $buttons]
+ set i [expr {[lsearch -exact $buttons $w] + $count}]
+ while {1} {
+ while {$i < 0} {
+ incr i $length
+ }
+ while {$i >= $length} {
+ incr i -$length
+ }
+ set mb [lindex $buttons $i]
+ if {[string equal [winfo class $mb] "Menubutton"] \
+ && [string compare [$mb cget -state] "disabled"] \
+ && [string compare [$mb cget -menu] ""] \
+ && [string compare [[$mb cget -menu] index last] "none"]} {
+ break
+ }
+ if {[string equal $mb $w]} {
+ return
+ }
+ incr i $count
+ }
+ MbPost $mb
+ MenuFirstEntry [$mb cget -menu]
+}
+
+# ::tk::MenuNextEntry --
+# 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 ::tk::MenuNextEntry {menu count} {
+
+ if {[string equal [$menu index last] "none"]} {
+ return
+ }
+ set length [expr {[$menu index last]+1}]
+ set quitAfter $length
+ set active [$menu index active]
+ if {[string equal $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 ne "disabled" && \
+ ($i!=0 || [$menu cget -type] ne "tearoff" \
+ || [$menu type 0] ne "tearoff")} {
+ break
+ }
+ }
+ if {$i == $active} {
+ return
+ }
+ incr i $count
+ incr quitAfter -1
+ }
+ $menu activate $i
+ GenerateMenuSelect $menu
+
+ if {[string equal [$menu type $i] "cascade"] \
+ && [string equal [$menu cget -type] "menubar"]} {
+ set cascade [$menu entrycget $i -menu]
+ if {[string compare $cascade ""]} {
+ # Here we auto-post a cascade. This is necessary when
+ # we traverse left/right in the menubar, but undesirable when
+ # we traverse up/down in a menu.
+ $menu postcascade $i
+ MenuFirstEntry $cascade
+ }
+ }
+}
+
+# ::tk::MenuFind --
+# 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 ::tk::MenuFind {w char} {
+ set char [string tolower $char]
+ set windowlist [winfo child $w]
+
+ foreach child $windowlist {
+ # Don't descend into other toplevels.
+ if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
+ continue
+ }
+ if {[string equal [winfo class $child] "Menu"] && \
+ [string equal [$child cget -type] "menubar"]} {
+ if {[string equal $char ""]} {
+ return $child
+ }
+ set last [$child index last]
+ for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
+ if {[string equal [$child type $i] "separator"]} {
+ continue
+ }
+ set char2 [string index [$child entrycget $i -label] \
+ [$child entrycget $i -underline]]
+ if {[string equal $char [string tolower $char2]] \
+ || [string equal $char ""]} {
+ if {[string compare [$child entrycget $i -state] "disabled"]} {
+ return $child
+ }
+ }
+ }
+ }
+ }
+
+ foreach child $windowlist {
+ # Don't descend into other toplevels.
+ if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
+ continue
+ }
+ switch [winfo class $child] {
+ Menubutton {
+ set char2 [string index [$child cget -text] \
+ [$child cget -underline]]
+ if {[string equal $char [string tolower $char2]] \
+ || [string equal $char ""]} {
+ if {[string compare [$child cget -state] "disabled"]} {
+ return $child
+ }
+ }
+ }
+
+ default {
+ set match [MenuFind $child $char]
+ if {[string compare $match ""]} {
+ return $match
+ }
+ }
+ }
+ }
+ return {}
+}
+
+# ::tk::TraverseToMenu --
+# 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 ::tk::TraverseToMenu {w char} {
+ variable ::tk::Priv
+ if {[string equal $char ""]} {
+ return
+ }
+ while {[string equal [winfo class $w] "Menu"]} {
+ if {[string compare [$w cget -type] "menubar"] \
+ && [string equal $Priv(postedMb) ""]} {
+ return
+ }
+ if {[string equal [$w cget -type] "menubar"]} {
+ break
+ }
+ set w [winfo parent $w]
+ }
+ set w [MenuFind [winfo toplevel $w] $char]
+ if {[string compare $w ""]} {
+ if {[string equal [winfo class $w] "Menu"]} {
+ tk_menuSetFocus $w
+ set Priv(window) $w
+ SaveGrabInfo $w
+ grab -global $w
+ TraverseWithinMenu $w $char
+ } else {
+ MbPost $w
+ MenuFirstEntry [$w cget -menu]
+ }
+ }
+}
+
+# ::tk::FirstMenu --
+# 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 ::tk::FirstMenu w {
+ variable ::tk::Priv
+ set w [MenuFind [winfo toplevel $w] ""]
+ if {[string compare $w ""]} {
+ if {[string equal [winfo class $w] "Menu"]} {
+ tk_menuSetFocus $w
+ set Priv(window) $w
+ SaveGrabInfo $w
+ grab -global $w
+ MenuFirstEntry $w
+ } else {
+ MbPost $w
+ MenuFirstEntry [$w cget -menu]
+ }
+ }
+}
+
+# ::tk::TraverseWithinMenu
+# 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 ::tk::TraverseWithinMenu {w char} {
+ if {[string equal $char ""]} {
+ return
+ }
+ set char [string tolower $char]
+ set last [$w index last]
+ if {[string equal $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 equal $char [string tolower $char2]]} {
+ if {[string equal [$w type $i] "cascade"]} {
+ $w activate $i
+ $w postcascade active
+ event generate $w <<MenuSelect>>
+ set m2 [$w entrycget $i -menu]
+ if {[string compare $m2 ""]} {
+ MenuFirstEntry $m2
+ }
+ } else {
+ MenuUnpost $w
+ uplevel #0 [list $w invoke $i]
+ }
+ return
+ }
+ }
+}
+
+# ::tk::MenuFirstEntry --
+# 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 tk::PostOverPoint) 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 ::tk::MenuFirstEntry menu {
+ if {[string equal $menu ""]} {
+ return
+ }
+ tk_menuSetFocus $menu
+ if {[string compare [$menu index active] "none"]} {
+ return
+ }
+ set last [$menu index last]
+ if {[string equal $last "none"]} {
+ return
+ }
+ for {set i 0} {$i <= $last} {incr i} {
+ if {([catch {set state [$menu entrycget $i -state]}] == 0) \
+ && [string compare $state "disabled"] \
+ && [string compare [$menu type $i] "tearoff"]} {
+ $menu activate $i
+ GenerateMenuSelect $menu
+ # Only post the cascade if the current menu is a menubar;
+ # otherwise, if the first entry of the cascade is a cascade,
+ # we can get an annoying cascading effect resulting in a bunch of
+ # menus getting posted (bug 676)
+ if {[string equal [$menu type $i] "cascade"] && \
+ [string equal [$menu cget -type] "menubar"]} {
+ set cascade [$menu entrycget $i -menu]
+ if {[string compare $cascade ""]} {
+ $menu postcascade $i
+ MenuFirstEntry $cascade
+ }
+ }
+ return
+ }
+ }
+}
+
+# ::tk::MenuFindName --
+# 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 ::tk::MenuFindName {menu s} {
+ set i ""
+ if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
+ catch {set i [$menu index $s]}
+ return $i
+ }
+ set last [$menu index last]
+ if {[string equal $last "none"]} {
+ return
+ }
+ for {set i 0} {$i <= $last} {incr i} {
+ if {![catch {$menu entrycget $i -label} label]} {
+ if {[string equal $label $s]} {
+ return $i
+ }
+ }
+ }
+ return ""
+}
+
+# ::tk::PostOverPoint --
+# 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 ::tk::PostOverPoint {menu x y {entry {}}} {
+ global tcl_platform
+
+ if {[string compare $entry {}]} {
+ if {$entry == [$menu index last]} {
+ incr y [expr {-([$menu yposition $entry] \
+ + [winfo reqheight $menu])/2}]
+ } else {
+ incr y [expr {-([$menu yposition $entry] \
+ + [$menu yposition [expr {$entry+1}]])/2}]
+ }
+ incr x [expr {-[winfo reqwidth $menu]/2}]
+ }
+ if {$tcl_platform(platform) == "windows"} {
+ # We need to fix some problems with menu posting on Windows.
+ set yoffset [expr {[winfo screenheight $menu] \
+ - $y - [winfo reqheight $menu]}]
+ if {$yoffset < 0} {
+ # The bottom of the menu is offscreen, so adjust upwards
+ incr y $yoffset
+ if {$y < 0} { set y 0 }
+ }
+ # If we're off the top of the screen (either because we were
+ # originally or because we just adjusted too far upwards),
+ # then make the menu popup on the top edge.
+ if {$y < 0} {
+ set y 0
+ }
+ }
+ $menu post $x $y
+ if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
+ $menu activate $entry
+ GenerateMenuSelect $menu
+ }
+}
+
+# ::tk::SaveGrabInfo --
+# Sets the variables tk::Priv(oldGrab) and tk::Priv(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 tk::SaveGrabInfo w {
+ variable ::tk::Priv
+ set Priv(oldGrab) [grab current $w]
+ if {$Priv(oldGrab) ne ""} {
+ set Priv(grabStatus) [grab status $Priv(oldGrab)]
+ }
+}
+
+# ::tk::RestoreOldGrab --
+# Restores the grab to what it was before TkSaveGrabInfo was called.
+#
+
+proc ::tk::RestoreOldGrab {} {
+ variable ::tk::Priv
+
+ if {$Priv(oldGrab) ne ""} {
+ # Be careful restoring the old grab, since it's window may not
+ # be visible anymore.
+
+ catch {
+ if {[string equal $Priv(grabStatus) "global"]} {
+ grab set -global $Priv(oldGrab)
+ } else {
+ grab set $Priv(oldGrab)
+ }
+ }
+ set Priv(oldGrab) ""
+ }
+}
+
+proc ::tk_menuSetFocus {menu} {
+ variable ::tk::Priv
+ if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} {
+ set Priv(focus) [focus]
+ }
+ focus $menu
+}
+
+proc ::tk::GenerateMenuSelect {menu} {
+ variable ::tk::Priv
+
+ if {[string equal $Priv(activeMenu) $menu] \
+ && [string equal $Priv(activeItem) [$menu index active]]} {
+ return
+ }
+
+ set Priv(activeMenu) $menu
+ set Priv(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 {}}} {
+ variable ::tk::Priv
+ global tcl_platform
+ if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
+ tk::MenuUnpost {}
+ }
+ tk::PostOverPoint $menu $x $y $entry
+ if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} {
+ tk::SaveGrabInfo $menu
+ grab -global $menu
+ set Priv(popup) $menu
+ tk_menuSetFocus $menu
+ }
+}
diff --git a/tcl/library/mkpsenc.tcl b/tcl/library/mkpsenc.tcl
new file mode 100644
index 00000000000..c1cf4129232
--- /dev/null
+++ b/tcl/library/mkpsenc.tcl
@@ -0,0 +1,1367 @@
+# mkpsenc.tcl --
+#
+# Creates Postscript encoding vector for given encoding
+#
+
+proc ::tk::CreatePostscriptEncoding {encoding} {
+ # now check for known. Even if it is known, it can be other
+ # than we need. GhostScript seems to be happy with such approach
+ set result "/CurrentEncoding \[\n"
+ for {set i 0} {$i<256} {incr i 8} {
+ for {set j 0} {$j<8} {incr j} {
+ set enc [encoding convertfrom $encoding [format %c [expr {$i+$j}]]]
+ if {[catch {format %04X [scan $enc %c]} hexcode]} {set hexcode {}}
+ if [info exists ::tk::psglyphs($hexcode)] {
+ append result "/$::tk::psglyphs($hexcode)"
+ } else {
+ append result "/space"
+ }
+ }
+ append result "\n"
+ }
+ append result "\] def\n"
+ return $result
+}
+
+# List of adobe glyph names. Converted from glyphlist.txt, downloaded
+# from Adobe
+
+namespace eval ::tk {
+array set psglyphs {
+ 0020 space
+ 0021 exclam
+ 0022 quotedbl
+ 0023 numbersign
+ 0024 dollar
+ 0025 percent
+ 0026 ampersand
+ 0027 quotesingle
+ 0028 parenleft
+ 0029 parenright
+ 002A asterisk
+ 002B plus
+ 002C comma
+ 002D hyphen
+ 002E period
+ 002F slash
+ 0030 zero
+ 0031 one
+ 0032 two
+ 0033 three
+ 0034 four
+ 0035 five
+ 0036 six
+ 0037 seven
+ 0038 eight
+ 0039 nine
+ 003A colon
+ 003B semicolon
+ 003C less
+ 003D equal
+ 003E greater
+ 003F question
+ 0040 at
+ 0041 A
+ 0042 B
+ 0043 C
+ 0044 D
+ 0045 E
+ 0046 F
+ 0047 G
+ 0048 H
+ 0049 I
+ 004A J
+ 004B K
+ 004C L
+ 004D M
+ 004E N
+ 004F O
+ 0050 P
+ 0051 Q
+ 0052 R
+ 0053 S
+ 0054 T
+ 0055 U
+ 0056 V
+ 0057 W
+ 0058 X
+ 0059 Y
+ 005A Z
+ 005B bracketleft
+ 005C backslash
+ 005D bracketright
+ 005E asciicircum
+ 005F underscore
+ 0060 grave
+ 0061 a
+ 0062 b
+ 0063 c
+ 0064 d
+ 0065 e
+ 0066 f
+ 0067 g
+ 0068 h
+ 0069 i
+ 006A j
+ 006B k
+ 006C l
+ 006D m
+ 006E n
+ 006F o
+ 0070 p
+ 0071 q
+ 0072 r
+ 0073 s
+ 0074 t
+ 0075 u
+ 0076 v
+ 0077 w
+ 0078 x
+ 0079 y
+ 007A z
+ 007B braceleft
+ 007C bar
+ 007D braceright
+ 007E asciitilde
+ 00A0 space
+ 00A1 exclamdown
+ 00A2 cent
+ 00A3 sterling
+ 00A4 currency
+ 00A5 yen
+ 00A6 brokenbar
+ 00A7 section
+ 00A8 dieresis
+ 00A9 copyright
+ 00AA ordfeminine
+ 00AB guillemotleft
+ 00AC logicalnot
+ 00AD hyphen
+ 00AE registered
+ 00AF macron
+ 00B0 degree
+ 00B1 plusminus
+ 00B2 twosuperior
+ 00B3 threesuperior
+ 00B4 acute
+ 00B5 mu
+ 00B6 paragraph
+ 00B7 periodcentered
+ 00B8 cedilla
+ 00B9 onesuperior
+ 00BA ordmasculine
+ 00BB guillemotright
+ 00BC onequarter
+ 00BD onehalf
+ 00BE threequarters
+ 00BF questiondown
+ 00C0 Agrave
+ 00C1 Aacute
+ 00C2 Acircumflex
+ 00C3 Atilde
+ 00C4 Adieresis
+ 00C5 Aring
+ 00C6 AE
+ 00C7 Ccedilla
+ 00C8 Egrave
+ 00C9 Eacute
+ 00CA Ecircumflex
+ 00CB Edieresis
+ 00CC Igrave
+ 00CD Iacute
+ 00CE Icircumflex
+ 00CF Idieresis
+ 00D0 Eth
+ 00D1 Ntilde
+ 00D2 Ograve
+ 00D3 Oacute
+ 00D4 Ocircumflex
+ 00D5 Otilde
+ 00D6 Odieresis
+ 00D7 multiply
+ 00D8 Oslash
+ 00D9 Ugrave
+ 00DA Uacute
+ 00DB Ucircumflex
+ 00DC Udieresis
+ 00DD Yacute
+ 00DE Thorn
+ 00DF germandbls
+ 00E0 agrave
+ 00E1 aacute
+ 00E2 acircumflex
+ 00E3 atilde
+ 00E4 adieresis
+ 00E5 aring
+ 00E6 ae
+ 00E7 ccedilla
+ 00E8 egrave
+ 00E9 eacute
+ 00EA ecircumflex
+ 00EB edieresis
+ 00EC igrave
+ 00ED iacute
+ 00EE icircumflex
+ 00EF idieresis
+ 00F0 eth
+ 00F1 ntilde
+ 00F2 ograve
+ 00F3 oacute
+ 00F4 ocircumflex
+ 00F5 otilde
+ 00F6 odieresis
+ 00F7 divide
+ 00F8 oslash
+ 00F9 ugrave
+ 00FA uacute
+ 00FB ucircumflex
+ 00FC udieresis
+ 00FD yacute
+ 00FE thorn
+ 00FF ydieresis
+ 0100 Amacron
+ 0101 amacron
+ 0102 Abreve
+ 0103 abreve
+ 0104 Aogonek
+ 0105 aogonek
+ 0106 Cacute
+ 0107 cacute
+ 0108 Ccircumflex
+ 0109 ccircumflex
+ 010A Cdotaccent
+ 010B cdotaccent
+ 010C Ccaron
+ 010D ccaron
+ 010E Dcaron
+ 010F dcaron
+ 0110 Dcroat
+ 0111 dcroat
+ 0112 Emacron
+ 0113 emacron
+ 0114 Ebreve
+ 0115 ebreve
+ 0116 Edotaccent
+ 0117 edotaccent
+ 0118 Eogonek
+ 0119 eogonek
+ 011A Ecaron
+ 011B ecaron
+ 011C Gcircumflex
+ 011D gcircumflex
+ 011E Gbreve
+ 011F gbreve
+ 0120 Gdotaccent
+ 0121 gdotaccent
+ 0122 Gcommaaccent
+ 0123 gcommaaccent
+ 0124 Hcircumflex
+ 0125 hcircumflex
+ 0126 Hbar
+ 0127 hbar
+ 0128 Itilde
+ 0129 itilde
+ 012A Imacron
+ 012B imacron
+ 012C Ibreve
+ 012D ibreve
+ 012E Iogonek
+ 012F iogonek
+ 0130 Idotaccent
+ 0131 dotlessi
+ 0132 IJ
+ 0133 ij
+ 0134 Jcircumflex
+ 0135 jcircumflex
+ 0136 Kcommaaccent
+ 0137 kcommaaccent
+ 0138 kgreenlandic
+ 0139 Lacute
+ 013A lacute
+ 013B Lcommaaccent
+ 013C lcommaaccent
+ 013D Lcaron
+ 013E lcaron
+ 013F Ldot
+ 0140 ldot
+ 0141 Lslash
+ 0142 lslash
+ 0143 Nacute
+ 0144 nacute
+ 0145 Ncommaaccent
+ 0146 ncommaaccent
+ 0147 Ncaron
+ 0148 ncaron
+ 0149 napostrophe
+ 014A Eng
+ 014B eng
+ 014C Omacron
+ 014D omacron
+ 014E Obreve
+ 014F obreve
+ 0150 Ohungarumlaut
+ 0151 ohungarumlaut
+ 0152 OE
+ 0153 oe
+ 0154 Racute
+ 0155 racute
+ 0156 Rcommaaccent
+ 0157 rcommaaccent
+ 0158 Rcaron
+ 0159 rcaron
+ 015A Sacute
+ 015B sacute
+ 015C Scircumflex
+ 015D scircumflex
+ 015E Scedilla
+ 015F scedilla
+ 0160 Scaron
+ 0161 scaron
+ 0162 Tcommaaccent
+ 0163 tcommaaccent
+ 0164 Tcaron
+ 0165 tcaron
+ 0166 Tbar
+ 0167 tbar
+ 0168 Utilde
+ 0169 utilde
+ 016A Umacron
+ 016B umacron
+ 016C Ubreve
+ 016D ubreve
+ 016E Uring
+ 016F uring
+ 0170 Uhungarumlaut
+ 0171 uhungarumlaut
+ 0172 Uogonek
+ 0173 uogonek
+ 0174 Wcircumflex
+ 0175 wcircumflex
+ 0176 Ycircumflex
+ 0177 ycircumflex
+ 0178 Ydieresis
+ 0179 Zacute
+ 017A zacute
+ 017B Zdotaccent
+ 017C zdotaccent
+ 017D Zcaron
+ 017E zcaron
+ 017F longs
+ 0192 florin
+ 01A0 Ohorn
+ 01A1 ohorn
+ 01AF Uhorn
+ 01B0 uhorn
+ 01E6 Gcaron
+ 01E7 gcaron
+ 01FA Aringacute
+ 01FB aringacute
+ 01FC AEacute
+ 01FD aeacute
+ 01FE Oslashacute
+ 01FF oslashacute
+ 0218 Scommaaccent
+ 0219 scommaaccent
+ 021A Tcommaaccent
+ 021B tcommaaccent
+ 02BC afii57929
+ 02BD afii64937
+ 02C6 circumflex
+ 02C7 caron
+ 02C9 macron
+ 02D8 breve
+ 02D9 dotaccent
+ 02DA ring
+ 02DB ogonek
+ 02DC tilde
+ 02DD hungarumlaut
+ 0300 gravecomb
+ 0301 acutecomb
+ 0303 tildecomb
+ 0309 hookabovecomb
+ 0323 dotbelowcomb
+ 0384 tonos
+ 0385 dieresistonos
+ 0386 Alphatonos
+ 0387 anoteleia
+ 0388 Epsilontonos
+ 0389 Etatonos
+ 038A Iotatonos
+ 038C Omicrontonos
+ 038E Upsilontonos
+ 038F Omegatonos
+ 0390 iotadieresistonos
+ 0391 Alpha
+ 0392 Beta
+ 0393 Gamma
+ 0394 Delta
+ 0395 Epsilon
+ 0396 Zeta
+ 0397 Eta
+ 0398 Theta
+ 0399 Iota
+ 039A Kappa
+ 039B Lambda
+ 039C Mu
+ 039D Nu
+ 039E Xi
+ 039F Omicron
+ 03A0 Pi
+ 03A1 Rho
+ 03A3 Sigma
+ 03A4 Tau
+ 03A5 Upsilon
+ 03A6 Phi
+ 03A7 Chi
+ 03A8 Psi
+ 03A9 Omega
+ 03AA Iotadieresis
+ 03AB Upsilondieresis
+ 03AC alphatonos
+ 03AD epsilontonos
+ 03AE etatonos
+ 03AF iotatonos
+ 03B0 upsilondieresistonos
+ 03B1 alpha
+ 03B2 beta
+ 03B3 gamma
+ 03B4 delta
+ 03B5 epsilon
+ 03B6 zeta
+ 03B7 eta
+ 03B8 theta
+ 03B9 iota
+ 03BA kappa
+ 03BB lambda
+ 03BC mu
+ 03BD nu
+ 03BE xi
+ 03BF omicron
+ 03C0 pi
+ 03C1 rho
+ 03C2 sigma1
+ 03C3 sigma
+ 03C4 tau
+ 03C5 upsilon
+ 03C6 phi
+ 03C7 chi
+ 03C8 psi
+ 03C9 omega
+ 03CA iotadieresis
+ 03CB upsilondieresis
+ 03CC omicrontonos
+ 03CD upsilontonos
+ 03CE omegatonos
+ 03D1 theta1
+ 03D2 Upsilon1
+ 03D5 phi1
+ 03D6 omega1
+ 0401 afii10023
+ 0402 afii10051
+ 0403 afii10052
+ 0404 afii10053
+ 0405 afii10054
+ 0406 afii10055
+ 0407 afii10056
+ 0408 afii10057
+ 0409 afii10058
+ 040A afii10059
+ 040B afii10060
+ 040C afii10061
+ 040E afii10062
+ 040F afii10145
+ 0410 afii10017
+ 0411 afii10018
+ 0412 afii10019
+ 0413 afii10020
+ 0414 afii10021
+ 0415 afii10022
+ 0416 afii10024
+ 0417 afii10025
+ 0418 afii10026
+ 0419 afii10027
+ 041A afii10028
+ 041B afii10029
+ 041C afii10030
+ 041D afii10031
+ 041E afii10032
+ 041F afii10033
+ 0420 afii10034
+ 0421 afii10035
+ 0422 afii10036
+ 0423 afii10037
+ 0424 afii10038
+ 0425 afii10039
+ 0426 afii10040
+ 0427 afii10041
+ 0428 afii10042
+ 0429 afii10043
+ 042A afii10044
+ 042B afii10045
+ 042C afii10046
+ 042D afii10047
+ 042E afii10048
+ 042F afii10049
+ 0430 afii10065
+ 0431 afii10066
+ 0432 afii10067
+ 0433 afii10068
+ 0434 afii10069
+ 0435 afii10070
+ 0436 afii10072
+ 0437 afii10073
+ 0438 afii10074
+ 0439 afii10075
+ 043A afii10076
+ 043B afii10077
+ 043C afii10078
+ 043D afii10079
+ 043E afii10080
+ 043F afii10081
+ 0440 afii10082
+ 0441 afii10083
+ 0442 afii10084
+ 0443 afii10085
+ 0444 afii10086
+ 0445 afii10087
+ 0446 afii10088
+ 0447 afii10089
+ 0448 afii10090
+ 0449 afii10091
+ 044A afii10092
+ 044B afii10093
+ 044C afii10094
+ 044D afii10095
+ 044E afii10096
+ 044F afii10097
+ 0451 afii10071
+ 0452 afii10099
+ 0453 afii10100
+ 0454 afii10101
+ 0455 afii10102
+ 0456 afii10103
+ 0457 afii10104
+ 0458 afii10105
+ 0459 afii10106
+ 045A afii10107
+ 045B afii10108
+ 045C afii10109
+ 045E afii10110
+ 045F afii10193
+ 0462 afii10146
+ 0463 afii10194
+ 0472 afii10147
+ 0473 afii10195
+ 0474 afii10148
+ 0475 afii10196
+ 0490 afii10050
+ 0491 afii10098
+ 04D9 afii10846
+ 05B0 afii57799
+ 05B1 afii57801
+ 05B2 afii57800
+ 05B3 afii57802
+ 05B4 afii57793
+ 05B5 afii57794
+ 05B6 afii57795
+ 05B7 afii57798
+ 05B8 afii57797
+ 05B9 afii57806
+ 05BB afii57796
+ 05BC afii57807
+ 05BD afii57839
+ 05BE afii57645
+ 05BF afii57841
+ 05C0 afii57842
+ 05C1 afii57804
+ 05C2 afii57803
+ 05C3 afii57658
+ 05D0 afii57664
+ 05D1 afii57665
+ 05D2 afii57666
+ 05D3 afii57667
+ 05D4 afii57668
+ 05D5 afii57669
+ 05D6 afii57670
+ 05D7 afii57671
+ 05D8 afii57672
+ 05D9 afii57673
+ 05DA afii57674
+ 05DB afii57675
+ 05DC afii57676
+ 05DD afii57677
+ 05DE afii57678
+ 05DF afii57679
+ 05E0 afii57680
+ 05E1 afii57681
+ 05E2 afii57682
+ 05E3 afii57683
+ 05E4 afii57684
+ 05E5 afii57685
+ 05E6 afii57686
+ 05E7 afii57687
+ 05E8 afii57688
+ 05E9 afii57689
+ 05EA afii57690
+ 05F0 afii57716
+ 05F1 afii57717
+ 05F2 afii57718
+ 060C afii57388
+ 061B afii57403
+ 061F afii57407
+ 0621 afii57409
+ 0622 afii57410
+ 0623 afii57411
+ 0624 afii57412
+ 0625 afii57413
+ 0626 afii57414
+ 0627 afii57415
+ 0628 afii57416
+ 0629 afii57417
+ 062A afii57418
+ 062B afii57419
+ 062C afii57420
+ 062D afii57421
+ 062E afii57422
+ 062F afii57423
+ 0630 afii57424
+ 0631 afii57425
+ 0632 afii57426
+ 0633 afii57427
+ 0634 afii57428
+ 0635 afii57429
+ 0636 afii57430
+ 0637 afii57431
+ 0638 afii57432
+ 0639 afii57433
+ 063A afii57434
+ 0640 afii57440
+ 0641 afii57441
+ 0642 afii57442
+ 0643 afii57443
+ 0644 afii57444
+ 0645 afii57445
+ 0646 afii57446
+ 0647 afii57470
+ 0648 afii57448
+ 0649 afii57449
+ 064A afii57450
+ 064B afii57451
+ 064C afii57452
+ 064D afii57453
+ 064E afii57454
+ 064F afii57455
+ 0650 afii57456
+ 0651 afii57457
+ 0652 afii57458
+ 0660 afii57392
+ 0661 afii57393
+ 0662 afii57394
+ 0663 afii57395
+ 0664 afii57396
+ 0665 afii57397
+ 0666 afii57398
+ 0667 afii57399
+ 0668 afii57400
+ 0669 afii57401
+ 066A afii57381
+ 066D afii63167
+ 0679 afii57511
+ 067E afii57506
+ 0686 afii57507
+ 0688 afii57512
+ 0691 afii57513
+ 0698 afii57508
+ 06A4 afii57505
+ 06AF afii57509
+ 06BA afii57514
+ 06D2 afii57519
+ 06D5 afii57534
+ 1E80 Wgrave
+ 1E81 wgrave
+ 1E82 Wacute
+ 1E83 wacute
+ 1E84 Wdieresis
+ 1E85 wdieresis
+ 1EF2 Ygrave
+ 1EF3 ygrave
+ 200C afii61664
+ 200D afii301
+ 200E afii299
+ 200F afii300
+ 2012 figuredash
+ 2013 endash
+ 2014 emdash
+ 2015 afii00208
+ 2017 underscoredbl
+ 2018 quoteleft
+ 2019 quoteright
+ 201A quotesinglbase
+ 201B quotereversed
+ 201C quotedblleft
+ 201D quotedblright
+ 201E quotedblbase
+ 2020 dagger
+ 2021 daggerdbl
+ 2022 bullet
+ 2024 onedotenleader
+ 2025 twodotenleader
+ 2026 ellipsis
+ 202C afii61573
+ 202D afii61574
+ 202E afii61575
+ 2030 perthousand
+ 2032 minute
+ 2033 second
+ 2039 guilsinglleft
+ 203A guilsinglright
+ 203C exclamdbl
+ 2044 fraction
+ 2070 zerosuperior
+ 2074 foursuperior
+ 2075 fivesuperior
+ 2076 sixsuperior
+ 2077 sevensuperior
+ 2078 eightsuperior
+ 2079 ninesuperior
+ 207D parenleftsuperior
+ 207E parenrightsuperior
+ 207F nsuperior
+ 2080 zeroinferior
+ 2081 oneinferior
+ 2082 twoinferior
+ 2083 threeinferior
+ 2084 fourinferior
+ 2085 fiveinferior
+ 2086 sixinferior
+ 2087 seveninferior
+ 2088 eightinferior
+ 2089 nineinferior
+ 208D parenleftinferior
+ 208E parenrightinferior
+ 20A1 colonmonetary
+ 20A3 franc
+ 20A4 lira
+ 20A7 peseta
+ 20AA afii57636
+ 20AB dong
+ 20AC Euro
+ 2105 afii61248
+ 2111 Ifraktur
+ 2113 afii61289
+ 2116 afii61352
+ 2118 weierstrass
+ 211C Rfraktur
+ 211E prescription
+ 2122 trademark
+ 2126 Omega
+ 212E estimated
+ 2135 aleph
+ 2153 onethird
+ 2154 twothirds
+ 215B oneeighth
+ 215C threeeighths
+ 215D fiveeighths
+ 215E seveneighths
+ 2190 arrowleft
+ 2191 arrowup
+ 2192 arrowright
+ 2193 arrowdown
+ 2194 arrowboth
+ 2195 arrowupdn
+ 21A8 arrowupdnbse
+ 21B5 carriagereturn
+ 21D0 arrowdblleft
+ 21D1 arrowdblup
+ 21D2 arrowdblright
+ 21D3 arrowdbldown
+ 21D4 arrowdblboth
+ 2200 universal
+ 2202 partialdiff
+ 2203 existential
+ 2205 emptyset
+ 2206 Delta
+ 2207 gradient
+ 2208 element
+ 2209 notelement
+ 220B suchthat
+ 220F product
+ 2211 summation
+ 2212 minus
+ 2215 fraction
+ 2217 asteriskmath
+ 2219 periodcentered
+ 221A radical
+ 221D proportional
+ 221E infinity
+ 221F orthogonal
+ 2220 angle
+ 2227 logicaland
+ 2228 logicalor
+ 2229 intersection
+ 222A union
+ 222B integral
+ 2234 therefore
+ 223C similar
+ 2245 congruent
+ 2248 approxequal
+ 2260 notequal
+ 2261 equivalence
+ 2264 lessequal
+ 2265 greaterequal
+ 2282 propersubset
+ 2283 propersuperset
+ 2284 notsubset
+ 2286 reflexsubset
+ 2287 reflexsuperset
+ 2295 circleplus
+ 2297 circlemultiply
+ 22A5 perpendicular
+ 22C5 dotmath
+ 2302 house
+ 2310 revlogicalnot
+ 2320 integraltp
+ 2321 integralbt
+ 2329 angleleft
+ 232A angleright
+ 2500 SF100000
+ 2502 SF110000
+ 250C SF010000
+ 2510 SF030000
+ 2514 SF020000
+ 2518 SF040000
+ 251C SF080000
+ 2524 SF090000
+ 252C SF060000
+ 2534 SF070000
+ 253C SF050000
+ 2550 SF430000
+ 2551 SF240000
+ 2552 SF510000
+ 2553 SF520000
+ 2554 SF390000
+ 2555 SF220000
+ 2556 SF210000
+ 2557 SF250000
+ 2558 SF500000
+ 2559 SF490000
+ 255A SF380000
+ 255B SF280000
+ 255C SF270000
+ 255D SF260000
+ 255E SF360000
+ 255F SF370000
+ 2560 SF420000
+ 2561 SF190000
+ 2562 SF200000
+ 2563 SF230000
+ 2564 SF470000
+ 2565 SF480000
+ 2566 SF410000
+ 2567 SF450000
+ 2568 SF460000
+ 2569 SF400000
+ 256A SF540000
+ 256B SF530000
+ 256C SF440000
+ 2580 upblock
+ 2584 dnblock
+ 2588 block
+ 258C lfblock
+ 2590 rtblock
+ 2591 ltshade
+ 2592 shade
+ 2593 dkshade
+ 25A0 filledbox
+ 25A1 H22073
+ 25AA H18543
+ 25AB H18551
+ 25AC filledrect
+ 25B2 triagup
+ 25BA triagrt
+ 25BC triagdn
+ 25C4 triaglf
+ 25CA lozenge
+ 25CB circle
+ 25CF H18533
+ 25D8 invbullet
+ 25D9 invcircle
+ 25E6 openbullet
+ 263A smileface
+ 263B invsmileface
+ 263C sun
+ 2640 female
+ 2642 male
+ 2660 spade
+ 2663 club
+ 2665 heart
+ 2666 diamond
+ 266A musicalnote
+ 266B musicalnotedbl
+ F6BE dotlessj
+ F6BF LL
+ F6C0 ll
+ F6C1 Scedilla
+ F6C2 scedilla
+ F6C3 commaaccent
+ F6C4 afii10063
+ F6C5 afii10064
+ F6C6 afii10192
+ F6C7 afii10831
+ F6C8 afii10832
+ F6C9 Acute
+ F6CA Caron
+ F6CB Dieresis
+ F6CC DieresisAcute
+ F6CD DieresisGrave
+ F6CE Grave
+ F6CF Hungarumlaut
+ F6D0 Macron
+ F6D1 cyrBreve
+ F6D2 cyrFlex
+ F6D3 dblGrave
+ F6D4 cyrbreve
+ F6D5 cyrflex
+ F6D6 dblgrave
+ F6D7 dieresisacute
+ F6D8 dieresisgrave
+ F6D9 copyrightserif
+ F6DA registerserif
+ F6DB trademarkserif
+ F6DC onefitted
+ F6DD rupiah
+ F6DE threequartersemdash
+ F6DF centinferior
+ F6E0 centsuperior
+ F6E1 commainferior
+ F6E2 commasuperior
+ F6E3 dollarinferior
+ F6E4 dollarsuperior
+ F6E5 hypheninferior
+ F6E6 hyphensuperior
+ F6E7 periodinferior
+ F6E8 periodsuperior
+ F6E9 asuperior
+ F6EA bsuperior
+ F6EB dsuperior
+ F6EC esuperior
+ F6ED isuperior
+ F6EE lsuperior
+ F6EF msuperior
+ F6F0 osuperior
+ F6F1 rsuperior
+ F6F2 ssuperior
+ F6F3 tsuperior
+ F6F4 Brevesmall
+ F6F5 Caronsmall
+ F6F6 Circumflexsmall
+ F6F7 Dotaccentsmall
+ F6F8 Hungarumlautsmall
+ F6F9 Lslashsmall
+ F6FA OEsmall
+ F6FB Ogoneksmall
+ F6FC Ringsmall
+ F6FD Scaronsmall
+ F6FE Tildesmall
+ F6FF Zcaronsmall
+ F721 exclamsmall
+ F724 dollaroldstyle
+ F726 ampersandsmall
+ F730 zerooldstyle
+ F731 oneoldstyle
+ F732 twooldstyle
+ F733 threeoldstyle
+ F734 fouroldstyle
+ F735 fiveoldstyle
+ F736 sixoldstyle
+ F737 sevenoldstyle
+ F738 eightoldstyle
+ F739 nineoldstyle
+ F73F questionsmall
+ F760 Gravesmall
+ F761 Asmall
+ F762 Bsmall
+ F763 Csmall
+ F764 Dsmall
+ F765 Esmall
+ F766 Fsmall
+ F767 Gsmall
+ F768 Hsmall
+ F769 Ismall
+ F76A Jsmall
+ F76B Ksmall
+ F76C Lsmall
+ F76D Msmall
+ F76E Nsmall
+ F76F Osmall
+ F770 Psmall
+ F771 Qsmall
+ F772 Rsmall
+ F773 Ssmall
+ F774 Tsmall
+ F775 Usmall
+ F776 Vsmall
+ F777 Wsmall
+ F778 Xsmall
+ F779 Ysmall
+ F77A Zsmall
+ F7A1 exclamdownsmall
+ F7A2 centoldstyle
+ F7A8 Dieresissmall
+ F7AF Macronsmall
+ F7B4 Acutesmall
+ F7B8 Cedillasmall
+ F7BF questiondownsmall
+ F7E0 Agravesmall
+ F7E1 Aacutesmall
+ F7E2 Acircumflexsmall
+ F7E3 Atildesmall
+ F7E4 Adieresissmall
+ F7E5 Aringsmall
+ F7E6 AEsmall
+ F7E7 Ccedillasmall
+ F7E8 Egravesmall
+ F7E9 Eacutesmall
+ F7EA Ecircumflexsmall
+ F7EB Edieresissmall
+ F7EC Igravesmall
+ F7ED Iacutesmall
+ F7EE Icircumflexsmall
+ F7EF Idieresissmall
+ F7F0 Ethsmall
+ F7F1 Ntildesmall
+ F7F2 Ogravesmall
+ F7F3 Oacutesmall
+ F7F4 Ocircumflexsmall
+ F7F5 Otildesmall
+ F7F6 Odieresissmall
+ F7F8 Oslashsmall
+ F7F9 Ugravesmall
+ F7FA Uacutesmall
+ F7FB Ucircumflexsmall
+ F7FC Udieresissmall
+ F7FD Yacutesmall
+ F7FE Thornsmall
+ F7FF Ydieresissmall
+ F8E5 radicalex
+ F8E6 arrowvertex
+ F8E7 arrowhorizex
+ F8E8 registersans
+ F8E9 copyrightsans
+ F8EA trademarksans
+ F8EB parenlefttp
+ F8EC parenleftex
+ F8ED parenleftbt
+ F8EE bracketlefttp
+ F8EF bracketleftex
+ F8F0 bracketleftbt
+ F8F1 bracelefttp
+ F8F2 braceleftmid
+ F8F3 braceleftbt
+ F8F4 braceex
+ F8F5 integralex
+ F8F6 parenrighttp
+ F8F7 parenrightex
+ F8F8 parenrightbt
+ F8F9 bracketrighttp
+ F8FA bracketrightex
+ F8FB bracketrightbt
+ F8FC bracerighttp
+ F8FD bracerightmid
+ F8FE bracerightbt
+ FB00 ff
+ FB01 fi
+ FB02 fl
+ FB03 ffi
+ FB04 ffl
+ FB1F afii57705
+ FB2A afii57694
+ FB2B afii57695
+ FB35 afii57723
+ FB4B afii57700
+}
+
+# precalculate entire prolog when this file is loaded
+# (to speed things up)
+set ps_preamable "%%BeginProlog\n"
+append ps_preamable [CreatePostscriptEncoding [encoding system]]
+append ps_preamable {
+50 dict begin
+% This is a standard prolog for Postscript generated by Tk's canvas
+% widget.
+% RCS: @(#) $Id$
+
+% The definitions below just define all of the variables used in
+% any of the procedures here. This is needed for obscure reasons
+% explained on p. 716 of the Postscript manual (Section H.2.7,
+% "Initializing Variables," in the section on Encapsulated Postscript).
+
+/baseline 0 def
+/stipimage 0 def
+/height 0 def
+/justify 0 def
+/lineLength 0 def
+/spacing 0 def
+/stipple 0 def
+/strings 0 def
+/xoffset 0 def
+/yoffset 0 def
+/tmpstip null def
+
+
+/cstringshow {
+ {
+ dup type /stringtype eq
+ { show } { glyphshow }
+ ifelse
+ }
+ forall
+} bind def
+
+
+
+/cstringwidth {
+ 0 exch 0 exch
+ {
+ dup type /stringtype eq
+ { stringwidth } {
+ currentfont /Encoding get exch 1 exch put (\001) stringwidth
+ }
+ ifelse
+ exch 3 1 roll add 3 1 roll add exch
+ }
+ forall
+} bind def
+
+% font ISOEncode font
+% This procedure changes the encoding of a font from the default
+% Postscript encoding to current system encoding. It's typically invoked just
+% before invoking "setfont". The body of this procedure comes from
+% Section 5.6.1 of the Postscript book.
+
+/ISOEncode {
+ dup length dict begin
+ {1 index /FID ne {def} {pop pop} ifelse} forall
+ /Encoding CurrentEncoding def
+ currentdict
+ end
+
+ % I'm not sure why it's necessary to use "definefont" on this new
+ % font, but it seems to be important; just use the name "Temporary"
+ % for the font.
+
+ /Temporary exch definefont
+} bind def
+
+% StrokeClip
+%
+% This procedure converts the current path into a clip area under
+% the assumption of stroking. It's a bit tricky because some Postscript
+% interpreters get errors during strokepath for dashed lines. If
+% this happens then turn off dashes and try again.
+
+/StrokeClip {
+ {strokepath} stopped {
+ (This Postscript printer gets limitcheck overflows when) =
+ (stippling dashed lines; lines will be printed solid instead.) =
+ [] 0 setdash strokepath} if
+ clip
+} bind def
+
+% desiredSize EvenPixels closestSize
+%
+% The procedure below is used for stippling. Given the optimal size
+% of a dot in a stipple pattern in the current user coordinate system,
+% compute the closest size that is an exact multiple of the device's
+% pixel size. This allows stipple patterns to be displayed without
+% aliasing effects.
+
+/EvenPixels {
+ % Compute exact number of device pixels per stipple dot.
+ dup 0 matrix currentmatrix dtransform
+ dup mul exch dup mul add sqrt
+
+ % Round to an integer, make sure the number is at least 1, and compute
+ % user coord distance corresponding to this.
+ dup round dup 1 lt {pop 1} if
+ exch div mul
+} bind def
+
+% width height string StippleFill --
+%
+% Given a path already set up and a clipping region generated from
+% it, this procedure will fill the clipping region with a stipple
+% pattern. "String" contains a proper image description of the
+% stipple pattern and "width" and "height" give its dimensions. Each
+% stipple dot is assumed to be about one unit across in the current
+% user coordinate system. This procedure trashes the graphics state.
+
+/StippleFill {
+ % The following code is needed to work around a NeWSprint bug.
+
+ /tmpstip 1 index def
+
+ % Change the scaling so that one user unit in user coordinates
+ % corresponds to the size of one stipple dot.
+ 1 EvenPixels dup scale
+
+ % Compute the bounding box occupied by the path (which is now
+ % the clipping region), and round the lower coordinates down
+ % to the nearest starting point for the stipple pattern. Be
+ % careful about negative numbers, since the rounding works
+ % differently on them.
+
+ pathbbox
+ 4 2 roll
+ 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll
+ 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll
+
+ % Stack now: width height string y1 y2 x1 x2
+ % Below is a doubly-nested for loop to iterate across this area
+ % in units of the stipple pattern size, going up columns then
+ % across rows, blasting out a stipple-pattern-sized rectangle at
+ % each position
+
+ 6 index exch {
+ 2 index 5 index 3 index {
+ % Stack now: width height string y1 y2 x y
+
+ gsave
+ 1 index exch translate
+ 5 index 5 index true matrix tmpstip imagemask
+ grestore
+ } for
+ pop
+ } for
+ pop pop pop pop pop
+} bind def
+
+% -- AdjustColor --
+% Given a color value already set for output by the caller, adjusts
+% that value to a grayscale or mono value if requested by the CL
+% variable.
+
+/AdjustColor {
+ CL 2 lt {
+ currentgray
+ CL 0 eq {
+ .5 lt {0} {1} ifelse
+ } if
+ setgray
+ } if
+} bind def
+
+% x y strings spacing xoffset yoffset justify stipple DrawText --
+% This procedure does all of the real work of drawing text. The
+% color and font must already have been set by the caller, and the
+% following arguments must be on the stack:
+%
+% x, y - Coordinates at which to draw text.
+% strings - An array of strings, one for each line of the text item,
+% in order from top to bottom.
+% spacing - Spacing between lines.
+% xoffset - Horizontal offset for text bbox relative to x and y: 0 for
+% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.
+% yoffset - Vertical offset for text bbox relative to x and y: 0 for
+% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.
+% justify - 0 for left justification, 0.5 for center, 1 for right justify.
+% stipple - Boolean value indicating whether or not text is to be
+% drawn in stippled fashion. If text is stippled,
+% procedure StippleText must have been defined to call
+% StippleFill in the right way.
+%
+% Also, when this procedure is invoked, the color and font must already
+% have been set for the text.
+
+/DrawText {
+ /stipple exch def
+ /justify exch def
+ /yoffset exch def
+ /xoffset exch def
+ /spacing exch def
+ /strings exch def
+
+ % First scan through all of the text to find the widest line.
+
+ /lineLength 0 def
+ strings {
+ cstringwidth pop
+ dup lineLength gt {/lineLength exch def} {pop} ifelse
+ newpath
+ } forall
+
+ % Compute the baseline offset and the actual font height.
+
+ 0 0 moveto (TXygqPZ) false charpath
+ pathbbox dup /baseline exch def
+ exch pop exch sub /height exch def pop
+ newpath
+
+ % Translate coordinates first so that the origin is at the upper-left
+ % corner of the text's bounding box. Remember that x and y for
+ % positioning are still on the stack.
+
+ translate
+ lineLength xoffset mul
+ strings length 1 sub spacing mul height add yoffset mul translate
+
+ % Now use the baseline and justification information to translate so
+ % that the origin is at the baseline and positioning point for the
+ % first line of text.
+
+ justify lineLength mul baseline neg translate
+
+ % Iterate over each of the lines to output it. For each line,
+ % compute its width again so it can be properly justified, then
+ % display it.
+
+ strings {
+ dup cstringwidth pop
+ justify neg mul 0 moveto
+ stipple {
+
+
+ % The text is stippled, so turn it into a path and print
+ % by calling StippledText, which in turn calls StippleFill.
+ % Unfortunately, many Postscript interpreters will get
+ % overflow errors if we try to do the whole string at
+ % once, so do it a character at a time.
+
+ gsave
+ /char (X) def
+ {
+ dup type /stringtype eq {
+ % This segment is a string.
+ {
+ char 0 3 -1 roll put
+ currentpoint
+ gsave
+ char true charpath clip StippleText
+ grestore
+ char stringwidth translate
+ moveto
+ } forall
+ } {
+ % This segment is glyph name
+ % Temporary override
+ currentfont /Encoding get exch 1 exch put
+ currentpoint
+ gsave (\001) true charpath clip StippleText
+ grestore
+ (\001) stringwidth translate
+ moveto
+ } ifelse
+ } forall
+ grestore
+ } {cstringshow} ifelse
+ 0 spacing neg translate
+ } forall
+} bind def
+
+%%EndProlog
+}
+
+}
+
+proc tk::ensure_psenc_is_loaded {} {
+}
diff --git a/tcl/library/msgbox.tcl b/tcl/library/msgbox.tcl
new file mode 100644
index 00000000000..20862b5b117
--- /dev/null
+++ b/tcl/library/msgbox.tcl
@@ -0,0 +1,419 @@
+# msgbox.tcl --
+#
+# Implements messageboxes for platforms that do not have native
+# messagebox support.
+#
+# RCS: @(#) $Id$
+#
+# 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.
+#
+
+# Ensure existence of ::tk::dialog namespace
+#
+namespace eval ::tk::dialog {}
+
+image create bitmap ::tk::dialog::b1 -foreground black \
+-data "#define b1_width 32\n#define b1_height 32
+static unsigned char q1_bits[] = {
+ 0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,
+ 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,
+ 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
+ 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
+ 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
+ 0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
+ 0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,
+ 0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,
+ 0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,
+ 0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::b2 -foreground white \
+-data "#define b2_width 32\n#define b2_height 32
+static unsigned char b2_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,
+ 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,
+ 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
+ 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
+ 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
+ 0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
+ 0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,
+ 0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,
+ 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,
+ 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::q -foreground blue \
+-data "#define q_width 32\n#define q_height 32
+static unsigned char q_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,
+ 0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,
+ 0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,
+ 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,
+ 0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 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, 0x00};"
+image create bitmap ::tk::dialog::i -foreground blue \
+-data "#define i_width 32\n#define i_height 32
+static unsigned char i_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,
+ 0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
+ 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
+ 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
+ 0x00, 0xf8, 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, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::w1 -foreground black \
+-data "#define w1_width 32\n#define w1_height 32
+static unsigned char w1_bits[] = {
+ 0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,
+ 0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,
+ 0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,
+ 0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,
+ 0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,
+ 0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,
+ 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,
+ 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,
+ 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,
+ 0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,
+ 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::w2 -foreground yellow \
+-data "#define w2_width 32\n#define w2_height 32
+static unsigned char w2_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
+ 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,
+ 0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,
+ 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
+ 0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,
+ 0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,
+ 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,
+ 0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,
+ 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,
+ 0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::w3 -foreground black \
+-data "#define w3_width 32\n#define w3_height 32
+static unsigned char w3_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, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
+ 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
+ 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,
+ 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
+ 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 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::MessageBox --
+#
+# 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.
+#
+# Color icons are used on Unix displays that have a color
+# depth of 4 or more and $tk_strictMotif is not on.
+#
+# 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 ::tk::MessageBox {args} {
+ global tcl_platform tk_strictMotif
+ variable ::tk::Priv
+
+ set w ::tk::PrivMsgBox
+ upvar $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 "" "" ""}
+ {-parent "" "" .}
+ {-title "" "" " "}
+ {-type "" "" "ok"}
+ }
+
+ tclParseConfigSpec $w $specs "" $args
+
+ if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
+ error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
+ }
+ if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ switch -- $data(-icon) {
+ "error" {set data(-icon) "stop"}
+ "warning" {set data(-icon) "caution"}
+ "info" {set data(-icon) "note"}
+ }
+ }
+
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+
+ switch -- $data(-type) {
+ abortretryignore {
+ set names [list abort retry ignore]
+ set labels [list &Abort &Retry &Ignore]
+ }
+ ok {
+ set names [list ok]
+ set labels {&OK}
+ }
+ okcancel {
+ set names [list ok cancel]
+ set labels [list &OK &Cancel]
+ }
+ retrycancel {
+ set names [list retry cancel]
+ set labels [list &Retry &Cancel]
+ }
+ yesno {
+ set names [list yes no]
+ set labels [list &Yes &No]
+ }
+ yesnocancel {
+ set names [list yes no cancel]
+ set labels [list &Yes &No &Cancel]
+ }
+ default {
+ error "bad -type value \"$data(-type)\": must be\
+ abortretryignore, ok, okcancel, retrycancel,\
+ yesno, or yesnocancel"
+ }
+ }
+
+ set maxWidth [eval mcmaxamp $labels]
+ if {$maxWidth <6} {
+ set maxWidth 6
+ }
+
+ set buttons {}
+ foreach name $names lab $labels {
+ lappend buttons [list $name -width $maxWidth -text [mc $lab]]
+ }
+
+ # If no default button was specified, the default default is the
+ # first button (Bug: 2218).
+
+ if {$data(-default) == ""} {
+ set data(-default) [lindex [lindex $buttons 0] 0]
+ }
+
+ set valid 0
+ foreach btn $buttons {
+ if {[string equal [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 { }
+ # There is only one background colour for the whole dialog
+ set bg [$w cget -background]
+
+ # Message boxes should be transient with respect to their parent so that
+ # they always stay on top of the parent window. But some window managers
+ # will simply create the child window as withdrawn if the parent is not
+ # viewable (because it is withdrawn or iconified). This is not good for
+ # "grab"bed windows. So only make the message box transient if the parent
+ # is viewable.
+ #
+ if {[winfo viewable [winfo toplevel $data(-parent)]] } {
+ wm transient $w $data(-parent)
+ }
+
+ if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ unsupported::MacWindowStyle style $w dBoxProc
+ }
+
+ frame $w.bot -background $bg
+ pack $w.bot -side bottom -fill both
+ frame $w.top -background $bg
+ pack $w.top -side top -fill both -expand 1
+ if {![string equal [tk windowingsystem] "classic"]
+ && ![string equal [tk windowingsystem] "aqua"]} {
+ $w.bot configure -relief raised -bd 1
+ $w.top configure -relief raised -bd 1
+ }
+
+ # 4. Fill the top part with bitmap and message (use the option
+ # database for -wraplength and -font so that they can be
+ # overridden by the caller).
+
+ option add *Dialog.msg.wrapLength 3i widgetDefault
+ if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ option add *Dialog.msg.font system widgetDefault
+ } else {
+ option add *Dialog.msg.font {Times 18} widgetDefault
+ }
+
+ label $w.msg -anchor nw -justify left -text $data(-message) \
+ -background $bg
+ if {[string compare $data(-icon) ""]} {
+ if {([string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"])
+ || ([winfo depth $w] < 4) || $tk_strictMotif} {
+ label $w.bitmap -bitmap $data(-icon) -background $bg
+ } else {
+ canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \
+ -background $bg
+ switch $data(-icon) {
+ error {
+ $w.bitmap create oval 0 0 31 31 -fill red -outline black
+ $w.bitmap create line 9 9 23 23 -fill white -width 4
+ $w.bitmap create line 9 23 23 9 -fill white -width 4
+ }
+ info {
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::b1
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::b2
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::i
+ }
+ question {
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::b1
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::b2
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::q
+ }
+ default {
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::w1
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::w2
+ $w.bitmap create image 0 0 -anchor nw \
+ -image ::tk::dialog::w3
+ }
+ }
+ }
+ }
+ grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
+ grid columnconfigure $w.top 1 -weight 1
+ grid rowconfigure $w.top 0 -weight 1
+
+ # 5. Create a row of buttons at the bottom of the dialog.
+
+ set i 0
+ foreach but $buttons {
+ set name [lindex $but 0]
+ set opts [lrange $but 1 end]
+ if {![llength $opts]} {
+ # Capitalize the first letter of $name
+ set capName [string toupper $name 0]
+ set opts [list -text $capName]
+ }
+
+ eval [list tk::AmpWidget button $w.$name] $opts \
+ [list -command [list set tk::Priv(button) $name]]
+
+ if {[string equal $name $data(-default)]} {
+ $w.$name configure -default active
+ } else {
+ $w.$name configure -default normal
+ }
+ pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
+
+ # create the binding for the key accelerator, based on the underline
+ #
+ # set underIdx [$w.$name cget -under]
+ # if {$underIdx >= 0} {
+ # set key [string index [$w.$name cget -text] $underIdx]
+ # bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
+ # bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
+ # }
+ # incr i
+ }
+ bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
+
+ if {[string compare {} $data(-default)]} {
+ bind $w <FocusIn> {
+ if {[string equal Button [winfo class %W]]} {
+ %W configure -default active
+ }
+ }
+ bind $w <FocusOut> {
+ if {[string equal Button [winfo class %W]]} {
+ %W configure -default normal
+ }
+ }
+ }
+
+ # 6. Create a binding for <Return> on the dialog
+
+ bind $w <Return> {
+ if {[string equal Button [winfo class %W]]} {
+ tk::ButtonInvoke %W
+ }
+ }
+
+ # 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.
+
+ ::tk::PlaceWindow $w widget $data(-parent)
+
+ # 8. Set a grab and claim the focus too.
+
+ if {[string compare $data(-default) ""]} {
+ set focus $w.$data(-default)
+ } else {
+ set focus $w
+ }
+ ::tk::SetFocusGrab $w $focus
+
+ # 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.
+
+ vwait ::tk::Priv(button)
+
+ ::tk::RestoreFocusGrab $w $focus
+
+ return $Priv(button)
+}
diff --git a/tcl/library/msgs/cs.msg b/tcl/library/msgs/cs.msg
new file mode 100644
index 00000000000..e4014a334a9
--- /dev/null
+++ b/tcl/library/msgs/cs.msg
@@ -0,0 +1,70 @@
+namespace eval ::tk {
+ ::msgcat::mcset cs "&Abort" "&P\u0159eru\u0161it"
+ ::msgcat::mcset cs "About..." "O programu..."
+ ::msgcat::mcset cs "All Files" "V\u0161echny soubory"
+ ::msgcat::mcset cs "Application Error" "Chyba programu"
+ ::msgcat::mcset cs "&Blue" "&Modr\341"
+ ::msgcat::mcset cs "&Cancel" "&Zru\u0161it"
+ ::msgcat::mcset cs "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nemohu zm\u011bnit atku\341ln\355 adres\341\u0159 na \"%1\$s\".\nP\u0159\355stup odm\355tnut."
+ ::msgcat::mcset cs "Choose Directory" "V\375b\u011br adres\341\u0159e"
+ ::msgcat::mcset cs "Clear" "Smazat"
+ ::msgcat::mcset cs "Color" "Barva"
+ ::msgcat::mcset cs "Console" "Konzole"
+ ::msgcat::mcset cs "Copy" "Kop\355rovat"
+ ::msgcat::mcset cs "Cut" "Vy\u0159\355znout"
+ ::msgcat::mcset cs "Delete" "Smazat"
+ ::msgcat::mcset cs "Details >>" "Detaily >>"
+ ::msgcat::mcset cs "Directory \"%1\$s\" does not exist." "Adres\341\u0159 \"%1\$s\" neexistuje."
+ ::msgcat::mcset cs "&Directory:" "&Adres\341\u0159:"
+ ::msgcat::mcset cs "Error: %1\$s" "Chyba: %1\$s"
+ ::msgcat::mcset cs "Exit" "Konec"
+ ::msgcat::mcset cs "File \"%1\$s\" already exists.\n\n" "Soubor \"%1\$s\" ji\u017e existuje.\n\n"
+ ::msgcat::mcset cs "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Soubor \"%1\$s\" ji\u017e existuje.\nChcete jej p\u0159epsat?"
+ ::msgcat::mcset cs "File \"%1\$s\" does not exist." "Soubor \"%1\$s\" neexistuje."
+ ::msgcat::mcset cs "File &name:" "&Jm\351no souboru:"
+ ::msgcat::mcset cs "File &names:" "&Jm\351na soubor\u016f:"
+ ::msgcat::mcset cs "Files of &type:" "&Typy soubor\u016f:"
+ ::msgcat::mcset cs "Fi&les:" "Sou&bory:"
+ ::msgcat::mcset cs "&Filter" "&Filtr"
+ ::msgcat::mcset cs "Fil&ter:" "Fil&tr:"
+ ::msgcat::mcset cs "&Green" "Ze&len\341"
+ ::msgcat::mcset cs "Hi"
+ ::msgcat::mcset cs "Hide Console" "Skr\375t konsolu"
+ ::msgcat::mcset cs "&Ignore" "&Ignorovat"
+ ::msgcat::mcset cs "Invalid file name \"%1\$s\"." "\u0160patn\351 jm\351no souboru \"%1\$s\"."
+ ::msgcat::mcset cs "Log Files" "Log soubory"
+ ::msgcat::mcset cs "&No" "&Ne"
+ ::msgcat::mcset cs "&OK"
+ ::msgcat::mcset cs "Ok"
+ ::msgcat::mcset cs "Open" "Otev\u0159\355t"
+ ::msgcat::mcset cs "&Open" "&Otev\u0159\355t"
+ ::msgcat::mcset cs "Open Multiple Files" "Otev\u0159\355t v\355ce soubor\u016f"
+ ::msgcat::mcset cs "Paste" "Vlo\u017eit"
+ ::msgcat::mcset cs "Quit" "Skon\u010dit"
+ ::msgcat::mcset cs "&Red" " \u010ce&rven\341"
+ ::msgcat::mcset cs "Replace existing file?" "Nahradit st\341vaj\355c\355 soubor?"
+ ::msgcat::mcset cs "&Retry" "Z&novu"
+ ::msgcat::mcset cs "&Save" "&Ulo\u017eit"
+ ::msgcat::mcset cs "Save As" "Ulo\u017eit jako"
+ ::msgcat::mcset cs "Save To Log" "Ulo\u017eit do logu"
+ ::msgcat::mcset cs "Select Log File" "Vybrat log soubor"
+ ::msgcat::mcset cs "Select a file to source" "Vybrat soubor k nahr\341n\355"
+ ::msgcat::mcset cs "&Selection:" "&V\375b\u011br:"
+ ::msgcat::mcset cs "Skip Messages" "P\u0159esko\u010dit zpr\341vy"
+ ::msgcat::mcset cs "Source..." "Nahr\341t..."
+ ::msgcat::mcset cs "Tcl Scripts" "Tcl skripty"
+ ::msgcat::mcset cs "Tcl for Windows" "Tcl pro Windows"
+ ::msgcat::mcset cs "Text Files" "Textov\351 soubory"
+ ::msgcat::mcset cs "&Yes" "&Ano"
+ ::msgcat::mcset cs "abort" "p\u0159eru\u0161it"
+ ::msgcat::mcset cs "blue" "modr\341"
+ ::msgcat::mcset cs "cancel" "zru\u0161it"
+ ::msgcat::mcset cs "extension" "p\u0159\355pona"
+ ::msgcat::mcset cs "extensions" "p\u0159\355pony"
+ ::msgcat::mcset cs "green" "zelen\341"
+ ::msgcat::mcset cs "ignore" "ignorovat"
+ ::msgcat::mcset cs "ok"
+ ::msgcat::mcset cs "red" "\u010derven\341"
+ ::msgcat::mcset cs "retry" "znovu"
+ ::msgcat::mcset cs "yes" "ano"
+}
diff --git a/tcl/library/msgs/de.msg b/tcl/library/msgs/de.msg
new file mode 100644
index 00000000000..c5ae6893d98
--- /dev/null
+++ b/tcl/library/msgs/de.msg
@@ -0,0 +1,70 @@
+namespace eval ::tk {
+ ::msgcat::mcset de "&Abort" "&Abbruch"
+ ::msgcat::mcset de "About..." "\u00dcber..."
+ ::msgcat::mcset de "All Files" "Alle Dateien"
+ ::msgcat::mcset de "Application Error" "Applikationsfehler"
+ ::msgcat::mcset de "&Blue" "&Blau"
+ ::msgcat::mcset de "&Cancel" "&Abbruch"
+ ::msgcat::mcset de "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kann nicht in das Verzeichnis \"%1\$s\" wechseln.\nKeine Rechte vorhanden."
+ ::msgcat::mcset de "Choose Directory" "W\u00e4hle Verzeichnis"
+ ::msgcat::mcset de "Clear" "R\u00fccksetzen"
+ ::msgcat::mcset de "Color" "Farbe"
+ ::msgcat::mcset de "Console" "Konsole"
+ ::msgcat::mcset de "Copy" "Kopieren"
+ ::msgcat::mcset de "Cut" "Ausschneiden"
+ ::msgcat::mcset de "Delete" "L\u00f6schen"
+ ::msgcat::mcset de "Details >>"
+ ::msgcat::mcset de "Directory \"%1\$s\" does not exist." "Das Verzeichnis \"%1\$s\" existiert nicht."
+ ::msgcat::mcset de "&Directory:" "&Verzeichnis:"
+ ::msgcat::mcset de "Error: %1\$s" "Fehler: %1\$s"
+ ::msgcat::mcset de "Exit" "Ende"
+ ::msgcat::mcset de "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Die Datei \"%1\$s\" ist bereits vorhanden.\nWollen sie diese Datei \u00fcberschreiben ?"
+ ::msgcat::mcset de "File \"%1\$s\" already exists.\n\n" "Die Datei \"%1\$s\" ist bereits vorhanden.\n\n"
+ ::msgcat::mcset de "File \"%1\$s\" does not exist." "Die Datei \"%1\$s\" existiert nicht."
+ ::msgcat::mcset de "File &name:" "Datei&name:"
+ ::msgcat::mcset de "File &names:" "Datei&namen:"
+ ::msgcat::mcset de "Files of &type:" "Dateien des &Typs:"
+ ::msgcat::mcset de "Fi&les:" "Dat&eien:"
+ ::msgcat::mcset de "&Filter"
+ ::msgcat::mcset de "Fil&ter:"
+ ::msgcat::mcset de "&Green" "&Gr\u00fcn"
+ ::msgcat::mcset de "Hi" "Hallo"
+ ::msgcat::mcset de "Hide Console" "Konsole unsichtbar machen"
+ ::msgcat::mcset de "&Ignore" "&Ignorieren"
+ ::msgcat::mcset de "Invalid file name \"%1\$s\"." "Ung\u00fcltiger Dateiname \"%1\$s\"."
+ ::msgcat::mcset de "Log Files" "Protokolldatei"
+ ::msgcat::mcset de "&No" "&Nein"
+ ::msgcat::mcset de "OK"
+ ::msgcat::mcset de "Ok"
+ ::msgcat::mcset de "Open" "\u00d6ffnen"
+ ::msgcat::mcset de "&Open" "\u00d6&ffnen"
+ ::msgcat::mcset de "Open Multiple Files"
+ ::msgcat::mcset de "Paste" "Einf\u00fcgen"
+ ::msgcat::mcset de "Quit" "Beenden"
+ ::msgcat::mcset de "&Red" "&Rot"
+ ::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen?"
+ ::msgcat::mcset de "&Retry" "&Wiederholen"
+ ::msgcat::mcset de "&Save" "&Speichern"
+ ::msgcat::mcset de "Save As" "Speichern unter"
+ ::msgcat::mcset de "Save To Log" "In Protokoll speichern"
+ ::msgcat::mcset de "Select Log File" "Protokolldatei ausw\u00e4hlen"
+ ::msgcat::mcset de "Select a file to source" "Auszuf\u00fchrende Datei ausw\u00e4hlen"
+ ::msgcat::mcset de "&Selection:" "Auswah&l:"
+ ::msgcat::mcset de "Skip Messages" "Weitere Nachrichten \u00fcberspringen"
+ ::msgcat::mcset de "Source..." "Ausf\u00fchren..."
+ ::msgcat::mcset de "Tcl Scripts" "Tcl-Skripte"
+ ::msgcat::mcset de "Tcl for Windows" "Tcl f\u00fcr Windows"
+ ::msgcat::mcset de "Text Files" "Textdateien"
+ ::msgcat::mcset de "&Yes" "&Ja"
+ ::msgcat::mcset de "abort" "abbrechen"
+ ::msgcat::mcset de "blue" "blau"
+ ::msgcat::mcset de "cancel" "abbrechen"
+ ::msgcat::mcset de "extension" "Erweiterung"
+ ::msgcat::mcset de "extensions" "Erweiterungen"
+ ::msgcat::mcset de "green" "gr\u00fcn"
+ ::msgcat::mcset de "ignore" "ignorieren"
+ ::msgcat::mcset de "ok"
+ ::msgcat::mcset de "red" "rot"
+ ::msgcat::mcset de "retry" "wiederholen"
+ ::msgcat::mcset de "yes" "ja"
+}
diff --git a/tcl/library/msgs/el.msg b/tcl/library/msgs/el.msg
new file mode 100644
index 00000000000..2e96cd96043
--- /dev/null
+++ b/tcl/library/msgs/el.msg
@@ -0,0 +1,86 @@
+## Messages for the Greek (Hellenic - "el") language.
+## Please report any changes/suggestions to:
+## petasis@iit.demokritos.gr
+
+namespace eval ::tk {
+ ::msgcat::mcset el "&Abort" "\u03a4\u03b5\u03c1\u03bc\u03b1\u03c4\u03b9\u03c3\u03bc\u03cc\u03c2"
+ ::msgcat::mcset el "About..." "\u03a3\u03c7\u03b5\u03c4\u03b9\u03ba\u03ac..."
+ ::msgcat::mcset el "All Files" "\u038c\u03bb\u03b1 \u03c4\u03b1 \u0391\u03c1\u03c7\u03b5\u03af\u03b1"
+ ::msgcat::mcset el "Application Error" "\u039b\u03ac\u03b8\u03bf\u03c2 \u0395\u03c6\u03b1\u03c1\u03bc\u03bf\u03b3\u03ae\u03c2"
+ ::msgcat::mcset el "&Blue" "\u039c\u03c0\u03bb\u03b5"
+ ::msgcat::mcset el "&Cancel" "\u0391\u03ba\u03cd\u03c1\u03c9\u03c3\u03b7"
+ ::msgcat::mcset el \
+"Cannot change to the directory \"%1\$s\".\nPermission denied." \
+"\u0394\u03b5\u03bd \u03b5\u03af\u03bd\u03b1\u03b9 \u03b4\u03c5\u03bd\u03b1\u03c4\u03ae \u03b7 \u03b1\u03bb\u03bb\u03b1\u03b3\u03ae \u03ba\u03b1\u03c4\u03b1\u03bb\u03cc\u03b3\u03bf\u03c5 \u03c3\u03b5 \"%1\$s\".\n\u0397 \u03c0\u03c1\u03cc\u03c3\u03b2\u03b1\u03c3\u03b7 \u03b4\u03b5\u03bd \u03b5\u03c0\u03b9\u03c4\u03c1\u03ad\u03c0\u03b5\u03c4\u03b1\u03b9."
+ ::msgcat::mcset el "Choose Directory" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae \u039a\u03b1\u03c4\u03b1\u03bb\u03cc\u03b3\u03bf\u03c5"
+ ::msgcat::mcset el "Clear" "\u039a\u03b1\u03b8\u03b1\u03c1\u03b9\u03c3\u03bc\u03cc\u03c2"
+ ::msgcat::mcset el "Color" "\u03a7\u03c1\u03ce\u03bc\u03b1"
+ ::msgcat::mcset el "Console" "\u039a\u03bf\u03bd\u03c3\u03cc\u03bb\u03b1"
+ ::msgcat::mcset el "Copy" "\u0391\u03bd\u03c4\u03b9\u03b3\u03c1\u03b1\u03c6\u03ae"
+ ::msgcat::mcset el "Cut" "\u0391\u03c0\u03bf\u03ba\u03bf\u03c0\u03ae"
+ ::msgcat::mcset el "Delete" "\u0394\u03b9\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae"
+ ::msgcat::mcset el "Details >>" "\u039b\u03b5\u03c0\u03c4\u03bf\u03bc\u03ad\u03c1\u03b5\u03b9\u03b5\u03c2 >>"
+ ::msgcat::mcset el "Directory \"%1\$s\" does not exist." \
+ "\u039f \u03ba\u03b1\u03c4\u03ac\u03bb\u03bf\u03b3\u03bf\u03c2 \"%1\$s\" \u03b4\u03b5\u03bd \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9."
+ ::msgcat::mcset el "&Directory:" "&\u039a\u03b1\u03c4\u03ac\u03bb\u03bf\u03b3\u03bf\u03c2:"
+ ::msgcat::mcset el "Error: %1\$s" "\u039b\u03ac\u03b8\u03bf\u03c2: %1\$s"
+ ::msgcat::mcset el "Exit" "\u0388\u03be\u03bf\u03b4\u03bf\u03c2"
+ ::msgcat::mcset el \
+ "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \
+ "\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03ae\u03b4\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9.\n\u0398\u03ad\u03bb\u03b5\u03c4\u03b5 \u03bd\u03b1 \u03b5\u03c0\u03b9\u03ba\u03b1\u03bb\u03c5\u03c6\u03b8\u03b5\u03af;"
+ ::msgcat::mcset el "File \"%1\$s\" already exists.\n\n" \
+ "\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03ae\u03b4\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9.\n\n"
+ ::msgcat::mcset el "File \"%1\$s\" does not exist." \
+ "\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03b4\u03b5\u03bd \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9."
+ ::msgcat::mcset el "File &name:" "\u038c&\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5:"
+ ::msgcat::mcset el "File &names:" "\u038c&\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03c9\u03bd:"
+ ::msgcat::mcset el "Files of &type:" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u03c4\u03bf\u03c5 &\u03c4\u03cd\u03c0\u03bf\u03c5:"
+ ::msgcat::mcset el "Fi&les:" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1:"
+ ::msgcat::mcset el "&Filter" "\u03a6\u03af\u03bb\u03c4\u03c1\u03bf"
+ ::msgcat::mcset el "Fil&ter:" "\u03a6\u03af\u03bb\u03c4\u03c1\u03bf:"
+ ::msgcat::mcset el "&Green" "\u03a0\u03c1\u03ac\u03c3\u03b9\u03bd\u03bf"
+ ::msgcat::mcset el "Hi" "\u0393\u03b5\u03b9\u03b1"
+ ::msgcat::mcset el "Hide Console" "\u0391\u03c0\u03cc\u03ba\u03c1\u03c5\u03c8\u03b7 \u03ba\u03bf\u03bd\u03c3\u03cc\u03bb\u03b1\u03c2"
+ ::msgcat::mcset el "&Ignore" "\u0391\u03b3\u03bd\u03cc\u03b7\u03c3\u03b7"
+ ::msgcat::mcset el "Invalid file name \"%1\$s\"." \
+ "\u0386\u03ba\u03c5\u03c1\u03bf \u03cc\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5 \"%1\$s\"."
+ ::msgcat::mcset el "Log Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2"
+ ::msgcat::mcset el "&No" "\u038c\u03c7\u03b9"
+ ::msgcat::mcset el "&OK" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9"
+ ::msgcat::mcset el "&Ok" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9"
+ ::msgcat::mcset el "Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1"
+ ::msgcat::mcset el "&Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1"
+ ::msgcat::mcset el "Open Multiple Files" \
+ "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1 \u03c0\u03bf\u03bb\u03bb\u03b1\u03c0\u03bb\u03ce\u03bd \u03b1\u03c1\u03c7\u03b5\u03af\u03c9\u03bd"
+ ::msgcat::mcset el "Paste" "\u0395\u03c0\u03b9\u03ba\u03cc\u03bb\u03bb\u03b7\u03c3\u03b7"
+ ::msgcat::mcset el "Quit" "\u0388\u03be\u03bf\u03b4\u03bf\u03c2"
+ ::msgcat::mcset el "&Red" "\u039a\u03cc\u03ba\u03ba\u03b9\u03bd\u03bf"
+ ::msgcat::mcset el "Replace existing file?" \
+ "\u0395\u03c0\u03b9\u03ba\u03ac\u03bb\u03c5\u03c8\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03bf\u03bd\u03c4\u03bf\u03c2 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5;"
+ ::msgcat::mcset el "&Retry" "\u03a0\u03c1\u03bf\u03c3\u03c0\u03ac\u03b8\u03b7\u03c3\u03b5 \u03be\u03b1\u03bd\u03ac"
+ ::msgcat::mcset el "&Save" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7"
+ ::msgcat::mcset el "Save As" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7 \u03c3\u03b1\u03bd"
+ ::msgcat::mcset el "Save To Log" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7 \u03c3\u03c4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \u03ba\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2"
+ ::msgcat::mcset el "Select Log File" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5 \u03ba\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2"
+ ::msgcat::mcset el "Select a file to source" \
+ "\u0395\u03c0\u03b9\u03bb\u03ad\u03be\u03c4\u03b5 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \u03b3\u03b9\u03b1 \u03b5\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7"
+ ::msgcat::mcset el "&Selection:" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae:"
+ ::msgcat::mcset el "Skip Messages" "\u0391\u03c0\u03bf\u03c6\u03c5\u03b3\u03ae \u03bc\u03c5\u03bd\u03b7\u03bc\u03ac\u03c4\u03c9\u03bd"
+ ::msgcat::mcset el "Source..." "\u0395\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7..."
+ ::msgcat::mcset el "Tcl Scripts" "Tcl Scripts"
+ ::msgcat::mcset el "Tcl for Windows" "Tcl \u03b3\u03b9\u03b1 Windows"
+ ::msgcat::mcset el "Text Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b5\u03b9\u03bc\u03ad\u03bd\u03bf\u03c5"
+ ::msgcat::mcset el "&Yes" "\u039d\u03b1\u03b9"
+ ::msgcat::mcset el "abort" "\u03c4\u03b5\u03c1\u03bc\u03b1\u03c4\u03b9\u03c3\u03bc\u03cc\u03c2"
+ ::msgcat::mcset el "blue" "\u03bc\u03c0\u03bb\u03b5"
+ ::msgcat::mcset el "cancel" "\u03b1\u03ba\u03cd\u03c1\u03c9\u03c3\u03b7"
+ ::msgcat::mcset el "extension" "\u03b5\u03c0\u03ad\u03ba\u03c4\u03b1\u03c3\u03b7"
+ ::msgcat::mcset el "extensions" "\u03b5\u03c0\u03b5\u03ba\u03c4\u03ac\u03c3\u03b5\u03b9\u03c2"
+ ::msgcat::mcset el "green" "\u03c0\u03c1\u03ac\u03c3\u03b9\u03bd\u03bf"
+ ::msgcat::mcset el "ignore" "\u03b1\u03b3\u03bd\u03cc\u03b7\u03c3\u03b7"
+ ::msgcat::mcset el "ok" "\u03b5\u03bd\u03c4\u03ac\u03be\u03b5\u03b9"
+ ::msgcat::mcset el "red" "\u03ba\u03cc\u03ba\u03ba\u03b9\u03bd\u03bf"
+ ::msgcat::mcset el "retry" "\u03c0\u03c1\u03bf\u03c3\u03c0\u03ac\u03b8\u03b7\u03c3\u03b5 \u03be\u03b1\u03bd\u03ac"
+ ::msgcat::mcset el "yes" "\u03bd\u03b1\u03b9"
+}
+
diff --git a/tcl/library/msgs/en.msg b/tcl/library/msgs/en.msg
new file mode 100644
index 00000000000..7242f913ce2
--- /dev/null
+++ b/tcl/library/msgs/en.msg
@@ -0,0 +1,70 @@
+namespace eval ::tk {
+ ::msgcat::mcset en "&Abort"
+ ::msgcat::mcset en "About..."
+ ::msgcat::mcset en "All Files"
+ ::msgcat::mcset en "Application Error"
+ ::msgcat::mcset en "&Blue"
+ ::msgcat::mcset en "&Cancel"
+ ::msgcat::mcset en "Cannot change to the directory \"%1\$s\".\nPermission denied."
+ ::msgcat::mcset en "Choose Directory"
+ ::msgcat::mcset en "Clear"
+ ::msgcat::mcset en "Color"
+ ::msgcat::mcset en "Console"
+ ::msgcat::mcset en "Copy"
+ ::msgcat::mcset en "Cut"
+ ::msgcat::mcset en "Delete"
+ ::msgcat::mcset en "Details >>"
+ ::msgcat::mcset en "Directory \"%1\$s\" does not exist."
+ ::msgcat::mcset en "&Directory:"
+ ::msgcat::mcset en "Error: %1\$s"
+ ::msgcat::mcset en "Exit"
+ ::msgcat::mcset en "File \"%1\$s\" already exists.\nDo you want to overwrite it?"
+ ::msgcat::mcset en "File \"%1\$s\" already exists.\n\n"
+ ::msgcat::mcset en "File \"%1\$s\" does not exist."
+ ::msgcat::mcset en "File &name:"
+ ::msgcat::mcset en "File &names:"
+ ::msgcat::mcset en "Files of &type:"
+ ::msgcat::mcset en "Fi&les:"
+ ::msgcat::mcset en "&Filter"
+ ::msgcat::mcset en "Fil&ter:"
+ ::msgcat::mcset en "&Green"
+ ::msgcat::mcset en "Hi"
+ ::msgcat::mcset en "Hide Console"
+ ::msgcat::mcset en "&Ignore"
+ ::msgcat::mcset en "Invalid file name \"%1\$s\"."
+ ::msgcat::mcset en "Log Files"
+ ::msgcat::mcset en "&No"
+ ::msgcat::mcset en "&OK"
+ ::msgcat::mcset en "Ok"
+ ::msgcat::mcset en "Open"
+ ::msgcat::mcset en "&Open"
+ ::msgcat::mcset en "Open Multiple Files"
+ ::msgcat::mcset en "Paste"
+ ::msgcat::mcset en "Quit"
+ ::msgcat::mcset en "&Red"
+ ::msgcat::mcset en "Replace existing file?"
+ ::msgcat::mcset en "&Retry"
+ ::msgcat::mcset en "&Save"
+ ::msgcat::mcset en "Save As"
+ ::msgcat::mcset en "Save To Log"
+ ::msgcat::mcset en "Select Log File"
+ ::msgcat::mcset en "Select a file to source"
+ ::msgcat::mcset en "&Selection:"
+ ::msgcat::mcset en "Skip Messages"
+ ::msgcat::mcset en "Source..."
+ ::msgcat::mcset en "Tcl Scripts"
+ ::msgcat::mcset en "Tcl for Windows"
+ ::msgcat::mcset en "Text Files"
+ ::msgcat::mcset en "&Yes"
+ ::msgcat::mcset en "abort"
+ ::msgcat::mcset en "blue"
+ ::msgcat::mcset en "cancel"
+ ::msgcat::mcset en "extension"
+ ::msgcat::mcset en "extensions"
+ ::msgcat::mcset en "green"
+ ::msgcat::mcset en "ignore"
+ ::msgcat::mcset en "ok"
+ ::msgcat::mcset en "red"
+ ::msgcat::mcset en "retry"
+ ::msgcat::mcset en "yes"
+}
diff --git a/tcl/library/msgs/en_gb.msg b/tcl/library/msgs/en_gb.msg
new file mode 100644
index 00000000000..efafa38c6d7
--- /dev/null
+++ b/tcl/library/msgs/en_gb.msg
@@ -0,0 +1,3 @@
+namespace eval ::tk {
+ ::msgcat::mcset en_gb Color Colour
+}
diff --git a/tcl/library/msgs/es.msg b/tcl/library/msgs/es.msg
new file mode 100644
index 00000000000..7de0faef215
--- /dev/null
+++ b/tcl/library/msgs/es.msg
@@ -0,0 +1,70 @@
+namespace eval ::tk {
+ ::msgcat::mcset es "&Abort" "&Abortar"
+ ::msgcat::mcset es "About..." "Acerca de ..."
+ ::msgcat::mcset es "All Files" "Todos los archivos"
+ ::msgcat::mcset es "Application Error" "Error de la aplicaci\u00f3n"
+ ::msgcat::mcset es "&Blue" "&Azul"
+ ::msgcat::mcset es "&Cancel" "&Cancelar"
+ ::msgcat::mcset es "Cannot change to the directory \"%1\$s\".\nPermission denied." "No es posible acceder al directorio \"%1\$s\".\nPermiso denegado."
+ ::msgcat::mcset es "Choose Directory" "Elegir directorio"
+ ::msgcat::mcset es "Clear" "Borrar"
+ ::msgcat::mcset es "Color" "Color"
+ ::msgcat::mcset es "Console" "Consola"
+ ::msgcat::mcset es "Copy" "Copiar"
+ ::msgcat::mcset es "Cut" "Cortar"
+ ::msgcat::mcset es "Delete" "Borrar"
+ ::msgcat::mcset es "Details >>" "Detalles >>"
+ ::msgcat::mcset es "Directory \"%1\$s\" does not exist." "El directorio \"%1\$s\" no existe."
+ ::msgcat::mcset es "&Directory:" "&Directorio:"
+ ::msgcat::mcset es "Error: %1\$s" "Error: %1\$s"
+ ::msgcat::mcset es "Exit" "Salir"
+ ::msgcat::mcset es "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "El archivo \"%1\$s\" ya existe.\nDesea sobreescribirlo?"
+ ::msgcat::mcset es "File \"%1\$s\" already exists.\n\n" "El archivo \"%1\$s\" ya existe.\n\n"
+ ::msgcat::mcset es "File \"%1\$s\" does not exist." "El archivo \"%1\$s\" no existe."
+ ::msgcat::mcset es "File &name:" "&Nombre de archivo:"
+ ::msgcat::mcset es "File &names:" "&Nombres de archivo:"
+ ::msgcat::mcset es "Files of &type:" "Archivos de &tipo:"
+ ::msgcat::mcset es "Fi&les:" "&Archivos:"
+ ::msgcat::mcset es "&Filter" "&Filtro"
+ ::msgcat::mcset es "Fil&ter:" "Fil&tro:"
+ ::msgcat::mcset es "&Green" "&Verde"
+ ::msgcat::mcset es "Hi" "Hola"
+ ::msgcat::mcset es "Hide Console" "Esconder la consola"
+ ::msgcat::mcset es "&Ignore" "&Ignorar"
+ ::msgcat::mcset es "Invalid file name \"%1\$s\"." "Nombre de archivo inv\u00e1lido \"%1\$s\"."
+ ::msgcat::mcset es "Log Files" "Ficheros de traza"
+ ::msgcat::mcset es "&No" "&No"
+ ::msgcat::mcset es "&OK" "&OK"
+ ::msgcat::mcset es "Ok" "Ok"
+ ::msgcat::mcset es "Open" "Abrir"
+ ::msgcat::mcset es "&Open" "&Abrir"
+ ::msgcat::mcset es "Open Multiple Files" "Abrir m\u00faltiples archivos"
+ ::msgcat::mcset es "Paste" "Pegar"
+ ::msgcat::mcset es "Quit" "Abandonar"
+ ::msgcat::mcset es "&Red" "&Rojo"
+ ::msgcat::mcset es "Replace existing file?" "Reemplazar el archivo existente?"
+ ::msgcat::mcset es "&Retry" "&Reintentar"
+ ::msgcat::mcset es "&Save" "&Salvar"
+ ::msgcat::mcset es "Save As" "Salvar como"
+ ::msgcat::mcset es "Save To Log" "Salvar al archivo de traza"
+ ::msgcat::mcset es "Select Log File" "Elegir un archivo de traza"
+ ::msgcat::mcset es "Select a file to source" "Seleccionar un archivo a evaluar"
+ ::msgcat::mcset es "&Selection:" "&Selecci\u00f3n:"
+ ::msgcat::mcset es "Skip Messages" "Omitir los mensajes"
+ ::msgcat::mcset es "Source..." "Evaluar..."
+ ::msgcat::mcset es "Tcl Scripts" "Scripts Tcl"
+ ::msgcat::mcset es "Tcl for Windows" "Tcl para Windows"
+ ::msgcat::mcset es "Text Files" "Archivos de texto"
+ ::msgcat::mcset es "&Yes" "&S\u00ed"
+ ::msgcat::mcset es "abort" "abortar"
+ ::msgcat::mcset es "blue" "azul"
+ ::msgcat::mcset es "cancel" "cancelar"
+ ::msgcat::mcset es "extension" "extensi\u00f3n"
+ ::msgcat::mcset es "extensions" "extensiones"
+ ::msgcat::mcset es "green" "verde"
+ ::msgcat::mcset es "ignore" "ignorar"
+ ::msgcat::mcset es "ok" "ok"
+ ::msgcat::mcset es "red" "rojo"
+ ::msgcat::mcset es "retry" "reintentar"
+ ::msgcat::mcset es "yes" "s\u00ed"
+}
diff --git a/tcl/library/msgs/fr.msg b/tcl/library/msgs/fr.msg
new file mode 100644
index 00000000000..6dba60afbea
--- /dev/null
+++ b/tcl/library/msgs/fr.msg
@@ -0,0 +1,70 @@
+namespace eval ::tk {
+ ::msgcat::mcset fr "&Abort" "&Annuler"
+ ::msgcat::mcset fr "About..." "\u00c0 propos..."
+ ::msgcat::mcset fr "All Files" "Tous les fichiers"
+ ::msgcat::mcset fr "Application Error" "Erreur d'application"
+ ::msgcat::mcset fr "&Blue" "&Bleu"
+ ::msgcat::mcset fr "&Cancel" "&Annuler"
+ ::msgcat::mcset fr "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossible d'acc\u00e9der au r\u00e9pertoire \"%1\$s\".\nPermission refus\u00e9e."
+ ::msgcat::mcset fr "Choose Directory" "Choisir r\u00e9pertoire"
+ ::msgcat::mcset fr "Clear" "Effacer"
+ ::msgcat::mcset fr "Color" "Couleur"
+ ::msgcat::mcset fr "Console"
+ ::msgcat::mcset fr "Copy" "Copier"
+ ::msgcat::mcset fr "Cut" "Couper"
+ ::msgcat::mcset fr "Delete" "Effacer"
+ ::msgcat::mcset fr "Details >>" "D\u00e9tails >>"
+ ::msgcat::mcset fr "Directory \"%1\$s\" does not exist."
+ ::msgcat::mcset fr "&Directory:" "&R\u00e9pertoire:"
+ ::msgcat::mcset fr "Error: %1\$s"
+ ::msgcat::mcset fr "Exit"
+ ::msgcat::mcset fr "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\nVoulez-vous l'\u00e9craser?"
+ ::msgcat::mcset fr "File \"%1\$s\" already exists.\n\n" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\n\n"
+ ::msgcat::mcset fr "File \"%1\$s\" does not exist." "Le fichier \"%1\$s\" n'existe pas."
+ ::msgcat::mcset fr "File &name:" "&Nom de fichier:"
+ ::msgcat::mcset fr "File &names:" "&Noms de fichiers:"
+ ::msgcat::mcset fr "Files of &type:" "&Type de fichiers:"
+ ::msgcat::mcset fr "Fi&les:" "Fich&iers:"
+ ::msgcat::mcset fr "&Filter" "&Filtre"
+ ::msgcat::mcset fr "Fil&ter:" "Fil&tre:"
+ ::msgcat::mcset fr "&Green" "&Vert"
+ ::msgcat::mcset fr "Hi" "All\u00f4"
+ ::msgcat::mcset fr "Hide Console" "Cacher la Console"
+ ::msgcat::mcset fr "&Ignore" "&Ignorer"
+ ::msgcat::mcset fr "Invalid file name \"%1\$s\"." "Nom de fichier invalide \"%1\$s\"."
+ ::msgcat::mcset fr "Log Files" "Fichiers de trace"
+ ::msgcat::mcset fr "&No" "&Non"
+ ::msgcat::mcset fr "&OK"
+ ::msgcat::mcset fr "Ok"
+ ::msgcat::mcset fr "Open" "Ouvrir"
+ ::msgcat::mcset fr "&Open" "&Ouvrir"
+ ::msgcat::mcset fr "Open Multiple Files" "Ouvrir plusieurs fichiers"
+ ::msgcat::mcset fr "Paste" "Coller"
+ ::msgcat::mcset fr "Quit" "Abandonner"
+ ::msgcat::mcset fr "&Red" "&Rouge"
+ ::msgcat::mcset fr "Replace existing file?" "Remplacer fichier existant?"
+ ::msgcat::mcset fr "&Retry" "&R\u00e9-essayer"
+ ::msgcat::mcset fr "&Save" "&Sauvegarder"
+ ::msgcat::mcset fr "Save As" "Sauvegarder sous"
+ ::msgcat::mcset fr "Save To Log" "Sauvegarde au fichier de trace"
+ ::msgcat::mcset fr "Select Log File" "Choisir un fichier de trace"
+ ::msgcat::mcset fr "Select a file to source" "Choisir un fichier \u00e0 \u00e9valuer"
+ ::msgcat::mcset fr "&Selection:" "&S\u00e9lection:"
+ ::msgcat::mcset fr "Skip Messages" "Omettre les messages"
+ ::msgcat::mcset fr "Source..." "\u00c9valuer..."
+ ::msgcat::mcset fr "Tcl Scripts" "Scripts Tcl"
+ ::msgcat::mcset fr "Tcl for Windows" "Tcl pour Windows"
+ ::msgcat::mcset fr "Text Files" "Fichiers texte"
+ ::msgcat::mcset fr "&Yes" "&Oui"
+ ::msgcat::mcset fr "abort" "annuler"
+ ::msgcat::mcset fr "blue" "bleu"
+ ::msgcat::mcset fr "cancel" "annuler"
+ ::msgcat::mcset fr "extension"
+ ::msgcat::mcset fr "extensions"
+ ::msgcat::mcset fr "green" "vert"
+ ::msgcat::mcset fr "ignore" "ignorer"
+ ::msgcat::mcset fr "ok"
+ ::msgcat::mcset fr "red" "rouge"
+ ::msgcat::mcset fr "retry" "r\u00e9-essayer"
+ ::msgcat::mcset fr "yes" "oui"
+}
diff --git a/tcl/library/msgs/it.msg b/tcl/library/msgs/it.msg
new file mode 100644
index 00000000000..9e6298b8d79
--- /dev/null
+++ b/tcl/library/msgs/it.msg
@@ -0,0 +1,70 @@
+namespace eval ::tk {
+ ::msgcat::mcset it "&Abort" "&Interrompi"
+ ::msgcat::mcset it "About..." "Informazioni ..."
+ ::msgcat::mcset it "All Files" "Tutti i file"
+ ::msgcat::mcset it "Application Error" "Errore dell' applicazione"
+ ::msgcat::mcset it "&Blue" "&Blu"
+ ::msgcat::mcset it "&Cancel" "&Annulla"
+ ::msgcat::mcset it "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossibile accedere alla directory \"%1\$s\".\nPermesso negato."
+ ::msgcat::mcset it "Choose Directory" "Scegli directory"
+ ::msgcat::mcset it "Clear" "Azzera"
+ ::msgcat::mcset it "Color" "Colore"
+ ::msgcat::mcset it "Console"
+ ::msgcat::mcset it "Copy" "Copia"
+ ::msgcat::mcset it "Cut" "Taglia"
+ ::msgcat::mcset it "Delete" "Incolla"
+ ::msgcat::mcset it "Details >>" "Dettagli >>"
+ ::msgcat::mcset it "Directory \"%1\$s\" does not exist." "La directory \"%1\$s\" non esiste."
+ ::msgcat::mcset it "&Directory:"
+ ::msgcat::mcset it "Error: %1\$s" "Errore: %1\$s"
+ ::msgcat::mcset it "Exit" "Esci"
+ ::msgcat::mcset it "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Il file \"%1\$s\" esiste gi\u00e0.\nVuoi sovrascriverlo?"
+ ::msgcat::mcset it "File \"%1\$s\" already exists.\n\n" "Il file \"%1\$s\" esiste gi\u00e0.\n\n"
+ ::msgcat::mcset it "File \"%1\$s\" does not exist." "Il file \"%1\$s\" non esiste."
+ ::msgcat::mcset it "File &name:" "&Nome del file:"
+ ::msgcat::mcset it "File &names:" "&Nomi dei file:"
+ ::msgcat::mcset it "Files of &type:" "File di &tipo:"
+ ::msgcat::mcset it "Fi&les:" "Fi&le:"
+ ::msgcat::mcset it "&Filter" "&Filtro"
+ ::msgcat::mcset it "Fil&ter:" "Fil&tro:"
+ ::msgcat::mcset it "&Green" "&Verde"
+ ::msgcat::mcset it "Hi" "Salve"
+ ::msgcat::mcset it "Hide Console" "Nascondi la console"
+ ::msgcat::mcset it "&Ignore" "&Ignora"
+ ::msgcat::mcset it "Invalid file name \"%1\$s\"." "Nome di file non valido \"%1\$s\"."
+ ::msgcat::mcset it "Log Files" "File di log"
+ ::msgcat::mcset it "&No"
+ ::msgcat::mcset it "&OK"
+ ::msgcat::mcset it "Ok"
+ ::msgcat::mcset it "&Open" "A&pri"
+ ::msgcat::mcset it "Open" "Apri"
+ ::msgcat::mcset it "Open Multiple Files" "Apri file multipli"
+ ::msgcat::mcset it "Paste" "Incolla"
+ ::msgcat::mcset it "Quit" "Esci"
+ ::msgcat::mcset it "&Red" "&Rosso"
+ ::msgcat::mcset it "Replace existing file?" "Sostituisci il file esistente?"
+ ::msgcat::mcset it "&Retry" "&Riprova"
+ ::msgcat::mcset it "&Save" "&Salva"
+ ::msgcat::mcset it "Save As" "Salva come"
+ ::msgcat::mcset it "Save To Log" "Salva il log"
+ ::msgcat::mcset it "Select Log File" "Scegli un file di log"
+ ::msgcat::mcset it "Select a file to source" "Scegli un file da eseguire"
+ ::msgcat::mcset it "&Selection:" "&Selezione:"
+ ::msgcat::mcset it "Skip Messages" "Salta i messaggi"
+ ::msgcat::mcset it "Source..." "Esegui..."
+ ::msgcat::mcset it "Tcl Scripts" "Scripts Tcl"
+ ::msgcat::mcset it "Tcl for Windows" "Tcl per Windows"
+ ::msgcat::mcset it "Text Files" "File di testo"
+ ::msgcat::mcset it "&Yes" "&Si"
+ ::msgcat::mcset it "abort" "interrompi"
+ ::msgcat::mcset it "blue" "blu"
+ ::msgcat::mcset it "cancel" "annulla"
+ ::msgcat::mcset it "extension" "estensione"
+ ::msgcat::mcset it "extensions" "estensioni"
+ ::msgcat::mcset it "green" "verde"
+ ::msgcat::mcset it "ignore" "ignora"
+ ::msgcat::mcset it "ok"
+ ::msgcat::mcset it "red" "rosso"
+ ::msgcat::mcset it "retry" "riprova"
+ ::msgcat::mcset it "yes" "si"
+}
diff --git a/tcl/library/msgs/nl.msg b/tcl/library/msgs/nl.msg
new file mode 100644
index 00000000000..daad8474bf0
--- /dev/null
+++ b/tcl/library/msgs/nl.msg
@@ -0,0 +1,106 @@
+namespace eval ::tk {
+ ::msgcat::mcset nl "\"%1\$s\" must be an absolute pathname" "\"%1\$s\" moet een absolute pad-naam zijn"
+ ::msgcat::mcset nl "%1\$s is not a toplevel window" "%1\$s is geen toplevel window"
+ ::msgcat::mcset nl ", or" ", of"
+ ::msgcat::mcset nl "-default, -icon, -message, -parent, -title, or -type" "-default, -icon, -message, -parent, -title, of -type"
+ ::msgcat::mcset nl "-initialdir, -mustexist, -parent, or -title" "-initialdir, -mustexist, -parent, of -title"
+ ::msgcat::mcset nl "&Abort" "&Afbreken"
+ ::msgcat::mcset nl "About..." "Over..."
+ ::msgcat::mcset nl "All Files" "Alle Bestanden"
+ ::msgcat::mcset nl "Application Error" "Toepassingsfout"
+ ::msgcat::mcset nl "&Blue" "&Blauw"
+ ::msgcat::mcset nl "&Cancel" "&Annuleren"
+ ::msgcat::mcset nl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan niet naar map \"%1\$s\" gaan.\nU heeft geen toestemming hiervoor."
+ ::msgcat::mcset nl "Choose Directory" "Kies map"
+ ::msgcat::mcset nl "Clear" "Wissen"
+ ::msgcat::mcset nl "Clear entry, Press OK; Enter %1\$s, press OK" "Wis veld, Druk op OK; Geef %1\$s in, druk op OK"
+ ::msgcat::mcset nl "Color" "Kleur"
+ ::msgcat::mcset nl "Console"
+ ::msgcat::mcset nl "Copy" "Copi\u00ebren"
+ ::msgcat::mcset nl "Cut" "Knippen"
+ ::msgcat::mcset nl "Delete" "Wissen"
+ ::msgcat::mcset nl "Details"
+ ::msgcat::mcset nl "Details >>"
+ ::msgcat::mcset nl "Directory \"%1\$s\" does not exist." "Map \"%1\$s\" bestaat niet."
+ ::msgcat::mcset nl "&Directory:" "&Map:"
+ ::msgcat::mcset nl "Enter \"%1\$s\", press OK" "Toets \"%1\$s\", druk op OK"
+ ::msgcat::mcset nl "Enter \"%1\$s\", press OK, enter \"%2\$s\", press OK" "Toets \"%1\$s\", druk op OK, toets \"%2\$s\", druk op OK"
+ ::msgcat::mcset nl "Error: %1\$s" "Fout: %1\$s"
+ ::msgcat::mcset nl "Exit" "Be\u00ebindigen"
+ ::msgcat::mcset nl "File \"%1\$s\" already exists.\n\n" "Bestand \"%1\$s\" bestaat al.\n\n"
+ ::msgcat::mcset nl "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Bestand \"%1\$s\" bestaat al.\nWilt u het overschrijven?"
+ ::msgcat::mcset nl "File \"%1\$s\" does not exist." "Bestand \"%1\$s\" bestaat niet."
+ ::msgcat::mcset nl "File &name:" "Bestands&naam:"
+ ::msgcat::mcset nl "File &names:" "Bestands&namen:"
+ ::msgcat::mcset nl "Files of &type:" "Bestanden van het &type:"
+ ::msgcat::mcset nl "Fi&les:" "&Bestanden:"
+ ::msgcat::mcset nl "&Filter"
+ ::msgcat::mcset nl "Fil&ter:"
+ ::msgcat::mcset nl "&Green" "&Groen"
+ ::msgcat::mcset nl "Hi" "H\u00e9"
+ ::msgcat::mcset nl "Hide Console" "Verberg Console"
+ ::msgcat::mcset nl "&Ignore"
+ ::msgcat::mcset nl "Invalid file name \"%1\$s\"." "Ongeldige bestandsnaam \"%1\$s\"."
+ ::msgcat::mcset nl "Log Files" "Log Bestanden"
+ ::msgcat::mcset nl "&No" "&Nee"
+ ::msgcat::mcset nl "&OK"
+ ::msgcat::mcset nl "Ok"
+ ::msgcat::mcset nl "&Open" "&Openen"
+ ::msgcat::mcset nl "Open" "Openen"
+ ::msgcat::mcset nl "Open Multiple Files" "Open meerdere bestanden"
+ ::msgcat::mcset nl "Paste" "Plakken"
+ ::msgcat::mcset nl "Please press %1\$s" "Druk op %1\$s, A.U.B."
+ ::msgcat::mcset nl "Please press ok" "Druk op ok, A.U.B."
+ ::msgcat::mcset nl "Press Cancel" "Druk op Annuleren"
+ ::msgcat::mcset nl "Press Ok" "Druk op Ok"
+ ::msgcat::mcset nl "Quit" "Stoppen"
+ ::msgcat::mcset nl "&Red" "&Rood"
+ ::msgcat::mcset nl "Replace existing file?" "Vervang bestaand bestand?"
+ ::msgcat::mcset nl "&Retry" "O&nieuw"
+ ::msgcat::mcset nl "&Save" "Op&slaan"
+ ::msgcat::mcset nl "Save As" "Opslaan als"
+ ::msgcat::mcset nl "Save To Log" "Opslaan naar Log"
+ ::msgcat::mcset nl "Select Log File" "Selecteer Log bestand"
+ ::msgcat::mcset nl "Select a file to source" "Selecteer bronbestand"
+ ::msgcat::mcset nl "&Selection:" "&Selectie:"
+ ::msgcat::mcset nl "Skip Messages" "Berichten overslaan"
+ ::msgcat::mcset nl "Source..." "Bron..."
+ ::msgcat::mcset nl "Tcl Scripts"
+ ::msgcat::mcset nl "Tcl for Windows" "Tcl voor Windows"
+ ::msgcat::mcset nl "Text Files" "Tekst Bestanden"
+ ::msgcat::mcset nl "&Yes" "&Ja"
+ ::msgcat::mcset nl "abort" "afbreken"
+ ::msgcat::mcset nl "abort, retry, ignore, ok, cancel, no, or yes" "afbreken, opnieuw, negeren, ok, annuleren, nee, of ja"
+ ::msgcat::mcset nl "abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel" "abortretryignore, ok, okcancel, retrycancel, yesno, of yesnocancel"
+ ::msgcat::mcset nl "bad %1\$s value \"%2\$s\": must be %3\$s" "foutieve %1\$s waarde \"%2\$s\": moet zijn %3\$s"
+ ::msgcat::mcset nl "bad file type \"%1\$s\", should be" "foutief bestandstype \"%1\$s\", moet zijn"
+ ::msgcat::mcset nl "bad option \"%1\$s\": should be %2\$s" "foutieve optie \"%1\$s\": moet zijn %2\$s"
+ ::msgcat::mcset nl "bad window path name \"%1\$s\"" "foutieve window pad naam \"%1\$s\""
+ ::msgcat::mcset nl "blue" "blauw"
+ ::msgcat::mcset nl "can't post %1\$s: it isn't a descendant of %2\$s (this is a new requirement in Tk versions 3.0 and later)" "kan %1\$s niet verzenden: het is geen afstammeling van %2\$s (dit is een niewe verplichting in Tk versies 3.0 en later)"
+ ::msgcat::mcset nl "cancel" "annuleren"
+ ::msgcat::mcset nl "default button index greater than number of buttons specified for tk_dialog" "default knop index is groter dan het aantal knoppen beschikbaar voor tk_dialog"
+ ::msgcat::mcset nl "display name to use (current one otherwise)" "te gebruiken schermnaam (anders huidige scherm)"
+ ::msgcat::mcset nl "error, info, question, or warning" "error, info, question, of warning"
+ ::msgcat::mcset nl "extension"
+ ::msgcat::mcset nl "extensions"
+ ::msgcat::mcset nl "focus group \"%1\$s\" doesn't exist" "focus groep \"%1\$s\" bestaat niet"
+ ::msgcat::mcset nl "green" "groen"
+ ::msgcat::mcset nl "history event %1\$s"
+ ::msgcat::mcset nl "ignore" "negeren"
+ ::msgcat::mcset nl "invalid default button \"%1\$s\"" "ongeldige default knop \"%1\$s\""
+ ::msgcat::mcset nl "macType"
+ ::msgcat::mcset nl "macTypes"
+ ::msgcat::mcset nl "must specify a background color" "een achtergrondkleur is verplicht"
+ ::msgcat::mcset nl "name of the slave interpreter" "naam van de slaaf interpreter"
+ ::msgcat::mcset nl "no winfo screen . nor env(DISPLAY)" "geen winfo scherm . noch env(DISPLAY)"
+ ::msgcat::mcset nl "ok"
+ ::msgcat::mcset nl "red" "rood"
+ ::msgcat::mcset nl "retry" "opnieuw"
+ ::msgcat::mcset nl "should contain 5 or 4 elements" "moet 4 of 5 elementen bevatten"
+ ::msgcat::mcset nl "spec"
+ ::msgcat::mcset nl "tk_chooseDirectory command" "tk_chooseDirectory commando"
+ ::msgcat::mcset nl "tk_chooseDirectory command, cancel gives null" "tk_chooseDirectory commando, annuleren geeft lege waarde"
+ ::msgcat::mcset nl "tk_chooseDirectory command, initialdir" "tk_chooseDirectory commando, initi\u00eble map"
+ ::msgcat::mcset nl "yes" "ja"
+}
diff --git a/tcl/library/msgs/ru.msg b/tcl/library/msgs/ru.msg
new file mode 100644
index 00000000000..9f6aa807e0a
--- /dev/null
+++ b/tcl/library/msgs/ru.msg
@@ -0,0 +1,73 @@
+namespace eval ::tk {
+ ::msgcat::mcset ru "&Abort" "&\u041e\u0442\u043c\u0435\u043d\u0438\u0442\u044c"
+ ::msgcat::mcset ru "About..." "\u041f\u0440\u043e..."
+ ::msgcat::mcset ru "All Files" "\u0412\u0441\u0435 \u0444\u0430\u0439\u043b\u044b"
+ ::msgcat::mcset ru "Application Error" "\u041e\u0448\u0438\u0431\u043a\u0430 \u0432 \u043f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0435"
+ ::msgcat::mcset ru "&Blue" " &\u0413\u043e\u043b\u0443\u0431\u043e\u0439"
+ ::msgcat::mcset ru "&Cancel" "\u041e\u0442&\u043c\u0435\u043d\u0430"
+ ::msgcat::mcset ru "Cannot change to the directory \"%1\$s\".\nPermission denied." \
+ "\u041d\u0435 \u043c\u043e\u0433\u0443 \u043f\u0435\u0440\u0435\u0439\u0442\u0438 \u0432 \u043a\u0430\u0442\u0430\u043b\u043e\u0433 \"%1\$s\".\n\u041d\u0435\u0434\u043e\u0441\u0442\u0430\u0442\u043e\u0447\u043d\u043e \u043f\u0440\u0430\u0432 \u0434\u043e\u0441\u0442\u0443\u043f\u0430"
+ ::msgcat::mcset ru "Choose Directory" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u043a\u0430\u0442\u0430\u043b\u043e\u0433"
+ ::msgcat::mcset ru "Clear" "\u041e\u0447\u0438\u0441\u0442\u0438\u0442\u044c"
+ ::msgcat::mcset ru "Color" "\u0426\u0432\u0435\u0442"
+ ::msgcat::mcset ru "Console" "\u041a\u043e\u043d\u0441\u043e\u043b\u044c"
+ ::msgcat::mcset ru "Copy" "\u041a\u043e\u043f\u0438\u0440\u043e\u0432\u0430\u0442\u044c"
+ ::msgcat::mcset ru "Cut" "\u0412\u044b\u0440\u0435\u0437\u0430\u0442\u044c"
+ ::msgcat::mcset ru "Delete" "\u0423\u0434\u0430\u043b\u0438\u0442\u044c"
+ ::msgcat::mcset ru "Details >>" "\u041f\u043e\u0434\u0440\u043e\u0431\u043d\u0435\u0435 >>"
+ ::msgcat::mcset ru "Directory \"%1\$s\" does not exist." "\u041a\u0430\u0442\u0430\u043b\u043e\u0433\u0430 \"%1\$s\" \u043d\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442."
+ ::msgcat::mcset ru "&Directory:" "&\u041a\u0430\u0442\u0430\u043b\u043e\u0433:"
+ ::msgcat::mcset ru "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s"
+ ::msgcat::mcset ru "Exit" "\u0412\u044b\u0445\u043e\u0434"
+ ::msgcat::mcset ru "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \
+ "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0435\u0433\u043e?"
+ ::msgcat::mcset ru "File \"%1\$s\" already exists.\n\n" "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\n"
+ ::msgcat::mcset ru "File \"%1\$s\" does not exist." "\u0424\u0430\u0439\u043b \"%1\$s\" \u043d\u0435 \u043d\u0430\u0439\u0434\u0435\u043d."
+ ::msgcat::mcset ru "File &name:" "&\u0418\u043c\u044f \u0444\u0430\u0439\u043b\u0430:"
+ ::msgcat::mcset ru "File &names:" "&\u0418\u043c\u0435\u043d\u0430 \u0444\u0430\u0439\u043b\u043e\u0432:"
+ ::msgcat::mcset ru "Files of &type:" "&\u0422\u0438\u043f \u0444\u0430\u0439\u043b\u043e\u0432:"
+ ::msgcat::mcset ru "Fi&les:" "\u0424\u0430\u0439&\u043b\u044b:"
+ ::msgcat::mcset ru "&Filter" "&\u0424\u0438\u043b\u044c\u0442\u0440"
+ ::msgcat::mcset ru "Fil&ter:" "\u0424\u0438\u043b\u044c&\u0442\u0440:"
+ ::msgcat::mcset ru "&Green" " &\u0417\u0435\u043b\u0435\u043d\u044b\u0439"
+ ::msgcat::mcset ru "Hi" "\u041f\u0440\u0438\u0432\u0435\u0442"
+ ::msgcat::mcset ru "Hide Console" "\u0421\u043f\u0440\u044f\u0442\u0430\u0442\u044c \u043a\u043e\u043d\u0441\u043e\u043b\u044c"
+ ::msgcat::mcset ru "&Ignore" "&\u0418\u0433\u043d\u043e\u0440\u0438\u0440\u043e\u0432\u0430\u0442\u044c"
+ ::msgcat::mcset ru "Invalid file name \"%1\$s\"." "\u041d\u0435\u0432\u0435\u0440\u043d\u043e\u0435 \u0438\u043c\u044f \u0444\u0430\u0439\u043b\u0430 \"%1\$s\"."
+ ::msgcat::mcset ru "Log Files" "\u0424\u0430\u0439\u043b\u044b \u0436\u0443\u0440\u043d\u0430\u043b\u0430"
+ ::msgcat::mcset ru "&No" "&\u041d\u0435\u0442"
+ ::msgcat::mcset ru "&OK" "&\u041e\u041a"
+ ::msgcat::mcset ru "Ok" "\u0414\u0430"
+ ::msgcat::mcset ru "Open" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c"
+ ::msgcat::mcset ru "&Open" "&\u041e\u0442\u043a\u0440\u044b\u0442\u044c"
+ ::msgcat::mcset ru "Open Multiple Files" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c \u043d\u0435\u0441\u043a\u043e\u043b\u044c\u043a\u043e \u0444\u0430\u0439\u043b\u043e\u0432"
+ ::msgcat::mcset ru "Paste" "\u0412\u0441\u0442\u0430\u0432\u0438\u0442\u044c"
+ ::msgcat::mcset ru "Quit" "\u0412\u044b\u0445\u043e\u0434"
+ ::msgcat::mcset ru "&Red" " &\u041a\u0440\u0430\u0441\u043d\u044b\u0439"
+ ::msgcat::mcset ru "Replace existing file?" "\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u044e\u0449\u0438\u0439 \u0444\u0430\u0439\u043b?"
+ ::msgcat::mcset ru "&Retry" "&\u041f\u043e\u0432\u0442\u043e\u0440\u0438\u0442\u044c"
+ ::msgcat::mcset ru "&Save" "&\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c"
+ ::msgcat::mcset ru "Save As" "\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c \u043a\u0430\u043a"
+ ::msgcat::mcset ru "Save To Log" "\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c \u0432 \u0436\u0443\u0440\u043d\u0430\u043b"
+ ::msgcat::mcset ru "Select Log File" "\u0412\u044b\u0431\u0440\u0430\u0442\u044c \u0436\u0443\u0440\u043d\u0430\u043b"
+ ::msgcat::mcset ru "Select a file to source" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u0444\u0430\u0439\u043b \u0434\u043b\u044f \u0438\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0430\u0446\u0438\u0438"
+ ::msgcat::mcset ru "&Selection:" "&Selection:"
+ ::msgcat::mcset ru "Skip Messages" "\u041f\u0440\u043e\u043f\u0443\u0441\u0442\u0438\u0442\u044c \u0441\u043e\u043e\u0431\u0449\u0435\u043d\u0438\u044f"
+ ::msgcat::mcset ru "Source..." "\u0418\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0438\u0440\u043e\u0432\u0430\u0442\u044c \u0444\u0430\u0439\u043b..."
+ ::msgcat::mcset ru "Tcl Scripts" "\u041f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0430 \u043d\u0430 \u044f\u0437\u044b\u043a\u0435 TCL"
+ ::msgcat::mcset ru "Tcl for Windows" "TCL \u0434\u043b\u044f Windows"
+ ::msgcat::mcset ru "Text Files" "\u0422\u0435\u043a\u0441\u0442\u043e\u0432\u044b\u0435 \u0444\u0430\u0439\u043b\u044b"
+ ::msgcat::mcset ru "&Yes" "&\u0414\u0430"
+ ::msgcat::mcset ru "abort" "\u043e\u0442\u043c\u0435\u043d\u0430"
+ ::msgcat::mcset ru "blue" " \u0433\u043e\u043b\u0443\u0431\u043e\u0439"
+ ::msgcat::mcset ru "cancel" "\u043e\u0442\u043c\u0435\u043d\u0430"
+ ::msgcat::mcset ru "extension" "\u0440\u0430\u0441\u0448\u0438\u0440\u0435\u043d\u0438\u0435"
+ ::msgcat::mcset ru "extensions" "\u0440\u0430\u0441\u0448\u0438\u0440\u0435\u043d\u0438\u044f"
+ ::msgcat::mcset ru "green" " \u0437\u0435\u043b\u0435\u043d\u044b\u0439"
+ ::msgcat::mcset ru "ignore" "\u043f\u0440\u043e\u043f\u0443\u0441\u0442\u0438\u0442\u044c"
+ ::msgcat::mcset ru "ok" "\u043e\u043a"
+ ::msgcat::mcset ru "red" " \u043a\u0440\u0430\u0441\u043d\u044b\u0439"
+ ::msgcat::mcset ru "retry" "\u043f\u043e\u0432\u0442\u043e\u0440\u0438\u0442\u044c"
+ ::msgcat::mcset ru "yes" "\u0434\u0430"
+}
+
diff --git a/tcl/library/obsolete.tcl b/tcl/library/obsolete.tcl
new file mode 100644
index 00000000000..587e2dd0b71
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+#
+# 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/tcl/library/optMenu.tcl b/tcl/library/optMenu.tcl
new file mode 100644
index 00000000000..15e981852df
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+#
+# 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/tcl/library/palette.tcl b/tcl/library/palette.tcl
new file mode 100644
index 00000000000..443c7da7139
--- /dev/null
+++ b/tcl/library/palette.tcl
@@ -0,0 +1,242 @@
+# palette.tcl --
+#
+# This file contains procedures that change the color palette used
+# by Tk.
+#
+# RCS: @(#) $Id$
+#
+# 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} {
+ if {[winfo depth .] == 1} {
+ # Just return on monochrome displays, otherwise errors will occur
+ return
+ }
+
+ # 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"
+ }
+ set bg [winfo rgb . $new(background)]
+ if {![info exists new(foreground)]} {
+ # Note that the range of each value in the triple returned by
+ # [winfo rgb] is 0-65535, and your eyes are more sensitive to
+ # green than to red, and more to red than to blue.
+ foreach {r g b} $bg {break}
+ if {$r+1.5*$g+0.5*$b > 100000} {
+ set new(foreground) black
+ } else {
+ set new(foreground) white
+ }
+ }
+ 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 labelframe
+ listbox menubutton menu message radiobutton scale scrollbar
+ spinbox 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, ::tk::RecolorTree 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 [tk::RecolorTree . 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 variable ::tk::Palette, for use the
+ # next time we change the options.
+
+ array set ::tk::Palette [array get new]
+}
+
+# ::tk::RecolorTree --
+# 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 ::tk::RecolorTree {w colors} {
+ upvar $colors c
+ set result {}
+ set prototype .___tk_set_palette.[string tolower [winfo class $w]]
+ if {![winfo exists $prototype]} {
+ unset prototype
+ }
+ foreach dbOption [array names c] {
+ set option -[string tolower $dbOption]
+ set class [string replace $dbOption 0 0 [string toupper \
+ [string index $dbOption 0]]]
+ 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 $class]
+ if {[string match {} $defaultcolor] || \
+ ([info exists prototype] && \
+ [$prototype cget $option] ne "$defaultcolor")} {
+ set defaultcolor [winfo rgb . [lindex $value 3]]
+ } else {
+ set defaultcolor [winfo rgb . $defaultcolor]
+ }
+ 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[::tk::RecolorTree $child c]"
+ }
+ return $result
+}
+
+# ::tk::Darken --
+# 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 ::tk::Darken {color percent} {
+ foreach {red green blue} [winfo rgb . $color] {
+ set red [expr {($red/256)*$percent/100}]
+ set green [expr {($green/256)*$percent/100}]
+ set blue [expr {($blue/256)*$percent/100}]
+ break
+ }
+ if {$red > 255} {
+ set red 255
+ }
+ if {$green > 255} {
+ set green 255
+ }
+ if {$blue > 255} {
+ set blue 255
+ }
+ return [format "#%02x%02x%02x" $red $green $blue]
+}
+
+# ::tk_bisque --
+# Reset the Tk color palette to the old "bisque" colors.
+#
+# Arguments:
+# None.
+
+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/tcl/library/panedwindow.tcl b/tcl/library/panedwindow.tcl
new file mode 100644
index 00000000000..c52bfa39910
--- /dev/null
+++ b/tcl/library/panedwindow.tcl
@@ -0,0 +1,181 @@
+# panedwindow.tcl --
+#
+# This file defines the default bindings for Tk panedwindow widgets and
+# provides procedures that help in implementing those bindings.
+#
+# RCS: @(#) $Id$
+#
+
+bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
+bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
+
+bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
+bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
+
+bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
+bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
+
+bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
+
+bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
+
+# Initialize namespace
+namespace eval ::tk::panedwindow {}
+
+# ::tk::panedwindow::MarkSash --
+#
+# Handle marking the correct sash for possible dragging
+#
+# Arguments:
+# w the widget
+# x widget local x coord
+# y widget local y coord
+# proxy whether this should be a proxy sash
+# Results:
+# None
+#
+proc ::tk::panedwindow::MarkSash {w x y proxy} {
+ set what [$w identify $x $y]
+ if { [llength $what] == 2 } {
+ foreach {index which} $what break
+ if { !$::tk_strictMotif || [string equal $which "handle"] } {
+ if {!$proxy} { $w sash mark $index $x $y }
+ set ::tk::Priv(sash) $index
+ foreach {sx sy} [$w sash coord $index] break
+ set ::tk::Priv(dx) [expr {$sx-$x}]
+ set ::tk::Priv(dy) [expr {$sy-$y}]
+ }
+ }
+}
+
+# ::tk::panedwindow::DragSash --
+#
+# Handle dragging of the correct sash
+#
+# Arguments:
+# w the widget
+# x widget local x coord
+# y widget local y coord
+# proxy whether this should be a proxy sash
+# Results:
+# Moves sash
+#
+proc ::tk::panedwindow::DragSash {w x y proxy} {
+ if { [info exists ::tk::Priv(sash)] } {
+ if {$proxy} {
+ $w proxy place \
+ [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
+ } else {
+ $w sash place $::tk::Priv(sash) \
+ [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
+ }
+ }
+}
+
+# ::tk::panedwindow::ReleaseSash --
+#
+# Handle releasing of the sash
+#
+# Arguments:
+# w the widget
+# proxy whether this should be a proxy sash
+# Results:
+# Returns ...
+#
+proc ::tk::panedwindow::ReleaseSash {w proxy} {
+ if { [info exists ::tk::Priv(sash)] } {
+ if {$proxy} {
+ foreach {x y} [$w proxy coord] break
+ $w sash place $::tk::Priv(sash) $x $y
+ $w proxy forget
+ }
+ unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy)
+ }
+}
+
+# ::tk::panedwindow::Motion --
+#
+# Handle motion on the widget. This is used to change the cursor
+# when the user moves over the sash area.
+#
+# Arguments:
+# w the widget
+# x widget local x coord
+# y widget local y coord
+# Results:
+# May change the cursor. Sets up a timer to verify that we are still
+# over the widget.
+#
+proc ::tk::panedwindow::Motion {w x y} {
+ variable ::tk::Priv
+ set id [$w identify $x $y]
+ if {([llength $id] == 2) && \
+ (!$::tk_strictMotif || [string equal [lindex $id 1] "handle"])} {
+ if { ![info exists Priv(panecursor)] } {
+ set Priv(panecursor) [$w cget -cursor]
+ if { [string equal [$w cget -sashcursor] ""] } {
+ if { [string equal [$w cget -orient] "horizontal"] } {
+ $w configure -cursor sb_h_double_arrow
+ } else {
+ $w configure -cursor sb_v_double_arrow
+ }
+ } else {
+ $w configure -cursor [$w cget -sashcursor]
+ }
+ if {[info exists Priv(pwAfterId)]} {
+ after cancel $Priv(pwAfterId)
+ }
+ set Priv(pwAfterId) [after 150 \
+ [list ::tk::panedwindow::Cursor $w]]
+ }
+ return
+ }
+ if { [info exists Priv(panecursor)] } {
+ $w configure -cursor $Priv(panecursor)
+ unset Priv(panecursor)
+ }
+}
+
+# ::tk::panedwindow::Cursor --
+#
+# Handles returning the normal cursor when we are no longer over the
+# sash area. This needs to be done this way, because the panedwindow
+# won't see Leave events when the mouse moves from the sash to a
+# paned child, although the child does receive an Enter event.
+#
+# Arguments:
+# w the widget
+# Results:
+# May restore the default cursor, or schedule a timer to do it.
+#
+proc ::tk::panedwindow::Cursor {w} {
+ variable ::tk::Priv
+ if {[info exists Priv(panecursor)]} {
+ if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == $w} {
+ set Priv(pwAfterId) [after 150 [list ::tk::panedwindow::Cursor $w]]
+ } else {
+ $w configure -cursor $Priv(panecursor)
+ unset Priv(panecursor)
+ if {[info exists Priv(pwAfterId)]} {
+ after cancel $Priv(pwAfterId)
+ unset Priv(pwAfterId)
+ }
+ }
+ }
+}
+
+# ::tk::panedwindow::Leave --
+#
+# Return to default cursor when leaving the pw widget.
+#
+# Arguments:
+# w the widget
+# Results:
+# Restores the default cursor
+#
+proc ::tk::panedwindow::Leave {w} {
+ if {[info exists ::tk::Priv(panecursor)]} {
+ $w configure -cursor $::tk::Priv(panecursor)
+ unset ::tk::Priv(panecursor)
+ }
+}
diff --git a/tcl/library/safetk.tcl b/tcl/library/safetk.tcl
new file mode 100644
index 00000000000..8c0a12bea10
--- /dev/null
+++ b/tcl/library/safetk.tcl
@@ -0,0 +1,277 @@
+# safetk.tcl --
+#
+# Support procs to use Tk in safe interpreters.
+#
+# 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.
+
+# see safetk.n for documentation
+
+#
+#
+# Note: It is now ok to let untrusted code being executed
+# between the creation of the interp and the actual loading
+# of Tk in that interp because the C side Tk_Init will
+# now look up the master interp and ask its safe::TkInit
+# for the actual parameters to use for it's initialization (if allowed),
+# not relying on the slave state.
+#
+
+# We use opt (optional arguments parsing)
+package require opt 0.4.1;
+
+namespace eval ::safe {
+
+ # counter for safe toplevels
+ variable tkSafeId 0;
+
+ #
+ # tkInterpInit : prepare the slave interpreter for tk loading
+ # most of the real job is done by loadTk
+ # returns the slave name (tkInterpInit does)
+ #
+ proc ::safe::tkInterpInit {slave argv} {
+ global env tk_library
+
+ # We have to make sure that the tk_library variable uses a file
+ # pathname that works better in Tk (of the style returned by
+ # [file join], ie C:/path/to/tk/lib, not C:\path\to\tk\lib
+ set tk_library [file join $tk_library]
+
+ # Clear Tk's access for that interp (path).
+ allowTk $slave $argv
+
+ # there seems to be an obscure case where the tk_library
+ # variable value is changed to point to a sym link destination
+ # dir instead of the sym link itself, and thus where the $tk_library
+ # would then not be anymore one of the auto_path dir, so we use
+ # the addToAccessPath which adds if it's not already in instead
+ # of the more conventional findInAccessPath.
+ # Might be usefull for masters without Tk really loaded too.
+ ::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]
+ return $slave
+ }
+
+
+# tkInterpLoadTk :
+# Do additional configuration as needed (calling tkInterpInit)
+# and actually load Tk into the slave.
+#
+# Either contained in the specified windowId (-use) or
+# creating a decorated toplevel for it.
+
+# empty definition for auto_mkIndex
+proc ::safe::loadTk {} {}
+
+::tcl::OptProc loadTk {
+ {slave -interp "name of the slave interpreter"}
+ {-use -windowId {} "window Id to use (new toplevel otherwise)"}
+ {-display -displayName {} "display name to use (current one otherwise)"}
+} {
+ set displayGiven [::tcl::OptProcArgGiven "-display"]
+ if {!$displayGiven} {
+
+ # Try to get the current display from "."
+ # (which might not exist if the master is tk-less)
+
+ if {[catch {set display [winfo screen .]}]} {
+ if {[info exists ::env(DISPLAY)]} {
+ set display $::env(DISPLAY)
+ } else {
+ Log $slave "no winfo screen . nor env(DISPLAY)" WARNING
+ set display ":0.0"
+ }
+ }
+ }
+ if {![::tcl::OptProcArgGiven "-use"]} {
+
+ # create a decorated toplevel
+
+ ::tcl::Lassign [tkTopLevel $slave $display] w use
+
+ # set our delete hook (slave arg is added by interpDelete)
+ # to clean up both window related code and tkInit(slave)
+ Set [DeleteHookName $slave] [list tkDelete {} $w]
+
+ } else {
+
+ # set our delete hook (slave arg is added by interpDelete)
+ # to clean up tkInit(slave)
+
+ Set [DeleteHookName $slave] [list disallowTk]
+
+ # Let's be nice and also accept tk window names instead of ids
+
+ if {[string match ".*" $use]} {
+ set windowName $use
+ set use [winfo id $windowName]
+ set nDisplay [winfo screen $windowName]
+ } else {
+
+ # Check for a better -display value
+ # (works only for multi screens on single host, but not
+ # cross hosts, for that a tk window name would be better
+ # but embeding is also usefull for non tk names)
+
+ if {![catch {winfo pathname $use} name]} {
+ set nDisplay [winfo screen $name]
+ } else {
+
+ # Can't have a better one
+
+ set nDisplay $display
+ }
+ }
+ if {[string compare $nDisplay $display]} {
+ if {$displayGiven} {
+ error "conflicting -display $display and -use\
+ $use -> $nDisplay"
+ } else {
+ set display $nDisplay
+ }
+ }
+ }
+
+ # Prepares the slave for tk with those parameters
+
+ tkInterpInit $slave [list "-use" $use "-display" $display]
+
+ load {} Tk $slave
+
+ return $slave
+}
+
+proc ::safe::TkInit {interpPath} {
+ variable tkInit
+ if {[info exists tkInit($interpPath)]} {
+ set value $tkInit($interpPath)
+ Log $interpPath "TkInit called, returning \"$value\"" NOTICE
+ return $value
+ } else {
+ Log $interpPath "TkInit called for interp with clearance:\
+ preventing Tk init" ERROR
+ error "not allowed"
+ }
+}
+
+# safe::allowTk --
+#
+# Set tkInit(interpPath) to allow Tk to be initialized in
+# safe::TkInit.
+#
+# Arguments:
+# interpPath slave interpreter handle
+# argv arguments passed to safe::TkInterpInit
+#
+# Results:
+# none.
+
+proc ::safe::allowTk {interpPath argv} {
+ variable tkInit
+ set tkInit($interpPath) $argv
+ return
+}
+
+
+# safe::disallowTk --
+#
+# Unset tkInit(interpPath) to disallow Tk from getting initialized
+# in safe::TkInit.
+#
+# Arguments:
+# interpPath slave interpreter handle
+#
+# Results:
+# none.
+
+proc ::safe::disallowTk {interpPath} {
+ variable tkInit
+ # This can already be deleted by the DeleteHook of the interp
+ if {[info exists tkInit($interpPath)]} {
+ unset tkInit($interpPath)
+ }
+ return
+}
+
+
+# safe::tkDelete --
+#
+# Clean up the window associated with the interp being deleted.
+#
+# Arguments:
+# interpPath slave interpreter handle
+#
+# Results:
+# none.
+
+proc ::safe::tkDelete {W window slave} {
+
+ # we are going to be called for each widget... skip untill it's
+ # top level
+
+ Log $slave "Called tkDelete $W $window" NOTICE
+ if {[::interp exists $slave]} {
+ if {[catch {::safe::interpDelete $slave} msg]} {
+ Log $slave "Deletion error : $msg"
+ }
+ }
+ if {[winfo exists $window]} {
+ Log $slave "Destroy toplevel $window" NOTICE
+ destroy $window
+ }
+
+ # clean up tkInit(slave)
+ disallowTk $slave
+ return
+}
+
+proc ::safe::tkTopLevel {slave display} {
+ variable tkSafeId
+ incr tkSafeId
+ set w ".safe$tkSafeId"
+ if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {
+ return -code error "Unable to create toplevel for\
+ safe slave \"$slave\" ($msg)"
+ }
+ Log $slave "New toplevel $w" NOTICE
+
+ set msg "Untrusted Tcl applet ($slave)"
+ wm title $w $msg
+
+ # 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/tcl/library/scale.tcl b/tcl/library/scale.tcl
new file mode 100644
index 00000000000..e9ab3e88a03
--- /dev/null
+++ b/tcl/library/scale.tcl
@@ -0,0 +1,274 @@
+# scale.tcl --
+#
+# This file defines the default bindings for Tk scale widgets and provides
+# procedures that help in implementing the bindings.
+#
+# RCS: @(#) $Id$
+#
+# 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 tk::Priv(activeBg) [%W cget -activebackground]
+ %W config -activebackground [%W cget -background]
+ }
+ tk::ScaleActivate %W %x %y
+}
+bind Scale <Motion> {
+ tk::ScaleActivate %W %x %y
+}
+bind Scale <Leave> {
+ if {$tk_strictMotif} {
+ %W config -activebackground $tk::Priv(activeBg)
+ }
+ if {[string equal [%W cget -state] "active"]} {
+ %W configure -state normal
+ }
+}
+bind Scale <1> {
+ tk::ScaleButtonDown %W %x %y
+}
+bind Scale <B1-Motion> {
+ tk::ScaleDrag %W %x %y
+}
+bind Scale <B1-Leave> { }
+bind Scale <B1-Enter> { }
+bind Scale <ButtonRelease-1> {
+ tk::CancelRepeat
+ tk::ScaleEndDrag %W
+ tk::ScaleActivate %W %x %y
+}
+bind Scale <2> {
+ tk::ScaleButton2Down %W %x %y
+}
+bind Scale <B2-Motion> {
+ tk::ScaleDrag %W %x %y
+}
+bind Scale <B2-Leave> { }
+bind Scale <B2-Enter> { }
+bind Scale <ButtonRelease-2> {
+ tk::CancelRepeat
+ tk::ScaleEndDrag %W
+ tk::ScaleActivate %W %x %y
+}
+if {[string equal $tcl_platform(platform) "windows"]} {
+ # On Windows do the same with button 3, as that is the right mouse button
+ bind Scale <3> [bind Scale <2>]
+ bind Scale <B3-Motion> [bind Scale <B2-Motion>]
+ bind Scale <B3-Leave> [bind Scale <B2-Leave>]
+ bind Scale <B3-Enter> [bind Scale <B2-Enter>]
+ bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
+}
+bind Scale <Control-1> {
+ tk::ScaleControlPress %W %x %y
+}
+bind Scale <Up> {
+ tk::ScaleIncrement %W up little noRepeat
+}
+bind Scale <Down> {
+ tk::ScaleIncrement %W down little noRepeat
+}
+bind Scale <Left> {
+ tk::ScaleIncrement %W up little noRepeat
+}
+bind Scale <Right> {
+ tk::ScaleIncrement %W down little noRepeat
+}
+bind Scale <Control-Up> {
+ tk::ScaleIncrement %W up big noRepeat
+}
+bind Scale <Control-Down> {
+ tk::ScaleIncrement %W down big noRepeat
+}
+bind Scale <Control-Left> {
+ tk::ScaleIncrement %W up big noRepeat
+}
+bind Scale <Control-Right> {
+ tk::ScaleIncrement %W down big noRepeat
+}
+bind Scale <Home> {
+ %W set [%W cget -from]
+}
+bind Scale <End> {
+ %W set [%W cget -to]
+}
+
+# ::tk::ScaleActivate --
+# 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 ::tk::ScaleActivate {w x y} {
+ if {[string equal [$w cget -state] "disabled"]} {
+ return
+ }
+ if {[string equal [$w identify $x $y] "slider"]} {
+ set state active
+ } else {
+ set state normal
+ }
+ if {[string compare [$w cget -state] $state]} {
+ $w configure -state $state
+ }
+}
+
+# ::tk::ScaleButtonDown --
+# 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 ::tk::ScaleButtonDown {w x y} {
+ variable ::tk::Priv
+ set Priv(dragging) 0
+ set el [$w identify $x $y]
+ if {[string equal $el "trough1"]} {
+ ScaleIncrement $w up little initial
+ } elseif {[string equal $el "trough2"]} {
+ ScaleIncrement $w down little initial
+ } elseif {[string equal $el "slider"]} {
+ set Priv(dragging) 1
+ set Priv(initValue) [$w get]
+ set coords [$w coords]
+ set Priv(deltaX) [expr {$x - [lindex $coords 0]}]
+ set Priv(deltaY) [expr {$y - [lindex $coords 1]}]
+ $w configure -sliderrelief sunken
+ }
+}
+
+# ::tk::ScaleDrag --
+# 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 ::tk::ScaleDrag {w x y} {
+ variable ::tk::Priv
+ if {!$Priv(dragging)} {
+ return
+ }
+ $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]
+}
+
+# ::tk::ScaleEndDrag --
+# 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 ::tk::ScaleEndDrag {w} {
+ variable ::tk::Priv
+ set Priv(dragging) 0
+ $w configure -sliderrelief raised
+}
+
+# ::tk::ScaleIncrement --
+# 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 ::tk::ScaleIncrement {w dir big repeat} {
+ variable ::tk::Priv
+ if {![winfo exists $w]} return
+ if {[string equal $big "big"]} {
+ set inc [$w cget -bigincrement]
+ if {$inc == 0} {
+ set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
+ }
+ if {$inc < [$w cget -resolution]} {
+ set inc [$w cget -resolution]
+ }
+ } else {
+ set inc [$w cget -resolution]
+ }
+ if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} {
+ set inc [expr {-$inc}]
+ }
+ $w set [expr {[$w get] + $inc}]
+
+ if {[string equal $repeat "again"]} {
+ set Priv(afterId) [after [$w cget -repeatinterval] \
+ [list tk::ScaleIncrement $w $dir $big again]]
+ } elseif {[string equal $repeat "initial"]} {
+ set delay [$w cget -repeatdelay]
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay \
+ [list tk::ScaleIncrement $w $dir $big again]]
+ }
+ }
+}
+
+# ::tk::ScaleControlPress --
+# 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 ::tk::ScaleControlPress {w x y} {
+ set el [$w identify $x $y]
+ if {[string equal $el "trough1"]} {
+ $w set [$w cget -from]
+ } elseif {[string equal $el "trough2"]} {
+ $w set [$w cget -to]
+ }
+}
+
+# ::tk::ScaleButton2Down
+# 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 ::tk::ScaleButton2Down {w x y} {
+ variable ::tk::Priv
+
+ if {[string equal [$w cget -state] "disabled"]} {
+ return
+ }
+ $w configure -state active
+ $w set [$w get $x $y]
+ set Priv(dragging) 1
+ set Priv(initValue) [$w get]
+ set coords "$x $y"
+ set Priv(deltaX) 0
+ set Priv(deltaY) 0
+}
diff --git a/tcl/library/scrlbar.tcl b/tcl/library/scrlbar.tcl
new file mode 100644
index 00000000000..8f241954dd4
--- /dev/null
+++ b/tcl/library/scrlbar.tcl
@@ -0,0 +1,415 @@
+# scrlbar.tcl --
+#
+# This file defines the default bindings for Tk scrollbar widgets.
+# It also provides procedures that help in implementing the bindings.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for scrollbars.
+#-------------------------------------------------------------------------
+
+# Standard Motif bindings:
+if {[string equal [tk windowingsystem] "x11"]} {
+
+bind Scrollbar <Enter> {
+ if {$tk_strictMotif} {
+ set tk::Priv(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 tk::Priv(activeBg)]} {
+ %W config -activebackground $tk::Priv(activeBg)
+ }
+ %W activate {}
+}
+bind Scrollbar <1> {
+ tk::ScrollButtonDown %W %x %y
+}
+bind Scrollbar <B1-Motion> {
+ tk::ScrollDrag %W %x %y
+}
+bind Scrollbar <B1-B2-Motion> {
+ tk::ScrollDrag %W %x %y
+}
+bind Scrollbar <ButtonRelease-1> {
+ tk::ScrollButtonUp %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> {
+ tk::ScrollButton2Down %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> {
+ tk::ScrollDrag %W %x %y
+}
+bind Scrollbar <ButtonRelease-2> {
+ tk::ScrollButtonUp %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> {
+ tk::ScrollTopBottom %W %x %y
+}
+bind Scrollbar <Control-2> {
+ tk::ScrollTopBottom %W %x %y
+}
+
+bind Scrollbar <Up> {
+ tk::ScrollByUnits %W v -1
+}
+bind Scrollbar <Down> {
+ tk::ScrollByUnits %W v 1
+}
+bind Scrollbar <Control-Up> {
+ tk::ScrollByPages %W v -1
+}
+bind Scrollbar <Control-Down> {
+ tk::ScrollByPages %W v 1
+}
+bind Scrollbar <Left> {
+ tk::ScrollByUnits %W h -1
+}
+bind Scrollbar <Right> {
+ tk::ScrollByUnits %W h 1
+}
+bind Scrollbar <Control-Left> {
+ tk::ScrollByPages %W h -1
+}
+bind Scrollbar <Control-Right> {
+ tk::ScrollByPages %W h 1
+}
+bind Scrollbar <Prior> {
+ tk::ScrollByPages %W hv -1
+}
+bind Scrollbar <Next> {
+ tk::ScrollByPages %W hv 1
+}
+bind Scrollbar <Home> {
+ tk::ScrollToPos %W 0
+}
+bind Scrollbar <End> {
+ tk::ScrollToPos %W 1
+}
+}
+# tk::ScrollButtonDown --
+# 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 tk::ScrollButtonDown {w x y} {
+ variable ::tk::Priv
+ set Priv(relief) [$w cget -activerelief]
+ $w configure -activerelief sunken
+ set element [$w identify $x $y]
+ if {[string equal $element "slider"]} {
+ ScrollStartDrag $w $x $y
+ } else {
+ ScrollSelect $w $element initial
+ }
+}
+
+# ::tk::ScrollButtonUp --
+# 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 ::tk::ScrollButtonUp {w x y} {
+ variable ::tk::Priv
+ tk::CancelRepeat
+ if {[info exists Priv(relief)]} {
+ # Avoid error due to spurious release events
+ $w configure -activerelief $Priv(relief)
+ ScrollEndDrag $w $x $y
+ $w activate [$w identify $x $y]
+ }
+}
+
+# ::tk::ScrollSelect --
+# 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 ::tk::ScrollSelect {w element repeat} {
+ variable ::tk::Priv
+ if {![winfo exists $w]} return
+ switch -- $element {
+ "arrow1" {ScrollByUnits $w hv -1}
+ "trough1" {ScrollByPages $w hv -1}
+ "trough2" {ScrollByPages $w hv 1}
+ "arrow2" {ScrollByUnits $w hv 1}
+ default {return}
+ }
+ if {[string equal $repeat "again"]} {
+ set Priv(afterId) [after [$w cget -repeatinterval] \
+ [list tk::ScrollSelect $w $element again]]
+ } elseif {[string equal $repeat "initial"]} {
+ set delay [$w cget -repeatdelay]
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay \
+ [list tk::ScrollSelect $w $element again]]
+ }
+ }
+}
+
+# ::tk::ScrollStartDrag --
+# 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 ::tk::ScrollStartDrag {w x y} {
+ variable ::tk::Priv
+
+ if {[string equal [$w cget -command] ""]} {
+ return
+ }
+ set Priv(pressX) $x
+ set Priv(pressY) $y
+ set Priv(initValues) [$w get]
+ set iv0 [lindex $Priv(initValues) 0]
+ if {[llength $Priv(initValues)] == 2} {
+ set Priv(initPos) $iv0
+ } elseif {$iv0 == 0} {
+ set Priv(initPos) 0.0
+ } else {
+ set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \
+ / [lindex $Priv(initValues) 0]}]
+ }
+}
+
+# ::tk::ScrollDrag --
+# 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 ::tk::ScrollDrag {w x y} {
+ variable ::tk::Priv
+
+ if {[string equal $Priv(initPos) ""]} {
+ return
+ }
+ set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]]
+ if {[$w cget -jump]} {
+ if {[llength $Priv(initValues)] == 2} {
+ $w set [expr {[lindex $Priv(initValues) 0] + $delta}] \
+ [expr {[lindex $Priv(initValues) 1] + $delta}]
+ } else {
+ set delta [expr {round($delta * [lindex $Priv(initValues) 0])}]
+ eval [list $w] set [lreplace $Priv(initValues) 2 3 \
+ [expr {[lindex $Priv(initValues) 2] + $delta}] \
+ [expr {[lindex $Priv(initValues) 3] + $delta}]]
+ }
+ } else {
+ ScrollToPos $w [expr {$Priv(initPos) + $delta}]
+ }
+}
+
+# ::tk::ScrollEndDrag --
+# 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 ::tk::ScrollEndDrag {w x y} {
+ variable ::tk::Priv
+
+ if {[string equal $Priv(initPos) ""]} {
+ return
+ }
+ if {[$w cget -jump]} {
+ set delta [$w delta [expr {$x - $Priv(pressX)}] \
+ [expr {$y - $Priv(pressY)}]]
+ ScrollToPos $w [expr {$Priv(initPos) + $delta}]
+ }
+ set Priv(initPos) ""
+}
+
+# ::tk::ScrollByUnits --
+# 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 ::tk::ScrollByUnits {w orient amount} {
+ set cmd [$w cget -command]
+ if {[string equal $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}]
+ }
+}
+
+# ::tk::ScrollByPages --
+# 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 ::tk::ScrollByPages {w orient amount} {
+ set cmd [$w cget -command]
+ if {[string equal $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)}]
+ }
+}
+
+# ::tk::ScrollToPos --
+# 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 ::tk::ScrollToPos {w pos} {
+ set cmd [$w cget -command]
+ if {[string equal $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)}]
+ }
+}
+
+# ::tk::ScrollTopBottom
+# 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 ::tk::ScrollTopBottom {w x y} {
+ variable ::tk::Priv
+ set element [$w identify $x $y]
+ if {[string match *1 $element]} {
+ ScrollToPos $w 0
+ } elseif {[string match *2 $element]} {
+ ScrollToPos $w 1
+ }
+
+ # Set Priv(relief), since it's needed by tk::ScrollButtonUp.
+
+ set Priv(relief) [$w cget -activerelief]
+}
+
+# ::tk::ScrollButton2Down
+# 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 ::tk::ScrollButton2Down {w x y} {
+ variable ::tk::Priv
+ set element [$w identify $x $y]
+ if {[string match {arrow[12]} $element]} {
+ ScrollButtonDown $w $x $y
+ return
+ }
+ ScrollToPos $w [$w fraction $x $y]
+ set Priv(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
+ ScrollStartDrag $w $x $y
+}
diff --git a/tcl/library/spinbox.tcl b/tcl/library/spinbox.tcl
new file mode 100644
index 00000000000..449d45d859b
--- /dev/null
+++ b/tcl/library/spinbox.tcl
@@ -0,0 +1,568 @@
+# spinbox.tcl --
+#
+# This file defines the default bindings for Tk spinbox widgets and provides
+# procedures that help in implementing those bindings. The spinbox builds
+# off the entry widget, so it can reuse Entry bindings and procedures.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1999-2000 Jeffrey Hobbs
+# Copyright (c) 2000 Ajuba Solutions
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tk::Priv 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.
+# data - Used for Cut and Copy
+#-------------------------------------------------------------------------
+
+# Initialize namespace
+namespace eval ::tk::spinbox {}
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+bind Spinbox <<Cut>> {
+ if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tk::Priv(data)
+ %W delete sel.first sel.last
+ unset tk::Priv(data)
+ }
+}
+bind Spinbox <<Copy>> {
+ if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tk::Priv(data)
+ unset tk::Priv(data)
+ }
+}
+bind Spinbox <<Paste>> {
+ global tcl_platform
+ catch {
+ if {[tk windowingsystem] ne "x11"} {
+ catch {
+ %W delete sel.first sel.last
+ }
+ }
+ %W insert insert [::tk::GetSelection %W CLIPBOARD]
+ ::tk::EntrySeeInsert %W
+ }
+}
+bind Spinbox <<Clear>> {
+ %W delete sel.first sel.last
+}
+bind Spinbox <<PasteSelection>> {
+ if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
+ || !$tk::Priv(mouseMoved)} {
+ ::tk::spinbox::Paste %W %x
+ }
+}
+
+# Standard Motif bindings:
+
+bind Spinbox <1> {
+ ::tk::spinbox::ButtonDown %W %x %y
+}
+bind Spinbox <B1-Motion> {
+ ::tk::spinbox::Motion %W %x %y
+}
+bind Spinbox <Double-1> {
+ set tk::Priv(selectMode) word
+ ::tk::spinbox::MouseSelect %W %x sel.first
+}
+bind Spinbox <Triple-1> {
+ set tk::Priv(selectMode) line
+ ::tk::spinbox::MouseSelect %W %x 0
+}
+bind Spinbox <Shift-1> {
+ set tk::Priv(selectMode) char
+ %W selection adjust @%x
+}
+bind Spinbox <Double-Shift-1> {
+ set tk::Priv(selectMode) word
+ ::tk::spinbox::MouseSelect %W %x
+}
+bind Spinbox <Triple-Shift-1> {
+ set tk::Priv(selectMode) line
+ ::tk::spinbox::MouseSelect %W %x
+}
+bind Spinbox <B1-Leave> {
+ set tk::Priv(x) %x
+ ::tk::spinbox::AutoScan %W
+}
+bind Spinbox <B1-Enter> {
+ tk::CancelRepeat
+}
+bind Spinbox <ButtonRelease-1> {
+ ::tk::spinbox::ButtonUp %W %x %y
+}
+bind Spinbox <Control-1> {
+ %W icursor @%x
+}
+
+bind Spinbox <Up> {
+ %W invoke buttonup
+}
+bind Spinbox <Down> {
+ %W invoke buttondown
+}
+
+bind Spinbox <Left> {
+ ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
+}
+bind Spinbox <Right> {
+ ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
+}
+bind Spinbox <Shift-Left> {
+ ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
+ ::tk::EntrySeeInsert %W
+}
+bind Spinbox <Shift-Right> {
+ ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
+ ::tk::EntrySeeInsert %W
+}
+bind Spinbox <Control-Left> {
+ ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
+}
+bind Spinbox <Control-Right> {
+ ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
+}
+bind Spinbox <Shift-Control-Left> {
+ ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]
+ ::tk::EntrySeeInsert %W
+}
+bind Spinbox <Shift-Control-Right> {
+ ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]
+ ::tk::EntrySeeInsert %W
+}
+bind Spinbox <Home> {
+ ::tk::EntrySetCursor %W 0
+}
+bind Spinbox <Shift-Home> {
+ ::tk::EntryKeySelect %W 0
+ ::tk::EntrySeeInsert %W
+}
+bind Spinbox <End> {
+ ::tk::EntrySetCursor %W end
+}
+bind Spinbox <Shift-End> {
+ ::tk::EntryKeySelect %W end
+ ::tk::EntrySeeInsert %W
+}
+
+bind Spinbox <Delete> {
+ if {[%W selection present]} {
+ %W delete sel.first sel.last
+ } else {
+ %W delete insert
+ }
+}
+bind Spinbox <BackSpace> {
+ ::tk::EntryBackspace %W
+}
+
+bind Spinbox <Control-space> {
+ %W selection from insert
+}
+bind Spinbox <Select> {
+ %W selection from insert
+}
+bind Spinbox <Control-Shift-space> {
+ %W selection adjust insert
+}
+bind Spinbox <Shift-Select> {
+ %W selection adjust insert
+}
+bind Spinbox <Control-slash> {
+ %W selection range 0 end
+}
+bind Spinbox <Control-backslash> {
+ %W selection clear
+}
+bind Spinbox <KeyPress> {
+ ::tk::EntryInsert %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 Spinbox <Alt-KeyPress> {# nothing}
+bind Spinbox <Meta-KeyPress> {# nothing}
+bind Spinbox <Control-KeyPress> {# nothing}
+bind Spinbox <Escape> {# nothing}
+bind Spinbox <Return> {# nothing}
+bind Spinbox <KP_Enter> {# nothing}
+bind Spinbox <Tab> {# nothing}
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ bind Spinbox <Command-KeyPress> {# nothing}
+}
+
+# On Windows, paste is done using Shift-Insert. Shift-Insert already
+# generates the <<Paste>> event, so we don't need to do anything here.
+if {[string compare $tcl_platform(platform) "windows"]} {
+ bind Spinbox <Insert> {
+ catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
+ }
+}
+
+# Additional emacs-like bindings:
+
+bind Spinbox <Control-a> {
+ if {!$tk_strictMotif} {
+ ::tk::EntrySetCursor %W 0
+ }
+}
+bind Spinbox <Control-b> {
+ if {!$tk_strictMotif} {
+ ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
+ }
+}
+bind Spinbox <Control-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert
+ }
+}
+bind Spinbox <Control-e> {
+ if {!$tk_strictMotif} {
+ ::tk::EntrySetCursor %W end
+ }
+}
+bind Spinbox <Control-f> {
+ if {!$tk_strictMotif} {
+ ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
+ }
+}
+bind Spinbox <Control-h> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryBackspace %W
+ }
+}
+bind Spinbox <Control-k> {
+ if {!$tk_strictMotif} {
+ %W delete insert end
+ }
+}
+bind Spinbox <Control-t> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryTranspose %W
+ }
+}
+bind Spinbox <Meta-b> {
+ if {!$tk_strictMotif} {
+ ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
+ }
+}
+bind Spinbox <Meta-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert [::tk::EntryNextWord %W insert]
+ }
+}
+bind Spinbox <Meta-f> {
+ if {!$tk_strictMotif} {
+ ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
+ }
+}
+bind Spinbox <Meta-BackSpace> {
+ if {!$tk_strictMotif} {
+ %W delete [::tk::EntryPreviousWord %W insert] insert
+ }
+}
+bind Spinbox <Meta-Delete> {
+ if {!$tk_strictMotif} {
+ %W delete [::tk::EntryPreviousWord %W insert] insert
+ }
+}
+
+# A few additional bindings of my own.
+
+bind Spinbox <2> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanMark %W %x
+ }
+}
+bind Spinbox <B2-Motion> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanDrag %W %x
+ }
+}
+
+# ::tk::spinbox::Invoke --
+# Invoke an element of the spinbox
+#
+# Arguments:
+# w - The spinbox window.
+# elem - Element to invoke
+
+proc ::tk::spinbox::Invoke {w elem} {
+ variable ::tk::Priv
+
+ if {![info exists Priv(outsideElement)]} {
+ $w invoke $elem
+ incr Priv(repeated)
+ }
+ set delay [$w cget -repeatinterval]
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay \
+ [list ::tk::spinbox::Invoke $w $elem]]
+ }
+}
+
+# ::tk::spinbox::ClosestGap --
+# 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 spinbox window.
+# x - X-coordinate within the window.
+
+proc ::tk::spinbox::ClosestGap {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
+}
+
+# ::tk::spinbox::ButtonDown --
+# This procedure is invoked to handle button-1 presses in spinbox
+# widgets. It moves the insertion cursor, sets the selection anchor,
+# and claims the input focus.
+#
+# Arguments:
+# w - The spinbox window in which the button was pressed.
+# x - The x-coordinate of the button press.
+
+proc ::tk::spinbox::ButtonDown {w x y} {
+ variable ::tk::Priv
+
+ # Get the element that was clicked in. If we are not directly over
+ # the spinbox, default to entry. This is necessary for spinbox grabs.
+ #
+ set Priv(element) [$w identify $x $y]
+ if {$Priv(element) eq ""} {
+ set Priv(element) "entry"
+ }
+
+ switch -exact $Priv(element) {
+ "buttonup" - "buttondown" {
+ if {"disabled" ne [$w cget -state]} {
+ $w selection element $Priv(element)
+ set Priv(repeated) 0
+ set Priv(relief) [$w cget -$Priv(element)relief]
+ catch {after cancel $Priv(afterId)}
+ set delay [$w cget -repeatdelay]
+ if {$delay > 0} {
+ set Priv(afterId) [after $delay \
+ [list ::tk::spinbox::Invoke $w $Priv(element)]]
+ }
+ if {[info exists Priv(outsideElement)]} {
+ unset Priv(outsideElement)
+ }
+ }
+ }
+ "entry" {
+ set Priv(selectMode) char
+ set Priv(mouseMoved) 0
+ set Priv(pressX) $x
+ $w icursor [::tk::spinbox::ClosestGap $w $x]
+ $w selection from insert
+ if {"disabled" ne [$w cget -state]} {focus $w}
+ $w selection clear
+ }
+ default {
+ return -code error "unknown spinbox element \"$Priv(element)\""
+ }
+ }
+}
+
+# ::tk::spinbox::ButtonUp --
+# This procedure is invoked to handle button-1 releases in spinbox
+# widgets.
+#
+# Arguments:
+# w - The spinbox window in which the button was pressed.
+# x - The x-coordinate of the button press.
+
+proc ::tk::spinbox::ButtonUp {w x y} {
+ variable ::tk::Priv
+
+ ::tk::CancelRepeat
+
+ # Priv(relief) may not exist if the ButtonUp is not paired with
+ # a preceding ButtonDown
+ if {[info exists Priv(element)] && [info exists Priv(relief)] && \
+ [string match "button*" $Priv(element)]} {
+ if {[info exists Priv(repeated)] && !$Priv(repeated)} {
+ $w invoke $Priv(element)
+ }
+ $w configure -$Priv(element)relief $Priv(relief)
+ $w selection element none
+ }
+}
+
+# ::tk::spinbox::MouseSelect --
+# 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 spinbox window in which the button was pressed.
+# x - The x-coordinate of the mouse.
+# cursor - optional place to set cursor.
+
+proc ::tk::spinbox::MouseSelect {w x {cursor {}}} {
+ variable ::tk::Priv
+
+ if {$Priv(element) ne "entry"} {
+ # The ButtonUp command triggered by ButtonRelease-1 handles
+ # invoking one of the spinbuttons.
+ return
+ }
+ set cur [::tk::spinbox::ClosestGap $w $x]
+ set anchor [$w index anchor]
+ if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
+ set Priv(mouseMoved) 1
+ }
+ switch $Priv(selectMode) {
+ char {
+ if {$Priv(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
+ }
+ }
+ if {$cursor ne {} && $cursor ne "ignore"} {
+ catch {$w icursor $cursor}
+ }
+ update idletasks
+}
+
+# ::tk::spinbox::Paste --
+# 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 spinbox window.
+# x - X position of the mouse.
+
+proc ::tk::spinbox::Paste {w x} {
+ $w icursor [::tk::spinbox::ClosestGap $w $x]
+ catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
+ if {[string equal "disabled" [$w cget -state]]} {focus $w}
+}
+
+# ::tk::spinbox::Motion --
+# This procedure is invoked when the mouse moves in a spinbox window
+# with button 1 down.
+#
+# Arguments:
+# w - The spinbox window.
+
+proc ::tk::spinbox::Motion {w x y} {
+ variable ::tk::Priv
+
+ if {![info exists Priv(element)]} {
+ set Priv(element) [$w identify $x $y]
+ }
+
+ set Priv(x) $x
+ if {"entry" eq $Priv(element)} {
+ ::tk::spinbox::MouseSelect $w $x ignore
+ } elseif {[$w identify $x $y] ne $Priv(element)} {
+ if {![info exists Priv(outsideElement)]} {
+ # We've wandered out of the spin button
+ # setting outside element will cause ::tk::spinbox::Invoke to
+ # loop without doing anything
+ set Priv(outsideElement) ""
+ $w selection element none
+ }
+ } elseif {[info exists Priv(outsideElement)]} {
+ unset Priv(outsideElement)
+ $w selection element $Priv(element)
+ }
+}
+
+# ::tk::spinbox::AutoScan --
+# This procedure is invoked when the mouse leaves an spinbox 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 spinbox window.
+
+proc ::tk::spinbox::AutoScan {w} {
+ variable ::tk::Priv
+
+ set x $Priv(x)
+ if {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ ::tk::spinbox::MouseSelect $w $x ignore
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ ::tk::spinbox::MouseSelect $w $x ignore
+ }
+ set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]]
+}
+
+# ::tk::spinbox::GetSelection --
+#
+# Returns the selected text of the spinbox. Differs from entry in that
+# a spinbox has no -show option to obscure contents.
+#
+# Arguments:
+# w - The spinbox window from which the text to get
+
+proc ::tk::spinbox::GetSelection {w} {
+ return [string range [$w get] [$w index sel.first] \
+ [expr {[$w index sel.last] - 1}]]
+}
diff --git a/tcl/library/tclIndex b/tcl/library/tclIndex
index c2da6bee4c5..6b3547d579f 100644
--- a/tcl/library/tclIndex
+++ b/tcl/library/tclIndex
@@ -6,77 +6,272 @@
# element name is the name of a command and the value is
# a script that loads the command.
-set auto_index(auto_reset) [list source [file join $dir auto.tcl]]
-set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]]
-set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]]
-set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]]
-set auto_index(history) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]
-set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]
-set auto_index(pkg_compareExtension) [list source [file join $dir package.tcl]]
-set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]
-set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]
-set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]]
-set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
-set auto_index(::pkg::create) [list source [file join $dir package.tcl]]
-set auto_index(parray) [list source [file join $dir parray.tcl]]
-set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpStateName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::IsInterp) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::PathListName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::VirtualPathListName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::PathNumberName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::StaticsOkName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::NestedOkName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Toplevel) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Set) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Lappend) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Unset) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Exists) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::GetAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::StaticsOk) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::NestedOk) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::DeleteHookName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]
-set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]
-set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]
-set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]
-set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]
-set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]
+set auto_index(::tk::dialog::error::Return) [list source [file join $dir bgerror.tcl]]
+set auto_index(::tk::dialog::error::Details) [list source [file join $dir bgerror.tcl]]
+set auto_index(::tk::dialog::error::SaveToLog) [list source [file join $dir bgerror.tcl]]
+set auto_index(::tk::dialog::error::Destroy) [list source [file join $dir bgerror.tcl]]
+set auto_index(::tk::dialog::error::bgerror) [list source [file join $dir bgerror.tcl]]
+set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]
+set auto_index(::tk::ButtonInvoke) [list source [file join $dir button.tcl]]
+set auto_index(::tk::ButtonAutoInvoke) [list source [file join $dir button.tcl]]
+set auto_index(::tk::CheckRadioInvoke) [list source [file join $dir button.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::) [list source [file join $dir choosedir.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::Config) [list source [file join $dir choosedir.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::OkCmd) [list source [file join $dir choosedir.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::DblClick) [list source [file join $dir choosedir.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::ListBrowse) [list source [file join $dir choosedir.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::Done) [list source [file join $dir choosedir.tcl]]
+set auto_index(::tk::dialog::color::) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::InitValues) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::Config) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::BuildDialog) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::SetRGBValue) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::XToRgb) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::RgbToX) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::DrawColorScale) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::CreateSelector) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::RedrawFinalColor) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::RedrawColorBars) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::StartMove) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::MoveSelector) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::ReleaseMouse) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::ResizeColorBars) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::HandleSelEntry) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::HandleRGBEntry) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::EnterColorBar) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::LeaveColorBar) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::OkCmd) [list source [file join $dir clrpick.tcl]]
+set auto_index(::tk::dialog::color::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(::tk::FocusGroup_Create) [list source [file join $dir comdlg.tcl]]
+set auto_index(::tk::FocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]
+set auto_index(::tk::FocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]
+set auto_index(::tk::FocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]
+set auto_index(::tk::FocusGroup_In) [list source [file join $dir comdlg.tcl]]
+set auto_index(::tk::FocusGroup_Out) [list source [file join $dir comdlg.tcl]]
+set auto_index(::tk::FDGetFileTypes) [list source [file join $dir comdlg.tcl]]
+set auto_index(::tk::ConsoleInit) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleSource) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleInvoke) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleHistory) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsolePrompt) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleBind) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleInsert) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleOutput) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleExit) [list source [file join $dir console.tcl]]
+set auto_index(::tk::ConsoleAbout) [list source [file join $dir console.tcl]]
+set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]
+set auto_index(::tk::EntryClosestGap) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryButton1) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryMouseSelect) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryPaste) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryAutoScan) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryKeySelect) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryInsert) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryBackspace) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntrySeeInsert) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntrySetCursor) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryTranspose) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryPreviousWord) [list source [file join $dir entry.tcl]]
+set auto_index(::tk::EntryGetSelection) [list source [file join $dir entry.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(::tk::FocusOK) [list source [file join $dir focus.tcl]]
+set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]
+set auto_index(::tk::ListboxBeginSelect) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxMotion) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxBeginExtend) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxBeginToggle) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxAutoScan) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxUpDown) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxExtendUpDown) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxDataExtend) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxCancel) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::ListboxSelectAll) [list source [file join $dir listbox.tcl]]
+set auto_index(::tk::MbEnter) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MbLeave) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MbPost) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuUnpost) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MbMotion) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MbButtonUp) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuMotion) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuButtonDown) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuLeave) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuInvoke) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuEscape) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuUpArrow) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuDownArrow) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuLeftArrow) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuRightArrow) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuNextMenu) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuNextEntry) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuFind) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::TraverseToMenu) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::FirstMenu) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::TraverseWithinMenu) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuFirstEntry) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::MenuFindName) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::PostOverPoint) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::SaveGrabInfo) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::RestoreOldGrab) [list source [file join $dir menu.tcl]]
+set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::GenerateMenuSelect) [list source [file join $dir menu.tcl]]
+set auto_index(tk_popup) [list source [file join $dir menu.tcl]]
+set auto_index(::tk::ensure_psenc_is_loaded) [list source [file join $dir mkpsenc.tcl]]
+set auto_index(::tk::MessageBox) [list source [file join $dir msgbox.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_optionMenu) [list source [file join $dir optMenu.tcl]]
+set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]
+set auto_index(::tk::RecolorTree) [list source [file join $dir palette.tcl]]
+set auto_index(::tk::Darken) [list source [file join $dir palette.tcl]]
+set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]
+set auto_index(::safe::tkInterpInit) [list source [file join $dir safetk.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::disallowTk) [list source [file join $dir safetk.tcl]]
+set auto_index(::safe::tkDelete) [list source [file join $dir safetk.tcl]]
+set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]
+set auto_index(::tk::ScaleActivate) [list source [file join $dir scale.tcl]]
+set auto_index(::tk::ScaleButtonDown) [list source [file join $dir scale.tcl]]
+set auto_index(::tk::ScaleDrag) [list source [file join $dir scale.tcl]]
+set auto_index(::tk::ScaleEndDrag) [list source [file join $dir scale.tcl]]
+set auto_index(::tk::ScaleIncrement) [list source [file join $dir scale.tcl]]
+set auto_index(::tk::ScaleControlPress) [list source [file join $dir scale.tcl]]
+set auto_index(::tk::ScaleButton2Down) [list source [file join $dir scale.tcl]]
+set auto_index(::tk::ScrollButtonDown) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollButtonUp) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollSelect) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollStartDrag) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollDrag) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollEndDrag) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollByUnits) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollByPages) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollToPos) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollTopBottom) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::ScrollButton2Down) [list source [file join $dir scrlbar.tcl]]
+set auto_index(::tk::spinbox::Invoke) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::ClosestGap) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::ButtonDown) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::ButtonUp) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::MouseSelect) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::Paste) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::Motion) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::AutoScan) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::KeySelect) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::Insert) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::Backspace) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::SeeInsert) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::SetCursor) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::Transpose) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::PreviousWord) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::spinbox::GetSelection) [list source [file join $dir spinbox.tcl]]
+set auto_index(::tk::TearOffMenu) [list source [file join $dir tearoff.tcl]]
+set auto_index(::tk::MenuDup) [list source [file join $dir tearoff.tcl]]
+set auto_index(::tk::TextClosestGap) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextButton1) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextSelectTo) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextKeyExtend) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextPaste) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextAutoScan) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextSetCursor) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextKeySelect) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextResetAnchor) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextInsert) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextUpDownLine) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextPrevPara) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextNextPara) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextScrollPages) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextTranspose) [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(::tk::TextNextPos) [list source [file join $dir text.tcl]]
+set auto_index(::tk::TextPrevPos) [list source [file join $dir text.tcl]]
+set auto_index(::tk::PlaceWindow) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::SetFocusGrab) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::RestoreFocusGrab) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::IconList) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Index) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Selection) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Curselection) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_DrawSelection) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Get) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Config) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Create) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_AutoScan) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Add) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Arrange) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Invoke) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_See) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Btn1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_CtrlBtn1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_ShiftBtn1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Motion1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Double1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Leave1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_FocusIn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_FocusOut) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_UpDown) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_LeftRight) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_KeyPress) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Goto) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::IconList_Reset) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::SetSelectMode) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Update) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::SetPathSilently) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::SetPath) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::SetFilter) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::ResolveFile) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::EntFocusIn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::EntFocusOut) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::ActivateEnt) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::VerifyFileName) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::InvokeBtn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::UpDirCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::JoinFile) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::OkCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::CancelCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::ListBrowse) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::ListInvoke) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Done) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::MotifFDialog) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_FileTypes) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_SetFilter) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_BuildUI) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_SetListMode) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::MotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::ListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::ListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::ListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::ListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::ListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tk_getFileType) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::unsupported::ExposePrivateCommand) [list source [file join $dir unsupported.tcl]]
+set auto_index(::tk::unsupported::ExposePrivateVariable) [list source [file join $dir unsupported.tcl]]
diff --git a/tcl/library/tearoff.tcl b/tcl/library/tearoff.tcl
new file mode 100644
index 00000000000..c714a607a90
--- /dev/null
+++ b/tcl/library/tearoff.tcl
@@ -0,0 +1,166 @@
+# tearoff.tcl --
+#
+# This file contains procedures that implement tear-off menus.
+#
+# RCS: @(#) $Id$
+#
+# 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.
+#
+
+# ::tk::TearoffMenu --
+# 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 ::tk::TearOffMenu {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 {[string compare [winfo toplevel $parent] $parent] \
+ || [string equal [winfo class $parent] "Menu"]} {
+ set parent [winfo parent $parent]
+ }
+ if {[string equal $parent "."]} {
+ set parent ""
+ }
+ for {set i 1} 1 {incr i} {
+ set menu $parent.tearoff$i
+ if {![winfo exists $menu]} {
+ break
+ }
+ }
+
+ $w clone $menu tearoff
+
+ # Pick a title for the new menu by looking at the parent of the
+ # original: if the parent is a menu, then use the text of the active
+ # entry. If it's a menubutton then use its text.
+
+ set parent [winfo parent $w]
+ if {[string compare [$menu cget -title] ""]} {
+ wm title $menu [$menu cget -title]
+ } else {
+ switch [winfo class $parent] {
+ Menubutton {
+ wm title $menu [$parent cget -text]
+ }
+ Menu {
+ wm title $menu [$parent entrycget active -label]
+ }
+ }
+ }
+
+ $menu post $x $y
+
+ if {[winfo exists $menu] == 0} {
+ return ""
+ }
+
+ # Set tk::Priv(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 tk::Priv(focus) %W
+ }
+
+ # If there is a -tearoffcommand option for the menu, invoke it
+ # now.
+
+ set cmd [$w cget -tearoffcommand]
+ if {[string compare $cmd ""]} {
+ uplevel #0 $cmd [list $w $menu]
+ }
+ return $menu
+}
+
+# ::tk::MenuDup --
+# 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 ::tk::MenuDup {src dst type} {
+ set cmd [list menu $dst -type $type]
+ foreach option [$src configure] {
+ if {[llength $option] == 2} {
+ continue
+ }
+ if {[string equal [lindex $option 0] "-type"]} {
+ continue
+ }
+ lappend cmd [lindex $option 0] [lindex $option 4]
+ }
+ eval $cmd
+ set last [$src index last]
+ if {[string equal $last "none"]} {
+ return
+ }
+ for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
+ set cmd [list $dst add [$src type $i]]
+ foreach option [$src entryconfigure $i] {
+ lappend cmd [lindex $option 0] [lindex $option 4]
+ }
+ eval $cmd
+ }
+
+ # Duplicate the binding tags and bindings from the source menu.
+
+ set tags [bindtags $src]
+ set srcLen [string length $src]
+
+ # Copy tags to x, replacing each substring of src with dst.
+
+ while {[set index [string first $src $tags]] != -1} {
+ append x [string range $tags 0 [expr {$index - 1}]]$dst
+ set tags [string range $tags [expr {$index + $srcLen}] end]
+ }
+ append x $tags
+
+ bindtags $dst $x
+
+ foreach event [bind $src] {
+ unset x
+ set script [bind $src $event]
+ set eventLen [string length $event]
+
+ # Copy script to x, replacing each substring of event with dst.
+
+ while {[set index [string first $event $script]] != -1} {
+ append x [string range $script 0 [expr {$index - 1}]]
+ append x $dst
+ set script [string range $script [expr {$index + $eventLen}] end]
+ }
+ append x $script
+
+ bind $dst $event $x
+ }
+}
diff --git a/tcl/library/text.tcl b/tcl/library/text.tcl
new file mode 100644
index 00000000000..70f6b8c74f0
--- /dev/null
+++ b/tcl/library/text.tcl
@@ -0,0 +1,1136 @@
+# text.tcl --
+#
+# This file defines the default bindings for Tk text widgets and provides
+# procedures that help in implementing the bindings.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of ::tk::Priv 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 text widgets.
+#-------------------------------------------------------------------------
+
+# Standard Motif bindings:
+
+bind Text <1> {
+ tk::TextButton1 %W %x %y
+ %W tag remove sel 0.0 end
+}
+bind Text <B1-Motion> {
+ set tk::Priv(x) %x
+ set tk::Priv(y) %y
+ tk::TextSelectTo %W %x %y
+}
+bind Text <Double-1> {
+ set tk::Priv(selectMode) word
+ tk::TextSelectTo %W %x %y
+ catch {%W mark set insert sel.last}
+}
+bind Text <Triple-1> {
+ set tk::Priv(selectMode) line
+ tk::TextSelectTo %W %x %y
+ catch {%W mark set insert sel.last}
+}
+bind Text <Shift-1> {
+ tk::TextResetAnchor %W @%x,%y
+ set tk::Priv(selectMode) char
+ tk::TextSelectTo %W %x %y
+}
+bind Text <Double-Shift-1> {
+ set tk::Priv(selectMode) word
+ tk::TextSelectTo %W %x %y 1
+}
+bind Text <Triple-Shift-1> {
+ set tk::Priv(selectMode) line
+ tk::TextSelectTo %W %x %y
+}
+bind Text <B1-Leave> {
+ set tk::Priv(x) %x
+ set tk::Priv(y) %y
+ tk::TextAutoScan %W
+}
+bind Text <B1-Enter> {
+ tk::CancelRepeat
+}
+bind Text <ButtonRelease-1> {
+ tk::CancelRepeat
+}
+bind Text <Control-1> {
+ %W mark set insert @%x,%y
+}
+bind Text <Left> {
+ tk::TextSetCursor %W insert-1c
+}
+bind Text <Right> {
+ tk::TextSetCursor %W insert+1c
+}
+bind Text <Up> {
+ tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
+}
+bind Text <Down> {
+ tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
+}
+bind Text <Shift-Left> {
+ tk::TextKeySelect %W [%W index {insert - 1c}]
+}
+bind Text <Shift-Right> {
+ tk::TextKeySelect %W [%W index {insert + 1c}]
+}
+bind Text <Shift-Up> {
+ tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
+}
+bind Text <Shift-Down> {
+ tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
+}
+bind Text <Control-Left> {
+ tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Control-Right> {
+ tk::TextSetCursor %W [tk::TextNextWord %W insert]
+}
+bind Text <Control-Up> {
+ tk::TextSetCursor %W [tk::TextPrevPara %W insert]
+}
+bind Text <Control-Down> {
+ tk::TextSetCursor %W [tk::TextNextPara %W insert]
+}
+bind Text <Shift-Control-Left> {
+ tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Shift-Control-Right> {
+ tk::TextKeySelect %W [tk::TextNextWord %W insert]
+}
+bind Text <Shift-Control-Up> {
+ tk::TextKeySelect %W [tk::TextPrevPara %W insert]
+}
+bind Text <Shift-Control-Down> {
+ tk::TextKeySelect %W [tk::TextNextPara %W insert]
+}
+bind Text <Prior> {
+ tk::TextSetCursor %W [tk::TextScrollPages %W -1]
+}
+bind Text <Shift-Prior> {
+ tk::TextKeySelect %W [tk::TextScrollPages %W -1]
+}
+bind Text <Next> {
+ tk::TextSetCursor %W [tk::TextScrollPages %W 1]
+}
+bind Text <Shift-Next> {
+ tk::TextKeySelect %W [tk::TextScrollPages %W 1]
+}
+bind Text <Control-Prior> {
+ %W xview scroll -1 page
+}
+bind Text <Control-Next> {
+ %W xview scroll 1 page
+}
+
+bind Text <Home> {
+ tk::TextSetCursor %W {insert linestart}
+}
+bind Text <Shift-Home> {
+ tk::TextKeySelect %W {insert linestart}
+}
+bind Text <End> {
+ tk::TextSetCursor %W {insert lineend}
+}
+bind Text <Shift-End> {
+ tk::TextKeySelect %W {insert lineend}
+}
+bind Text <Control-Home> {
+ tk::TextSetCursor %W 1.0
+}
+bind Text <Control-Shift-Home> {
+ tk::TextKeySelect %W 1.0
+}
+bind Text <Control-End> {
+ tk::TextSetCursor %W {end - 1 char}
+}
+bind Text <Control-Shift-End> {
+ tk::TextKeySelect %W {end - 1 char}
+}
+
+bind Text <Tab> {
+ if { [string equal [%W cget -state] "normal"] } {
+ tk::TextInsert %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> {
+ tk::TextInsert %W \t
+}
+bind Text <Return> {
+ tk::TextInsert %W \n
+ if {[%W cget -autoseparators]} {%W edit separator}
+}
+bind Text <Delete> {
+ if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
+ %W delete sel.first sel.last
+ } else {
+ %W delete insert
+ %W see insert
+ }
+}
+bind Text <BackSpace> {
+ if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
+ %W delete sel.first sel.last
+ } elseif {[%W compare insert != 1.0]} {
+ %W delete insert-1c
+ %W see insert
+ }
+}
+
+bind Text <Control-space> {
+ %W mark set anchor insert
+}
+bind Text <Select> {
+ %W mark set anchor insert
+}
+bind Text <Control-Shift-space> {
+ set tk::Priv(selectMode) char
+ tk::TextKeyExtend %W insert
+}
+bind Text <Shift-Select> {
+ set tk::Priv(selectMode) char
+ tk::TextKeyExtend %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 {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
+ || !$tk::Priv(mouseMoved)} {
+ tk::TextPasteSelection %W %x %y
+ }
+}
+bind Text <Insert> {
+ catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
+}
+bind Text <KeyPress> {
+ tk::TextInsert %W %A
+}
+
+# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
+# Otherwise, if a widget binding for one of these is defined, the
+# <KeyPress> class binding will also fire and insert the character,
+# which is wrong. Ditto for <Escape>.
+
+bind Text <Alt-KeyPress> {# nothing }
+bind Text <Meta-KeyPress> {# nothing}
+bind Text <Control-KeyPress> {# nothing}
+bind Text <Escape> {# nothing}
+bind Text <KP_Enter> {# nothing}
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+ bind Text <Command-KeyPress> {# nothing}
+}
+
+# Additional emacs-like bindings:
+
+bind Text <Control-a> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %W {insert linestart}
+ }
+}
+bind Text <Control-b> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %W insert-1c
+ }
+}
+bind Text <Control-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert
+ }
+}
+bind Text <Control-e> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %W {insert lineend}
+ }
+}
+bind Text <Control-f> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %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} {
+ tk::TextSetCursor %W [tk::TextUpDownLine %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} {
+ tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
+ }
+}
+bind Text <Control-t> {
+ if {!$tk_strictMotif} {
+ tk::TextTranspose %W
+ }
+}
+
+bind Text <<Undo>> {
+ catch { %W edit undo }
+}
+
+bind Text <<Redo>> {
+ catch { %W edit redo }
+}
+
+if {[string compare $tcl_platform(platform) "windows"]} {
+bind Text <Control-v> {
+ if {!$tk_strictMotif} {
+ tk::TextScrollPages %W 1
+ }
+}
+}
+
+bind Text <Meta-b> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
+ }
+}
+bind Text <Meta-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert [tk::TextNextWord %W insert]
+ }
+}
+bind Text <Meta-f> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %W [tk::TextNextWord %W insert]
+ }
+}
+bind Text <Meta-less> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %W 1.0
+ }
+}
+bind Text <Meta-greater> {
+ if {!$tk_strictMotif} {
+ tk::TextSetCursor %W end-1c
+ }
+}
+bind Text <Meta-BackSpace> {
+ if {!$tk_strictMotif} {
+ %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
+ }
+}
+bind Text <Meta-Delete> {
+ if {!$tk_strictMotif} {
+ %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
+ }
+}
+
+# Macintosh only bindings:
+
+# if text black & highlight black -> text white, other text the same
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
+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> {
+ tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Option-Right> {
+ tk::TextSetCursor %W [tk::TextNextWord %W insert]
+}
+bind Text <Option-Up> {
+ tk::TextSetCursor %W [tk::TextPrevPara %W insert]
+}
+bind Text <Option-Down> {
+ tk::TextSetCursor %W [tk::TextNextPara %W insert]
+}
+bind Text <Shift-Option-Left> {
+ tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Shift-Option-Right> {
+ tk::TextKeySelect %W [tk::TextNextWord %W insert]
+}
+bind Text <Shift-Option-Up> {
+ tk::TextKeySelect %W [tk::TextPrevPara %W insert]
+}
+bind Text <Shift-Option-Down> {
+ tk::TextKeySelect %W [tk::TextNextPara %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} {
+ tk::TextScanMark %W %x %y
+ }
+}
+bind Text <B2-Motion> {
+ if {!$tk_strictMotif} {
+ tk::TextScanDrag %W %x %y
+ }
+}
+set ::tk::Priv(prevPos) {}
+
+# The MouseWheel will typically only fire on Windows. However,
+# someone could use the "event generate" command to produce one
+# on other platforms.
+
+bind Text <MouseWheel> {
+ %W yview scroll [expr {- (%D / 120) * 4}] units
+}
+
+if {[string equal "x11" [tk windowingsystem]]} {
+ # Support for mousewheels on Linux/Unix commonly comes through mapping
+ # the wheel to the extended buttons. If you have a mousewheel, find
+ # Linux configuration info at:
+ # http://www.inria.fr/koala/colas/mouse-wheel-scroll/
+ bind Text <4> {
+ if {!$tk_strictMotif} {
+ %W yview scroll -5 units
+ }
+ }
+ bind Text <5> {
+ if {!$tk_strictMotif} {
+ %W yview scroll 5 units
+ }
+ }
+}
+
+# ::tk::TextClosestGap --
+# 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 ::tk::TextClosestGap {w x y} {
+ set pos [$w index @$x,$y]
+ set bbox [$w bbox $pos]
+ if {[string equal $bbox ""]} {
+ return $pos
+ }
+ if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
+ return $pos
+ }
+ $w index "$pos + 1 char"
+}
+
+# ::tk::TextButton1 --
+# 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 ::tk::TextButton1 {w x y} {
+ variable ::tk::Priv
+
+ set Priv(selectMode) char
+ set Priv(mouseMoved) 0
+ set Priv(pressX) $x
+ $w mark set insert [TextClosestGap $w $x $y]
+ $w mark set anchor insert
+ # Allow focus in any case on Windows, because that will let the
+ # selection be displayed even for state disabled text widgets.
+ if {[string equal $::tcl_platform(platform) "windows"] \
+ || [string equal [$w cget -state] "normal"]} {focus $w}
+ if {[$w cget -autoseparators]} {$w edit separator}
+}
+
+# ::tk::TextSelectTo --
+# 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 ::tk::TextSelectTo {w x y {extend 0}} {
+ global tcl_platform
+ variable ::tk::Priv
+
+ set cur [TextClosestGap $w $x $y]
+ if {[catch {$w index anchor}]} {
+ $w mark set anchor $cur
+ }
+ set anchor [$w index anchor]
+ if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
+ set Priv(mouseMoved) 1
+ }
+ switch $Priv(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 [TextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
+ if { !$extend } {
+ set last [TextNextPos $w "anchor" tcl_wordBreakAfter]
+ } else {
+ set last anchor
+ }
+ } else {
+ set last [TextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
+ if { !$extend } {
+ set first [TextPrevPos $w anchor tcl_wordBreakBefore]
+ } else {
+ set first anchor
+ }
+ }
+ }
+ 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 {$Priv(mouseMoved) || [string compare $Priv(selectMode) "char"]} {
+ $w tag remove sel 0.0 end
+ $w mark set insert $cur
+ $w tag add sel $first $last
+ $w tag remove sel $last end
+ update idletasks
+ }
+}
+
+# ::tk::TextKeyExtend --
+# 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 ::tk::TextKeyExtend {w index} {
+
+ 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
+}
+
+# ::tk::TextPasteSelection --
+# 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 ::tk::TextPasteSelection {w x y} {
+ $w mark set insert [TextClosestGap $w $x $y]
+ if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
+ set oldSeparator [$w cget -autoseparators]
+ if {$oldSeparator} {
+ $w configure -autoseparators 0
+ $w edit separator
+ }
+ $w insert insert $sel
+ if {$oldSeparator} {
+ $w edit separator
+ $w configure -autoseparators 1
+ }
+ }
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
+}
+
+# ::tk::TextAutoScan --
+# 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
+# ::tk::Priv(x) and ::tk::Priv(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 ::tk::TextAutoScan {w} {
+ variable ::tk::Priv
+ if {![winfo exists $w]} return
+ if {$Priv(y) >= [winfo height $w]} {
+ $w yview scroll 2 units
+ } elseif {$Priv(y) < 0} {
+ $w yview scroll -2 units
+ } elseif {$Priv(x) >= [winfo width $w]} {
+ $w xview scroll 2 units
+ } elseif {$Priv(x) < 0} {
+ $w xview scroll -2 units
+ } else {
+ return
+ }
+ TextSelectTo $w $Priv(x) $Priv(y)
+ set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
+}
+
+# ::tk::TextSetCursor
+# 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 ::tk::TextSetCursor {w pos} {
+
+ 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
+ if {[$w cget -autoseparators]} {$w edit separator}
+}
+
+# ::tk::TextKeySelect
+# 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 ::tk::TextKeySelect {w new} {
+
+ if {[string equal [$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
+}
+
+# ::tk::TextResetAnchor --
+# 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 ::tk::TextResetAnchor {w index} {
+
+ if {[string equal [$w tag ranges sel] ""]} {
+ # Don't move the anchor if there is no selection now; this makes
+ # the widget behave "correctly" when the user clicks once, then
+ # shift-clicks somewhere -- ie, the area between the two clicks will be
+ # selected. [Bug: 5929].
+ 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
+ }
+}
+
+# ::tk::TextInsert --
+# 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 ::tk::TextInsert {w s} {
+ if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} {
+ return
+ }
+ set compound 0
+ catch {
+ if {[$w compare sel.first <= insert] \
+ && [$w compare sel.last >= insert]} {
+ set oldSeparator [$w cget -autoseparators]
+ if { $oldSeparator } {
+ $w configure -autoseparators 0
+ $w edit separator
+ set compound 1
+ }
+ $w delete sel.first sel.last
+ }
+ }
+ $w insert insert $s
+ $w see insert
+ if { $compound && $oldSeparator } {
+ $w edit separator
+ $w configure -autoseparators 1
+ }
+}
+
+# ::tk::TextUpDownLine --
+# 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 ::tk::TextUpDownLine {w n} {
+ variable ::tk::Priv
+
+ set i [$w index insert]
+ scan $i "%d.%d" line char
+ if {[string compare $Priv(prevPos) $i]} {
+ set Priv(char) $char
+ }
+ set new [$w index [expr {$line + $n}].$Priv(char)]
+ if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
+ set new $i
+ }
+ set Priv(prevPos) $new
+ return $new
+}
+
+# ::tk::TextPrevPara --
+# 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 ::tk::TextPrevPara {w pos} {
+ set pos [$w index "$pos linestart"]
+ while {1} {
+ if {([string equal [$w get "$pos - 1 line"] "\n"] \
+ && [string compare [$w get $pos] "\n"]) \
+ || [string equal $pos "1.0"]} {
+ if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \
+ dummy index]} {
+ set pos [$w index "$pos + [lindex $index 0] chars"]
+ }
+ if {[$w compare $pos != insert] || [string equal $pos 1.0]} {
+ return $pos
+ }
+ }
+ set pos [$w index "$pos - 1 line"]
+ }
+}
+
+# ::tk::TextNextPara --
+# 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 ::tk::TextNextPara {w start} {
+ set pos [$w index "$start linestart + 1 line"]
+ while {[string compare [$w get $pos] "\n"]} {
+ if {[$w compare $pos == end]} {
+ return [$w index "end - 1c"]
+ }
+ set pos [$w index "$pos + 1 line"]
+ }
+ while {[string equal [$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
+}
+
+# ::tk::TextScrollPages --
+# 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 ::tk::TextScrollPages {w count} {
+ set bbox [$w bbox insert]
+ $w yview scroll $count pages
+ if {[string equal $bbox ""]} {
+ return [$w index @[expr {[winfo height $w]/2}],0]
+ }
+ return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
+}
+
+# ::tk::TextTranspose --
+# 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 ::tk::TextTranspose 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
+ if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
+ set oldSeparator [$w cget -autoseparators]
+ if { $oldSeparator } {
+ $w configure -autoseparators 0
+ $w edit separator
+ }
+ if {[string compare [tk windowingsystem] "x11"]} {
+ catch { $w delete sel.first sel.last }
+ }
+ $w insert insert $sel
+ if { $oldSeparator } {
+ $w edit separator
+ $w configure -autoseparators 1
+ }
+ }
+}
+
+# ::tk::TextNextWord --
+# Returns the index of the next word position after a given position in the
+# text. The next word is platform dependent and may be either the next
+# end-of-word position or the next start-of-word position after the next
+# end-of-word position.
+#
+# Arguments:
+# w - The text window in which the cursor is to move.
+# start - Position at which to start search.
+
+if {[string equal $tcl_platform(platform) "windows"]} {
+ proc ::tk::TextNextWord {w start} {
+ TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
+ tcl_startOfNextWord
+ }
+} else {
+ proc ::tk::TextNextWord {w start} {
+ TextNextPos $w $start tcl_endOfWord
+ }
+}
+
+# ::tk::TextNextPos --
+# 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 ::tk::TextNextPos {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} {
+ ## Adjust for embedded windows and images
+ ## dump gives us 3 items per window/image
+ set dump [$w dump -image -window $start "$start + $pos c"]
+ if {[llength $dump]} {
+ set pos [expr {$pos + ([llength $dump]/3)}]
+ }
+ return [$w index "$start + $pos c"]
+ }
+ set cur [$w index "$cur lineend +1c"]
+ }
+ return end
+}
+
+# ::tk::TextPrevPos --
+# 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 ::tk::TextPrevPos {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} {
+ ## Adjust for embedded windows and images
+ ## dump gives us 3 items per window/image
+ set dump [$w dump -image -window "$cur linestart" "$start - 1c"]
+ if {[llength $dump]} {
+ ## This is a hokey extra hack for control-arrow movement
+ ## that should be in a while loop to be correct (hobbs)
+ if {[$w compare [lindex $dump 2] > \
+ "$cur linestart - 1c + $pos c"]} {
+ incr pos -1
+ }
+ set pos [expr {$pos + ([llength $dump]/3)}]
+ }
+ return [$w index "$cur linestart - 1c + $pos c"]
+ }
+ set cur [$w index "$cur linestart - 1c"]
+ }
+ return 0.0
+}
+
+# ::tk::TextScanMark --
+#
+# Marks the start of a possible scan drag operation
+#
+# Arguments:
+# w - The text window from which the text to get
+# x - x location on screen
+# y - y location on screen
+
+proc ::tk::TextScanMark {w x y} {
+ $w scan mark $x $y
+ set ::tk::Priv(x) $x
+ set ::tk::Priv(y) $y
+ set ::tk::Priv(mouseMoved) 0
+}
+
+# ::tk::TextScanDrag --
+#
+# Marks the start of a possible scan drag operation
+#
+# Arguments:
+# w - The text window from which the text to get
+# x - x location on screen
+# y - y location on screen
+
+proc ::tk::TextScanDrag {w x y} {
+ # Make sure these exist, as some weird situations can trigger the
+ # motion binding without the initial press. [Bug #220269]
+ if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
+ if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y }
+ if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} {
+ set ::tk::Priv(mouseMoved) 1
+ }
+ if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} {
+ $w scan dragto $x $y
+ }
+}
diff --git a/tcl/library/tk.tcl b/tcl/library/tk.tcl
new file mode 100644
index 00000000000..add0cd50878
--- /dev/null
+++ b/tcl/library/tk.tcl
@@ -0,0 +1,580 @@
+# tk.tcl --
+#
+# Initialization script normally executed in the interpreter for each
+# Tk-based application. Arranges class bindings for widgets.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
+#
+# 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.4
+package require -exact Tcl 8.4
+
+# Create a ::tk namespace
+namespace eval ::tk {
+ # Set up the msgcat commands
+ namespace eval msgcat {
+ namespace export mc mcmax
+ if {[interp issafe] || [catch {package require msgcat}]} {
+ # The msgcat package is not available. Supply our own
+ # minimal replacement.
+ proc mc {src args} {
+ return [eval [list format $src] $args]
+ }
+ proc mcmax {args} {
+ set max 0
+ foreach string $args {
+ set len [string length $string]
+ if {$len>$max} {
+ set max $len
+ }
+ }
+ return $max
+ }
+ } else {
+ # Get the commands from the msgcat package that Tk uses.
+ namespace import ::msgcat::mc
+ namespace import ::msgcat::mcmax
+ ::msgcat::mcload [file join $::tk_library msgs]
+ }
+ }
+ namespace import ::tk::msgcat::*
+}
+
+# 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] && [string compare {} $::tk_library] && \
+ [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
+
+# Turn on useinputmethods (X Input Methods) by default.
+# We catch this because safe interpreters may not allow the call.
+
+catch {tk useinputmethods 1}
+
+# ::tk::PlaceWindow --
+# place a toplevel at a particular position
+# Arguments:
+# toplevel name of toplevel window
+# ?placement? pointer ?center? ; places $w centered on the pointer
+# widget widgetPath ; centers $w over widget_name
+# defaults to placing toplevel in the middle of the screen
+# ?anchor? center or widgetPath
+# Results:
+# Returns nothing
+#
+proc ::tk::PlaceWindow {w {place ""} {anchor ""}} {
+ wm withdraw $w
+ update idletasks
+ set checkBounds 1
+ if {[string equal -len [string length $place] $place "pointer"]} {
+ ## place at POINTER (centered if $anchor == center)
+ if {[string equal -len [string length $anchor] $anchor "center"]} {
+ set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
+ set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
+ } else {
+ set x [winfo pointerx $w]
+ set y [winfo pointery $w]
+ }
+ } elseif {[string equal -len [string length $place] $place "widget"] && \
+ [winfo exists $anchor] && [winfo ismapped $anchor]} {
+ ## center about WIDGET $anchor, widget must be mapped
+ set x [expr {[winfo rootx $anchor] + \
+ ([winfo width $anchor]-[winfo reqwidth $w])/2}]
+ set y [expr {[winfo rooty $anchor] + \
+ ([winfo height $anchor]-[winfo reqheight $w])/2}]
+ } else {
+ set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
+ set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
+ set checkBounds 0
+ }
+ if {$checkBounds} {
+ if {$x < 0} {
+ set x 0
+ } elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {
+ set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]
+ }
+ if {$y < 0} {
+ set y 0
+ } elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {
+ set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]
+ }
+ if {[tk windowingsystem] eq "macintosh" \
+ || [tk windowingsystem] eq "aqua"} {
+ # Avoid the native menu bar which sits on top of everything.
+ if {$y < 20} { set y 20 }
+ }
+ }
+ wm geometry $w +$x+$y
+ wm deiconify $w
+}
+
+# ::tk::SetFocusGrab --
+# swap out current focus and grab temporarily (for dialogs)
+# Arguments:
+# grab new window to grab
+# focus window to give focus to
+# Results:
+# Returns nothing
+#
+proc ::tk::SetFocusGrab {grab {focus {}}} {
+ set index "$grab,$focus"
+ upvar ::tk::FocusGrab($index) data
+
+ lappend data [focus]
+ set oldGrab [grab current $grab]
+ lappend data $oldGrab
+ if {[winfo exists $oldGrab]} {
+ lappend data [grab status $oldGrab]
+ }
+ # The "grab" command will fail if another application
+ # already holds the grab. So catch it.
+ catch {grab $grab}
+ if {[winfo exists $focus]} {
+ focus $focus
+ }
+}
+
+# ::tk::RestoreFocusGrab --
+# restore old focus and grab (for dialogs)
+# Arguments:
+# grab window that had taken grab
+# focus window that had taken focus
+# destroy destroy|withdraw - how to handle the old grabbed window
+# Results:
+# Returns nothing
+#
+proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {
+ set index "$grab,$focus"
+ if {[info exists ::tk::FocusGrab($index)]} {
+ foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }
+ unset ::tk::FocusGrab($index)
+ } else {
+ set oldGrab ""
+ }
+
+ catch {focus $oldFocus}
+ grab release $grab
+ if {[string equal $destroy "withdraw"]} {
+ wm withdraw $grab
+ } else {
+ destroy $grab
+ }
+ if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {
+ if {[string equal $oldStatus "global"]} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+}
+
+# ::tk::GetSelection --
+# This tries to obtain the default selection. On Unix, we first try
+# and get a UTF8_STRING, a type supported by modern Unix apps for
+# passing Unicode data safely. We fall back on the default STRING
+# type otherwise. On Windows, only the STRING type is necessary.
+# Arguments:
+# w The widget for which the selection will be retrieved.
+# Important for the -displayof property.
+# sel The source of the selection (PRIMARY or CLIPBOARD)
+# Results:
+# Returns the selection, or an error if none could be found
+#
+if {[string equal $tcl_platform(platform) "unix"]} {
+ proc ::tk::GetSelection {w {sel PRIMARY}} {
+ if {[catch {selection get -displayof $w -selection $sel \
+ -type UTF8_STRING} txt] \
+ && [catch {selection get -displayof $w -selection $sel} txt]} {
+ return -code error "could not find default selection"
+ } else {
+ return $txt
+ }
+ }
+} else {
+ proc ::tk::GetSelection {w {sel PRIMARY}} {
+ if {[catch {selection get -displayof $w -selection $sel} txt]} {
+ return -code error "could not find default selection"
+ } else {
+ return $txt
+ }
+ }
+}
+
+# ::tk::ScreenChanged --
+# 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 variable "::tk::Priv" 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 ::tk::ScreenChanged 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 ::tk::Priv.$disp ::tk::Priv
+ variable ::tk::Priv
+ global tcl_platform
+
+ if {[info exists Priv]} {
+ set Priv(screen) $screen
+ return
+ }
+ array set Priv {
+ activeMenu {}
+ activeItem {}
+ afterId {}
+ buttons 0
+ buttonWindow {}
+ dragging 0
+ focus {}
+ grab {}
+ initPos {}
+ inMenubutton {}
+ listboxPrev {}
+ menuBar {}
+ mouseMoved 0
+ oldGrab {}
+ popup {}
+ postedMb {}
+ pressX 0
+ pressY 0
+ prevPos 0
+ selectMode char
+ }
+ set Priv(screen) $screen
+ set Priv(tearoff) [string equal [tk windowingsystem] "x11"]
+ set Priv(window) {}
+}
+
+# Do initial setup for Priv, 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).
+
+tk::ScreenChanged [winfo screen .]
+
+# ::tk::EventMotifBindings --
+# 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 ::tk::EventMotifBindings {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>
+ event $op <<Undo>> <Control-underscore>
+}
+
+#----------------------------------------------------------------------
+# Define common dialogs on platforms where they are not implemented
+# using compiled code.
+#----------------------------------------------------------------------
+
+if {[string equal [info commands tk_chooseColor] ""]} {
+ proc ::tk_chooseColor {args} {
+ return [eval tk::dialog::color:: $args]
+ }
+}
+if {[string equal [info commands tk_getOpenFile] ""]} {
+ proc ::tk_getOpenFile {args} {
+ if {$::tk_strictMotif} {
+ return [eval tk::MotifFDialog open $args]
+ } else {
+ return [eval ::tk::dialog::file:: open $args]
+ }
+ }
+}
+if {[string equal [info commands tk_getSaveFile] ""]} {
+ proc ::tk_getSaveFile {args} {
+ if {$::tk_strictMotif} {
+ return [eval tk::MotifFDialog save $args]
+ } else {
+ return [eval ::tk::dialog::file:: save $args]
+ }
+ }
+}
+if {[string equal [info commands tk_messageBox] ""]} {
+ proc ::tk_messageBox {args} {
+ return [eval tk::MessageBox $args]
+ }
+}
+if {[string equal [info command tk_chooseDirectory] ""]} {
+ proc ::tk_chooseDirectory {args} {
+ return [eval ::tk::dialog::file::chooseDir:: $args]
+ }
+}
+
+#----------------------------------------------------------------------
+# Define the set of common virtual events.
+#----------------------------------------------------------------------
+
+switch [tk windowingsystem] {
+ "x11" {
+ 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>
+ event add <<Undo>> <Control-Key-z>
+ event add <<Redo>> <Control-Key-Z>
+ # Some OS's define a goofy (as in, not <Shift-Tab>) keysym
+ # that is returned when the user presses <Shift-Tab>. In order for
+ # tab traversal to work, we have to add these keysyms to the
+ # PrevWindow event.
+ # The info exists is necessary, because tcl_platform(os) doesn't
+ # exist in safe interpreters.
+ if {[info exists tcl_platform(os)]} {
+ switch $tcl_platform(os) {
+ "IRIX" -
+ "Linux" { event add <<PrevWindow>> <ISO_Left_Tab> }
+ "HP-UX" {
+ # This seems to be correct on *some* HP systems.
+ catch { event add <<PrevWindow>> <hpBackTab> }
+ }
+ }
+ }
+ trace variable ::tk_strictMotif w ::tk::EventMotifBindings
+ set ::tk_strictMotif $::tk_strictMotif
+ }
+ "win32" {
+ 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>
+ event add <<Undo>> <Control-Key-z>
+ event add <<Redo>> <Control-Key-y>
+ }
+ "aqua" {
+ event add <<Cut>> <Command-Key-x> <Key-F2>
+ event add <<Copy>> <Command-Key-c> <Key-F3>
+ event add <<Paste>> <Command-Key-v> <Key-F4>
+ event add <<PasteSelection>> <ButtonRelease-2>
+ event add <<Clear>> <Clear>
+ event add <<Undo>> <Command-Key-z>
+ event add <<Redo>> <Command-Key-y>
+ }
+ "classic" {
+ 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>
+ event add <<Undo>> <Control-Key-z> <Key-F1>
+ event add <<Redo>> <Control-Key-Z>
+ }
+}
+# ----------------------------------------------------------------------
+# Read in files that define all of the class bindings.
+# ----------------------------------------------------------------------
+
+if {$::tk_library ne ""} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
+ proc ::tk::SourceLibFile {file} {
+ if {[catch {
+ namespace eval :: \
+ [list source [file join $::tk_library $file.tcl]]
+ }]} {
+ namespace eval :: [list source -rsrc $file]
+ }
+ }
+ } else {
+ proc ::tk::SourceLibFile {file} {
+ namespace eval :: [list source [file join $::tk_library $file.tcl]]
+ }
+ }
+ namespace eval ::tk {
+ SourceLibFile button
+ SourceLibFile entry
+ SourceLibFile listbox
+ SourceLibFile menu
+ SourceLibFile panedwindow
+ SourceLibFile scale
+ SourceLibFile scrlbar
+ SourceLibFile spinbox
+ SourceLibFile text
+ }
+}
+# ----------------------------------------------------------------------
+# Default bindings for keyboard traversal.
+# ----------------------------------------------------------------------
+
+event add <<PrevWindow>> <Shift-Tab>
+bind all <Tab> {tk::TabToWindow [tk_focusNext %W]}
+bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
+
+# ::tk::CancelRepeat --
+# This procedure is invoked to cancel an auto-repeat action described
+# by ::tk::Priv(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 ::tk::CancelRepeat {} {
+ variable ::tk::Priv
+ after cancel $Priv(afterId)
+ set Priv(afterId) {}
+}
+
+# ::tk::TabToWindow --
+# 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 ::tk::TabToWindow {w} {
+ if {[string equal [winfo class $w] Entry]} {
+ $w selection range 0 end
+ $w icursor end
+ }
+ focus $w
+}
+
+# ::tk::UnderlineAmpersand --
+# This procedure takes some text with ampersand and returns
+# text w/o ampersand and position of the ampersand.
+# Double ampersands are converted to single ones.
+# Position returned is -1 when there is no ampersand.
+#
+proc ::tk::UnderlineAmpersand {text} {
+ set idx [string first "&" $text]
+ if {$idx >= 0} {
+ set underline $idx
+ # ignore "&&"
+ while {[string match "&" [string index $text [expr {$idx + 1}]]]} {
+ set base [expr {$idx + 2}]
+ set idx [string first "&" [string range $text $base end]]
+ if {$idx < 0} {
+ break
+ } else {
+ set underline [expr {$underline + $idx + 1}]
+ incr idx $base
+ }
+ }
+ }
+ if {$idx >= 0} {
+ regsub -all -- {&([^&])} $text {\1} text
+ }
+ return [list $text $idx]
+}
+
+# ::tk::SetAmpText --
+# Given widget path and text with "magic ampersands",
+# sets -text and -underline options for the widget
+#
+proc ::tk::SetAmpText {widget text} {
+ foreach {newtext under} [::tk::UnderlineAmpersand $text] {
+ $widget configure -text $newtext -underline $under
+ }
+}
+
+# ::tk::AmpWidget --
+# Creates new widget, turning -text option into -text and
+# -underline options, returned by ::tk::UnderlineAmpersand.
+#
+proc ::tk::AmpWidget {class path args} {
+ set wcmd [list $class $path]
+ foreach {opt val} $args {
+ if {[string equal $opt {-text}]} {
+ foreach {newtext under} [::tk::UnderlineAmpersand $val] {
+ lappend wcmd -text $newtext -underline $under
+ }
+ } else {
+ lappend wcmd $opt $val
+ }
+ }
+ eval $wcmd
+ if {$class=="button"} {
+ bind $path <<AltUnderlined>> [list $path invoke]
+ }
+ return $path
+}
+
+# ::tk::FindAltKeyTarget --
+# search recursively through the hierarchy of visible widgets
+# to find button or label which has $char as underlined character
+#
+proc ::tk::FindAltKeyTarget {path char} {
+ switch [winfo class $path] {
+ Button -
+ Label {
+ if {[string equal -nocase $char \
+ [string index [$path cget -text] \
+ [$path cget -underline]]]} {return $path} else {return {}}
+ }
+ default {
+ foreach child \
+ [concat [grid slaves $path] \
+ [pack slaves $path] \
+ [place slaves $path] ] {
+ if {""!=[set target [::tk::FindAltKeyTarget $child $char]]} {
+ return $target
+ }
+ }
+ }
+ }
+ return {}
+}
+
+# ::tk::AltKeyInDialog --
+# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>>
+# to button or label which has appropriate underlined character
+#
+proc ::tk::AltKeyInDialog {path key} {
+ set target [::tk::FindAltKeyTarget $path $key]
+ if { $target == ""} return
+ event generate $target <<AltUnderlined>>
+}
+
+# ::tk::mcmaxamp --
+# Replacement for mcmax, used for texts with "magic ampersand" in it.
+#
+
+proc ::tk::mcmaxamp {args} {
+ set maxlen 0
+ foreach arg $args {
+ set length [string length [lindex [::tk::UnderlineAmpersand [mc $arg]] 0]]
+ if {$length>$maxlen} {
+ set maxlen $length
+ }
+ }
+ return $maxlen
+}
+# For now, turn off the custom mdef proc for the mac:
+
+if {[string equal [tk windowingsystem] "aqua"]} {
+ namespace eval ::tk::mac {
+ set useCustomMDEF 0
+ }
+}
diff --git a/tcl/library/tkfbox.tcl b/tcl/library/tkfbox.tcl
new file mode 100644
index 00000000000..256447abfb2
--- /dev/null
+++ b/tcl/library/tkfbox.tcl
@@ -0,0 +1,1803 @@
+# 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
+# selecting the "Directory" option menu. The user can select
+# files by clicking on the file icons or by entering a filename
+# in the "Filename:" entry.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1994-1998 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#----------------------------------------------------------------------
+#
+# I C O N L I S T
+#
+# This is a pseudo-widget that implements the icon list inside the
+# ::tk::dialog::file:: dialog box.
+#
+#----------------------------------------------------------------------
+
+# ::tk::IconList --
+#
+# Creates an IconList widget.
+#
+proc ::tk::IconList {w args} {
+ IconList_Config $w $args
+ IconList_Create $w
+}
+
+proc ::tk::IconList_Index {w i} {
+ upvar #0 ::tk::$w data
+ upvar #0 ::tk::$w:itemList itemList
+ if {![info exists data(list)]} {set data(list) {}}
+ switch -regexp -- $i {
+ "^-?[0-9]+$" {
+ if { $i < 0 } {
+ set i 0
+ }
+ if { $i >= [llength $data(list)] } {
+ set i [expr {[llength $data(list)] - 1}]
+ }
+ return $i
+ }
+ "^active$" {
+ return $data(index,active)
+ }
+ "^anchor$" {
+ return $data(index,anchor)
+ }
+ "^end$" {
+ return [llength $data(list)]
+ }
+ "@-?[0-9]+,-?[0-9]+" {
+ foreach {x y} [scan $i "@%d,%d"] {
+ break
+ }
+ set item [$data(canvas) find closest $x $y]
+ return [lindex [$data(canvas) itemcget $item -tags] 1]
+ }
+ }
+}
+
+proc ::tk::IconList_Selection {w op args} {
+ upvar ::tk::$w data
+ switch -exact -- $op {
+ "anchor" {
+ if { [llength $args] == 1 } {
+ set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]
+ } else {
+ return $data(index,anchor)
+ }
+ }
+ "clear" {
+ if { [llength $args] == 2 } {
+ foreach {first last} $args {
+ break
+ }
+ } elseif { [llength $args] == 1 } {
+ set first [set last [lindex $args 0]]
+ } else {
+ error "wrong # args: should be [lindex [info level 0] 0] path\
+ clear first ?last?"
+ }
+ set first [IconList_Index $w $first]
+ set last [IconList_Index $w $last]
+ if { $first > $last } {
+ set tmp $first
+ set first $last
+ set last $tmp
+ }
+ set ind 0
+ foreach item $data(selection) {
+ if { $item >= $first } {
+ set first $ind
+ break
+ }
+ }
+ set ind [expr {[llength $data(selection)] - 1}]
+ for {} {$ind >= 0} {incr ind -1} {
+ set item [lindex $data(selection) $ind]
+ if { $item <= $last } {
+ set last $ind
+ break
+ }
+ }
+
+ if { $first > $last } {
+ return
+ }
+ set data(selection) [lreplace $data(selection) $first $last]
+ event generate $w <<ListboxSelect>>
+ IconList_DrawSelection $w
+ }
+ "includes" {
+ set index [lsearch -exact $data(selection) [lindex $args 0]]
+ return [expr {$index != -1}]
+ }
+ "set" {
+ if { [llength $args] == 2 } {
+ foreach {first last} $args {
+ break
+ }
+ } elseif { [llength $args] == 1 } {
+ set last [set first [lindex $args 0]]
+ } else {
+ error "wrong # args: should be [lindex [info level 0] 0] path\
+ set first ?last?"
+ }
+
+ set first [IconList_Index $w $first]
+ set last [IconList_Index $w $last]
+ if { $first > $last } {
+ set tmp $first
+ set first $last
+ set last $tmp
+ }
+ for {set i $first} {$i <= $last} {incr i} {
+ lappend data(selection) $i
+ }
+ set data(selection) [lsort -integer -unique $data(selection)]
+ event generate $w <<ListboxSelect>>
+ IconList_DrawSelection $w
+ }
+ }
+}
+
+proc ::tk::IconList_Curselection {w} {
+ upvar ::tk::$w data
+ return $data(selection)
+}
+
+proc ::tk::IconList_DrawSelection {w} {
+ upvar ::tk::$w data
+ upvar ::tk::$w:itemList itemList
+
+ $data(canvas) delete selection
+ foreach item $data(selection) {
+ set rTag [lindex [lindex $data(list) $item] 2]
+ foreach {iTag tTag text serial} $itemList($rTag) {
+ break
+ }
+
+ set bbox [$data(canvas) bbox $tTag]
+ $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \
+ -tags selection
+ }
+ $data(canvas) lower selection
+ return
+}
+
+proc ::tk::IconList_Get {w item} {
+ upvar ::tk::$w data
+ upvar ::tk::$w:itemList itemList
+ set rTag [lindex [lindex $data(list) $item] 2]
+ foreach {iTag tTag text serial} $itemList($rTag) {
+ break
+ }
+ return $text
+}
+
+# ::tk::IconList_Config --
+#
+# Configure the widget variables of IconList, according to the command
+# line arguments.
+#
+proc ::tk::IconList_Config {w argList} {
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-command "" "" ""}
+ {-multiple "" "" "0"}
+ }
+
+ # 2: parse the arguments
+ #
+ tclParseConfigSpec ::tk::$w $specs "" $argList
+}
+
+# ::tk::IconList_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 ::tk::IconList_Create {w} {
+ upvar ::tk::$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 [list $data(canvas) xview]
+ $data(canvas) config -xscrollcommand [list $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
+ set data(selection) {}
+ set data(index,anchor) ""
+
+ # Creates the event bindings.
+ #
+ bind $data(canvas) <Configure> [list tk::IconList_Arrange $w]
+
+ bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y]
+ bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y]
+ bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y]
+ bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y]
+ bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y]
+ bind $data(canvas) <B1-Enter> [list tk::CancelRepeat]
+ bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
+ bind $data(canvas) <Double-ButtonRelease-1> \
+ [list tk::IconList_Double1 $w %x %y]
+
+ bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1]
+ bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1]
+ bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1]
+ bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1]
+ bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w]
+ bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A]
+ bind $data(canvas) <Control-KeyPress> ";"
+ bind $data(canvas) <Alt-KeyPress> ";"
+
+ bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w]
+ bind $data(canvas) <FocusOut> [list tk::IconList_FocusOut $w]
+
+ return $w
+}
+
+# ::tk::IconList_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 ::tk::IconList_AutoScan {w} {
+ upvar ::tk::$w data
+ variable ::tk::Priv
+
+ if {![winfo exists $w]} return
+ set x $Priv(x)
+ set y $Priv(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
+ }
+
+ IconList_Motion1 $w $x $y
+ set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
+}
+
+# Deletes all the items inside the canvas subwidget and reset the IconList's
+# state.
+#
+proc ::tk::IconList_DeleteAll {w} {
+ upvar ::tk::$w data
+ upvar ::tk::$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
+ set data(selection) {}
+ set data(index,anchor) ""
+ $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 ::tk::IconList_Add {w image items} {
+ upvar ::tk::$w data
+ upvar ::tk::$w:itemList itemList
+ upvar ::tk::$w:textList textList
+
+ foreach text $items {
+ set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
+ -tags [list icon $data(numItems) item$data(numItems)]]
+ set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \
+ -font $data(font) \
+ -tags [list text $data(numItems) item$data(numItems)]]
+ set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \
+ -tags [list rect $data(numItems) item$data(numItems)]]
+
+ foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {
+ break
+ }
+ set iW [expr {$x2 - $x1}]
+ set iH [expr {$y2 - $y1}]
+ if {$data(maxIW) < $iW} {
+ set data(maxIW) $iW
+ }
+ if {$data(maxIH) < $iH} {
+ set data(maxIH) $iH
+ }
+
+ foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {
+ break
+ }
+ set tW [expr {$x2 - $x1}]
+ set tH [expr {$y2 - $y1}]
+ 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 ::tk::IconList_Arrange {w} {
+ upvar ::tk::$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
+ foreach {iTag tTag rTag iW iH tW tH} $sublist {
+ break
+ }
+
+ 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 $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 [list $pad $pad $sW $H]
+ $data(sbar) config -command ""
+ $data(canvas) xview moveto 0
+ set data(noScroll) 1
+ } else {
+ $data(canvas) config -scrollregion [list $pad $pad $sW $H]
+ $data(sbar) config -command [list $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) != ""} {
+ IconList_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 ::tk::IconList_Invoke {w} {
+ upvar ::tk::$w data
+
+ if {$data(-command) != "" && [llength $data(selection)]} {
+ uplevel #0 $data(-command)
+ }
+}
+
+# ::tk::IconList_See --
+#
+# If the item is not (completely) visible, scroll the canvas so that
+# it becomes visible.
+proc ::tk::IconList_See {w rTag} {
+ upvar ::tk::$w data
+ upvar ::tk::$w:itemList itemList
+
+ if {$data(noScroll)} {
+ return
+ }
+ set sRegion [$data(canvas) cget -scrollregion]
+ if {[string equal $sRegion {}]} {
+ return
+ }
+
+ if { $rTag < 0 || $rTag >= [llength $data(list)] } {
+ return
+ }
+
+ set bbox [$data(canvas) bbox item$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 ::tk::IconList_Btn1 {w x y} {
+ upvar ::tk::$w data
+
+ focus $data(canvas)
+ set x [expr {int([$data(canvas) canvasx $x])}]
+ set y [expr {int([$data(canvas) canvasy $y])}]
+ set i [IconList_Index $w @${x},${y}]
+ if {$i==""} return
+ IconList_Selection $w clear 0 end
+ IconList_Selection $w set $i
+ IconList_Selection $w anchor $i
+}
+
+proc ::tk::IconList_CtrlBtn1 {w x y} {
+ upvar ::tk::$w data
+
+ if { $data(-multiple) } {
+ focus $data(canvas)
+ set x [expr {int([$data(canvas) canvasx $x])}]
+ set y [expr {int([$data(canvas) canvasy $y])}]
+ set i [IconList_Index $w @${x},${y}]
+ if {$i==""} return
+ if { [IconList_Selection $w includes $i] } {
+ IconList_Selection $w clear $i
+ } else {
+ IconList_Selection $w set $i
+ IconList_Selection $w anchor $i
+ }
+ }
+}
+
+proc ::tk::IconList_ShiftBtn1 {w x y} {
+ upvar ::tk::$w data
+
+ if { $data(-multiple) } {
+ focus $data(canvas)
+ set x [expr {int([$data(canvas) canvasx $x])}]
+ set y [expr {int([$data(canvas) canvasy $y])}]
+ set i [IconList_Index $w @${x},${y}]
+ if {$i==""} return
+ set a [IconList_Index $w anchor]
+ if { [string equal $a ""] } {
+ set a $i
+ }
+ IconList_Selection $w clear 0 end
+ IconList_Selection $w set $a $i
+ }
+}
+
+# Gets called on button-1 motions
+#
+proc ::tk::IconList_Motion1 {w x y} {
+ upvar ::tk::$w data
+ variable ::tk::Priv
+ set Priv(x) $x
+ set Priv(y) $y
+ set x [expr {int([$data(canvas) canvasx $x])}]
+ set y [expr {int([$data(canvas) canvasy $y])}]
+ set i [IconList_Index $w @${x},${y}]
+ if {$i==""} return
+ IconList_Selection $w clear 0 end
+ IconList_Selection $w set $i
+}
+
+proc ::tk::IconList_Double1 {w x y} {
+ upvar ::tk::$w data
+
+ if {[llength $data(selection)]} {
+ IconList_Invoke $w
+ }
+}
+
+proc ::tk::IconList_ReturnKey {w} {
+ IconList_Invoke $w
+}
+
+proc ::tk::IconList_Leave1 {w x y} {
+ variable ::tk::Priv
+
+ set Priv(x) $x
+ set Priv(y) $y
+ IconList_AutoScan $w
+}
+
+proc ::tk::IconList_FocusIn {w} {
+ upvar ::tk::$w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {[llength $data(selection)]} {
+ IconList_DrawSelection $w
+ }
+}
+
+proc ::tk::IconList_FocusOut {w} {
+ IconList_Selection $w clear 0 end
+}
+
+# ::tk::IconList_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 ::tk::IconList_UpDown {w amount} {
+ upvar ::tk::$w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ set curr [tk::IconList_Curselection $w]
+ if { [llength $curr] == 0 } {
+ set i 0
+ } else {
+ set i [tk::IconList_Index $w anchor]
+ if {$i==""} return
+ incr i $amount
+ }
+ IconList_Selection $w clear 0 end
+ IconList_Selection $w set $i
+ IconList_Selection $w anchor $i
+ IconList_See $w $i
+}
+
+# ::tk::IconList_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 ::tk::IconList_LeftRight {w amount} {
+ upvar ::tk::$w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ set curr [IconList_Curselection $w]
+ if { [llength $curr] == 0 } {
+ set i 0
+ } else {
+ set i [IconList_Index $w anchor]
+ if {$i==""} return
+ incr i [expr {$amount*$data(itemsPerColumn)}]
+ }
+ IconList_Selection $w clear 0 end
+ IconList_Selection $w set $i
+ IconList_Selection $w anchor $i
+ IconList_See $w $i
+}
+
+#----------------------------------------------------------------------
+# Accelerator key bindings
+#----------------------------------------------------------------------
+
+# ::tk::IconList_KeyPress --
+#
+# Gets called when user enters an arbitrary key in the listbox.
+#
+proc ::tk::IconList_KeyPress {w key} {
+ variable ::tk::Priv
+
+ append Priv(ILAccel,$w) $key
+ IconList_Goto $w $Priv(ILAccel,$w)
+ catch {
+ after cancel $Priv(ILAccel,$w,afterId)
+ }
+ set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
+}
+
+proc ::tk::IconList_Goto {w text} {
+ upvar ::tk::$w data
+ upvar ::tk::$w:textList textList
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {[string equal {} $text]} {
+ 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 equal $text $sub]} {
+ set theIndex $i
+ break
+ }
+ incr i
+ if {$i == $data(numItems)} {
+ set i 0
+ }
+ if {$i == $start} {
+ break
+ }
+ }
+
+ if {$theIndex > -1} {
+ IconList_Selection $w clear 0 end
+ IconList_Selection $w set $theIndex
+ IconList_Selection $w anchor $theIndex
+ IconList_See $w $theIndex
+ }
+}
+
+proc ::tk::IconList_Reset {w} {
+ variable ::tk::Priv
+
+ catch {unset Priv(ILAccel,$w)}
+}
+
+#----------------------------------------------------------------------
+#
+# F I L E D I A L O G
+#
+#----------------------------------------------------------------------
+
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::file {
+ namespace import ::tk::msgcat::*
+}
+
+# ::tk::dialog::file:: --
+#
+# Implements the TK file selection dialog. This dialog is used when
+# the tk_strictMotif flag is set to false. This procedure shouldn't
+# be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
+#
+# Arguments:
+# type "open" or "save"
+# args Options parsed by the procedure.
+#
+
+proc ::tk::dialog::file:: {type args} {
+ variable ::tk::Priv
+ set dataName __tk_filedialog
+ upvar ::tk::dialog::file::$dataName data
+
+ ::tk::dialog::file::Config $dataName $type $args
+
+ if {[string equal $data(-parent) .]} {
+ set w .$dataName
+ } else {
+ set w $data(-parent).$dataName
+ }
+
+ # (re)create the dialog box if necessary
+ #
+ if {![winfo exists $w]} {
+ ::tk::dialog::file::Create $w TkFDialog
+ } elseif {[string compare [winfo class $w] TkFDialog]} {
+ destroy $w
+ ::tk::dialog::file::Create $w TkFDialog
+ } 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
+ ::tk::dialog::file::SetSelectMode $w $data(-multiple)
+ }
+
+ # Dialog boxes should be transient with respect to their parent,
+ # so that they will always stay on top of their parent window. However,
+ # some window managers will create the window as withdrawn if the parent
+ # window is withdrawn or iconified. Combined with the grab we put on the
+ # window, this can hang the entire application. Therefore we only make
+ # the dialog transient if the parent is viewable.
+
+ if {[winfo viewable [winfo toplevel $data(-parent)]] } {
+ wm transient $w $data(-parent)
+ }
+
+ # Add traces on the selectPath variable
+ #
+
+ trace variable data(selectPath) w "::tk::dialog::file::SetPath $w"
+ $data(dirMenuBtn) configure \
+ -textvariable ::tk::dialog::file::${dataName}(selectPath)
+
+ # Initialize the file types menu
+ #
+ if {[llength $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 ::tk::dialog::file::SetFilter $w $type]
+ }
+ ::tk::dialog::file::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
+ }
+ ::tk::dialog::file::UpdateWhenIdle $w
+
+ # Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ ::tk::PlaceWindow $w widget $data(-parent)
+ wm title $w $data(-title)
+
+ # Set a grab and claim the focus too.
+
+ ::tk::SetFocusGrab $w $data(ent)
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $data(selectFile)
+ $data(ent) selection range 0 end
+ $data(ent) icursor end
+
+ # Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ vwait ::tk::Priv(selectFilePath)
+
+ ::tk::RestoreFocusGrab $w $data(ent) withdraw
+
+ # Cleanup traces on selectPath variable
+ #
+
+ foreach trace [trace vinfo data(selectPath)] {
+ trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
+ }
+ $data(dirMenuBtn) configure -textvariable {}
+
+ return $Priv(selectFilePath)
+}
+
+# ::tk::dialog::file::Config --
+#
+# Configures the TK filedialog according to the argument list
+#
+proc ::tk::dialog::file::Config {dataName type argList} {
+ upvar ::tk::dialog::file::$dataName data
+
+ set data(type) $type
+
+ # 0: Delete all variable that were set on data(selectPath) the
+ # last time the file dialog is used. The traces may cause troubles
+ # if the dialog is now used with a different -parent option.
+
+ foreach trace [trace vinfo data(selectPath)] {
+ trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
+ }
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-defaultextension "" "" ""}
+ {-filetypes "" "" ""}
+ {-initialdir "" "" ""}
+ {-initialfile "" "" ""}
+ {-parent "" "" "."}
+ {-title "" "" ""}
+ }
+
+ # The "-multiple" option is only available for the "open" file dialog.
+ #
+ if { [string equal $type "open"] } {
+ lappend specs {-multiple "" "" "0"}
+ }
+
+ # 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 ::tk::dialog::file::$dataName $specs "" $argList
+
+ if {$data(-title) == ""} {
+ if {[string equal $type "open"]} {
+ set data(-title) "[mc "Open"]"
+ } else {
+ set data(-title) "[mc "Save As"]"
+ }
+ }
+
+ # 4: set the default directory and selection according to the -initial
+ # settings
+ #
+ if {$data(-initialdir) != ""} {
+ # Ensure that initialdir is an absolute path name.
+ if {[file isdirectory $data(-initialdir)]} {
+ set old [pwd]
+ cd $data(-initialdir)
+ set data(selectPath) [pwd]
+ cd $old
+ } else {
+ set data(selectPath) [pwd]
+ }
+ }
+ set data(selectFile) $data(-initialfile)
+
+ # 5. Parse the -filetypes option
+ #
+ set data(-filetypes) [::tk::FDGetFileTypes $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 more easily.
+ if {![string compare $type save]} {
+ set data(-multiple) 0
+ } elseif {$data(-multiple)} {
+ set data(-multiple) 1
+ } else {
+ set data(-multiple) 0
+ }
+}
+
+proc ::tk::dialog::file::Create {w class} {
+ set dataName [lindex [split $w .] end]
+ upvar ::tk::dialog::file::$dataName data
+ variable ::tk::Priv
+ global tk_library
+
+ toplevel $w -class $class
+
+ # f1: the frame with the directory option menu
+ #
+ set f1 [frame $w.f1]
+ bind [::tk::AmpWidget label $f1.lab -text "[mc "&Directory:"]" ] \
+ <<AltUnderlined>> [list focus $f1.menu]
+
+ set data(dirMenuBtn) $f1.menu
+ set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
+ set data(upBtn) [button $f1.up]
+ if {![info exists Priv(updirImage)]} {
+ set Priv(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 $Priv(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.
+ #
+ if { [string equal $class TkFDialog] } {
+ if { $data(-multiple) } {
+ set fNameCaption "[mc {File &names:}]"
+ } else {
+ set fNameCaption "[mc {File &name:}]"
+ }
+ set fTypeCaption [mc "Files of &type:"]
+ set fCaptionWidth [::tk::mcmaxamp $fNameCaption $fTypeCaption]
+ set fCaptionWidth [expr {$fCaptionWidth<14?14:$fCaptionWidth}]
+ set iconListCommand [list ::tk::dialog::file::OkCmd $w]
+ } else {
+ set fNameCaption [mc "&Selection:"]
+ set fCaptionWidth [string length $fNameCaption]
+ set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
+ }
+ set data(icons) [::tk::IconList $w.icons \
+ -command $iconListCommand \
+ -multiple $data(-multiple)]
+ bind $data(icons) <<ListboxSelect>> \
+ [list ::tk::dialog::file::ListBrowse $w]
+
+ # f2: the frame with the OK button and the "file name" field
+ #
+ set f2 [frame $w.f2 -bd 0]
+ bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -width $fCaptionWidth \
+ -pady 0] <<AltUnderlined>> [list focus $f2.ent]
+ set data(ent) [entry $f2.ent]
+
+ # The font to use for the icons. The default Canvas font on Unix
+ # is just deviant.
+ set ::tk::$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]
+
+ # Make the file types bits only if this is a File Dialog
+ if { [string equal $class TkFDialog] } {
+ # 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) [::tk::AmpWidget button $f3.lab -text $fTypeCaption \
+ -anchor e -width $fCaptionWidth \
+ -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
+ bind $data(typeMenuLab) <<AltUnderlined>> [list focus \
+ $data(typeMenuBtn)]
+ }
+
+ # the okBtn is created after the typeMenu so that the keyboard traversal
+ # is in the right order
+ set maxWidth [::tk::mcmaxamp &OK &Cancel]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
+ set data(okBtn) [::tk::AmpWidget button $f2.ok -text "[mc "&OK"]" \
+ -width $maxWidth -default active -pady 3]
+ set data(cancelBtn) [::tk::AmpWidget button $f3.cancel -text "[mc "&Cancel"]" \
+ -width $maxWidth -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
+ if { [string equal $class TkFDialog] } {
+ 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 that are common to Directory and File Dialogs
+ #
+
+ wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
+ $data(upBtn) config -command [list ::tk::dialog::file::UpDirCmd $w]
+ $data(cancelBtn) config -command [list ::tk::dialog::file::CancelCmd $w]
+ bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
+ # Set up event handlers specific to File or Directory Dialogs
+ #
+
+ if { [string equal $class TkFDialog] } {
+ bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
+ $data(okBtn) config -command [list ::tk::dialog::file::OkCmd $w]
+ bind $w <Alt-t> [format {
+ if {[string equal [%s cget -state] "normal"]} {
+ focus %s
+ }
+ } $data(typeMenuBtn) $data(typeMenuBtn)]
+ } else {
+ set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
+ bind $data(ent) <Return> $okCmd
+ $data(okBtn) config -command $okCmd
+ bind $w <Alt-s> [list focus $data(ent)]
+ bind $w <Alt-o> [list tk::ButtonInvoke $data(okBtn)]
+ }
+
+ # Build the focus group for all the entries
+ #
+ ::tk::FocusGroup_Create $w
+ ::tk::FocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
+ ::tk::FocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
+}
+
+# ::tk::dialog::file::SetSelectMode --
+#
+# Set the select mode of the dialog to single select or multi-select.
+#
+# Arguments:
+# w The dialog path.
+# multi 1 if the dialog is multi-select; 0 otherwise.
+#
+# Results:
+# None.
+
+proc ::tk::dialog::file::SetSelectMode {w multi} {
+ set dataName __tk_filedialog
+ upvar ::tk::dialog::file::$dataName data
+ if { $multi } {
+ set fNameCaption "[mc {File &names:}]"
+ } else {
+ set fNameCaption "[mc {File &name:}]"
+ }
+ set iconListCommand [list ::tk::dialog::file::OkCmd $w]
+ ::tk::SetAmpText $w.f2.lab $fNameCaption
+ ::tk::IconList_Config $data(icons) \
+ [list -multiple $multi -command $iconListCommand]
+ return
+}
+
+# ::tk::dialog::file::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 ::tk::dialog::file::UpdateWhenIdle {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {[info exists data(updateId)]} {
+ return
+ } else {
+ set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
+ }
+}
+
+# ::tk::dialog::file::Update --
+#
+# Loads the files and directories into the IconList widget. Also
+# sets up the directory option menu for quick access to parent
+# directories.
+#
+proc ::tk::dialog::file::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]} {
+ return
+ }
+ set class [winfo class $w]
+ if { [string compare $class TkFDialog] && \
+ [string compare $class TkChooseDir] } {
+ return
+ }
+
+ set dataName [winfo name $w]
+ upvar ::tk::dialog::file::$dataName data
+ variable ::tk::Priv
+ global tk_library
+ catch {unset data(updateId)}
+
+ if {![info exists Priv(folderImage)]} {
+ set Priv(folderImage) [image create photo -data {
+R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
+QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
+ set Priv(fileImage) [image create photo -data {
+R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
+rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
+ }
+ set folder $Priv(folderImage)
+ set file $Priv(fileImage)
+
+ set appPWD [pwd]
+ if {[catch {
+ cd $data(selectPath)
+ }]} {
+ # We cannot change directory to $data(selectPath). $data(selectPath)
+ # should have been checked before ::tk::dialog::file::Update is called, so
+ # we normally won't come to here. Anyways, give an error and abort
+ # action.
+ tk_messageBox -type ok -parent $w -message \
+ "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]"\
+ -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
+
+ ::tk::IconList_DeleteAll $data(icons)
+
+ # Make the dir list
+ #
+ set completeFileList [lsort -dictionary -unique [glob -nocomplain .* *]]
+ set dirList {}
+ foreach f $completeFileList {
+ if {[string equal $f .]} {
+ continue
+ }
+ if {[string equal $f ..]} {
+ continue
+ }
+ if {[file isdir ./$f]} {
+ lappend dirList $f
+ }
+ }
+ ::tk::IconList_Add $data(icons) $folder $dirList
+ if { [string equal $class TkFDialog] } {
+ # Make the file list if this is a File Dialog
+ #
+ if {[string equal $data(filter) *]} {
+ set files $completeFileList
+ } else {
+ set files {}
+ foreach f $completeFileList {
+ foreach pat $data(filter) {
+ if { [string match $pat $f] } {
+ lappend files $f
+ break
+ }
+ }
+ }
+ }
+ set fileList {}
+ foreach f $files {
+ if {![file isdir ./$f]} {
+ lappend fileList $f
+ }
+ }
+ ::tk::IconList_Add $data(icons) $file $fileList
+ }
+
+ ::tk::IconList_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) ::tk::dialog::file::$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
+
+ if { [string equal $class TkFDialog] } {
+ # Restore the Open/Save Button if this is a File Dialog
+ #
+ if {[string equal $data(type) open]} {
+ ::tk::SetAmpText $data(okBtn) [mc "&Open"]
+ set maxWidth [::tk::mcmaxamp [mc "&Open"]]
+ if {$maxWidth>[$data(okBtn) cget -width]} {
+ $data(okBtn) config -width $maxWidth
+ $data(cancelBtn) config -width $maxWidth
+ }
+ } else {
+ ::tk::SetAmpText $data(okBtn) [mc "&Save"]
+ set maxWidth [::tk::mcmaxamp [mc "&Save"]]
+ if {$maxWidth>[$data(okBtn) cget -width]} {
+ $data(okBtn) config -width $maxWidth
+ $data(cancelBtn) config -width $maxWidth
+ }
+ }
+ }
+
+ # turn off the busy cursor.
+ #
+ $data(ent) config -cursor $entCursor
+ $w config -cursor $dlgCursor
+}
+
+# ::tk::dialog::file::SetPathSilently --
+#
+# Sets data(selectPath) without invoking the trace procedure
+#
+proc ::tk::dialog::file::SetPathSilently {w path} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ trace vdelete data(selectPath) w [list ::tk::dialog::file::SetPath $w]
+ set data(selectPath) $path
+ trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
+}
+
+
+# This proc gets called whenever data(selectPath) is set
+#
+proc ::tk::dialog::file::SetPath {w name1 name2 op} {
+ if {[winfo exists $w]} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+ ::tk::dialog::file::UpdateWhenIdle $w
+ # On directory dialogs, we keep the entry in sync with the currentdir.
+ if { [string equal [winfo class $w] TkChooseDir] } {
+ $data(ent) delete 0 end
+ $data(ent) insert end $data(selectPath)
+ }
+ }
+}
+
+# This proc gets called whenever data(filter) is set
+#
+proc ::tk::dialog::file::SetFilter {w type} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+ upvar ::tk::$data(icons) icons
+
+ set data(filter) [lindex $type 1]
+ $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1
+
+ # If we aren't using a default extension, use the one suppled
+ # by the filter.
+ if {![info exists data(extUsed)]} {
+ if {[string length $data(-defaultextension)]} {
+ set data(extUsed) 1
+ } else {
+ set data(extUsed) 0
+ }
+ }
+
+ if {!$data(extUsed)} {
+ # Get the first extension in the list that matches {^\*\.\w+$}
+ # and remove all * from the filter.
+ set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
+ if {$index >= 0} {
+ set data(-defaultextension) \
+ [string trimleft [lindex $data(filter) $index] "*"]
+ } else {
+ # Couldn't find anything! Reset to a safe default...
+ set data(-defaultextension) ""
+ }
+ }
+
+ $icons(sbar) set 0.0 0.0
+
+ ::tk::dialog::file::UpdateWhenIdle $w
+}
+
+# tk::dialog::file::ResolveFile --
+#
+# 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 ::tk::dialog::file::ResolveFile {context text defaultext} {
+
+ set appPWD [pwd]
+
+ set path [::tk::dialog::file::JoinFile $context $text]
+
+ # If the file has no extension, append the default. Be careful not
+ # to do this for directories, otherwise typing a dirname in the box
+ # will give back "dirname.extension" instead of trying to change dir.
+ if {![file isdirectory $path] && [string equal [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 ::tk::dialog::file::EntFocusIn {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {[string compare [$data(ent) get] ""]} {
+ $data(ent) selection range 0 end
+ $data(ent) icursor end
+ } else {
+ $data(ent) selection clear
+ }
+
+ if { [string equal [winfo class $w] TkFDialog] } {
+ # If this is a File Dialog, make sure the buttons are labeled right.
+ if {[string equal $data(type) open]} {
+ ::tk::SetAmpText $data(okBtn) [mc "&Open"]
+ } else {
+ ::tk::SetAmpText $data(okBtn) [mc "&Save"]
+ }
+ }
+}
+
+proc ::tk::dialog::file::EntFocusOut {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ $data(ent) selection clear
+}
+
+
+# Gets called when user presses Return in the "File name" entry.
+#
+proc ::tk::dialog::file::ActivateEnt {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set text [$data(ent) get]
+ if {$data(-multiple)} {
+ # For the multiple case we have to be careful to get the file
+ # names as a true list, watching out for a single file with a
+ # space in the name. Thus we query the IconList directly.
+
+ set data(selectFile) ""
+ foreach item [::tk::IconList_Curselection $data(icons)] {
+ ::tk::dialog::file::VerifyFileName $w \
+ [::tk::IconList_Get $data(icons) $item]
+ }
+ } else {
+ ::tk::dialog::file::VerifyFileName $w $text
+ }
+}
+
+# Verification procedure
+#
+proc ::tk::dialog::file::VerifyFileName {w filename} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \
+ $data(-defaultextension)]
+ foreach {flag path file} $list {
+ break
+ }
+
+ switch -- $flag {
+ OK {
+ if {[string equal $file ""]} {
+ # user has entered an existing (sub)directory
+ set data(selectPath) $path
+ $data(ent) delete 0 end
+ } else {
+ ::tk::dialog::file::SetPathSilently $w $path
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ set data(selectFile) $file
+ }
+ ::tk::dialog::file::Done $w
+ }
+ }
+ PATTERN {
+ set data(selectPath) $path
+ set data(filter) $file
+ }
+ FILE {
+ if {[string equal $data(type) open]} {
+ tk_messageBox -icon warning -type ok -parent $w \
+ -message "[mc "File \"%1\$s\" does not exist." [file join $path $file]]"
+ $data(ent) selection range 0 end
+ $data(ent) icursor end
+ } else {
+ ::tk::dialog::file::SetPathSilently $w $path
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ set data(selectFile) $file
+ }
+ ::tk::dialog::file::Done $w
+ }
+ }
+ PATH {
+ tk_messageBox -icon warning -type ok -parent $w \
+ -message "[mc "Directory \"%1\$s\" does not exist." $path]"
+ $data(ent) selection range 0 end
+ $data(ent) icursor end
+ }
+ CHDIR {
+ tk_messageBox -type ok -parent $w -message \
+ "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]"\
+ -icon warning
+ $data(ent) selection range 0 end
+ $data(ent) icursor end
+ }
+ ERROR {
+ tk_messageBox -type ok -parent $w -message \
+ "[mc "Invalid file name \"%1\$s\"." $path]"\
+ -icon warning
+ $data(ent) selection range 0 end
+ $data(ent) icursor end
+ }
+ }
+}
+
+# Gets called when user presses the Alt-s or Alt-o keys.
+#
+proc ::tk::dialog::file::InvokeBtn {w key} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {[string equal [$data(okBtn) cget -text] $key]} {
+ ::tk::ButtonInvoke $data(okBtn)
+ }
+}
+
+# Gets called when user presses the "parent directory" button
+#
+proc ::tk::dialog::file::UpDirCmd {w} {
+ upvar ::tk::dialog::file::[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 ::tk::dialog::file::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 ::tk::dialog::file::OkCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set filenames {}
+ foreach item [::tk::IconList_Curselection $data(icons)] {
+ lappend filenames [::tk::IconList_Get $data(icons) $item]
+ }
+
+ if {([llength $filenames] && !$data(-multiple)) || \
+ ($data(-multiple) && ([llength $filenames] == 1))} {
+ set filename [lindex $filenames 0]
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $filename]
+ if {[file isdirectory $file]} {
+ ::tk::dialog::file::ListInvoke $w [list $filename]
+ return
+ }
+ }
+
+ ::tk::dialog::file::ActivateEnt $w
+}
+
+# Gets called when user presses the "Cancel" button
+#
+proc ::tk::dialog::file::CancelCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+ variable ::tk::Priv
+
+ set Priv(selectFilePath) ""
+}
+
+# Gets called when user browses the IconList widget (dragging mouse, arrow
+# keys, etc)
+#
+proc ::tk::dialog::file::ListBrowse {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set text {}
+ foreach item [::tk::IconList_Curselection $data(icons)] {
+ lappend text [::tk::IconList_Get $data(icons) $item]
+ }
+ if {[llength $text] == 0} {
+ return
+ }
+ if { [llength $text] > 1 } {
+ set newtext {}
+ foreach file $text {
+ set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file]
+ if { ![file isdirectory $fullfile] } {
+ lappend newtext $file
+ }
+ }
+ set text $newtext
+ set isDir 0
+ } else {
+ set text [lindex $text 0]
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
+ set isDir [file isdirectory $file]
+ }
+ if {!$isDir} {
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $text
+
+ if { [string equal [winfo class $w] TkFDialog] } {
+ if {[string equal $data(type) open]} {
+ ::tk::SetAmpText $data(okBtn) [mc "&Open"]
+ } else {
+ ::tk::SetAmpText $data(okBtn) [mc "&Save"]
+ }
+ }
+ } else {
+ if { [string equal [winfo class $w] TkFDialog] } {
+ ::tk::SetAmpText $data(okBtn) [mc "&Open"]
+ }
+ }
+}
+
+# Gets called when user invokes the IconList widget (double-click,
+# Return key, etc)
+#
+proc ::tk::dialog::file::ListInvoke {w filenames} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {[llength $filenames] == 0} {
+ return
+ }
+
+ set file [::tk::dialog::file::JoinFile $data(selectPath) \
+ [lindex $filenames 0]]
+
+ set class [winfo class $w]
+ if {[string equal $class TkChooseDir] || [file isdirectory $file]} {
+ set appPWD [pwd]
+ if {[catch {cd $file}]} {
+ tk_messageBox -type ok -parent $w -message \
+ "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]"\
+ -icon warning
+ } else {
+ cd $appPWD
+ set data(selectPath) $file
+ }
+ } else {
+ if {$data(-multiple)} {
+ set data(selectFile) $filenames
+ } else {
+ set data(selectFile) $file
+ }
+ ::tk::dialog::file::Done $w
+ }
+}
+
+# ::tk::dialog::file::Done --
+#
+# Gets called when user has input a valid filename. Pops up a
+# dialog box to confirm selection when necessary. Sets the
+# tk::Priv(selectFilePath) variable, which will break the "vwait"
+# loop in ::tk::dialog::file:: and return the selected filename to the
+# script that calls tk_getOpenFile or tk_getSaveFile
+#
+proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+ variable ::tk::Priv
+
+ if {[string equal $selectFilePath ""]} {
+ if {$data(-multiple)} {
+ set selectFilePath {}
+ foreach f $data(selectFile) {
+ lappend selectFilePath [::tk::dialog::file::JoinFile \
+ $data(selectPath) $f]
+ }
+ } else {
+ set selectFilePath [::tk::dialog::file::JoinFile \
+ $data(selectPath) $data(selectFile)]
+ }
+
+ set Priv(selectFile) $data(selectFile)
+ set Priv(selectPath) $data(selectPath)
+
+ if {[string equal $data(type) save]} {
+ if {[file exists $selectFilePath]} {
+ set reply [tk_messageBox -icon warning -type yesno\
+ -parent $w -message \
+ "[mc "File \"%1\$s\" already exists.\nDo you want to overwrite it?" $selectFilePath]"]
+ if {[string equal $reply "no"]} {
+ return
+ }
+ }
+ }
+ }
+ set Priv(selectFilePath) $selectFilePath
+}
diff --git a/tcl/library/unsupported.tcl b/tcl/library/unsupported.tcl
new file mode 100644
index 00000000000..0db34bc8e07
--- /dev/null
+++ b/tcl/library/unsupported.tcl
@@ -0,0 +1,297 @@
+# unsupported.tcl --
+#
+# Commands provided by Tk without official support. Use them at your
+# own risk. They may change or go away without notice.
+#
+# RCS: @(#) $Id$
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# Unsupported compatibility interface for folks accessing Tk's private
+# commands and variable against recommended usage.
+# ----------------------------------------------------------------------
+
+namespace eval ::tk::unsupported {
+
+ # Map from the old global names of Tk private commands to their
+ # new namespace-encapsulated names.
+
+ variable PrivateCommands
+ array set PrivateCommands {
+ tkButtonAutoInvoke ::tk::ButtonAutoInvoke
+ tkButtonDown ::tk::ButtonDown
+ tkButtonEnter ::tk::ButtonEnter
+ tkButtonInvoke ::tk::ButtonInvoke
+ tkButtonLeave ::tk::ButtonLeave
+ tkButtonUp ::tk::ButtonUp
+ tkCancelRepeat ::tk::CancelRepeat
+ tkCheckRadioDown ::tk::CheckRadioDown
+ tkCheckRadioEnter ::tk::CheckRadioEnter
+ tkCheckRadioInvoke ::tk::CheckRadioInvoke
+ tkColorDialog ::tk::dialog::color::
+ tkColorDialog_BuildDialog ::tk::dialog::color::BuildDialog
+ tkColorDialog_CancelCmd ::tk::dialog::color::CancelCmd
+ tkColorDialog_Config ::tk::dialog::color::Config
+ tkColorDialog_CreateSelector ::tk::dialog::color::CreateSelector
+ tkColorDialog_DrawColorScale ::tk::dialog::color::DrawColorScale
+ tkColorDialog_EnterColorBar ::tk::dialog::color::EnterColorBar
+ tkColorDialog_InitValues ::tk::dialog::color::InitValues
+ tkColorDialog_HandleRGBEntry ::tk::dialog::color::HandleRGBEntry
+ tkColorDialog_HandleSelEntry ::tk::dialog::color::HandleSelEntry
+ tkColorDialog_LeaveColorBar ::tk::dialog::color::LeaveColorBar
+ tkColorDialog_MoveSelector ::tk::dialog::color::MoveSelector
+ tkColorDialog_OkCmd ::tk::dialog::color::OkCmd
+ tkColorDialog_RedrawColorBars ::tk::dialog::color::RedrawColorBars
+ tkColorDialog_RedrawFinalColor ::tk::dialog::color::RedrawFinalColor
+ tkColorDialog_ReleaseMouse ::tk::dialog::color::ReleaseMouse
+ tkColorDialog_ResizeColorBars ::tk::dialog::color::ResizeColorBars
+ tkColorDialog_RgbToX ::tk::dialog::color::RgbToX
+ tkColorDialog_SetRGBValue ::tk::dialog::color::SetRGBValue
+ tkColorDialog_StartMove ::tk::dialog::color::StartMove
+ tkColorDialog_XToRgb ::tk::dialog::color::XToRGB
+ tkConsoleAbout ::tk::ConsoleAbout
+ tkConsoleBind ::tk::ConsoleBind
+ tkConsoleExit ::tk::ConsoleExit
+ tkConsoleHistory ::tk::ConsoleHistory
+ tkConsoleInit ::tk::ConsoleInit
+ tkConsoleInsert ::tk::ConsoleInsert
+ tkConsoleInvoke ::tk::ConsoleInvoke
+ tkConsoleOutput ::tk::ConsoleOutput
+ tkConsolePrompt ::tk::ConsolePrompt
+ tkConsoleSource ::tk::ConsoleSource
+ tkDarken ::tk::Darken
+ tkEntryAutoScan ::tk::EntryAutoScan
+ tkEntryBackspace ::tk::EntryBackspace
+ tkEntryButton1 ::tk::EntryButton1
+ tkEntryClosestGap ::tk::EntryClosestGap
+ tkEntryGetSelection ::tk::EntryGetSelection
+ tkEntryInsert ::tk::EntryInsert
+ tkEntryKeySelect ::tk::EntryKeySelect
+ tkEntryMouseSelect ::tk::EntryMouseSelect
+ tkEntryNextWord ::tk::EntryNextWord
+ tkEntryPaste ::tk::EntryPaste
+ tkEntryPreviousWord ::tk::EntryPreviousWord
+ tkEntrySeeInsert ::tk::EntrySeeInsert
+ tkEntrySetCursor ::tk::EntrySetCursor
+ tkEntryTranspose ::tk::EntryTranspose
+ tkEventMotifBindings ::tk::EventMotifBindings
+ tkFDGetFileTypes ::tk::FDGetFileTypes
+ tkFirstMenu ::tk::FirstMenu
+ tkFocusGroup_BindIn ::tk::FocusGroup_BindIn
+ tkFocusGroup_BindOut ::tk::FocusGroup_BindOut
+ tkFocusGroup_Create ::tk::FocusGroup_Create
+ tkFocusGroup_Destroy ::tk::FocusGroup_Destroy
+ tkFocusGroup_In ::tk::FocusGroup_In
+ tkFocusGroup_Out ::tk::FocusGroup_Out
+ tkFocusOK ::tk::FocusOK
+ tkGenerateMenuSelect ::tk::GenerateMenuSelect
+ tkIconList ::tk::IconList
+ tkIconList_Add ::tk::IconList_Add
+ tkIconList_Arrange ::tk::IconList_Arrange
+ tkIconList_AutoScan ::tk::IconList_AutoScan
+ tkIconList_Btn1 ::tk::IconList_Btn1
+ tkIconList_Config ::tk::IconList_Config
+ tkIconList_Create ::tk::IconList_Create
+ tkIconList_CtrlBtn1 ::tk::IconList_CtrlBtn1
+ tkIconList_Curselection ::tk::IconList_Curselection
+ tkIconList_DeleteAll ::tk::IconList_DeleteAll
+ tkIconList_Double1 ::tk::IconList_Double1
+ tkIconList_DrawSelection ::tk::IconList_DrawSelection
+ tkIconList_FocusIn ::tk::IconList_FocusIn
+ tkIconList_FocusOut ::tk::IconList_FocusOut
+ tkIconList_Get ::tk::IconList_Get
+ tkIconList_Goto ::tk::IconList_Goto
+ tkIconList_Index ::tk::IconList_Index
+ tkIconList_Invoke ::tk::IconList_Invoke
+ tkIconList_KeyPress ::tk::IconList_KeyPress
+ tkIconList_Leave1 ::tk::IconList_Leave1
+ tkIconList_LeftRight ::tk::IconList_LeftRight
+ tkIconList_Motion1 ::tk::IconList_Motion1
+ tkIconList_Reset ::tk::IconList_Reset
+ tkIconList_ReturnKey ::tk::IconList_ReturnKey
+ tkIconList_See ::tk::IconList_See
+ tkIconList_Select ::tk::IconList_Select
+ tkIconList_Selection ::tk::IconList_Selection
+ tkIconList_ShiftBtn1 ::tk::IconList_ShiftBtn1
+ tkIconList_UpDown ::tk::IconList_UpDown
+ tkListbox ::tk::Listbox
+ tkListboxAutoScan ::tk::ListboxAutoScan
+ tkListboxBeginExtend ::tk::ListboxBeginExtend
+ tkListboxBeginSelect ::tk::ListboxBeginSelect
+ tkListboxBeginToggle ::tk::ListboxBeginToggle
+ tkListboxCancel ::tk::ListboxCancel
+ tkListboxDataExtend ::tk::ListboxDataExtend
+ tkListboxExtendUpDown ::tk::ListboxExtendUpDown
+ tkListboxKeyAccel_Goto ::tk::ListboxKeyAccel_Goto
+ tkListboxKeyAccel_Key ::tk::ListboxKeyAccel_Key
+ tkListboxKeyAccel_Reset ::tk::ListboxKeyAccel_Reset
+ tkListboxKeyAccel_Set ::tk::ListboxKeyAccel_Set
+ tkListboxKeyAccel_Unset ::tk::ListboxKeyAccel_Unxet
+ tkListboxMotion ::tk::ListboxMotion
+ tkListboxSelectAll ::tk::ListboxSelectAll
+ tkListboxUpDown ::tk::ListboxUpDown
+ tkListboxBeginToggle ::tk::ListboxBeginToggle
+ tkMbButtonUp ::tk::MbButtonUp
+ tkMbEnter ::tk::MbEnter
+ tkMbLeave ::tk::MbLeave
+ tkMbMotion ::tk::MbMotion
+ tkMbPost ::tk::MbPost
+ tkMenuButtonDown ::tk::MenuButtonDown
+ tkMenuDownArrow ::tk::MenuDownArrow
+ tkMenuDup ::tk::MenuDup
+ tkMenuEscape ::tk::MenuEscape
+ tkMenuFind ::tk::MenuFind
+ tkMenuFindName ::tk::MenuFindName
+ tkMenuFirstEntry ::tk::MenuFirstEntry
+ tkMenuInvoke ::tk::MenuInvoke
+ tkMenuLeave ::tk::MenuLeave
+ tkMenuLeftArrow ::tk::MenuLeftArrow
+ tkMenuMotion ::tk::MenuMotion
+ tkMenuNextEntry ::tk::MenuNextEntry
+ tkMenuNextMenu ::tk::MenuNextMenu
+ tkMenuRightArrow ::tk::MenuRightArrow
+ tkMenuUnpost ::tk::MenuUnpost
+ tkMenuUpArrow ::tk::MenuUpArrow
+ tkMessageBox ::tk::MessageBox
+ tkMotifFDialog ::tk::MotifFDialog
+ tkMotifFDialog_ActivateDList ::tk::MotifFDialog_ActivateDList
+ tkMotifFDialog_ActivateFList ::tk::MotifFDialog_ActivateFList
+ tkMotifFDialog_ActivateFEnt ::tk::MotifFDialog_ActivateFEnt
+ tkMotifFDialog_ActivateSEnt ::tk::MotifFDialog_ActivateSEnt
+ tkMotifFDialog ::tk::MotifFDialog
+ tkMotifFDialog_BrowseDList ::tk::MotifFDialog_BrowseDList
+ tkMotifFDialog_BrowseFList ::tk::MotifFDialog_BrowseFList
+ tkMotifFDialog_BuildUI ::tk::MotifFDialog_BuildUI
+ tkMotifFDialog_CancelCmd ::tk::MotifFDialog_CancelCmd
+ tkMotifFDialog_Config ::tk::MotifFDialog_Config
+ tkMotifFDialog_Create ::tk::MotifFDialog_Create
+ tkMotifFDialog_FileTypes ::tk::MotifFDialog_FileTypes
+ tkMotifFDialog_FilterCmd ::tk::MotifFDialog_FilterCmd
+ tkMotifFDialog_InterpFilter ::tk::MotifFDialog_InterpFilter
+ tkMotifFDialog_LoadFiles ::tk::MotifFDialog_LoadFiles
+ tkMotifFDialog_MakeSList ::tk::MotifFDialog_MakeSList
+ tkMotifFDialog_OkCmd ::tk::MotifFDialog_OkCmd
+ tkMotifFDialog_SetFilter ::tk::MotifFDialog_SetFilter
+ tkMotifFDialog_SetListMode ::tk::MotifFDialog_SetListMode
+ tkMotifFDialog_Update ::tk::MotifFDialog_Update
+ tkPostOverPoint ::tk::PostOverPoint
+ tkRecolorTree ::tk::RecolorTree
+ tkRestoreOldGrab ::tk::RestoreOldGrab
+ tkSaveGrabInfo ::tk::SaveGrabInfo
+ tkScaleActivate ::tk::ScaleActivate
+ tkScaleButtonDown ::tk::ScaleButtonDown
+ tkScaleButton2Down ::tk::ScaleButton2Down
+ tkScaleControlPress ::tk::ScaleControlPress
+ tkScaleDrag ::tk::ScaleDrag
+ tkScaleEndDrag ::tk::ScaleEndDrag
+ tkScaleIncrement ::tk::ScaleIncrement
+ tkScreenChanged ::tk::ScreenChanged
+ tkScrollButtonDown ::tk::ScrollButtonDown
+ tkScrollButton2Down ::tk::ScrollButton2Down
+ tkScrollButtonDrag ::tk::ScrollButtonDrag
+ tkScrollButtonUp ::tk::ScrollButtonUp
+ tkScrollByPages ::tk::ScrollByPages
+ tkScrollByUnits ::tk::ScrollByUnits
+ tkScrollEndDrag ::tk::ScrollEndDrag
+ tkScrollSelect ::tk::ScrollSelect
+ tkScrollStartDrag ::tk::ScrollStartDrag
+ tkScrollTopBottom ::tk::ScrollTopBottom
+ tkScrollToPos ::tk::ScrollToPos
+ tkTabToWindow ::tk::TabToWindow
+ tkTearOffMenu ::tk::TearOffMenu
+ tkTextAutoScan ::tk::TextAutoScan
+ tkTextButton1 ::tk::TextButton1
+ tkTextClosestGap ::tk::TextClosestGap
+ tkTextInsert ::tk::TextInsert
+ tkTextKeyExtend ::tk::TextKeyExtend
+ tkTextKeySelect ::tk::TextKeySelect
+ tkTextNextPara ::tk::TextNextPara
+ tkTextNextPos ::tk::TextNextPos
+ tkTextNextWord ::tk::TextNextWord
+ tkTextPaste ::tk::TextPaste
+ tkTextPrevPara ::tk::TextPrevPara
+ tkTextPrevPos ::tk::TextPrevPos
+ tkTextPrevWord ::tk::TextPrevWord
+ tkTextResetAnchor ::tk::TextResetAnchor
+ tkTextScrollPages ::tk::TextScrollPages
+ tkTextSelectTo ::tk::TextSelectTo
+ tkTextSetCursor ::tk::TextSetCursor
+ tkTextTranspose ::tk::TextTranspose
+ tkTextUpDownLine ::tk::TextUpDownLine
+ tkTraverseToMenu ::tk::TraverseToMenu
+ tkTraverseWithinMenu ::tk::TraverseWithinMenu
+ unsupported1 ::tk::unsupported::MacWindowStyle
+ }
+
+ # Map from the old global names of Tk private variable to their
+ # new namespace-encapsulated names.
+
+ variable PrivateVariables
+ array set PrivateVariables {
+ droped_to_start ::tk::mac::Droped_to_start
+ histNum ::tk::HistNum
+ stub_location ::tk::mac::Stub_location
+ tkFocusIn ::tk::FocusIn
+ tkFocusOut ::tk::FocusOut
+ tkPalette ::tk::Palette
+ tkPriv ::tk::Priv
+ tkPrivMsgBox ::tk::PrivMsgBox
+ }
+}
+
+# ::tk::unsupported::ExposePrivateCommand --
+#
+# Expose one of Tk's private commands to be visible under its
+# old global name
+#
+# Arguments:
+# cmd Global name by which the command was once known,
+# or a glob-style pattern.
+#
+# Results:
+# None.
+#
+# Side effects:
+# The old command name in the global namespace is aliased to the
+# new private name.
+
+proc ::tk::unsupported::ExposePrivateCommand {cmd} {
+ variable PrivateCommands
+ set cmds [array get PrivateCommands $cmd]
+ if {[llength $cmds] == 0} {
+ return -code error "No compatibility support for \[$cmd]"
+ }
+ foreach {old new} $cmds {
+ namespace eval :: [list interp alias {} $old {}] $new
+ }
+}
+
+# ::tk::unsupported::ExposePrivateVariable --
+#
+# Expose one of Tk's private variables to be visible under its
+# old global name
+#
+# Arguments:
+# var Global name by which the variable was once known,
+# or a glob-style pattern.
+#
+# Results:
+# None.
+#
+# Side effects:
+# The old variable name in the global namespace is aliased to the
+# new private name.
+
+proc ::tk::unsupported::ExposePrivateVariable {var} {
+ variable PrivateVariables
+ set vars [array get PrivateVariables $var]
+ if {[llength $vars] == 0} {
+ return -code error "No compatibility support for \$$var"
+ }
+ namespace eval ::tk::mac {}
+ foreach {old new} $vars {
+ namespace eval :: [list upvar "#0" $new $old]
+ }
+}
diff --git a/tcl/library/xmfbox.tcl b/tcl/library/xmfbox.tcl
new file mode 100644
index 00000000000..31b02efe557
--- /dev/null
+++ b/tcl/library/xmfbox.tcl
@@ -0,0 +1,961 @@
+# xmfbox.tcl --
+#
+# Implements the "Motif" style file selection dialog for the
+# Unix platform. This implementation is used only if the
+# "::tk_strictMotif" flag is set.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Scriptics Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::file {}
+
+
+# ::tk::MotifFDialog --
+#
+# Implements a file dialog similar to the standard Motif file
+# selection box.
+#
+# Arguments:
+# type "open" or "save"
+# args Options parsed by the procedure.
+#
+# Results:
+# When -multiple is set to 0, this returns the absolute pathname
+# of the selected file. (NOTE: This is not the same as a single
+# element list.)
+#
+# When -multiple is set to > 0, this returns a Tcl list of absolute
+# pathnames. The argument for -multiple is ignored, but for consistency
+# with Windows it defines the maximum amount of memory to allocate for
+# the returned filenames.
+
+proc ::tk::MotifFDialog {type args} {
+ variable ::tk::Priv
+ set dataName __tk_filedialog
+ upvar ::tk::dialog::file::$dataName data
+
+ set w [MotifFDialog_Create $dataName $type $args]
+
+ # Set a grab and claim the focus too.
+
+ ::tk::SetFocusGrab $w $data(sEnt)
+ $data(sEnt) selection range 0 end
+
+ # Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ vwait ::tk::Priv(selectFilePath)
+ ::tk::RestoreFocusGrab $w $data(sEnt) withdraw
+
+ return $Priv(selectFilePath)
+}
+
+# ::tk::MotifFDialog_Create --
+#
+# Creates the Motif file dialog (if it doesn't exist yet) and
+# initialize the internal data structure associated with the
+# dialog.
+#
+# This procedure is used by ::tk::MotifFDialog to create the
+# dialog. It's also used by the test suite to test the Motif
+# file dialog implementation. User code shouldn't call this
+# procedure directly.
+#
+# Arguments:
+# dataName Name of the global "data" array for the file dialog.
+# type "Save" or "Open"
+# argList Options parsed by the procedure.
+#
+# Results:
+# Pathname of the file dialog.
+
+proc ::tk::MotifFDialog_Create {dataName type argList} {
+ upvar ::tk::dialog::file::$dataName data
+
+ MotifFDialog_Config $dataName $type $argList
+
+ if {[string equal $data(-parent) .]} {
+ set w .$dataName
+ } else {
+ set w $data(-parent).$dataName
+ }
+
+ # (re)create the dialog box if necessary
+ #
+ if {![winfo exists $w]} {
+ MotifFDialog_BuildUI $w
+ } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
+ destroy $w
+ MotifFDialog_BuildUI $w
+ } else {
+ set data(fEnt) $w.top.f1.ent
+ set data(dList) $w.top.f2.a.l
+ set data(fList) $w.top.f2.b.l
+ set data(sEnt) $w.top.f3.ent
+ set data(okBtn) $w.bot.ok
+ set data(filterBtn) $w.bot.filter
+ set data(cancelBtn) $w.bot.cancel
+ }
+ MotifFDialog_SetListMode $w
+
+ # Dialog boxes should be transient with respect to their parent,
+ # so that they will always stay on top of their parent window. However,
+ # some window managers will create the window as withdrawn if the parent
+ # window is withdrawn or iconified. Combined with the grab we put on the
+ # window, this can hang the entire application. Therefore we only make
+ # the dialog transient if the parent is viewable.
+
+ if {[winfo viewable [winfo toplevel $data(-parent)]] } {
+ wm transient $w $data(-parent)
+ }
+
+ MotifFDialog_FileTypes $w
+ MotifFDialog_Update $w
+
+ # Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display (Motif style) and de-iconify it.
+
+ ::tk::PlaceWindow $w
+ wm title $w $data(-title)
+
+ return $w
+}
+
+# ::tk::MotifFDialog_FileTypes --
+#
+# Checks the -filetypes option. If present this adds a list of radio-
+# buttons to pick the file types from.
+#
+# Arguments:
+# w Pathname of the tk_get*File dialogue.
+#
+# Results:
+# none
+
+proc ::tk::MotifFDialog_FileTypes {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set f $w.top.f3.types
+ catch {destroy $f}
+
+ # No file types: use "*" as the filter and display no radio-buttons
+ if {$data(-filetypes) == ""} {
+ set data(filter) *
+ return
+ }
+
+ # The filetypes radiobuttons
+ # set data(fileType) $data(-defaulttype)
+ set data(fileType) 0
+
+ MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)]
+
+ #don't produce radiobuttons for only one filetype
+ if {[llength $data(-filetypes)] == 1} {
+ return
+ }
+
+ frame $f
+ set cnt 0
+ if {$data(-filetypes) != {}} {
+ foreach type $data(-filetypes) {
+ set title [lindex [lindex $type 0] 0]
+ set filter [lindex $type 1]
+ radiobutton $f.b$cnt \
+ -text $title \
+ -variable ::tk::dialog::file::[winfo name $w](fileType) \
+ -value $cnt \
+ -command "[list tk::MotifFDialog_SetFilter $w $type]"
+ pack $f.b$cnt -side left
+ incr cnt
+ }
+ }
+ $f.b$data(fileType) invoke
+
+ pack $f -side bottom -fill both
+
+ return
+}
+
+# This proc gets called whenever data(filter) is set
+#
+proc ::tk::MotifFDialog_SetFilter {w type} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+ variable ::tk::Priv
+
+ set data(filter) [lindex $type 1]
+ set Priv(selectFileType) [lindex [lindex $type 0] 0]
+
+ MotifFDialog_Update $w
+}
+
+# ::tk::MotifFDialog_Config --
+#
+# Iterates over the optional arguments to determine the option
+# values for the Motif file dialog; gives default values to
+# unspecified options.
+#
+# Arguments:
+# dataName The name of the global variable in which
+# data for the file dialog is stored.
+# type "Save" or "Open"
+# argList Options parsed by the procedure.
+
+proc ::tk::MotifFDialog_Config {dataName type argList} {
+ upvar ::tk::dialog::file::$dataName data
+
+ set data(type) $type
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-defaultextension "" "" ""}
+ {-filetypes "" "" ""}
+ {-initialdir "" "" ""}
+ {-initialfile "" "" ""}
+ {-parent "" "" "."}
+ {-title "" "" ""}
+ }
+ if { [string equal $type "open"] } {
+ lappend specs {-multiple "" "" "0"}
+ }
+
+ set data(-multiple) 0
+ # 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 ::tk::dialog::file::$dataName $specs "" $argList
+
+ if {[string equal $data(-title) ""]} {
+ if {[string equal $type "open"]} {
+ if {$data(-multiple) != 0} {
+ set data(-title) "[mc {Open Multiple Files}]"
+ } else {
+ set data(-title) [mc "Open"]
+ }
+ } else {
+ set data(-title) [mc "Save As"]
+ }
+ }
+
+ # 4: set the default directory and selection according to the -initial
+ # settings
+ #
+ if {[string compare $data(-initialdir) ""]} {
+ if {[file isdirectory $data(-initialdir)]} {
+ set data(selectPath) [lindex [glob $data(-initialdir)] 0]
+ } else {
+ set data(selectPath) [pwd]
+ }
+
+ # Convert the initialdir to an absolute path name.
+
+ set old [pwd]
+ cd $data(selectPath)
+ set data(selectPath) [pwd]
+ cd $old
+ }
+ set data(selectFile) $data(-initialfile)
+
+ # 5. Parse the -filetypes option. 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) [::tk::FDGetFileTypes $data(-filetypes)]
+
+ if {![info exists data(filter)]} {
+ set data(filter) *
+ }
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+}
+
+# ::tk::MotifFDialog_BuildUI --
+#
+# Builds the UI components of the Motif file dialog.
+#
+# Arguments:
+# w Pathname of the dialog to build.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_BuildUI {w} {
+ set dataName [lindex [split $w .] end]
+ upvar ::tk::dialog::file::$dataName data
+
+ # Create the dialog toplevel and internal frames.
+ #
+ toplevel $w -class TkMotifFDialog
+ set top [frame $w.top -relief raised -bd 1]
+ set bot [frame $w.bot -relief raised -bd 1]
+
+ pack $w.bot -side bottom -fill x
+ pack $w.top -side top -expand yes -fill both
+
+ 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
+ #
+ bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \
+ <<AltUnderlined>> [list focus $f1.ent]
+ 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) [MotifFDialog_MakeSList $w $f2a \
+ [mc "&Directory:"] DList]
+ set data(fList) [MotifFDialog_MakeSList $w $f2b \
+ [mc "Fi&les:"] FList]
+
+ # The Selection box
+ #
+ bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \
+ <<AltUnderlined>> [list focus $f3.ent]
+ 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 maxWidth [::tk::mcmaxamp &OK &Filter &Cancel]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
+ set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \
+ -width $maxWidth \
+ -command [list tk::MotifFDialog_OkCmd $w]]
+ set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc "&Filter"] \
+ -width $maxWidth \
+ -command [list tk::MotifFDialog_FilterCmd $w]]
+ set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc "&Cancel"] \
+ -width $maxWidth \
+ -command [list tk::MotifFDialog_CancelCmd $w]]
+
+ pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
+ -side left
+
+ # Create the bindings:
+ #
+ bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
+
+ bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w]
+ bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w]
+
+ wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]
+}
+
+proc ::tk::MotifFDialog_SetListMode {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {$data(-multiple) != 0} {
+ set selectmode extended
+ } else {
+ set selectmode browse
+ }
+ set f $w.top.f2.b
+ $f.l configure -selectmode $selectmode
+}
+
+# ::tk::MotifFDialog_MakeSList --
+#
+# Create a scrolled-listbox and set the keyboard accelerator
+# bindings so that the list selection follows what the user
+# types.
+#
+# Arguments:
+# w Pathname of the dialog box.
+# f Frame widget inside which to create the scrolled
+# listbox. This frame widget already exists.
+# label The string to display on top of the listbox.
+# under Sets the -under option of the label.
+# cmdPrefix Specifies procedures to call when the listbox is
+# browsed or activated.
+
+proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} {
+ bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \
+ <<AltUnderlined>> [list focus $f.l]
+ listbox $f.l -width 12 -height 5 -exportselection 0\
+ -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
+ scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview]
+ scrollbar $f.h -orient horizontal -takefocus 0 -command [list $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 <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w]
+ bind $list <Double-ButtonRelease-1> \
+ [list tk::MotifFDialog_Activate$cmdPrefix $w]
+ bind $list <Return> "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \
+ tk::MotifFDialog_Activate$cmdPrefix [list $w]"
+
+ bindtags $list [list Listbox $list [winfo toplevel $list] all]
+ ListBoxKeyAccel_Set $list
+
+ return $f.l
+}
+
+# ::tk::MotifFDialog_InterpFilter --
+#
+# Interpret the string in the filter entry into two components:
+# the directory and the pattern. If the string is a relative
+# pathname, give a warning to the user and restore the pattern
+# to original.
+#
+# Arguments:
+# w pathname of the dialog box.
+#
+# Results:
+# A list of two elements. The first element is the directory
+# specified # by the filter. The second element is the filter
+# pattern itself.
+
+proc ::tk::MotifFDialog_InterpFilter {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set text [string trim [$data(fEnt) get]]
+
+ # Perform tilde substitution
+ #
+ set badTilde 0
+ if {[string equal [string index $text 0] ~]} {
+ set list [file split $text]
+ set tilde [lindex $list 0]
+ if {[catch {set tilde [glob $tilde]}]} {
+ set badTilde 1
+ } else {
+ set text [eval file join [concat $tilde [lrange $list 1 end]]]
+ }
+ }
+
+ # If the string is a relative pathname, combine it
+ # with the current selectPath.
+
+ set relative 0
+ if {[string equal [file pathtype $text] "relative"]} {
+ set relative 1
+ } elseif {$badTilde} {
+ set relative 1
+ }
+
+ if {$relative} {
+ tk_messageBox -icon warning -type ok \
+ -message "\"$text\" must be an absolute pathname"
+
+ $data(fEnt) delete 0 end
+ $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
+ $data(filter)]
+
+ return [list $data(selectPath) $data(filter)]
+ }
+
+ set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
+
+ if {[file isdirectory $resolved]} {
+ set dir $resolved
+ set fil $data(filter)
+ } else {
+ set dir [file dirname $resolved]
+ set fil [file tail $resolved]
+ }
+
+ return [list $dir $fil]
+}
+
+# ::tk::MotifFDialog_Update
+#
+# Load the files and synchronize the "filter" and "selection" fields
+# boxes.
+#
+# Arguments:
+# w pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_Update {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ $data(fEnt) delete 0 end
+ $data(fEnt) insert 0 \
+ [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
+ $data(sEnt) delete 0 end
+ $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
+ $data(selectFile)]
+
+ MotifFDialog_LoadFiles $w
+}
+
+# ::tk::MotifFDialog_LoadFiles --
+#
+# Loads the files and directories into the two listboxes according
+# to the filter setting.
+#
+# Arguments:
+# w pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_LoadFiles {w} {
+ upvar ::tk::dialog::file::[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 and file lists
+ #
+ # For speed we only have one glob, which reduces the file system
+ # calls (good for slow NFS networks).
+ #
+ # We also do two smaller sorts (files + dirs) instead of one large sort,
+ # which gives a small speed increase.
+ #
+ set top 0
+ set dlist ""
+ set flist ""
+ foreach f [glob -nocomplain .* *] {
+ if {[file isdir ./$f]} {
+ lappend dlist $f
+ } else {
+ foreach pat $data(filter) {
+ if {[string match $pat $f]} {
+ if {[string match .* $f]} {
+ incr top
+ }
+ lappend flist $f
+ break
+ }
+ }
+ }
+ }
+ eval [list $data(dList) insert end] [lsort -dictionary $dlist]
+ eval [list $data(fList) insert end] [lsort -dictionary $flist]
+
+ # 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
+}
+
+# ::tk::MotifFDialog_BrowseDList --
+#
+# This procedure is called when the directory list is browsed
+# (clicked-over) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_BrowseDList {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ focus $data(dList)
+ if {[string equal [$data(dList) curselection] ""]} {
+ return
+ }
+ set subdir [$data(dList) get [$data(dList) curselection]]
+ if {[string equal $subdir ""]} {
+ return
+ }
+
+ $data(fList) selection clear 0 end
+
+ set list [MotifFDialog_InterpFilter $w]
+ set data(filter) [lindex $list 1]
+
+ switch -- $subdir {
+ . {
+ set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
+ }
+ .. {
+ set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
+ $data(filter)]
+ }
+ default {
+ set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
+ $data(selectPath) $subdir] $data(filter)]
+ }
+ }
+
+ $data(fEnt) delete 0 end
+ $data(fEnt) insert 0 $newSpec
+}
+
+# ::tk::MotifFDialog_ActivateDList --
+#
+# This procedure is called when the directory list is activated
+# (double-clicked) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_ActivateDList {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {[string equal [$data(dList) curselection] ""]} {
+ return
+ }
+ set subdir [$data(dList) get [$data(dList) curselection]]
+ if {[string equal $subdir ""]} {
+ return
+ }
+
+ $data(fList) selection clear 0 end
+
+ switch -- $subdir {
+ . {
+ set newDir $data(selectPath)
+ }
+ .. {
+ set newDir [file dirname $data(selectPath)]
+ }
+ default {
+ set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
+ }
+ }
+
+ set data(selectPath) $newDir
+ MotifFDialog_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
+ }
+}
+
+# ::tk::MotifFDialog_BrowseFList --
+#
+# This procedure is called when the file list is browsed
+# (clicked-over) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_BrowseFList {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ focus $data(fList)
+ set data(selectFile) ""
+ foreach item [$data(fList) curselection] {
+ lappend data(selectFile) [$data(fList) get $item]
+ }
+ if {[llength $data(selectFile)] == 0} {
+ return
+ }
+
+ $data(dList) selection clear 0 end
+
+ $data(fEnt) delete 0 end
+ $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
+ $data(filter)]
+ $data(fEnt) xview end
+
+ # if it's a multiple selection box, just put in the filenames
+ # otherwise put in the full path as usual
+ $data(sEnt) delete 0 end
+ if {$data(-multiple) != 0} {
+ $data(sEnt) insert 0 $data(selectFile)
+ } else {
+ $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
+ [lindex $data(selectFile) 0]]
+ }
+ $data(sEnt) xview end
+}
+
+# ::tk::MotifFDialog_ActivateFList --
+#
+# This procedure is called when the file list is activated
+# (double-clicked) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_ActivateFList {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ if {[string equal [$data(fList) curselection] ""]} {
+ return
+ }
+ set data(selectFile) [$data(fList) get [$data(fList) curselection]]
+ if {[string equal $data(selectFile) ""]} {
+ return
+ } else {
+ MotifFDialog_ActivateSEnt $w
+ }
+}
+
+# ::tk::MotifFDialog_ActivateFEnt --
+#
+# This procedure is called when the user presses Return inside
+# the "filter" entry. It updates the dialog according to the
+# text inside the filter entry.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_ActivateFEnt {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set list [MotifFDialog_InterpFilter $w]
+ set data(selectPath) [lindex $list 0]
+ set data(filter) [lindex $list 1]
+
+ MotifFDialog_Update $w
+}
+
+# ::tk::MotifFDialog_ActivateSEnt --
+#
+# This procedure is called when the user presses Return inside
+# the "selection" entry. It sets the ::tk::Priv(selectFilePath)
+# variable so that the vwait loop in tk::MotifFDialog will be
+# terminated.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc ::tk::MotifFDialog_ActivateSEnt {w} {
+ variable ::tk::Priv
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ set selectFilePath [string trim [$data(sEnt) get]]
+
+ if {[string equal $selectFilePath ""]} {
+ MotifFDialog_FilterCmd $w
+ return
+ }
+
+ if {$data(-multiple) == 0} {
+ set selectFilePath [list $selectFilePath]
+ }
+
+ if {[file isdirectory [lindex $selectFilePath 0]]} {
+ set data(selectPath) [lindex [glob $selectFilePath] 0]
+ set data(selectFile) ""
+ MotifFDialog_Update $w
+ return
+ }
+
+ set newFileList ""
+ foreach item $selectFilePath {
+ if {[string compare [file pathtype $item] "absolute"]} {
+ set item [file join $data(selectPath) $item]
+ } elseif {![file exists [file dirname $item]]} {
+ tk_messageBox -icon warning -type ok \
+ -message [mc {Directory "%1$s" does not exist.} \
+ [file dirname $item]]
+ return
+ }
+
+ if {![file exists $item]} {
+ if {[string equal $data(type) open]} {
+ tk_messageBox -icon warning -type ok \
+ -message [mc {File "%1$s" does not exist.} $item]
+ return
+ }
+ } else {
+ if {[string equal $data(type) save]} {
+ set message [format %s%s \
+ [mc {File "%1$s" already exists.\n\n} \
+ $selectFilePath] \
+ [mc {Replace existing file?}]]
+ set answer [tk_messageBox -icon warning -type yesno \
+ -message $message]
+ if {[string equal $answer "no"]} {
+ return
+ }
+ }
+ }
+
+ lappend newFileList $item
+ }
+
+ if {$data(-multiple) != 0} {
+ set Priv(selectFilePath) $newFileList
+ } else {
+ set Priv(selectFilePath) [lindex $newFileList 0]
+ }
+
+ # Set selectFile and selectPath to first item in list
+ set Priv(selectFile) [file tail [lindex $newFileList 0]]
+ set Priv(selectPath) [file dirname [lindex $newFileList 0]]
+}
+
+
+proc ::tk::MotifFDialog_OkCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ MotifFDialog_ActivateSEnt $w
+}
+
+proc ::tk::MotifFDialog_FilterCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
+
+ MotifFDialog_ActivateFEnt $w
+}
+
+proc ::tk::MotifFDialog_CancelCmd {w} {
+ variable ::tk::Priv
+
+ set Priv(selectFilePath) ""
+ set Priv(selectFile) ""
+ set Priv(selectPath) ""
+}
+
+proc ::tk::ListBoxKeyAccel_Set {w} {
+ bind Listbox <Any-KeyPress> ""
+ bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w]
+ bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A]
+}
+
+proc ::tk::ListBoxKeyAccel_Unset {w} {
+ variable ::tk::Priv
+
+ catch {after cancel $Priv(lbAccel,$w,afterId)}
+ catch {unset Priv(lbAccel,$w)}
+ catch {unset Priv(lbAccel,$w,afterId)}
+}
+
+# ::tk::ListBoxKeyAccel_Key--
+#
+# This procedure maintains a list of recently entered keystrokes
+# over a listbox widget. It arranges an idle event to move the
+# selection of the listbox to the entry that begins with the
+# keystrokes.
+#
+# Arguments:
+# w The pathname of the listbox.
+# key The key which the user just pressed.
+#
+# Results:
+# None.
+
+proc ::tk::ListBoxKeyAccel_Key {w key} {
+ variable ::tk::Priv
+
+ if { $key == "" } {
+ return
+ }
+ append Priv(lbAccel,$w) $key
+ ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w)
+ catch {
+ after cancel $Priv(lbAccel,$w,afterId)
+ }
+ set Priv(lbAccel,$w,afterId) [after 500 \
+ [list tk::ListBoxKeyAccel_Reset $w]]
+}
+
+proc ::tk::ListBoxKeyAccel_Goto {w string} {
+ variable ::tk::Priv
+
+ 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
+ event generate $w <<ListboxSelect>>
+ }
+}
+
+proc ::tk::ListBoxKeyAccel_Reset {w} {
+ variable ::tk::Priv
+
+ catch {unset Priv(lbAccel,$w)}
+}
+
+proc ::tk_getFileType {} {
+ variable ::tk::Priv
+
+ return $Priv(selectFileType)
+}
+
diff --git a/tcl/license.terms b/tcl/license.terms
index f1dcaa5245c..03ca6fcb319 100644
--- a/tcl/license.terms
+++ b/tcl/license.terms
@@ -1,8 +1,7 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
+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
@@ -37,4 +36,4 @@ 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.
+terms specified in this license.
diff --git a/tcl/mac/MW_TkBuildLibHeader.h b/tcl/mac/MW_TkBuildLibHeader.h
new file mode 100644
index 00000000000..cbca0c26896
--- /dev/null
+++ b/tcl/mac/MW_TkBuildLibHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TkBuildLibHeaderPPC"
+#elif __CFM68K__
+#include "MW_TkBuildLibHeaderCFM68K"
+#else
+#include "MW_TkBuildLibHeader68K"
+#endif
diff --git a/tcl/mac/MW_TkBuildLibHeader.pch b/tcl/mac/MW_TkBuildLibHeader.pch
new file mode 100644
index 00000000000..727d7b95148
--- /dev/null
+++ b/tcl/mac/MW_TkBuildLibHeader.pch
@@ -0,0 +1,36 @@
+/*
+ * MW_TkBuildLibHeader.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_TkBuildLibHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TkBuildLibHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TkBuildLibHeader68K"
+#endif
+
+#define BUILD_tk 1
+
+#include "MW_TkHeaderCommon.h"
diff --git a/tcl/mac/MW_TkHeader.h b/tcl/mac/MW_TkHeader.h
new file mode 100755
index 00000000000..a5ee4642cca
--- /dev/null
+++ b/tcl/mac/MW_TkHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TkHeaderPPC"
+#elif __CFM68K__
+#include "MW_TkHeaderCFM68K"
+#else
+#include "MW_TkHeader68K"
+#endif
diff --git a/tcl/mac/MW_TkHeader.pch b/tcl/mac/MW_TkHeader.pch
new file mode 100644
index 00000000000..f0c624afc01
--- /dev/null
+++ b/tcl/mac/MW_TkHeader.pch
@@ -0,0 +1,34 @@
+/*
+ * 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 "MW_TkHeaderCommon.h"
diff --git a/tcl/mac/MW_TkHeaderCommon.h b/tcl/mac/MW_TkHeaderCommon.h
new file mode 100644
index 00000000000..ab43eb566ff
--- /dev/null
+++ b/tcl/mac/MW_TkHeaderCommon.h
@@ -0,0 +1,40 @@
+/*
+ * MW_TkHeaderCommon.h --
+ *
+ * Common includes for precompiled headers
+ *
+ * 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$
+ */
+
+#pragma once
+
+#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"
+
+#include "tk.h"
+#include "tkInt.h"
diff --git a/tcl/mac/MW_TkOldImgHeader.h b/tcl/mac/MW_TkOldImgHeader.h
new file mode 100755
index 00000000000..309ca2020e7
--- /dev/null
+++ b/tcl/mac/MW_TkOldImgHeader.h
@@ -0,0 +1,3 @@
+#define USE_OLD_IMAGE
+
+#include "MW_TkBuildLibHeader.pch"
diff --git a/tcl/mac/MW_TkOldImgStaticHeader.h b/tcl/mac/MW_TkOldImgStaticHeader.h
new file mode 100644
index 00000000000..967b763d03e
--- /dev/null
+++ b/tcl/mac/MW_TkOldImgStaticHeader.h
@@ -0,0 +1,3 @@
+#define USE_OLD_IMAGE
+
+#include "MW_TkStaticHeader.pch"
diff --git a/tcl/mac/MW_TkStaticHeader.h b/tcl/mac/MW_TkStaticHeader.h
new file mode 100644
index 00000000000..b381c226de8
--- /dev/null
+++ b/tcl/mac/MW_TkStaticHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TkStaticHeaderPPC"
+#elif __CFM68K__
+#include "MW_TkStaticHeaderCFM68K"
+#else
+#include "MW_TkStaticHeader68K"
+#endif
diff --git a/tcl/mac/MW_TkStaticHeader.pch b/tcl/mac/MW_TkStaticHeader.pch
new file mode 100644
index 00000000000..e6f749436ce
--- /dev/null
+++ b/tcl/mac/MW_TkStaticHeader.pch
@@ -0,0 +1,36 @@
+/*
+ * MW_TkStaticHeader.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_TkStaticHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TkStaticHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TkStaticHeader68K"
+#endif
+
+#define STATIC_BUILD 1
+
+#include "MW_TkHeaderCommon.h"
diff --git a/tcl/mac/MW_TkTestHeader.h b/tcl/mac/MW_TkTestHeader.h
new file mode 100755
index 00000000000..995e9fd22ff
--- /dev/null
+++ b/tcl/mac/MW_TkTestHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TkTestHeaderPPC"
+#elif __CFM68K__
+#include "MW_TkTestHeaderCFM68K"
+#else
+#include "MW_TkTestHeader68K"
+#endif
diff --git a/tcl/mac/MW_TkTestHeader.pch b/tcl/mac/MW_TkTestHeader.pch
new file mode 100755
index 00000000000..91efb4350e2
--- /dev/null
+++ b/tcl/mac/MW_TkTestHeader.pch
@@ -0,0 +1,42 @@
+/*
+ * MW_TkTestHeader.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_TkTestHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TkTestHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TkTestHeader68K"
+#endif
+
+#define BUILD_tk 1
+
+#define STATIC_BUILD 1
+
+#define TCL_DEBUG 1
+
+#define TCL_THREADS 1
+
+#include "MW_TkHeaderCommon.h"
diff --git a/tcl/mac/README b/tcl/mac/README
index edb077e8779..42db19e1297 100644
--- a/tcl/mac/README
+++ b/tcl/mac/README
@@ -1,69 +1,81 @@
-Tcl 8.4 for Macintosh
+Tk 8.4 for Macintosh
+
+Originally by Ray Johnson while at Sun Microsystems Labs
+with major help from Jim Ingham while at Cygnus Solutions
RCS: @(#) $Id$
1. Introduction
---------------
-This is the README file for the Macintosh version of the Tcl
-scripting language. The home page for the Mac/Tcl info is
- http://www.tcl.tk/software/mac/
+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.
-A summary of what's new in this release is at
- http://www.tcl.tk/software/tcltk/8.4.html
+3. Mac specific features
+------------------------
-A summary of Macintosh-specific features is at
+There are several features or enhancements in Tk that are unique to
+the Macintosh version of Tk. The list of these features is
+maintained at
http://www.tcl.tk/software/mac/features.html
-2. The Distribution
+4. The Distribution
-------------------
-Macintosh Tcl is distributed in three different forms. This should
-make it easier to only download what you need. Substitute <version>
-with the version you wish to use. The packages are as follows:
+Macintosh Tk is distributed in three different forms. This should
+make it easier to only download what you need. Replace <version>
+with the current version of Tk. The packages are as follows:
mactk<version>.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 "Tcl Shell" and "Wish" applications. In addition,
- it installs the Tcl & Tk libraries in the Extensions folder inside
- your System Folder.
+ 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-<version>.sea.hqx
This release contains the full release of Tcl and Tk for the
- Macintosh plus the More Files packages which Macintosh Tcl and Tk
- rely on.
+ Macintosh plus the More Files package on which Macintosh Tcl and
+ Tk rely.
-mactcl-source-<version>.sea.hqx
+mactk-source-<version>.sea.hqx
- This release contains the complete source for Tcl. In
- addition, Metrowerks CodeWarrior libraries and project files
+ 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.
-The "html" subdirectory contains reference documentation in
-in the HTML format. You may also find these pages at:
-
- http://www.tcl.tk/man/
-
-3. Compiling Tcl
-----------------
+5. Compiling Tk
+---------------
-In order to compile Macintosh Tcl you must have the
+In order to compile Macintosh Tk you must have the
following items:
- CodeWarrior Pro 5+
- Mac Tcl (sources)
- More Files 1.4.9
+ CodeWarrior Pro 5 or higher
+ Mac Tcl (source)
+ (which requires More Files 1.4.9)
+ Mac Tk (source)
+
+The project files included with the Mac Tcl source should work
+fine. The only thing you may need to update are the access paths.
+As with Tcl, you need to upgrade to the 2.0.1 version of the C
+compilers or later to build the CFM68K version of Tcl/Tk.
-The included project files should work fine. However, for
-current release notes please check this page:
+Special notes:
- http://www.tcl.tk/doc/howto/compile.html#mac
+* Check out the file bugs.doc for information about known bugs.
-If you have comments or Bug reports, please use the SourceForge
-Bug tracker to report them:
+* 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 supported the Appearance Manager well. Tk 8.0.4 extended this support
+ to the menu system, though you have to have Appearance 1.0.1 or later
+ installed for this to work.
+
+If you have comments or Bug reports, use our on-line database at
http://tcl.sourceforge.net/
diff --git a/tcl/mac/bugs.doc b/tcl/mac/bugs.doc
index a4936e2e04f..120489d9fbd 100644
--- a/tcl/mac/bugs.doc
+++ b/tcl/mac/bugs.doc
@@ -1,44 +1,54 @@
-Known bug list for Tcl 8.0 for Macintosh
+Known bug list for Tk 8.0 for Macintosh
-by Ray Johnson
+Originally by Ray Johnson
Sun Microsystems Laboratories
rjohnson@eng.sun.com
+Maintained by:
+Jim Ingham
+Cygnus Solutions, a Red Hat Company
+jingham@cygnus.com
+
RCS: @(#) $Id$
-This was a new feature as of Tcl7.6b1 and as such I'll started with
-a clean slate. I currently know of no reproducable bugs. I often
-get vague reports - but nothing I've been able to confirm. Let
-me know what bugs you find!
-
-The Macintosh version of Tcl passes most all tests in the Tcl
-test suite. Slower Macs may fail some tests in event.test whose
-timing constraints are too tight. If other tests fail please report
-them.
-
-Ray
-
-Known bugs in the current release.
-
-* With the socket code you can't use the "localhost" host name. This
- is actually a known bug in Apple's MacTcp stack. However, you can
- use [info hostname] whereever you would have used "localhost" to
- achive the same effect.
-
-* Most socket bugs have been fixed. We do have a couple of test cases
- that will hang the Mac, however, and we are still working on them.
- If you find additional test cases that show crashes please let us
- know!
-
-* In Tcl 8.2, the new Regexp code seems to be more deeply recursive than
-the older version in Tcl8.0. As a result, I have had to increase the Stack
-size of Tcl to 1Meg. If you are not doing regexps with many subexpressions,
-this is probably more stack than you will need. You can relink with the
-stack set to 512K, and you will be fine for most purposes.
-* This regexp problem is fixed in Tcl8.3. If you are going to do complex
-regexp's, it is probably a good idea to keep the stack size big. But normal
-regexps will not cause crashes.
-
-* The "clock scan -base" command does not work. The epoch is wrong.
-* The file mtime command does not work when setting the time, it is off
-by 4 years.
+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 only implemented within the same app.
+
+* You cannot color buttons, and the indicators for radiobuttons and
+ checkbuttons under Appearance. They will always use the current
+ Theme color. But, then, you are not supposed to...
+
+* Drawing is not really correct. This shows up mostly in the canvas
+ when line widths are greater than one. Unfortunantly, this will not
+ be easy to fix.
+
+* The active menu highlight color in Tearoff menus will not match the system-wide
+ menu highlight color under Appearance. It will be black instead. This is not
+ easy to fix, since the Appearance API's don't really allow you to get your hands
+ on this information...
+
+There are many other bugs. However, will no get listed until they
+are reported at least once. Send those bug reports in!
+
+
+
+Jim
diff --git a/tcl/mac/license.terms b/tcl/mac/license.terms
index f1dcaa5245c..03ca6fcb319 100644
--- a/tcl/mac/license.terms
+++ b/tcl/mac/license.terms
@@ -1,8 +1,7 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
+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
@@ -37,4 +36,4 @@ 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.
+terms specified in this license.
diff --git a/tcl/mac/tclets.r b/tcl/mac/tclets.r
new file mode 100755
index 00000000000..e4553aef54b
--- /dev/null
+++ b/tcl/mac/tclets.r
@@ -0,0 +1,172 @@
+/*
+ * tclets.r --
+ *
+ */
+
+/*
+ * 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>
+
+/*
+ * We now load the Tclets code into the resource fork
+ */
+
+#define TK_LIBRARY_RESOURCES 3000
+
+read 'TEXT' (TK_LIBRARY_RESOURCES+114, "tclshrc", purgeable)
+ "::mac:tclets.tcl";
+
+data 'icns' (-16455) {
+ $"6963 6E73 0000 08F8 6963 7323 0000 0048" /* icns...¯ics#...H */
+ $"0100 02EE 05CE 09EE 13DE 23FF 47CE 86C6" /* ...Ó.‘Ó.Þ#G‘Ü */
+ $"4681 22C2 12C4 0888 0410 0220 0140 0080" /* FÅ"¬.Ÿ.à... .@.Ä */
+ $"0100 03EE 07CE 0FEE 1FFE 3FFF 7FFE FFFE" /* ...Ó.‘.Ó.œ?.œœ */
+ $"7FFF 3FFE 1FFC 0FF8 07F0 03E0 01C0 0080" /* .?œ.¸.¯.•.ý.¿.Ä */
+ $"6963 7334 0000 0088 0000 000F 0000 0000" /* ics4...à........ */
+ $"0000 00FC F6D0 FFF0 0000 0FC5 DD00 F6F0" /* ...¸–­•...‰ð.–• */
+ $"0000 FCCD 66F0 F6F0 000F CC6E 66CE F6F0" /* ..¸Õf•–•..Ãnf‘–• */
+ $"00FC CC6E 67EF F6FF 0FCC CD66 66CC F6F0" /* .¸ÃngÔ–.ÃÕffÖ• */
+ $"FCCC CDDC 66CC CFA0 0FCC CD6C EDCC CC0F" /* ¸ÃÕÐfæÝ.ÃÕlÌÃÃ. */
+ $"00FC CC6C E6CC CCF0 000F CC6C 66CC CF00" /* .¸ÃlÊÃÕ..Ãlfæ. */
+ $"0000 FCCC 6CCC F000 0000 0FCC DCCF 0000" /* ..¸ÃlÕ....ÃЦ.. */
+ $"0000 00FD DCF0 0000 0000 000F CF00 0000" /* ...›Ð•......¦... */
+ $"0000 0000 F000 0000 6963 7338 0000 0108" /* ....•...ics8.... */
+ $"0000 0000 0000 00FF 0000 0000 0000 0000" /* ............... */
+ $"0000 0000 0000 FF2B FFEC 7F00 FFFF FF00" /* ......+Ï... */
+ $"0000 0000 00FF 2BB0 7F7F 0000 FFEC FF00" /* .....+ƒ....Ï. */
+ $"0000 0000 FF2B 2B7F ECEC FF00 FFEC FF00" /* ....++.ÏÏ.Ï. */
+ $"0000 00FF 2B2B ECFC ECEC 2BFB FFEC FF00" /* ...++ϸÏÏ+šÏ. */
+ $"0000 FF2B 2B2B ECFC ECC0 FBFF FFEC FFFF" /* ..+++ϸϿšÏ */
+ $"00FF 2B2B 2B7F ECEC ECEC 2B2B FFEC FF00" /* .+++.ÏÏÏÏ++Ï. */
+ $"FF2B 2B2B 2B7F 7FF6 ECEC 2B2B 2BFF FD00" /* ++++..–ÏÏ+++›. */
+ $"00FF 2B2B 2B7F ECF6 FCF9 2B2B 2B2B 00FF" /* .+++.Ï–¸˜++++. */
+ $"0000 FF2B 2B2B ECF6 FCEC 2B2B 2B2B FF00" /* ..+++Ï–¸Ï++++. */
+ $"0000 00FF 2B2B ECF6 ECEC 2B2B 2BFF 0000" /* ...++Ï–ÏÏ+++.. */
+ $"0000 0000 FF2B 2BF6 EC2B 2B2B FF00 0000" /* ....++–Ï+++... */
+ $"0000 0000 00FF 2BF6 F92B 2BFF 0000 0000" /* .....+–˜++.... */
+ $"0000 0000 0000 FFF9 F92B FF00 0000 0000" /* ......˜˜+..... */
+ $"0000 0000 0000 00FF 2BFF 0000 0000 0000" /* .......+...... */
+ $"0000 0000 0000 0000 FF00 0000 0000 0000" /* ............... */
+ $"4943 4E23 0000 0108 0001 0000 0002 8000" /* ICN#..........Ä. */
+ $"0004 78F8 0008 70F8 0010 F0F8 0021 E8F8" /* ..x¯..p¯..•¯.!˯ */
+ $"0043 C4F8 0081 FAF8 0107 F1F8 0207 F0F8" /* .CŸ¯.Å™¯..Ò¯..•¯ */
+ $"0407 F7FF 0807 E3FE 1007 E1FC 200E E0F8" /* ..—..“œ..·¸ .ý¯ */
+ $"4002 E074 800E E022 400E E001 200E C002" /* @.ýtÄ.ý"@.ý. .¿. */
+ $"1006 E004 0806 C008 0406 E010 0202 C020" /* ..ý...¿...ý...¿ */
+ $"0102 C040 0080 8080 0040 0100 0020 0200" /* ..¿@.ÄÄÄ.@... .. */
+ $"0010 0400 0008 0800 0004 1000 0002 2000" /* .............. . */
+ $"0001 4000 0000 8000 0001 0000 0003 8000" /* ..@...Ä.......Ä. */
+ $"0007 F8F8 000F F0F8 001F F0F8 003F F8F8" /* ..¯¯..•¯..•¯.?¯¯ */
+ $"007F FCF8 00FF FEF8 01FF FFF8 03FF FFF8" /* ..¸¯.œ¯.¯.¯ */
+ $"07FF FFFF 0FFF FFFE 1FFF FFFC 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 6963 6C34 0000 0208" /* ..¿...Ä.icl4.... */
+ $"0000 0000 0000 000F 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 00FC F000 0000 0000 0000" /* .......¸•....... */
+ $"0000 0000 0000 0FCC CFD6 D000 FFFF F000" /* .......æ÷­.•. */
+ $"0000 0000 0000 FCCC C556 0000 F767 F000" /* ......¸Ã‰V..—g•. */
+ $"0000 0000 000F CCCC 566F 0000 F676 F000" /* ......ÃÃVo..–v•. */
+ $"0000 0000 00FC CCC5 6F5C F000 F767 F000" /* .....¸Ã‰o\•.—g•. */
+ $"0000 0000 0FCC CC66 66CC 0F00 F676 F000" /* .....ÃÃffÃ..–v•. */
+ $"0000 0000 FCCC CCD5 5666 FCF0 F767 F000" /* ....¸ÃùVf¸•—g•. */
+ $"0000 000F CCCC C656 5667 CCCF F676 F000" /* ....ÃÃVVgæ–v•. */
+ $"0000 00FC CCCC C6E5 5566 CCCC F767 F000" /* ...¸ÃÃÂUfÃ×g•. */
+ $"0000 0FCC CCCC C656 5657 CFFF F676 FFFF" /* ...ÃÃÃVVW¦–v */
+ $"0000 FCCC CCCC C6E5 565C CCF7 6767 67F0" /* ..¸ÃÃÃÂV\×ggg• */
+ $"000F CCCC CCCC C655 565C CCCF 7676 7F00" /* ..ÃÃÃÃUV\ævv.. */
+ $"00FC CCCC CCCC 7660 556C CCCC F767 F000" /* .¸ÃÃÃÃv`UlÃ×g•. */
+ $"0FCC CCCC CCCC CD5D 567C CCCC CF7F CF00" /* .ÃÃÃÃÃÕ]V|Ãæ.¦. */
+ $"FCCC CCCC CCCC 6660 556C CCCC CCFC CCF0" /* ¸ÃÃÃÃÃf`UlÃÃøÕ */
+ $"0FCC CCCC CCCC 665C 565C CCCC CCCC CCCF" /* .ÃÃÃÃÃf\V\ÃÃÃÃæ */
+ $"00FC CCCC CCCC 6660 E6DC CCCC CCCC CCF0" /* .¸ÃÃÃÃf`ÊÐÃÃÃÃÕ */
+ $"000F CCCC CCCC C650 656C CCCC CCCC CF00" /* ..ÃÃÃÃPelÃÃÃæ. */
+ $"0000 FCCC CCCC C6EC 5ECC CCCC CCCC F000" /* ..¸ÃÃÃÏ^ÃÃÃÃÕ. */
+ $"0000 0FCC CCCC C650 566C CCCC CCCF 0000" /* ...ÃÃÃPVlÃÃæ.. */
+ $"0000 00FC CCCC CC50 D5CC CCCC CCF0 0000" /* ...¸ÃÃÃP¹ÃÃÃÕ.. */
+ $"0000 000F CCCC CC50 56CC CCCC CF00 0000" /* ....ÃÃÃPVÃÃæ... */
+ $"0000 0000 FCCC CCD0 5CCC CCCC F000 0000" /* ....¸Ãí\ÃÃÕ... */
+ $"0000 0000 0FCC CCD0 DCCC CCCF 0000 0000" /* .....ÃíÐÃæ.... */
+ $"0000 0000 00FC CCD0 DCCC CCF0 0000 0000" /* .....¸Ã­ÐÃÕ.... */
+ $"0000 0000 000F CCD0 DCCC CF00 0000 0000" /* ......íÐæ..... */
+ $"0000 0000 0000 FCC0 CCCC F000 0000 0000" /* ......¸¿ÃÕ..... */
+ $"0000 0000 0000 0FCD 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" /* ........•....... */
+ $"6963 6C38 0000 0408 0000 0000 0000 0000" /* icl8............ */
+ $"0000 0000 0000 00FF 0000 0000 0000 0000" /* ............... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 FF2B FF00 0000 0000 0000" /* ......+....... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 00FF 2B2B 2BFF 7FEC 7F00 0000" /* .....+++.Ï.... */
+ $"FFFF FFFF FF00 0000 0000 0000 0000 0000" /* ........... */
+ $"0000 0000 FF2B 2B2B 2BB0 B0EC 0000 0000" /* ....++++ƒƒÏ.... */
+ $"FFC0 ECC0 FF00 0000 0000 0000 0000 0000" /* ¿Ï¿........... */
+ $"0000 00FF 2B2B 2B2B B0EC ECFF 0000 0000" /* ...++++ƒÏÏ.... */
+ $"FFEC C0EC FF00 0000 0000 0000 0000 0000" /* Ï¿Ï........... */
+ $"0000 FF2B 2B2B 2BB0 ECFF B02B FF00 0000" /* ..++++ƒÏƒ+... */
+ $"FFC0 ECC0 FF00 0000 0000 0000 0000 0000" /* ¿Ï¿........... */
+ $"00FF 2B2B 2B2B ECEC ECEC 2B2B 00FF 0000" /* .++++ÏÏÏÏ++... */
+ $"FFEC C0EC FF00 0000 0000 0000 0000 0000" /* Ï¿Ï........... */
+ $"FF2B 2B2B 2B2B F9B0 B0EC ECEC FF2B FF00" /* +++++˜ƒƒÏÏÏ+. */
+ $"FFC0 ECC0 FF00 0000 0000 0000 0000 00FF" /* ¿Ï¿.......... */
+ $"2B2B 2B2B 2BEC B0EC B0EC ECC0 2B2B 2BFF" /* +++++σσÏÏ¿+++ */
+ $"FFEC C0EC FF00 0000 0000 0000 0000 FF2B" /* Ï¿Ï.........+ */
+ $"2B2B 2B2B 2BEC FCB0 B0B0 ECEC 2B2B 2B2B" /* +++++ϸƒƒƒÏÏ++++ */
+ $"FFC0 ECC0 FF00 0000 0000 0000 00FF 2B2B" /* ¿Ï¿........++ */
+ $"2B2B 2B2B 2BEC B0EC B0EC B0C0 2BFF FFFF" /* +++++σσσ¿+ */
+ $"FFEC C0EC FFFF FFFF 0000 0000 FF2B 2B2B" /* Ï¿Ï....+++ */
+ $"2B2B 2B2B 2BEC FCB0 B0EC B02B 2B2B FFC0" /* +++++ϸƒƒÏƒ+++¿ */
+ $"ECC0 ECC0 ECC0 FF00 0000 00FF 2B2B 2B2B" /* Ï¿Ï¿Ï¿....++++ */
+ $"2B2B 2B2B 2BEC B0B0 B0EC B02B 2B2B 2BFF" /* +++++σƒƒÏƒ++++ */
+ $"C0EC C0EC C0FF 0000 0000 FF2B 2B2B 2B2B" /* ¿Ï¿Ï¿....+++++ */
+ $"2B2B 2B2B C0EC EC00 B0B0 EC2B 2B2B 2B2B" /* ++++¿ÏÏ.ƒƒÏ+++++ */
+ $"FFC0 ECC0 FF00 0000 00FF 2B2B 2B2B 2B2B" /* ¿Ï¿....++++++ */
+ $"2B2B 2B2B 2BF9 B0F9 B0EC C02B 2B2B 2B2B" /* +++++˜ƒ˜ƒÏ¿+++++ */
+ $"2BFF C0FF 2BFF 0000 FF2B 2B2B 2B2B 2B2B" /* +¿+..+++++++ */
+ $"2B2B 2B2B ECEC EC00 B0B0 EC2B 2B2B 2B2B" /* ++++ÏÏÏ.ƒƒÏ+++++ */
+ $"2B2B FF2B 2B2B FF00 00FF 2B2B 2B2B 2B2B" /* +++++..++++++ */
+ $"2B2B 2B2B ECEC B02B B0EC B02B 2B2B 2B2B" /* ++++Ïσ+ƒÏƒ+++++ */
+ $"2B2B 2B2B 2B2B 2BFF 0000 FF2B 2B2B 2B2B" /* +++++++..+++++ */
+ $"2B2B 2B2B ECEC EC00 FCEC F92B 2B2B 2B2B" /* ++++ÏÏÏ.¸Ï˜+++++ */
+ $"2B2B 2B2B 2B2B FF00 0000 00FF 2B2B 2B2B" /* ++++++....++++ */
+ $"2B2B 2B2B 2BEC B000 ECB0 EC2B 2B2B 2B2B" /* +++++σ.σÏ+++++ */
+ $"2B2B 2B2B 2BFF 0000 0000 0000 FF2B 2B2B" /* +++++......+++ */
+ $"2B2B 2B2B 2BEC FC2B B0FC 2B2B 2B2B 2B2B" /* +++++ϸ+ƒ¸++++++ */
+ $"2B2B 2B2B FF00 0000 0000 0000 00FF 2B2B" /* ++++........++ */
+ $"2B2B 2B2B 2BEC B000 B0EC EC2B 2B2B 2B2B" /* +++++σ.ƒÏÏ+++++ */
+ $"2B2B 2BFF 0000 0000 0000 0000 0000 FF2B" /* +++..........+ */
+ $"2B2B 2B2B 2B2B B000 7FB0 2B2B 2B2B 2B2B" /* ++++++ƒ..ƒ++++++ */
+ $"2B2B FF00 0000 0000 0000 0000 0000 00FF" /* ++............ */
+ $"2B2B 2B2B 2B2B B000 B0EC 2B2B 2B2B 2B2B" /* ++++++ƒ.ƒÏ++++++ */
+ $"2BFF 0000 0000 0000 0000 0000 0000 0000" /* +.............. */
+ $"FF2B 2B2B 2B2B F900 B02B 2B2B 2B2B 2B2B" /* +++++˜.ƒ+++++++ */
+ $"FF00 0000 0000 0000 0000 0000 0000 0000" /* ............... */
+ $"00FF 2B2B 2B2B F900 F92B 2B2B 2B2B 2BFF" /* .++++˜.˜++++++ */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 FF2B 2B2B F900 F92B 2B2B 2B2B FF00" /* ..+++˜.˜+++++. */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 00FF 2B2B F900 F92B 2B2B 2BFF 0000" /* ...++˜.˜++++.. */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 FF2B 2B00 2B2B 2B2B FF00 0000" /* ....++.++++... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 00FF 2BF9 2B2B 2BFF 0000 0000" /* .....+˜+++.... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 FF2B 2B2B FF00 0000 0000" /* ......+++..... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 00FF 2BFF 0000 0000 0000" /* .......+...... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 0000 FF00 0000 0000 0000" /* ............... */
+ $"0000 0000 0000 0000" /* ........ */
+};
diff --git a/tcl/mac/tclets.tcl b/tcl/mac/tclets.tcl
new file mode 100644
index 00000000000..fa147e82819
--- /dev/null
+++ b/tcl/mac/tclets.tcl
@@ -0,0 +1,225 @@
+# 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.
+#
+
+namespace eval ::tk {}
+namespace eval ::tk::mac {}
+
+# ::tk::mac::OpenDocument --
+#
+# This procedure is a called whenever Wish recieves an "Open" event. The
+# procedure must be named ::tk::mac::OpenDocument 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 ::tk::mac::OpenDocument {args} {
+ variable 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
+ ::tk::unsupported::MacWindowStyle 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
+}
+
+# ::tk::mac::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 ::tk::mac::GetStub {} {
+ global env
+ variable 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
+ }
+}
+
+# ::tk::mac::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 ::tk::mac::SelectStub {} {
+ global env
+ variable Stub_location
+
+ # Give a helper screen to guide user
+ toplevel .helper -menu .bar
+ ::tk::unsupported::MacWindowStyle 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 [namespace which -variable Stub_location] \
+ $Stub_location]
+ close $id
+ }
+}
+
+# ::tk::mac::CreateMenus --
+#
+# Create the menubar for this application.
+#
+# Parameters:
+# None.
+#
+# Results:
+# None.
+
+proc ::tk::mac::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 [namespace code 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 [namespace code SelectStub]
+ .bar.file add separator
+ .bar.file add command -label "Quit" -accel Command-Q -command exit
+}
+
+# ::tk::mac::ShowAbout --
+#
+# Show the about box for Drag & Drop Tclets.
+#
+# Parameters:
+# None.
+#
+# Results:
+# None.
+
+proc ::tk::mac::ShowAbout {} {
+ tk_messageBox -icon info -type ok -message \
+"Drag & Drop Tclets
+by Ray Johnson\n\n\
+Copyright (c) 1997 Sun Microsystems, Inc."
+}
+
+# ::tk::mac::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 ::tk::mac::Start {} {
+ variable 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!
+::tk::mac::Start
diff --git a/tcl/mac/tkMac.h b/tcl/mac/tkMac.h
new file mode 100644
index 00000000000..362f6f9a3d9
--- /dev/null
+++ b/tcl/mac/tkMac.h
@@ -0,0 +1,56 @@
+/*
+ * 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
+
+#ifndef _TK
+#include <tk.h>
+#endif
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+#include <Windows.h>
+#include <QDOffscreen.h>
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * 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);
+
+#include "tkPlatDecls.h"
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKMAC */
diff --git a/tcl/mac/tkMacAppInit.c b/tcl/mac/tkMacAppInit.c
new file mode 100644
index 00000000000..11cfccfba48
--- /dev/null
+++ b/tcl/mac/tkMacAppInit.c
@@ -0,0 +1,443 @@
+/*
+ * 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 "tclInt.h"
+#include "tclMac.h"
+#include "tclMacInt.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));
+int kbhit _ANSI_ARGS_((void));
+int getch _ANSI_ARGS_((void));
+void clrscr _ANSI_ARGS_((void));
+short SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event));
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int MacintoshInit _ANSI_ARGS_((void));
+static int SetupMainInterp _ANSI_ARGS_((Tcl_Interp *interp));
+static void SetupSIOUX _ANSI_ARGS_((void));
+
+static int inMacExit = 0;
+static pascal void NoMoreOutput() { inMacExit = 1; }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 is actually #defined to
+ * Tk_MainEx(argc, argv, Tcl_AppInit, Tcl_CreateInterp())
+ * Unfortunately, you also HAVE to call Tcl_FindExecutable
+ * BEFORE creating the first interp, or the tcl_library will not
+ * get set properly. So we call it by hand here...
+ */
+
+ Tcl_FindExecutable(newArgv[0]);
+ 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 the interp's 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();
+ if (TkMacHaveAppearance() >= 0x110) {
+ InitFloatingWindows();
+ } else {
+ 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);
+ 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 (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
+ goto error;
+ }
+ SetupSIOUX();
+ TclMacInstallExitToShellPatch(NoMoreOutput);
+ }
+
+ /*
+ * Attach the global interpreter to tk's expected global console
+ */
+
+ gStdoutInterp = interp;
+
+ return TCL_OK;
+
+error:
+ panic(Tcl_GetStringResult(interp));
+ 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)
+{
+ if (!inMacExit) {
+ Tcl_DString ds;
+ Tcl_ExternalToUtfDString(NULL, buffer, n, &ds);
+ TkConsolePrint(gStdoutInterp, TCL_STDOUT, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return n;
+ } else {
+ return 0;
+ }
+}
+
+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);
+}
+
+int kbhit(void)
+{
+ return 0;
+}
+
+int getch(void)
+{
+ return 0;
+}
+
+void clrscr(void)
+{
+ return;
+}
+
+short
+SIOUXHandleOneEvent(EventRecord *event)
+{
+ return 0;
+}
+static void SetupSIOUX(void) {
+#ifndef STATIC_BUILD
+ extern DLLIMPORT void SetupConsolePlugins(void*, void*, void*, void*,
+ void*, void*, void*, void*);
+ SetupConsolePlugins( &InstallConsole,
+ &RemoveConsole,
+ &WriteCharsToConsole,
+ &ReadCharsFromConsole,
+ &__ttyname,
+ &kbhit,
+ &getch,
+ &clrscr);
+#endif
+}
diff --git a/tcl/mac/tkMacAppearanceStubs.c b/tcl/mac/tkMacAppearanceStubs.c
new file mode 100755
index 00000000000..0fd0feeddb6
--- /dev/null
+++ b/tcl/mac/tkMacAppearanceStubs.c
@@ -0,0 +1,104 @@
+/*
+ * tkMacAppearanceStubs.c --
+ *
+ * This file contains stubs for some MacOS8.6+ Toolbox calls that
+ * are not contained in any of the CFM68K stubs libraries. Their
+ * use must be conditionalized by checks (usually for Appearance version
+ * greater than 1.1), so they will never get called on a CFM68k system.
+ * Putting in the stubs means I don't have to clutter the code BOTH
+ * with appearance version checks & #ifdef GENERATING_CFM68K...
+ *
+ * Copyright (c) 1999 Scriptics Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ *
+ */
+
+#include <MacWindows.h>
+#include <Appearance.h>
+
+/* Export these calls from the Tk library, since we may need to use
+ * them in shell calls.
+ */
+
+pascal OSStatus
+MoveWindowStructure(
+ WindowPtr window,
+ short hGlobal,
+ short vGlobal)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return noErr;
+
+}
+
+pascal OSStatus
+CreateNewWindow(
+ WindowClass windowClass,
+ WindowAttributes attributes,
+ const Rect *bounds,
+ WindowPtr *outWindow)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return noErr;
+
+}
+
+pascal WindowPtr
+FrontNonFloatingWindow()
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return NULL;
+}
+
+pascal OSStatus
+GetWindowClass(
+ WindowPtr window,
+ WindowClass *outClass)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return noErr;
+}
+
+pascal OSStatus
+ApplyThemeBackground(
+ ThemeBackgroundKind inKind,
+ const Rect* bounds,
+ ThemeDrawState inState,
+ SInt16 inDepth,
+ Boolean inColorDev)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return noErr;
+}
+
+pascal OSStatus
+InitFloatingWindows(void)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return noErr;
+}
+
+pascal OSStatus
+ShowFloatingWindows(void)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return noErr;
+}
+
+pascal OSStatus
+HideFloatingWindows(void)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return noErr;
+}
+
+pascal Boolean
+IsValidWindowPtr(GrafPtr grafPort)
+{
+ panic("Error: Running stub for PPC-Only routine");
+ return true;
+}
+
diff --git a/tcl/mac/tkMacApplication.r b/tcl/mac/tkMacApplication.r
new file mode 100644
index 00000000000..51f0f7038c1
--- /dev/null
+++ b/tcl/mac/tkMacApplication.r
@@ -0,0 +1,317 @@
+/*
+ * 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 <Balloons.r>
+#include <BalloonTypes.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
+# define RELEASE_CODE 0x00
+#else
+# define MINOR_VERSION TK_MINOR_VERSION * 16
+# define RELEASE_CODE TK_RELEASE_SERIAL
+#endif
+
+resource 'vers' (1) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
+ TK_PATCH_LEVEL,
+ TK_PATCH_LEVEL ", by Ray Johnson & Jim Ingham" "\n" "© 2001 Tcl Core Team"
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
+ TK_PATCH_LEVEL,
+ "Wish " TK_PATCH_LEVEL " © 1993-2001"
+};
+
+#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 " © 1993-2001"
+};
+
+/*
+ * 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"
+ }
+};
+
+#define kIconHelpString 256
+
+resource 'hfdr' (-5696, purgeable) {
+ HelpMgrVersion, hmDefaultOptions, 0, 0,
+ {HMSTRResItem {kIconHelpString}}
+};
+resource 'STR ' (kIconHelpString, purgeable) {
+ "This is the interpreter for Tcl & Tk scripts"
+ " running on Macintosh computers."
+};
+
+/*
+ * 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"
+};
+
+/*
+ * 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"
+ */
+ };
+};
+
+data 'alis' (1000, "Library Folder") {
+ $"0000 0000 00BA 0002 0001 012F 0000 0000" /* .....†...../.... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 985C FB00 4244 0000 0000" /* ......ò\š.BD.... */
+ $"0002 1328 5375 7070 6F72 7420 4C69 6272" /* ...(Support Libr */
+ $"6172 6965 7329 0000 0000 0000 0000 0000" /* aries).......... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0076 8504 B617 A796 003D 0027 025B" /* ...vÖ..ßñ.=.'.[ */
+ $"01E4 0001 0001 0000 0000 0000 0000 0000" /* .”.............. */
+ $"0000 0000 0000 0000 0001 2F00 0002 0015" /* ........../..... */
+ $"2F3A 2853 7570 706F 7274 204C 6962 7261" /* /:(Support Libra */
+ $"7269 6573 2900 FFFF 0000" /* ries)... */
+};
+
diff --git a/tcl/mac/tkMacBitmap.c b/tcl/mac/tkMacBitmap.c
new file mode 100644
index 00000000000..ccbf2b2296c
--- /dev/null
+++ b/tcl/mac/tkMacBitmap.c
@@ -0,0 +1,279 @@
+/*
+ * tkMacBitmap.c --
+ *
+ * This file handles the implementation of native bitmaps.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDefineNativeBitmaps()
+{
+ int new;
+ Tcl_HashEntry *predefHashPtr;
+ TkPredefBitmap *predefPtr;
+ char * name;
+ BuiltInIcon *builtInPtr;
+ NativeIcon *nativeIconPtr;
+ Tcl_HashTable *tablePtr;
+
+ for (builtInPtr = builtInIcons; builtInPtr->name != NULL; builtInPtr++) {
+ name = Tk_GetUid(builtInPtr->name);
+ tablePtr = TkGetBitmapPredefTable();
+ predefHashPtr = Tcl_CreateHashEntry(tablePtr, name, &new);
+ if (!new) {
+ continue;
+ }
+ predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
+ nativeIconPtr = (NativeIcon *) ckalloc(sizeof(NativeIcon));
+ nativeIconPtr->id = builtInPtr->id;
+ nativeIconPtr->type = builtInPtr->type;
+ 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 the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+TkpCreateNativeBitmap(
+ Display *display,
+ CONST 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 the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+TkpGetNativeAppBitmap(
+ Display *display, /* The display. */
+ CONST 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, destWrote;
+ Str255 nativeName;
+
+ /*
+ * macRoman is the encoding that the resource fork uses.
+ */
+
+ Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), name,
+ strlen(name), 0, NULL,
+ (char *) &nativeName[1],
+ 255, NULL, &destWrote, NULL); /* Internalize native */
+ nativeName[0] = destWrote;
+
+ resource = GetNamedResource('cicn', nativeName);
+ if (resource != NULL) {
+ type = TYPE3;
+ } else {
+ resource = GetNamedResource('ICON', nativeName);
+ if (resource != NULL) {
+ type = TYPE2;
+ }
+ }
+
+ if (resource == NULL) {
+ return NULL;
+ }
+
+ pix = Tk_GetPixmap(display, None, 32, 32, 0);
+ destPort = TkMacGetDrawablePort(pix);
+
+ 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/tcl/mac/tkMacButton.c b/tcl/mac/tkMacButton.c
new file mode 100644
index 00000000000..effd3e17546
--- /dev/null
+++ b/tcl/mac/tkMacButton.c
@@ -0,0 +1,1699 @@
+/*
+ * 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 <ControlDefinitions.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 void ButtonEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+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.
+ */
+
+Tk_ClassProcs tkpButtonProcs = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkButtonWorldChanged, /* worldChangedProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+{
+ TkButton *buttonPtr;
+ buttonPtr = (TkButton *) ckalloc(sizeof(TkButton));
+ Tk_CreateEventHandler(tkwin, ActivateMask,
+ ButtonEventProc, (ClientData) buttonPtr);
+ return buttonPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, fullWidth, fullHeight;
+ int imageXOffset, imageYOffset, textXOffset, textYOffset;
+ int haveImage = 0, haveText = 0;
+ int offset; /* 0 means this is a normal widget. 1 means
+ * it is an image button, so we offset the
+ * image to make the button appear to move
+ * up and down as the relief changes. */
+ int hasImageOrBitmap;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ int drawType, borderWidth;
+
+ GetGWorld(&saveWorld, &saveDevice);
+
+ butPtr->flags &= ~REDRAW_PENDING;
+ if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the button in a pixmap, then copies the pixmap to the
+ * screen in a single operation. This means that there's no
+ * point in time where the on-sreen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(butPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ hasImageOrBitmap = ((butPtr->image != NULL) || (butPtr->bitmap != None));
+ offset = (butPtr->type == TYPE_BUTTON) && hasImageOrBitmap;
+
+ border = butPtr->normalBorder;
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
+ gc = butPtr->disabledGC;
+ } else if ((butPtr->type == TYPE_BUTTON)
+ && (butPtr->state == STATE_ACTIVE)) {
+ gc = butPtr->activeTextGC;
+ border = butPtr->activeBorder;
+ } else {
+ gc = butPtr->normalTextGC;
+ }
+
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
+ && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
+ border = butPtr->selectBorder;
+ }
+
+ /*
+ * Override the relief specified for the button if this is a
+ * checkbutton or radiobutton and there's no indicator.
+ * However, don't do this in the presence of Appearance, since
+ * then the bevel button will take care of the relief.
+ */
+
+ relief = butPtr->relief;
+
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
+ if (!TkMacHaveAppearance() || !hasImageOrBitmap) {
+ if (butPtr->flags & SELECTED) {
+ relief = TK_RELIEF_SUNKEN;
+ } else if (butPtr->overRelief != relief) {
+ relief = butPtr->offRelief;
+ }
+ }
+ }
+
+ /*
+ * 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);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+ haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ imageXOffset = 0;
+ imageYOffset = 0;
+ textXOffset = 0;
+ textYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (butPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + butPtr->padY;
+ } else {
+ imageYOffset = butPtr->textHeight + butPtr->padY;
+ }
+ fullHeight = height + butPtr->textHeight + butPtr->padY;
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ if (butPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + butPtr->padX;
+ } else {
+ imageXOffset = butPtr->textWidth + butPtr->padX;
+ }
+ fullWidth = butPtr->textWidth + butPtr->padX + width;
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + fullWidth, fullHeight, &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 + imageXOffset,
+ y + imageYOffset);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width,
+ height, pixmap, x + imageXOffset,
+ y + imageYOffset);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x + imageXOffset,
+ y + imageYOffset);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc,
+ 0, 0, (unsigned int) width,
+ (unsigned int) height, x + imageXOffset,
+ y + imageYOffset, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+
+ Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
+ x + textXOffset, y + textYOffset, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, gc,
+ butPtr->textLayout, x + textXOffset, y + textYOffset,
+ butPtr->underline);
+ y += fullHeight/2;
+ } else {
+ if (haveImage) {
+ 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 {
+ 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 == STATE_DISABLED)
+ && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->selectBorder)->pixel);
+ }
+ XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
+ 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, haveImage = 0, haveText = 0;
+ int txtWidth, txtHeight;
+ Tk_FontMetrics fm;
+
+ width = 0;
+ height = 0;
+ txtWidth = 0;
+ txtHeight = 0;
+ avgWidth = 0;
+
+ /*
+ * First figure out the size of the contents of the button.
+ */
+
+ butPtr->indicatorSpace = 0;
+ if (butPtr->image != NULL) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+
+ if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) {
+ Tk_FreeTextLayout(butPtr->textLayout);
+ butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
+
+ txtWidth = butPtr->textWidth;
+ txtHeight = butPtr->textHeight;
+ avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
+ Tk_GetFontMetrics(butPtr->tkfont, &fm);
+ haveText = (txtWidth != 0 && txtHeight != 0);
+ }
+
+ /*
+ * If the button is compound (ie, it shows both an image and text),
+ * the new geometry is a combination of the image and text geometry.
+ * We only honor the compound bit if the button has both text and an
+ * image, because otherwise it is not really a compound button.
+ */
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ height += txtHeight + butPtr->padY;
+ width = (width > txtWidth ? width : txtWidth);
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ width += txtWidth + butPtr->padX;
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ width = (width > txtWidth ? width : txtWidth);
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ 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;
+ }
+ }
+
+ width += 2*butPtr->padX;
+ height += 2*butPtr->padY;
+
+ } else {
+ if (haveImage) {
+ 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 {
+ width = txtWidth;
+ height = txtHeight;
+ 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 != STATE_DISABLED) {
+ butPtr->inset += butPtr->highlightWidth;
+ }
+ } else if (TkMacHaveAppearance()) {
+ butPtr->inset = 0;
+ width += (2 * butPtr->borderWidth + 4);
+ height += (2 * butPtr->borderWidth + 4);
+ } else {
+ butPtr->inset = butPtr->borderWidth;
+ width += 2;
+ height += 2;
+ if (butPtr->defaultState != STATE_DISABLED) {
+ butPtr->inset += butPtr->highlightWidth;
+ }
+ }
+ } else if ((butPtr->type != TYPE_LABEL)) {
+ if (butPtr->indicatorOn) {
+ butPtr->inset = 0;
+ } else {
+ /*
+ * Under Appearance, the Checkbutton or radiobutton with an image
+ * is represented by a BevelButton with the Sticky defProc...
+ * So we must set its height in the same way as the Button
+ * with an image or bitmap.
+ */
+ if (((butPtr->image != None) || (butPtr->bitmap != None))
+ && TkMacHaveAppearance()) {
+ int border;
+ butPtr->inset = 0;
+ if ( butPtr->borderWidth <= 2 ) {
+ border = 6;
+ } else {
+ border = 2 * butPtr->borderWidth + 2;
+ }
+ width += border;
+ height += border;
+ } else {
+ butPtr->inset = butPtr->borderWidth;
+ }
+ }
+ } else {
+ butPtr->inset = butPtr->borderWidth;
+ }
+
+
+
+ Tk_GeometryRequest(butPtr->tkwin, (int) (width + butPtr->indicatorSpace
+ + 2*butPtr->inset), (int) (height + 2*butPtr->inset));
+ Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 (!tkMacAppInFront || butPtr->state == STATE_DISABLED) {
+ (**controlHandle).contrlHilite = kControlInactivePart;
+ } else if (butPtr->state == STATE_ACTIVE) {
+ if (isBevel) {
+ (**controlHandle).contrlHilite = kControlButtonPart;
+ } else {
+ switch (butPtr->type) {
+ case TYPE_BUTTON:
+ (**controlHandle).contrlHilite = kControlButtonPart;
+ break;
+ case TYPE_RADIO_BUTTON:
+ (**controlHandle).contrlHilite = kControlRadioButtonPart;
+ break;
+ case TYPE_CHECK_BUTTON:
+ (**controlHandle).contrlHilite = kControlCheckBoxPart;
+ break;
+ }
+ }
+ } else {
+ (**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. This is not
+ * necessary under Appearance, and will have to go when we Carbonize Tk...
+ */
+ if (!TkMacHaveAppearance()) {
+ ((CWindowPeek) windowRef)->nextWindow = (CWindowPeek) LMGetWindowList();
+ LMSetWindowList(windowRef);
+ }
+
+ /*
+ * Now we can set the port to our doctered up window. We next need
+ * to muck with the colors for the port & window to draw the control
+ * with the proper Tk colors. If we need to we also draw a default
+ * ring for buttons.
+ * Under Appearance, we draw the control directly into destPort, and
+ * just set the default control data.
+ */
+
+ if (TkMacHaveAppearance()) {
+ SetPort((GrafPort *) destPort);
+ } else {
+ SetPort(windowRef);
+ }
+
+ windowColorChanged = UpdateControlColors(butPtr, controlHandle,
+ ccTabHandle, &saveBackColor);
+
+ if ((butPtr->type == TYPE_BUTTON) && TkMacHaveAppearance()) {
+ Boolean isDefault;
+
+ if (butPtr->defaultState == STATE_ACTIVE) {
+ isDefault = true;
+ } else {
+ isDefault = false;
+ }
+ SetControlData(controlHandle, kControlNoPart,
+ kControlPushButtonDefaultTag,
+ sizeof(isDefault), (Ptr) &isDefault);
+ }
+
+ if (TkMacHaveAppearance()) {
+ DrawControlInCurrentPort(userPaneHandle);
+ } else {
+ Draw1Control(controlHandle);
+ }
+
+ if (!TkMacHaveAppearance() &&
+ (butPtr->type == TYPE_BUTTON) &&
+ (butPtr->defaultState == STATE_ACTIVE)) {
+ Rect box = (**controlHandle).contrlRect;
+ RGBColor rgbColor;
+
+ TkSetMacColor(butPtr->highlightColorPtr->pixel, &rgbColor);
+ RGBForeColor(&rgbColor);
+ PenSize(butPtr->highlightWidth - 1, butPtr->highlightWidth - 1);
+ InsetRect(&box, -butPtr->highlightWidth, -butPtr->highlightWidth);
+ FrameRoundRect(&box, 16, 16);
+ }
+
+ if (windowColorChanged) {
+ RGBColor dummyColor;
+ ChangeBackgroundWindowColor(windowRef, saveBackColor, &dummyColor);
+ }
+
+ /*
+ * Clean up: remove the hidden window from the main window list, and
+ * hide the control we drew.
+ */
+
+ if (TkMacHaveAppearance()) {
+ SetControlVisibility(controlHandle, false, false);
+ if (isBevel) {
+ KillPicture(bevelButtonContent.u.picture);
+ }
+ } else {
+ (**controlHandle).contrlVis = 0;
+ }
+ if (!TkMacHaveAppearance()) {
+ 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;
+ GWorldPtr frontWin = NULL;
+ TkMacWindowList *winListPtr;
+
+ /*
+ * 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.
+ */
+
+ /*
+ * This is a bit of a hack... The problem is that under appearance,
+ * taking a window out of the window list causes instability, so we can't
+ * do that. OTOH, we need to make sure that this window is NEVER the front
+ * window, or we may inadvertently send keystrokes to it...
+ * So we put it BEHIND ".", and then we won't ever be able to destroy
+ * ALL the windows that are above it.
+ */
+
+ for (winListPtr = tkMacWindowListPtr; winListPtr != NULL;
+ winListPtr = winListPtr->nextPtr) {
+ frontWin = ((MacDrawable *) tkMacWindowListPtr->winPtr->privatePtr)->portPtr;
+ if (strcmp(tkMacWindowListPtr->winPtr->pathName, ".") == 0) {
+ break;
+ }
+ }
+
+ windowRef = NewCWindow(NULL, &geometry, "\pempty", false,
+ zoomDocProc, (WindowRef) frontWin, 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.
+ * I actually don't see the point of doing this, and it causes Floating
+ * Window support to crash under Appearance, so I just leave it out.
+ * Note that we have to do without this under Carbon, since you can't
+ * go poking at the window list...
+ */
+
+ if (!TkMacHaveAppearance()) {
+ 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;
+
+ if (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--;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ButtonEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkButton *buttonPtr = (TkButton *) clientData;
+
+ if (eventPtr->type == ActivateNotify
+ || eventPtr->type == DeactivateNotify) {
+ if ((buttonPtr->tkwin == NULL) || (!Tk_IsMapped(buttonPtr->tkwin))) {
+ return;
+ }
+ if ((buttonPtr->flags & REDRAW_PENDING) == 0) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) buttonPtr);
+ buttonPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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/tcl/mac/tkMacClipboard.c b/tcl/mac/tkMacClipboard.c
new file mode 100644
index 00000000000..06979ad6620
--- /dev/null
+++ b/tcl/mac/tkMacClipboard.c
@@ -0,0 +1,303 @@
+/*
+ * 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 the interp's 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) {
+ Tcl_DString encodedText;
+
+ SetHandleSize(handle, (Size) length + 1);
+ HLock(handle);
+ (*handle)[length] = '\0';
+
+ Tcl_ExternalToUtfDString(NULL, *handle, length, &encodedText);
+ result = (*proc)(clientData, interp,
+ Tcl_DStringValue(&encodedText));
+ Tcl_DStringFree(&encodedText);
+
+ 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) TkGetMainInfoList()->winPtr;
+
+ if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {
+
+ /*
+ * Only claim and empty the clipboard if we aren't already the
+ * owner of the clipboard.
+ */
+
+ dispPtr = TkGetMainInfoList()->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 = TkGetDisplayList();
+ if ((dispPtr == NULL) || !dispPtr->clipboardActive) {
+ return;
+ }
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = targetPtr->nextPtr) {
+ if (targetPtr->type == XA_STRING)
+ break;
+ }
+ if (targetPtr != NULL) {
+ Tcl_DString encodedText;
+
+ 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();
+ Tcl_UtfToExternalDString(NULL, buffer, length, &encodedText);
+ PutScrap(Tcl_DStringLength(&encodedText), 'TEXT',
+ Tcl_DStringValue(&encodedText));
+ Tcl_DStringFree(&encodedText);
+ 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 (TkGetMainInfoList() != NULL) {
+ Tk_ClearSelection((Tk_Window) TkGetMainInfoList()->winPtr,
+ Tk_InternAtom((Tk_Window) TkGetMainInfoList()->winPtr,
+ "CLIPBOARD"));
+ }
+
+ return;
+}
diff --git a/tcl/mac/tkMacColor.c b/tcl/mac/tkMacColor.c
new file mode 100644
index 00000000000..ada360f2974
--- /dev/null
+++ b/tcl/mac/tkMacColor.c
@@ -0,0 +1,504 @@
+/*
+ * 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:
+ return GetMenuPartColor((pixel >> 24), macColor);
+ 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;
+
+ /* Under Appearance, we don't want to set any menu colors when we
+ are asked for the standard menu colors. So we return false (which
+ means don't use this color... */
+
+ if (TkMacHaveAppearance()) {
+ macColor->red = 0xFFFF;
+ macColor->green = 0;
+ macColor->blue = 0;
+ return false;
+ } else {
+ 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 true;
+ case MENU_ACTIVE_TEXT_PIXEL:
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->blue = macColor->green = 0xFFFF;
+ } else {
+ *macColor = mcEntryPtr->mctRGB2;
+ }
+ return true;
+ case MENU_BACKGROUND_PIXEL:
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->blue = macColor->green = 0xFFFF;
+ } else {
+ *macColor = mcEntryPtr->mctRGB2;
+ }
+ return true;
+ 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 true;
+ case MENU_TEXT_PIXEL:
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->green = macColor->blue = 0;
+ } else {
+ *macColor = mcEntryPtr->mctRGB3;
+ }
+ return true;
+ }
+ return false;
+}
+}
diff --git a/tcl/mac/tkMacConfig.c b/tcl/mac/tkMacConfig.c
new file mode 100644
index 00000000000..ead3692f57f
--- /dev/null
+++ b/tcl/mac/tkMacConfig.c
@@ -0,0 +1,45 @@
+/*
+ * tkMacConfig.c --
+ *
+ * This module implements the Macintosh system defaults for
+ * the configuration package.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "tkInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetSystemDefault --
+ *
+ * Given a dbName and className for a configuration option,
+ * return a string representation of the option.
+ *
+ * Results:
+ * Returns a Tk_Uid that is the string identifier that identifies
+ * this option. Returns NULL if there are no system defaults
+ * that match this pair.
+ *
+ * Side effects:
+ * None, once the package is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkpGetSystemDefault(
+ Tk_Window tkwin, /* A window to use. */
+ CONST char *dbName, /* The option database name. */
+ CONST char *className) /* The name of the option class. */
+{
+ return NULL;
+}
diff --git a/tcl/mac/tkMacCursor.c b/tcl/mac/tkMacCursor.c
new file mode 100644
index 00000000000..05bd5fd1439
--- /dev/null
+++ b/tcl/mac/tkMacCursor.c
@@ -0,0 +1,401 @@
+/*
+ * 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,
+ CONST 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,
+ CONST char *string)
+{
+ Handle resource;
+ Str255 curName;
+ int destWrote, inCurLen;
+
+ inCurLen = strlen(string);
+ if (inCurLen > 255) {
+ return;
+ }
+
+ /*
+ * macRoman is the encoding that the resource fork uses.
+ */
+
+ Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), string,
+ inCurLen, 0, NULL,
+ (char *) &curName[1],
+ 255, NULL, &destWrote, NULL); /* Internalize native */
+ curName[0] = destWrote;
+
+ resource = GetNamedResource('crsr', curName);
+
+ if (resource != NULL) {
+ short id;
+ Str255 theName;
+ ResType theType;
+
+ 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) {
+ CONST 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. */
+ CONST char *source, /* Bitmap data for cursor shape. */
+ CONST 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeCursor --
+ *
+ * This procedure is called to release a cursor allocated by
+ * TkGetCursorByName.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor data structure is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeCursor(
+ TkCursor *cursorPtr)
+{
+ TkMacCursor *macCursorPtr = (TkMacCursor *) cursorPtr;
+
+ switch (macCursorPtr->type) {
+ case COLOR:
+ DisposeCCursor((CCrsrHandle) macCursorPtr->macCursor);
+ break;
+ case NORMAL:
+ ReleaseResource(macCursorPtr->macCursor);
+ break;
+ }
+
+ if (macCursorPtr == gCurrentCursor) {
+ gCurrentCursor = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacInstallCursor --
+ *
+ * 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/tcl/mac/tkMacCursors.r b/tcl/mac/tkMacCursors.r
new file mode 100644
index 00000000000..0c5b6cb83f8
--- /dev/null
+++ b/tcl/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/tcl/mac/tkMacDefault.h b/tcl/mac/tkMacDefault.h
new file mode 100644
index 00000000000..947b0dc4c0c
--- /dev/null
+++ b/tcl/mac/tkMacDefault.h
@@ -0,0 +1,529 @@
+/*
+ * 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_COMPOUND "none"
+#define DEF_BUTTON_DEFAULT "disabled"
+#define DEF_BUTTON_DISABLED_FG_COLOR DISABLED
+#define DEF_BUTTON_DISABLED_FG_MONO ""
+#define DEF_BUTTON_FG "systemButtonText"
+#define DEF_CHKRAD_FG DEF_BUTTON_FG
+#define DEF_BUTTON_FONT "system"
+#define DEF_BUTTON_HEIGHT "0"
+#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR
+#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO
+#define DEF_BUTTON_HIGHLIGHT "systemButtonFrame"
+#define DEF_LABEL_HIGHLIGHT_WIDTH "0"
+#define DEF_BUTTON_HIGHLIGHT_WIDTH "4"
+#define DEF_BUTTON_IMAGE (char *) NULL
+#define DEF_BUTTON_INDICATOR "1"
+#define DEF_BUTTON_JUSTIFY "center"
+#define DEF_BUTTON_OFF_VALUE "0"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_OVER_RELIEF ""
+#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_REPEAT_DELAY "0"
+#define DEF_BUTTON_REPEAT_INTERVAL "0"
+#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_DISABLED_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_DISABLED_BG_MONO WHITE
+#define DEF_ENTRY_DISABLED_FG DISABLED
+#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_READONLY_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_READONLY_BG_MONO WHITE
+/* #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_PADX "0"
+#define DEF_FRAME_PADY "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for labelframes:
+ */
+
+#define DEF_LABELFRAME_BORDER_WIDTH "2"
+#define DEF_LABELFRAME_CLASS "Labelframe"
+#define DEF_LABELFRAME_RELIEF "groove"
+#define DEF_LABELFRAME_FG "systemButtonText"
+#define DEF_LABELFRAME_FONT "system"
+#define DEF_LABELFRAME_TEXT ""
+#define DEF_LABELFRAME_LABELANCHOR "nw"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_ACTIVE_STYLE "underline"
+#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_DISABLED_FG DISABLED
+#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_LIST_VARIABLE ""
+#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_STATE "normal"
+#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_COMPOUND "none"
+#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_COLOR DEF_MENUBUTTON_BG_COLOR
+#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO
+#define DEF_MENUBUTTON_HIGHLIGHT BLACK
+#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0"
+#define DEF_MENUBUTTON_IMAGE (char *) NULL
+#define DEF_MENUBUTTON_INDICATOR "0"
+/* #define DEF_MENUBUTTON_JUSTIFY "center" */
+#define DEF_MENUBUTTON_JUSTIFY "left"
+#define DEF_MENUBUTTON_MENU ""
+#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 panedwindows
+ */
+
+#define DEF_PANEDWINDOW_BG_COLOR NORMAL_BG
+#define DEF_PANEDWINDOW_BG_MONO WHITE
+#define DEF_PANEDWINDOW_BORDERWIDTH "2"
+#define DEF_PANEDWINDOW_CURSOR ""
+#define DEF_PANEDWINDOW_HANDLEPAD "8"
+#define DEF_PANEDWINDOW_HANDLESIZE "8"
+#define DEF_PANEDWINDOW_HEIGHT ""
+#define DEF_PANEDWINDOW_OPAQUERESIZE "0"
+#define DEF_PANEDWINDOW_ORIENT "horizontal"
+#define DEF_PANEDWINDOW_RELIEF "flat"
+#define DEF_PANEDWINDOW_SASHCURSOR ""
+#define DEF_PANEDWINDOW_SASHPAD "2"
+#define DEF_PANEDWINDOW_SASHRELIEF "raised"
+#define DEF_PANEDWINDOW_SASHWIDTH "2"
+#define DEF_PANEDWINDOW_SHOWHANDLE "0"
+#define DEF_PANEDWINDOW_WIDTH ""
+
+/*
+ * Defaults for panedwindow panes
+ */
+
+#define DEF_PANEDWINDOW_PANE_AFTER ""
+#define DEF_PANEDWINDOW_PANE_BEFORE ""
+#define DEF_PANEDWINDOW_PANE_HEIGHT ""
+#define DEF_PANEDWINDOW_PANE_MINSIZE "0"
+#define DEF_PANEDWINDOW_PANE_PADX "0"
+#define DEF_PANEDWINDOW_PANE_PADY "0"
+#define DEF_PANEDWINDOW_PANE_STICKY "nsew"
+#define DEF_PANEDWINDOW_PANE_WIDTH ""
+
+/*
+ * 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_COLOR DEF_SCALE_BG_COLOR
+#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO
+#define DEF_SCALE_HIGHLIGHT BLACK
+#define DEF_SCALE_HIGHLIGHT_WIDTH "0"
+#define DEF_SCALE_LABEL ""
+#define DEF_SCALE_LENGTH "100"
+#define DEF_SCALE_ORIENT "vertical"
+#define DEF_SCALE_RELIEF "flat"
+#define DEF_SCALE_REPEAT_DELAY "300"
+#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_AUTO_SEPARATORS "1"
+#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_MAX_UNDO "0"
+#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_UNDO "0"
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+
+/*
+ * 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 ""
+#define DEF_TOPLEVEL_USE ""
+
+#endif /* _TKMACDEFAULT */
diff --git a/tcl/mac/tkMacDialog.c b/tcl/mac/tkMacDialog.c
new file mode 100644
index 00000000000..060b45f4a44
--- /dev/null
+++ b/tcl/mac/tkMacDialog.c
@@ -0,0 +1,1420 @@
+/*
+ * tkMacDialog.c --
+ *
+ * Contains the Mac implementation of the common dialog boxes.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 <Navigation.h>
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tclMacInt.h"
+#include "tkMacInt.h"
+#include "tkFileFilter.h"
+
+#ifndef StrLength
+#define StrLength(s) (*((unsigned char *) (s)))
+#endif
+#ifndef StrBody
+#define StrBody(s) ((char *) (s) + 1)
+#endif
+
+/*
+ * The following are ID's for resources that are defined in tkMacResource.r
+ */
+#define OPEN_BOX 130
+#define OPEN_POPUP 131
+#define OPEN_MENU 132
+#define OPEN_POPUP_ITEM 10
+
+#define SAVE_FILE 0
+#define OPEN_FILE 1
+#define CHOOSE_FOLDER 2
+
+#define MATCHED 0
+#define UNMATCHED 1
+
+/*
+ * The following structure is used in the GetFileName() function. It stored
+ * information about the file dialog and the file filters.
+ */
+typedef struct _OpenFileData {
+ FileFilterList fl; /* List of file filters. */
+ SInt16 curType; /* The filetype currently being
+ * listed. */
+ short popupItem; /* Item number of the popup in the
+ * dialog. */
+ int usePopup; /* True if we show the popup menu (this
+ * is an open operation and the
+ * -filetypes option is set). */
+} OpenFileData;
+
+
+static pascal Boolean FileFilterProc _ANSI_ARGS_((CInfoPBPtr pb,
+ void *myData));
+static int GetFileName _ANSI_ARGS_ ((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], int isOpen));
+static int NavGetFileName _ANSI_ARGS_ ((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], int isOpen));
+static Boolean MatchOneType _ANSI_ARGS_((StringPtr fileNamePtr, OSType fileType,
+ OpenFileData *myofdPtr, FileFilter *filterPtr));
+static pascal short OpenHookProc _ANSI_ARGS_((short item,
+ DialogPtr theDialog, OpenFileData * myofdPtr));
+static int ParseFileDlgArgs _ANSI_ARGS_ ((Tcl_Interp * interp,
+ OpenFileData * myofdPtr, int argc, char ** argv,
+ int isOpen));
+static pascal Boolean OpenFileFilterProc(AEDesc* theItem, void* info,
+ NavCallBackUserData callBackUD,
+ NavFilterModes filterMode );
+pascal void OpenEventProc(NavEventCallbackMessage callBackSelector,
+ NavCBRecPtr callBackParms,
+ NavCallBackUserData callBackUD );
+static void InitFileDialogs();
+static int StdGetFile(Tcl_Interp *interp, OpenFileData *ofd,
+ unsigned char *initialFile, int isOpen);
+static int NavServicesGetFile(Tcl_Interp *interp, OpenFileData *ofd,
+ AEDesc *initialDesc, unsigned char *initialFile,
+ StringPtr title, StringPtr message, int multiple, int isOpen);
+static int HandleInitialDirectory (Tcl_Interp *interp, char *initialDir, FSSpec *dirSpec,
+ AEDesc *dirDescPtr);
+/*
+ * Filter and hook functions used by the tk_getOpenFile and tk_getSaveFile
+ * commands.
+ */
+
+int fileDlgInited = 0;
+int useNavServices = 0;
+NavObjectFilterUPP openFileFilterUPP;
+NavEventUPP openFileEventUPP;
+
+static FileFilterYDUPP openFilter = NULL;
+static DlgHookYDUPP openHook = NULL;
+static DlgHookYDUPP saveHook = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseColorObjCmd --
+ *
+ * This procedure implements the color dialog box for the Mac
+ * platform. See the user documentation for details on what it
+ * does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseColorObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
+{
+ Tk_Window parent;
+ char *title;
+ int i, picked, srcRead, dstWrote;
+ long response;
+ OSErr err;
+ static inited = 0;
+ static RGBColor in;
+ static CONST char *optionStrings[] = {
+ "-initialcolor", "-parent", "-title", NULL
+ };
+ enum options {
+ COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
+ };
+
+ if (inited == 0) {
+ /*
+ * 'in' stores the last color picked. The next time the color dialog
+ * pops up, the last color will remain in the dialog.
+ */
+
+ in.red = 0xffff;
+ in.green = 0xffff;
+ in.blue = 0xffff;
+ inited = 1;
+ }
+
+ parent = (Tk_Window) clientData;
+ title = "Choose a color:";
+ picked = 0;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *option, *value;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ option = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", option, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ value = Tcl_GetStringFromObj(objv[i + 1], NULL);
+
+ switch ((enum options) index) {
+ case COLOR_INITIAL: {
+ XColor *colorPtr;
+
+ colorPtr = Tk_GetColor(interp, parent, value);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ in.red = colorPtr->red;
+ in.green = colorPtr->green;
+ in.blue = colorPtr->blue;
+ Tk_FreeColor(colorPtr);
+ break;
+ }
+ case COLOR_PARENT: {
+ parent = Tk_NameToWindow(interp, value, parent);
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case COLOR_TITLE: {
+ title = value;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Use the gestalt manager to determine how to bring
+ * up the color picker. If versin 2.0 isn't available
+ * we can assume version 1.0 is available as it comes with
+ * Color Quickdraw which Tk requires to run at all.
+ */
+
+ err = Gestalt(gestaltColorPicker, &response);
+ if ((err == noErr) && (response == 0x0200L)) {
+ ColorPickerInfo cpinfo;
+
+ /*
+ * Version 2.0 of the color picker is available. Let's use it
+ */
+
+ cpinfo.theColor.profile = 0L;
+ cpinfo.theColor.color.rgb.red = in.red;
+ cpinfo.theColor.color.rgb.green = in.green;
+ cpinfo.theColor.color.rgb.blue = in.blue;
+ cpinfo.dstProfile = 0L;
+ cpinfo.flags = kColorPickerCanModifyPalette | kColorPickerCanAnimatePalette;
+ cpinfo.placeWhere = kDeepestColorScreen;
+ cpinfo.pickerType = 0L;
+ cpinfo.eventProc = NULL;
+ cpinfo.colorProc = NULL;
+ cpinfo.colorProcData = NULL;
+
+ Tcl_UtfToExternal(NULL, NULL, title, -1, 0, NULL,
+ StrBody(cpinfo.prompt), 255, &srcRead, &dstWrote, NULL);
+ StrLength(cpinfo.prompt) = (unsigned char) dstWrote;
+
+ if ((PickColor(&cpinfo) == noErr) && (cpinfo.newColorChosen != 0)) {
+ in.red = cpinfo.theColor.color.rgb.red;
+ in.green = cpinfo.theColor.color.rgb.green;
+ in.blue = cpinfo.theColor.color.rgb.blue;
+ picked = 1;
+ }
+ } else {
+ RGBColor out;
+ Str255 prompt;
+ Point point = {-1, -1};
+
+ /*
+ * Use version 1.0 of the color picker
+ */
+
+ Tcl_UtfToExternal(NULL, NULL, title, -1, 0, NULL, StrBody(prompt),
+ 255, &srcRead, &dstWrote, NULL);
+ StrLength(prompt) = (unsigned char) dstWrote;
+
+ if (GetColor(point, prompt, &in, &out)) {
+ in = out;
+ picked = 1;
+ }
+ }
+
+ if (picked != 0) {
+ char result[32];
+
+ sprintf(result, "#%02x%02x%02x", in.red >> 8, in.green >> 8,
+ in.blue >> 8);
+ Tcl_AppendResult(interp, result, NULL);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOpenFileObjCmd --
+ *
+ * This procedure implements the "open file" dialog box for the
+ * Mac platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See user documentation.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetOpenFileObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
+{
+ int i, result, multiple;
+ OpenFileData ofd;
+ Tk_Window parent;
+ Str255 message, title;
+ AEDesc initialDesc = {typeNull, NULL};
+ FSSpec dirSpec;
+ static CONST char *openOptionStrings[] = {
+ "-defaultextension", "-filetypes",
+ "-initialdir", "-initialfile",
+ "-message", "-multiple",
+ "-parent", "-title", NULL
+ };
+ enum openOptions {
+ OPEN_DEFAULT, OPEN_TYPES,
+ OPEN_INITDIR, OPEN_INITFILE,
+ OPEN_MESSAGE, OPEN_MULTIPLE,
+ OPEN_PARENT, OPEN_TITLE
+ };
+
+ if (!fileDlgInited) {
+ InitFileDialogs();
+ }
+
+ result = TCL_ERROR;
+ parent = (Tk_Window) clientData;
+ multiple = false;
+ title[0] = 0;
+ message[0] = 0;
+
+ TkInitFileFilters(&ofd.fl);
+
+ ofd.curType = 0;
+ ofd.popupItem = OPEN_POPUP_ITEM;
+ ofd.usePopup = 1;
+
+ for (i = 1; i < objc; i += 2) {
+ char *choice;
+ int index, choiceLen;
+ char *string;
+ int srcRead, dstWrote;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], openOptionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto end;
+ }
+
+ switch (index) {
+ case OPEN_DEFAULT:
+ break;
+ case OPEN_TYPES:
+ choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ if (TkGetFileFilters(interp, &ofd.fl, choice, 0)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case OPEN_INITDIR:
+ choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ if (HandleInitialDirectory(interp, choice, &dirSpec,
+ &initialDesc) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case OPEN_INITFILE:
+ break;
+ case OPEN_MESSAGE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, NULL, choice, choiceLen,
+ 0, NULL, StrBody(message), 255,
+ &srcRead, &dstWrote, NULL);
+ message[0] = dstWrote;
+ break;
+ case OPEN_MULTIPLE:
+ if (Tcl_GetBooleanFromObj(interp, objv[i + 1], &multiple) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case OPEN_PARENT:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ parent = Tk_NameToWindow(interp, choice, parent);
+ if (parent == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case OPEN_TITLE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, NULL, choice, choiceLen,
+ 0, NULL, StrBody(title), 255,
+ &srcRead, &dstWrote, NULL);
+ title[0] = dstWrote;
+ break;
+ }
+ }
+
+ if (useNavServices) {
+ AEDesc *initialPtr = NULL;
+
+ if (initialDesc.descriptorType == typeFSS) {
+ initialPtr = &initialDesc;
+ }
+ result = NavServicesGetFile(interp, &ofd, initialPtr, NULL,
+ title, message, multiple, OPEN_FILE);
+ } else {
+ result = StdGetFile(interp, &ofd, NULL, OPEN_FILE);
+ }
+
+ end:
+ TkFreeFileFilters(&ofd.fl);
+ AEDisposeDesc(&initialDesc);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetSaveFileObjCmd --
+ *
+ * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
+ * instead
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See user documentation.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetSaveFileObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
+{
+ int i, result;
+ Str255 initialFile;
+ Tk_Window parent;
+ AEDesc initialDesc = {typeNull, NULL};
+ FSSpec dirSpec;
+ Str255 title, message;
+ OpenFileData ofd;
+ static CONST char *saveOptionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-message", "-parent", "-title", NULL
+ };
+ enum saveOptions {
+ SAVE_DEFAULT, SAVE_TYPES, SAVE_INITDIR, SAVE_INITFILE,
+ SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE
+ };
+
+ if (!fileDlgInited) {
+ InitFileDialogs();
+ }
+
+ result = TCL_ERROR;
+ parent = (Tk_Window) clientData;
+ StrLength(initialFile) = 0;
+ title[0] = 0;
+ message[0] = 0;
+
+
+ for (i = 1; i < objc; i += 2) {
+ char *choice;
+ int index, choiceLen;
+ char *string;
+ Tcl_DString ds;
+ int srcRead, dstWrote;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], saveOptionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case SAVE_DEFAULT:
+ break;
+ case SAVE_TYPES:
+ break;
+ case SAVE_INITDIR:
+ choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ if (HandleInitialDirectory(interp, choice, &dirSpec,
+ &initialDesc) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case SAVE_INITFILE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ if (Tcl_TranslateFileName(interp, choice, &ds) == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL,
+ StrBody(initialFile), 255, &srcRead, &dstWrote, NULL);
+ StrLength(initialFile) = (unsigned char) dstWrote;
+ Tcl_DStringFree(&ds);
+ break;
+ case SAVE_MESSAGE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, NULL, choice, choiceLen,
+ 0, NULL, StrBody(message), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(message) = (unsigned char) dstWrote;
+ break;
+ case SAVE_PARENT:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ parent = Tk_NameToWindow(interp, choice, parent);
+ if (parent == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case SAVE_TITLE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, NULL, choice, choiceLen,
+ 0, NULL, StrBody(title), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(title) = (unsigned char) dstWrote;
+ break;
+ }
+ }
+
+ TkInitFileFilters(&ofd.fl);
+ ofd.usePopup = 0;
+
+ if (useNavServices) {
+ AEDesc *initialPtr = NULL;
+
+ if (initialDesc.descriptorType == typeFSS) {
+ initialPtr = &initialDesc;
+ }
+ result = NavServicesGetFile(interp, &ofd, initialPtr, initialFile,
+ title, message, false, SAVE_FILE);
+ } else {
+ result = StdGetFile(interp, NULL, initialFile, SAVE_FILE);
+ }
+
+ end:
+
+ AEDisposeDesc(&initialDesc);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseDirectoryObjCmd --
+ *
+ * This procedure implements the "tk_chooseDirectory" dialog box
+ * for the Windows platform. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A modal dialog window is created. Tcl_SetServiceMode() is
+ * called to allow background events to be processed
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int i, result;
+ Tk_Window parent;
+ AEDesc initialDesc = {typeNull, NULL};
+ FSSpec dirSpec;
+ Str255 message, title;
+ int srcRead, dstWrote;
+ OpenFileData ofd;
+ static CONST char *chooseOptionStrings[] = {
+ "-initialdir", "-message", "-mustexist", "-parent", "-title", NULL
+ };
+ enum chooseOptions {
+ CHOOSE_INITDIR, CHOOSE_MESSAGE, CHOOSE_MUSTEXIST,
+ CHOOSE_PARENT, CHOOSE_TITLE
+ };
+
+
+ if (!NavServicesAvailable()) {
+ return TCL_ERROR;
+ }
+
+ if (!fileDlgInited) {
+ InitFileDialogs();
+ }
+ result = TCL_ERROR;
+ parent = (Tk_Window) clientData;
+ title[0] = 0;
+ message[0] = 0;
+
+ for (i = 1; i < objc; i += 2) {
+ char *choice;
+ int index, choiceLen;
+ char *string;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], chooseOptionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case CHOOSE_INITDIR:
+ choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ if (HandleInitialDirectory(interp, choice, &dirSpec,
+ &initialDesc) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case CHOOSE_MESSAGE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, NULL, choice, choiceLen,
+ 0, NULL, StrBody(message), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(message) = (unsigned char) dstWrote;
+ break;
+ case CHOOSE_PARENT:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ parent = Tk_NameToWindow(interp, choice, parent);
+ if (parent == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case CHOOSE_TITLE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, NULL, choice, choiceLen,
+ 0, NULL, StrBody(title), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(title) = (unsigned char) dstWrote;
+ break;
+ }
+ }
+
+ TkInitFileFilters(&ofd.fl);
+ ofd.usePopup = 0;
+
+ if (useNavServices) {
+ AEDesc *initialPtr = NULL;
+
+ if (initialDesc.descriptorType == typeFSS) {
+ initialPtr = &initialDesc;
+ }
+ result = NavServicesGetFile(interp, &ofd, initialPtr, NULL,
+ title, message, false, CHOOSE_FOLDER);
+ } else {
+ result = TCL_ERROR;
+ }
+
+ end:
+ AEDisposeDesc(&initialDesc);
+
+ return result;
+}
+
+int
+HandleInitialDirectory (
+ Tcl_Interp *interp,
+ char *initialDir,
+ FSSpec *dirSpec,
+ AEDesc *dirDescPtr)
+{
+ Tcl_DString ds;
+ long dirID;
+ OSErr err;
+ Boolean isDirectory;
+ Str255 dir;
+ int srcRead, dstWrote;
+
+ if (Tcl_TranslateFileName(interp, initialDir, &ds) == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL, StrBody(dir), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(dir) = (unsigned char) dstWrote;
+ Tcl_DStringFree(&ds);
+
+ err = FSpLocationFromPath(StrLength(dir), StrBody(dir), dirSpec);
+ if (err != noErr) {
+ Tcl_AppendResult(interp, "bad directory \"", initialDir, "\"", NULL);
+ return TCL_ERROR;
+ }
+ err = FSpGetDirectoryIDTcl(dirSpec, &dirID, &isDirectory);
+ if ((err != noErr) || !isDirectory) {
+ Tcl_AppendResult(interp, "bad directory \"", initialDir, "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ if (useNavServices) {
+ AECreateDesc( typeFSS, dirSpec, sizeof(*dirSpec), dirDescPtr);
+ } else {
+ /*
+ * Make sure you negate -dirSpec.vRefNum because the
+ * standard file package wants it that way !
+ */
+
+ LMSetSFSaveDisk(-dirSpec->vRefNum);
+ LMSetCurDirStore(dirID);
+ }
+ return TCL_OK;
+}
+
+static void
+InitFileDialogs()
+{
+ fileDlgInited = 1;
+
+ if (NavServicesAvailable()) {
+ openFileFilterUPP = NewNavObjectFilterProc(OpenFileFilterProc);
+ openFileEventUPP = NewNavEventProc(OpenEventProc);
+ useNavServices = 1;
+ } else {
+ openFilter = NewFileFilterYDProc(FileFilterProc);
+ openHook = NewDlgHookYDProc(OpenHookProc);
+ saveHook = NewDlgHookYDProc(OpenHookProc);
+ useNavServices = 0;
+ }
+
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileName --
+ *
+ * Calls the Mac file dialog functions for the user to choose a
+ * file to or save.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * If the user selects a file, the native pathname of the file
+ * is returned in the interp's result. Otherwise an empty string
+ * is returned in the interp's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFileName(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[], /* Argument objects. */
+ int isOpen) /* true if we should call GetOpenFileName(),
+ * false if we should call GetSaveFileName() */
+{
+ return TCL_OK;
+}
+
+static int
+NavServicesGetFile(
+ Tcl_Interp *interp,
+ OpenFileData *ofdPtr,
+ AEDesc *initialDesc,
+ unsigned char *initialFile,
+ StringPtr title,
+ StringPtr message,
+ int multiple,
+ int isOpen)
+{
+ NavReplyRecord theReply;
+ NavDialogOptions diagOptions;
+ OSErr err;
+ Tcl_Obj *theResult;
+ int result;
+
+
+ diagOptions.location.h = -1;
+ diagOptions.location.v = -1;
+ diagOptions.dialogOptionFlags = kNavDontAutoTranslate
+ + kNavDontAddTranslateItems;
+
+ if (multiple) {
+ diagOptions.dialogOptionFlags += kNavAllowMultipleFiles;
+ }
+
+ if (ofdPtr != NULL && ofdPtr->usePopup) {
+ FileFilter *filterPtr;
+
+ filterPtr = ofdPtr->fl.filters;
+ if (filterPtr == NULL) {
+ ofdPtr->usePopup = 0;
+ }
+ }
+
+ if (ofdPtr != NULL && ofdPtr->usePopup) {
+ NavMenuItemSpecHandle popupExtensionHandle = NULL;
+ NavMenuItemSpec *popupItems;
+ FileFilter *filterPtr;
+ short index = 0;
+
+ ofdPtr->curType = 0;
+
+ popupExtensionHandle = (NavMenuItemSpecHandle) NewHandle(ofdPtr->fl.numFilters
+ * sizeof(NavMenuItemSpec));
+ HLock((Handle) popupExtensionHandle);
+ popupItems = *popupExtensionHandle;
+
+ for (filterPtr = ofdPtr->fl.filters; filterPtr != NULL;
+ filterPtr = filterPtr->next, popupItems++, index++) {
+ int len;
+
+ len = strlen(filterPtr->name);
+ BlockMove(filterPtr->name, popupItems->menuItemName + 1, len);
+ popupItems->menuItemName[0] = len;
+ popupItems->menuCreator = 'WIsH';
+ popupItems->menuType = index;
+ }
+ HUnlock((Handle) popupExtensionHandle);
+ diagOptions.popupExtension = popupExtensionHandle;
+ } else {
+ diagOptions.dialogOptionFlags += kNavNoTypePopup;
+ diagOptions.popupExtension = NULL;
+ }
+
+ if ((initialFile != NULL) && (initialFile[0] != 0)) {
+ char *lastColon;
+ int len;
+
+ len = initialFile[0];
+
+ p2cstr(initialFile);
+ lastColon = strrchr((char *)initialFile, ':');
+ if (lastColon != NULL) {
+ len -= lastColon - ((char *) (initialFile + 1));
+ BlockMove(lastColon + 1, diagOptions.savedFileName + 1, len);
+ diagOptions.savedFileName[0] = len;
+ } else {
+ BlockMove(initialFile, diagOptions.savedFileName + 1, len);
+ diagOptions.savedFileName[0] = len;
+ }
+ } else {
+ diagOptions.savedFileName[0] = 0;
+ }
+
+ strcpy((char *) (diagOptions.clientName + 1),"Wish");
+ diagOptions.clientName[0] = strlen("Wish");
+
+ if (title == NULL) {
+ diagOptions.windowTitle[0] = 0;
+ } else {
+ BlockMove(title, diagOptions.windowTitle, title[0] + 1);
+ diagOptions.windowTitle[0] = title[0];
+ }
+
+ if (message == NULL) {
+ diagOptions.message[0] = 0;
+ } else {
+ BlockMove(message, diagOptions.message, message[0] + 1);
+ diagOptions.message[0] = message[0];
+ }
+
+ diagOptions.actionButtonLabel[0] = 0;
+ diagOptions.cancelButtonLabel[0] = 0;
+ diagOptions.preferenceKey = 0;
+
+ /* Now process the selection list. We have to use the popupExtension
+ * to fill the menu.
+ */
+
+
+ if (isOpen == OPEN_FILE) {
+ err = NavGetFile(initialDesc, &theReply, &diagOptions, openFileEventUPP,
+ NULL, openFileFilterUPP, NULL, ofdPtr);
+ } else if (isOpen == SAVE_FILE) {
+ err = NavPutFile (initialDesc, &theReply, &diagOptions, openFileEventUPP,
+ 'TEXT', 'WIsH', NULL);
+ } else if (isOpen == CHOOSE_FOLDER) {
+ err = NavChooseFolder (initialDesc, &theReply, &diagOptions,
+ openFileEventUPP, NULL, NULL);
+ }
+
+
+ /*
+ * Most commands assume that the file dialogs return a single
+ * item, not a list. So only build a list if multiple is true...
+ */
+
+ if (multiple) {
+ theResult = Tcl_NewListObj(0, NULL);
+ } else {
+ theResult = Tcl_NewObj();
+ }
+
+ if ( theReply.validRecord && err == noErr ) {
+ AEDesc resultDesc;
+ long count;
+ Tcl_DString fileName;
+ Handle pathHandle;
+ int length;
+
+ if ( err == noErr ) {
+ err = AECountItems(&(theReply.selection), &count);
+ if (err == noErr) {
+ long i;
+ for (i = 1; i <= count; i++ ) {
+ err = AEGetNthDesc(&(theReply.selection),
+ i, typeFSS, NULL, &resultDesc);
+ if (err == noErr) {
+ HLock(resultDesc.dataHandle);
+ pathHandle = NULL;
+ FSpPathFromLocation((FSSpec *) *resultDesc.dataHandle,
+ &length, &pathHandle);
+ HLock(pathHandle);
+ Tcl_ExternalToUtfDString(NULL, (char *) *pathHandle, -1, &fileName);
+ if (multiple) {
+ Tcl_ListObjAppendElement(interp, theResult,
+ Tcl_NewStringObj(Tcl_DStringValue(&fileName),
+ Tcl_DStringLength(&fileName)));
+ } else {
+ Tcl_SetStringObj(theResult, Tcl_DStringValue(&fileName),
+ Tcl_DStringLength(&fileName));
+ }
+
+ Tcl_DStringFree(&fileName);
+ HUnlock(pathHandle);
+ DisposeHandle(pathHandle);
+ HUnlock(resultDesc.dataHandle);
+ AEDisposeDesc( &resultDesc );
+ }
+ }
+ }
+ }
+ err = NavDisposeReply( &theReply );
+ Tcl_SetObjResult(interp, theResult);
+ result = TCL_OK;
+ } else if (err == userCanceledErr) {
+ result = TCL_OK;
+ } else {
+ result = TCL_ERROR;
+ }
+
+ if (diagOptions.popupExtension != NULL) {
+ DisposeHandle((Handle) diagOptions.popupExtension);
+ }
+
+ return result;
+}
+
+static pascal Boolean
+OpenFileFilterProc(
+ AEDesc* theItem, void* info,
+ NavCallBackUserData callBackUD,
+ NavFilterModes filterMode )
+{
+ OpenFileData *ofdPtr = (OpenFileData *) callBackUD;
+ if (!ofdPtr->usePopup) {
+ return true;
+ } else {
+ if (ofdPtr->fl.numFilters == 0) {
+ return true;
+ } else {
+
+ if ( theItem->descriptorType == typeFSS ) {
+ NavFileOrFolderInfo* theInfo = (NavFileOrFolderInfo*)info;
+ int result;
+
+ if ( !theInfo->isFolder ) {
+ OSType fileType;
+ StringPtr fileNamePtr;
+ int i;
+ FileFilter *filterPtr;
+
+ fileType = theInfo->fileAndFolder.fileInfo.finderInfo.fdType;
+ HLock(theItem->dataHandle);
+ fileNamePtr = (((FSSpec *) *theItem->dataHandle)->name);
+
+ if (ofdPtr->usePopup) {
+ i = ofdPtr->curType;
+ for (filterPtr=ofdPtr->fl.filters; filterPtr && i>0; i--) {
+ filterPtr = filterPtr->next;
+ }
+ if (filterPtr) {
+ result = MatchOneType(fileNamePtr, fileType,
+ ofdPtr, filterPtr);
+ } else {
+ result = false;
+ }
+ } else {
+ /*
+ * We are not using the popup menu. In this case, the file is
+ * considered matched if it matches any of the file filters.
+ */
+ result = UNMATCHED;
+ for (filterPtr=ofdPtr->fl.filters; filterPtr;
+ filterPtr=filterPtr->next) {
+ if (MatchOneType(fileNamePtr, fileType,
+ ofdPtr, filterPtr) == MATCHED) {
+ result = MATCHED;
+ break;
+ }
+ }
+ }
+
+ HUnlock(theItem->dataHandle);
+ return (result == MATCHED);
+ } else {
+ return true;
+ }
+ }
+ }
+
+ return true;
+ }
+}
+
+pascal void
+OpenEventProc(
+ NavEventCallbackMessage callBackSelector,
+ NavCBRecPtr callBackParams,
+ NavCallBackUserData callBackUD )
+{
+ NavMenuItemSpec *chosenItem;
+ OpenFileData *ofd = (OpenFileData *) callBackUD;
+
+ if (callBackSelector == kNavCBPopupMenuSelect) {
+ chosenItem = (NavMenuItemSpec *) callBackParams->eventData.eventDataParms.param;
+ ofd->curType = chosenItem->menuType;
+ } else if (callBackSelector == kNavCBEvent) {
+ if (callBackParams->eventData.eventDataParms.event->what == updateEvt) {
+ if (TkMacConvertEvent( callBackParams->eventData.eventDataParms.event)) {
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS|TCL_DONT_WAIT|TCL_WINDOW_EVENTS)) {
+ /* Empty Body */
+ }
+ }
+ }
+ }
+}
+
+static int
+StdGetFile(
+ Tcl_Interp *interp,
+ OpenFileData *ofd,
+ unsigned char *initialFile,
+ int isOpen)
+{
+ int i;
+ StandardFileReply reply;
+ Point mypoint;
+ MenuHandle menu = NULL;
+
+
+ /*
+ * Set the items in the file types popup.
+ */
+
+ /*
+ * Delete all the entries inside the popup menu, in case there's any
+ * left overs from previous invocation of this command
+ */
+
+ if (ofd != NULL && ofd->usePopup) {
+ FileFilter *filterPtr;
+
+ menu = GetMenu(OPEN_MENU);
+ for (i = CountMItems(menu); i > 0; i--) {
+ /*
+ * The item indices are one based. Also, if we delete from
+ * the beginning, the items may be re-numbered. So we
+ * delete from the end
+ */
+
+ DeleteMenuItem(menu, i);
+ }
+
+ filterPtr = ofd->fl.filters;
+ if (filterPtr == NULL) {
+ ofd->usePopup = 0;
+ } else {
+ for ( ; filterPtr != NULL; filterPtr = filterPtr->next) {
+ Str255 str;
+
+ StrLength(str) = (unsigned char) strlen(filterPtr->name);
+ strcpy(StrBody(str), filterPtr->name);
+ AppendMenu(menu, str);
+ }
+ }
+ }
+
+ /*
+ * Call the toolbox file dialog function.
+ */
+
+ SetPt(&mypoint, -1, -1);
+ TkpSetCursor(NULL);
+ if (isOpen == OPEN_FILE) {
+ if (ofd != NULL && ofd->usePopup) {
+ CustomGetFile(openFilter, (short) -1, NULL, &reply, OPEN_BOX,
+ mypoint, openHook, NULL, NULL, NULL, (void*) ofd);
+ } else {
+ StandardGetFile(NULL, -1, NULL, &reply);
+ }
+ } else if (isOpen == SAVE_FILE) {
+ static Str255 prompt = "\pSave as";
+
+ if (ofd != NULL && ofd->usePopup) {
+ /*
+ * Currently this never gets called because we don't use
+ * popup for the save dialog.
+ */
+ CustomPutFile(prompt, initialFile, &reply, OPEN_BOX,
+ mypoint, saveHook, NULL, NULL, NULL, (void *) ofd);
+ } else {
+ StandardPutFile(prompt, initialFile, &reply);
+ }
+ }
+
+ /*
+ * Now parse the reply, and populate the Tcl result.
+ */
+
+ if (reply.sfGood) {
+ int length;
+ Handle pathHandle;
+
+ pathHandle = NULL;
+ FSpPathFromLocation(&reply.sfFile, &length, &pathHandle);
+ if (pathHandle != NULL) {
+ Tcl_DString ds;
+
+ HLock(pathHandle);
+ Tcl_ExternalToUtfDString(NULL, (char *) *pathHandle, -1, &ds);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ HUnlock(pathHandle);
+ DisposeHandle(pathHandle);
+ }
+ }
+
+ if (menu != NULL) {
+ DisposeMenu(menu);
+ }
+
+ return TCL_OK;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 *ofdPtr) /* Information about the file dialog. */
+{
+ short ignore;
+ Rect rect;
+ Handle handle;
+ int newType;
+
+ switch (item) {
+ case sfHookFirstCall:
+ if (ofdPtr->usePopup) {
+ /*
+ * Set the popup list to display the selected type.
+ */
+ GetDialogItem(theDialog, ofdPtr->popupItem, &ignore, &handle,
+ &rect);
+ SetControlValue((ControlRef) handle, ofdPtr->curType + 1);
+ }
+ return sfHookNullEvent;
+
+ case OPEN_POPUP_ITEM:
+ if (ofdPtr->usePopup) {
+ GetDialogItem(theDialog, ofdPtr->popupItem,
+ &ignore, &handle, &rect);
+ newType = GetControlValue((ControlRef) handle) - 1;
+ if (ofdPtr->curType != newType) {
+ if (newType<0 || newType>ofdPtr->fl.numFilters) {
+ /*
+ * Sanity check. Looks like the user selected an
+ * non-existent menu item?? Don't do anything.
+ */
+ } else {
+ ofdPtr->curType = newType;
+ }
+ return sfHookRebuildList;
+ }
+ }
+ break;
+ }
+
+ 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 * ofdPtr = (OpenFileData*)myData;
+ FileFilter * filterPtr;
+
+ if (ofdPtr->fl.numFilters == 0) {
+ /*
+ * No types have been specified. List all files by default
+ */
+ return MATCHED;
+ }
+
+ if (pb->dirInfo.ioFlAttrib & 0x10) {
+ /*
+ * This is a directory: always show it
+ */
+ return MATCHED;
+ }
+
+ if (ofdPtr->usePopup) {
+ i = ofdPtr->curType;
+ for (filterPtr=ofdPtr->fl.filters; filterPtr && i>0; i--) {
+ filterPtr = filterPtr->next;
+ }
+ if (filterPtr) {
+ return MatchOneType(pb->hFileInfo.ioNamePtr, pb->hFileInfo.ioFlFndrInfo.fdType,
+ ofdPtr, filterPtr);
+ } else {
+ return UNMATCHED;
+ }
+ } else {
+ /*
+ * We are not using the popup menu. In this case, the file is
+ * considered matched if it matches any of the file filters.
+ */
+
+ for (filterPtr=ofdPtr->fl.filters; filterPtr;
+ filterPtr=filterPtr->next) {
+ if (MatchOneType(pb->hFileInfo.ioNamePtr, pb->hFileInfo.ioFlFndrInfo.fdType,
+ ofdPtr, 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(
+ StringPtr fileNamePtr, /* Name of the file */
+ OSType fileType, /* Type of the file */
+ OpenFileData * ofdPtr, /* Information about this file dialog */
+ FileFilter * filterPtr) /* Match the file described by pb against
+ * this filter */
+{
+ FileFilterClause * clausePtr;
+
+ /*
+ * A file matches with a file type if it matches with at least one
+ * 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 (fileNamePtr == NULL) {
+ continue;
+ }
+ p = (char*)(fileNamePtr);
+ 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 (fileType == mfPtr->type) {
+ macMatched = 1;
+ break;
+ }
+ }
+
+ if (globMatched && macMatched) {
+ return MATCHED;
+ }
+ }
+
+ return UNMATCHED;
+}
+
+
diff --git a/tcl/mac/tkMacDraw.c b/tcl/mac/tkMacDraw.c
new file mode 100644
index 00000000000..8e659e9c1eb
--- /dev/null
+++ b/tcl/mac/tkMacDraw.c
@@ -0,0 +1,1196 @@
+/*
+ * 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"
+#include "tkPort.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;
+ if (image->bytes_per_line >= 0x4000) {
+ panic("TkImage too wide!");
+ }
+ 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);
+ }
+ if (gc->line_style != LineSolid) {
+ unsigned char *p = (unsigned char *) &(gc->dashes);
+ /*
+ * Here the dash pattern should be set in the drawing,
+ * environment, but I don't know how to do that for the Mac.
+ *
+ * p[] is an array of unsigned chars containing the dash list.
+ * A '\0' indicates the end of this list.
+ *
+ * Someone knows how to implement this? If you have a more
+ * complete implementation of SetUpGraphicsPort() for
+ * the Mac (or for Windows), please let me know.
+ *
+ * Jan Nijtmans
+ * CMG Arnhem, B.V.
+ * email: j.nijtmans@chello.nl (private)
+ * jan.nijtmans@cmg.nl (work)
+ * url: http://purl.oclc.org/net/nijtmans/
+ */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawpHighlightBorder --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus.
+ *
+ * On the Macintosh, this puts a 1 pixel border in the bgGC color
+ * between the widget and the focus ring, except in the case where
+ * highlightWidth is 1, in which case the border is left out.
+ *
+ * For proper Mac L&F, use highlightWidth of 3.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawHighlightBorder (
+ Tk_Window tkwin,
+ GC fgGC,
+ GC bgGC,
+ int highlightWidth,
+ Drawable drawable)
+{
+ if (highlightWidth == 1) {
+ TkDrawInsetFocusHighlight (tkwin, fgGC, highlightWidth, drawable, 0);
+ } else {
+ TkDrawInsetFocusHighlight (tkwin, bgGC, highlightWidth, drawable, 0);
+ if (fgGC != bgGC) {
+ TkDrawInsetFocusHighlight (tkwin, fgGC, highlightWidth - 1, drawable, 0);
+ }
+ }
+}
diff --git a/tcl/mac/tkMacEmbed.c b/tcl/mac/tkMacEmbed.c
new file mode 100644
index 00000000000..f15d709c1f5
--- /dev/null
+++ b/tcl/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-1997 Sun Microsystems, 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 the interp's 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. */
+ CONST 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. */
+ CONST 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/tcl/mac/tkMacFont.c b/tcl/mac/tkMacFont.c
new file mode 100644
index 00000000000..fd98d650fad
--- /dev/null
+++ b/tcl/mac/tkMacFont.c
@@ -0,0 +1,2151 @@
+/*
+ * 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 <Script.h>
+#include <Resources.h>
+#include <TextUtils.h>
+
+#include "tkMacInt.h"
+#include "tkFont.h"
+
+/*
+ * For doing things with Mac strings and Fixed numbers. This probably should move
+ * the mac header file.
+ */
+
+#ifndef StrLength
+#define StrLength(s) (*((unsigned char *) (s)))
+#endif
+#ifndef StrBody
+#define StrBody(s) ((char *) (s) + 1)
+#endif
+#define pstrcmp(s1, s2) RelString((s1), (s2), 1, 1)
+#define pstrcasecmp(s1, s2) RelString((s1), (s2), 0, 1)
+
+#ifndef Fixed2Int
+#define Fixed2Int(f) ((f) >> 16)
+#define Int2Fixed(i) ((i) << 16)
+#endif
+
+/*
+ * The preferred font encodings.
+ */
+
+static CONST char *encodingList[] = {
+ "macRoman", "macJapan", NULL
+};
+
+/*
+ * The following structures are used to map the script/language codes of a
+ * font to the name that should be passed to Tcl_GetTextEncoding() to obtain
+ * the encoding for that font. The set of numeric constants is fixed and
+ * defined by Apple.
+ */
+
+static TkStateMap scriptMap[] = {
+ {smRoman, "macRoman"},
+ {smJapanese, "macJapan"},
+ {smTradChinese, "macChinese"},
+ {smKorean, "macKorean"},
+ {smArabic, "macArabic"},
+ {smHebrew, "macHebrew"},
+ {smGreek, "macGreek"},
+ {smCyrillic, "macCyrillic"},
+ {smRSymbol, "macRSymbol"},
+ {smDevanagari, "macDevanagari"},
+ {smGurmukhi, "macGurmukhi"},
+ {smGujarati, "macGujarati"},
+ {smOriya, "macOriya"},
+ {smBengali, "macBengali"},
+ {smTamil, "macTamil"},
+ {smTelugu, "macTelugu"},
+ {smKannada, "macKannada"},
+ {smMalayalam, "macMalayalam"},
+ {smSinhalese, "macSinhalese"},
+ {smBurmese, "macBurmese"},
+ {smKhmer, "macKhmer"},
+ {smThai, "macThailand"},
+ {smLaotian, "macLaos"},
+ {smGeorgian, "macGeorgia"},
+ {smArmenian, "macArmenia"},
+ {smSimpChinese, "macSimpChinese"},
+ {smTibetan, "macTIbet"},
+ {smMongolian, "macMongolia"},
+ {smGeez, "macEthiopia"},
+ {smEastEurRoman, "macCentEuro"},
+ {smVietnamese, "macVietnam"},
+ {smExtArabic, "macSindhi"},
+ {NULL, NULL}
+};
+
+static TkStateMap romanMap[] = {
+ {langCroatian, "macCroatian"},
+ {langSlovenian, "macCroatian"},
+ {langIcelandic, "macIceland"},
+ {langRomanian, "macRomania"},
+ {langTurkish, "macTurkish"},
+ {langGreek, "macGreek"},
+ {NULL, NULL}
+};
+
+static TkStateMap cyrillicMap[] = {
+ {langUkrainian, "macUkraine"},
+ {langBulgarian, "macBulgaria"},
+ {NULL, NULL}
+};
+
+/*
+ * The following structure represents a font family. It is assumed that
+ * all screen fonts constructed from the same "font family" share certain
+ * properties; all screen fonts with the same "font family" point to a
+ * shared instance of this structure. The most important shared property
+ * is the character existence metrics, used to determine if a screen font
+ * can display a given Unicode character.
+ *
+ * Under Macintosh, a "font family" is uniquely identified by its face number.
+ */
+
+
+#define FONTMAP_SHIFT 10
+
+#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar) * 8 - FONTMAP_SHIFT))
+#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT)
+
+typedef struct FontFamily {
+ struct FontFamily *nextPtr; /* Next in list of all known font families. */
+ int refCount; /* How many SubFonts are referring to this
+ * FontFamily. When the refCount drops to
+ * zero, this FontFamily may be freed. */
+ /*
+ * Key.
+ */
+
+ short faceNum; /* Unique face number key for this FontFamily. */
+
+ /*
+ * Derived properties.
+ */
+
+ Tcl_Encoding encoding; /* Encoding for this font family. */
+ int isSymbolFont; /* Non-zero if this is a symbol family. */
+ int isMultiByteFont; /* Non-zero if this is a multi-byte family. */
+ char typeTable[256]; /* Table that identfies all lead bytes for a
+ * multi-byte family, used when measuring chars.
+ * If a byte is a lead byte, the value at the
+ * corresponding position in the typeTable is 1,
+ * otherwise 0. If this is a single-byte font,
+ * all entries are 0. */
+ char *fontMap[FONTMAP_PAGES];
+ /* Two-level sparse table used to determine
+ * quickly if the specified character exists.
+ * As characters are encountered, more pages
+ * in this table are dynamically added. The
+ * contents of each page is a bitmask
+ * consisting of FONTMAP_BITSPERPAGE bits,
+ * representing whether this font can be used
+ * to display the given character at the
+ * corresponding bit position. The high bits
+ * of the character are used to pick which
+ * page of the table is used. */
+} FontFamily;
+
+/*
+ * The following structure encapsulates an individual screen font. A font
+ * object is made up of however many SubFonts are necessary to display a
+ * stream of multilingual characters.
+ */
+
+typedef struct SubFont {
+ char **fontMap; /* Pointer to font map from the FontFamily,
+ * cached here to save a dereference. */
+ FontFamily *familyPtr; /* The FontFamily for this SubFont. */
+} SubFont;
+
+/*
+ * The following structure represents Macintosh's implementation of a font
+ * object.
+ */
+
+#define SUBFONT_SPACE 3
+
+typedef struct MacFont {
+ TkFont font; /* Stuff used by generic font package. Must
+ * be first in structure. */
+ SubFont staticSubFonts[SUBFONT_SPACE];
+ /* Builtin space for a limited number of
+ * SubFonts. */
+ int numSubFonts; /* Length of following array. */
+ SubFont *subFontArray; /* Array of SubFonts that have been loaded
+ * in order to draw/measure all the characters
+ * encountered by this font so far. All fonts
+ * start off with one SubFont initialized by
+ * AllocFont() from the original set of font
+ * attributes. Usually points to
+ * staticSubFonts, but may point to malloced
+ * space if there are lots of SubFonts. */
+
+ short size; /* Font size in pixels, constructed from
+ * font attributes. */
+ short style; /* Style bits, constructed from font
+ * attributes. */
+} MacFont;
+
+/*
+ * The following structure is used to map between the UTF-8 name for a font and
+ * the name that the Macintosh uses to refer to the font, in order to determine
+ * if a font exists. The Macintosh names for fonts are stored in the encoding
+ * of the font itself.
+ */
+
+typedef struct FontNameMap {
+ Tk_Uid utfName; /* The name of the font in UTF-8. */
+ StringPtr nativeName; /* The name of the font in the font's encoding. */
+ short faceNum; /* Unique face number for this font. */
+} FontNameMap;
+
+/*
+ * The list of font families that are currently loaded. As screen fonts
+ * are loaded, this list grows to hold information about what characters
+ * exist in each font family.
+ */
+
+static FontFamily *fontFamilyList = NULL;
+
+/*
+ * Information cached about the system at startup time.
+ */
+
+static FontNameMap *gFontNameMap = NULL;
+static GWorldPtr gWorld = NULL;
+
+/*
+ * Procedures used only in this file.
+ */
+
+static FontFamily * AllocFontFamily(CONST MacFont *fontPtr, int family);
+static SubFont * CanUseFallback(MacFont *fontPtr,
+ CONST char *fallbackName, int ch);
+static SubFont * CanUseFallbackWithAliases(MacFont *fontPtr,
+ char *faceName, int ch, Tcl_DString *nameTriedPtr);
+static SubFont * FindSubFontForChar(MacFont *fontPtr, int ch);
+static void FontMapInsert(SubFont *subFontPtr, int ch);
+static void FontMapLoadPage(SubFont *subFontPtr, int row);
+static int FontMapLookup(SubFont *subFontPtr, int ch);
+static void FreeFontFamily(FontFamily *familyPtr);
+static void InitFont(Tk_Window tkwin, int family, int size,
+ int style, MacFont *fontPtr);
+static void InitSubFont(CONST MacFont *fontPtr, int family,
+ SubFont *subFontPtr);
+static void MultiFontDrawText(MacFont *fontPtr,
+ CONST char *source, int numBytes, int x, int y);
+static void ReleaseFont(MacFont *fontPtr);
+static void ReleaseSubFont(SubFont *subFontPtr);
+static int SeenName(CONST char *name, Tcl_DString *dsPtr);
+
+static CONST char * BreakLine(FontFamily *familyPtr, int flags,
+ CONST char *source, int numBytes, int *widthPtr);
+static int GetFamilyNum(CONST char *faceName, short *familyPtr);
+static int GetFamilyOrAliasNum(CONST char *faceName,
+ short *familyPtr);
+static Tcl_Encoding GetFontEncoding(int faceNum, int allowSymbol,
+ int *isSymbolPtr);
+static Tk_Uid GetUtfFaceName(StringPtr faceNameStr);
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependant code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * See comments below.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ MenuHandle fontMenu;
+ FontNameMap *tmpFontNameMap, *newFontNameMap, *mapPtr;
+ int i, j, numFonts, fontMapOffset, isSymbol;
+ Str255 nativeName;
+ Tcl_DString ds;
+ Tcl_Encoding encoding;
+ Tcl_Encoding *encodings;
+
+ if (gWorld == NULL) {
+ /*
+ * Do the following one time only.
+ */
+
+ Rect rect = {0, 0, 1, 1};
+
+ SetFractEnable(0);
+
+ /*
+ * Used for saving and restoring state while drawing and measuring.
+ */
+
+ if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {
+ panic("TkpFontPkgInit: NewGWorld failed");
+ }
+
+ /*
+ * The name of each font is stored in the encoding of that font.
+ * How would we translate a name from UTF-8 into the native encoding
+ * of the font unless we knew the encoding of that font? We can't.
+ * So, precompute the UTF-8 and native names of all fonts on the
+ * system. The when the user asks for font by its UTF-8 name, we
+ * lookup the name in that table and really ask for the font by its
+ * native name. Any unknown UTF-8 names will be mapped to the system
+ * font.
+ */
+
+ fontMenu = NewMenu('FT', "\px");
+ AppendResMenu(fontMenu, 'FONT');
+
+ numFonts = CountMItems(fontMenu);
+ tmpFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * numFonts);
+ encodings = (Tcl_Encoding *) ckalloc(sizeof(Tcl_Encoding) * numFonts);
+
+ mapPtr = tmpFontNameMap;
+ for (i = 0; i < numFonts; i++) {
+ GetMenuItemText(fontMenu, i + 1, nativeName);
+ GetFNum(nativeName, &mapPtr->faceNum);
+ encodings[i] = GetFontEncoding(mapPtr->faceNum, 0, &isSymbol);
+ Tcl_ExternalToUtfDString(encodings[i], StrBody(nativeName),
+ StrLength(nativeName), &ds);
+ mapPtr->utfName = Tk_GetUid(Tcl_DStringValue(&ds));
+ mapPtr->nativeName = (StringPtr) ckalloc(StrLength(nativeName) + 1);
+ memcpy(mapPtr->nativeName, nativeName, StrLength(nativeName) + 1);
+ Tcl_DStringFree(&ds);
+ mapPtr++;
+ }
+ DisposeMenu(fontMenu);
+
+ /*
+ * Reorder FontNameMap so fonts with the preferred encodings are at
+ * the front of the list. The relative order of fonts that all have
+ * the same encoding is preserved. Fonts with unknown encodings get
+ * stuck at the end.
+ */
+
+ newFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * (numFonts + 1));
+ fontMapOffset = 0;
+ for (i = 0; encodingList[i] != NULL; i++) {
+ encoding = Tcl_GetEncoding(NULL, encodingList[i]);
+ if (encoding == NULL) {
+ continue;
+ }
+ for (j = 0; j < numFonts; j++) {
+ if (encodings[j] == encoding) {
+ newFontNameMap[fontMapOffset] = tmpFontNameMap[j];
+ fontMapOffset++;
+ Tcl_FreeEncoding(encodings[j]);
+ tmpFontNameMap[j].utfName = NULL;
+ }
+ }
+ Tcl_FreeEncoding(encoding);
+ }
+ for (i = 0; i < numFonts; i++) {
+ if (tmpFontNameMap[i].utfName != NULL) {
+ newFontNameMap[fontMapOffset] = tmpFontNameMap[i];
+ fontMapOffset++;
+ Tcl_FreeEncoding(encodings[i]);
+ }
+ }
+ if (fontMapOffset != numFonts) {
+ panic("TkpFontPkgInit: unexpected number of fonts");
+ }
+
+ mapPtr = &newFontNameMap[numFonts];
+ mapPtr->utfName = NULL;
+ mapPtr->nativeName = NULL;
+ mapPtr->faceNum = 0;
+
+ ckfree((char *) tmpFontNameMap);
+ ckfree((char *) encodings);
+
+ gFontNameMap = newFontNameMap;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetNativeFont --
+ *
+ * Map a platform-specific native font name to a TkFont.
+ *
+ * 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;
+ MacFont *fontPtr;
+
+ if (strcmp(name, "system") == 0) {
+ family = GetSysFont();
+ } else if (strcmp(name, "application") == 0) {
+ family = GetAppFont();
+ } else {
+ return NULL;
+ }
+
+ fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
+ InitFont(tkwin, family, 0, 0, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFromAttributes --
+ *
+ * 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. */
+{
+ short faceNum, style;
+ int i, j;
+ char *faceName, *fallback;
+ char ***fallbacks;
+ MacFont *fontPtr;
+
+ /*
+ * Algorithm to get the closest font to the one requested.
+ *
+ * try fontname
+ * try all aliases for fontname
+ * foreach fallback for fontname
+ * try the fallback
+ * try all aliases for the fallback
+ */
+
+ faceNum = 0;
+ faceName = faPtr->family;
+ if (faceName != NULL) {
+ if (GetFamilyOrAliasNum(faceName, &faceNum) != 0) {
+ goto found;
+ }
+ fallbacks = TkFontGetFallbacks();
+ for (i = 0; fallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(faceName, fallback) == 0) {
+ for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) {
+ if (GetFamilyOrAliasNum(fallback, &faceNum)) {
+ goto found;
+ }
+ }
+ }
+ break;
+ }
+ }
+ }
+
+ found:
+ style = 0;
+ if (faPtr->weight != TK_FW_NORMAL) {
+ style |= bold;
+ }
+ if (faPtr->slant != TK_FS_ROMAN) {
+ style |= italic;
+ }
+ if (faPtr->underline) {
+ style |= underline;
+ }
+ if (tkFontPtr == NULL) {
+ fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
+ } else {
+ fontPtr = (MacFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+ }
+ InitFont(tkwin, faceNum, faPtr->size, style, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpDeleteFont --
+ *
+ * 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. */
+{
+ MacFont *fontPtr;
+
+ fontPtr = (MacFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFamilies --
+ *
+ * Return information about the font families that are available
+ * on the display of the given window.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list of all the available
+ * font families.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkpGetFontFamilies(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ Tk_Window tkwin) /* For display to query. */
+{
+ FontNameMap *mapPtr;
+ Tcl_Obj *resultPtr, *strPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ strPtr = Tcl_NewStringObj(mapPtr->utfName, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpGetSubFonts --
+ *
+ * A function used by the testing package for querying the actual
+ * screen fonts that make up a font object.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list containing the
+ * names of the screen fonts that make up the given font object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpGetSubFonts(interp, tkfont)
+ Tcl_Interp *interp; /* Interp to hold result. */
+ Tk_Font tkfont; /* Font object to query. */
+{
+ int i;
+ Tcl_Obj *resultPtr, *strPtr;
+ MacFont *fontPtr;
+ FontFamily *familyPtr;
+ Str255 nativeName;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ fontPtr = (MacFont *) tkfont;
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ familyPtr = fontPtr->subFontArray[i].familyPtr;
+ GetFontName(familyPtr->faceNum, nativeName);
+ strPtr = Tcl_NewStringObj(GetUtfFaceName(nativeName), -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_MeasureChars --
+ *
+ * Determine the number of characters from the string that will fit
+ * in the given horizontal span. The measurement is done under the
+ * assumption that Tk_DrawChars() will be used to actually display
+ * the characters.
+ *
+ * Results:
+ * The return value is the number of bytes from source that
+ * fit into the span that extends from 0 to maxLength. *lengthPtr is
+ * filled with the x-coordinate of the right edge of the last
+ * character that did fit.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_MeasureChars(
+ Tk_Font tkfont, /* Font in which characters will be drawn. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes, /* Maximum number of bytes to consider
+ * from source string. */
+ int maxLength, /* If >= 0, maxLength specifies the longest
+ * permissible line length; don't consider any
+ * character that would cross this
+ * x-position. If < 0, then line length is
+ * unbounded and the flags argument is
+ * ignored. */
+ int flags, /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ int *lengthPtr) /* Filled with x-location just after the
+ * terminating character. */
+{
+ MacFont *fontPtr;
+ FontFamily *lastFamilyPtr;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ int curX, curByte;
+
+ /*
+ * According to "Inside Macintosh: Text", the Macintosh may
+ * automatically substitute
+ * ligatures or context-sensitive presentation forms when
+ * measuring/displaying text within a font run. We cannot safely
+ * measure individual characters and add up the widths w/o errors.
+ * However, if we convert a range of text from UTF-8 to, say,
+ * Shift-JIS, and get the offset into the Shift-JIS string as to
+ * where a word or line break would occur, then can we map that
+ * number back to UTF-8?
+ */
+
+ fontPtr = (MacFont *) tkfont;
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(gWorld, NULL);
+
+ TextSize(fontPtr->size);
+ TextFace(fontPtr->style);
+
+ lastFamilyPtr = fontPtr->subFontArray[0].familyPtr;
+
+ if (numBytes == 0) {
+ curX = 0;
+ curByte = 0;
+ } else if (maxLength < 0) {
+ CONST char *p, *end, *next;
+ Tcl_UniChar ch;
+ FontFamily *thisFamilyPtr;
+ Tcl_DString runString;
+
+ /*
+ * A three step process:
+ * 1. Find a contiguous range of characters that can all be
+ * represented by a single screen font.
+ * 2. Convert those chars to the encoding of that font.
+ * 3. Measure converted chars.
+ */
+
+ curX = 0;
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
+ if (thisFamilyPtr != lastFamilyPtr) {
+ TextFont(lastFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source,
+ p - source, &runString);
+ curX += TextWidth(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ lastFamilyPtr = thisFamilyPtr;
+ source = p;
+ }
+ p = next;
+ }
+ TextFont(lastFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, p - source,
+ &runString);
+ curX += TextWidth(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ curByte = numBytes;
+ } else {
+ CONST char *p, *end, *next, *sourceOrig;
+ int widthLeft;
+ FontFamily *thisFamilyPtr;
+ Tcl_UniChar ch;
+ CONST char *rest;
+
+ /*
+ * How many chars will fit in the space allotted?
+ */
+
+ if (maxLength > 32767) {
+ maxLength = 32767;
+ }
+
+ widthLeft = maxLength;
+ sourceOrig = source;
+ end = source + numBytes;
+ for (p = source; p < end; p = next) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
+ if (thisFamilyPtr != lastFamilyPtr) {
+ if (p > source) {
+ rest = BreakLine(lastFamilyPtr, flags, source,
+ p - source, &widthLeft);
+ flags &= ~TK_AT_LEAST_ONE;
+ if (rest != NULL) {
+ p = source;
+ break;
+ }
+ }
+ lastFamilyPtr = thisFamilyPtr;
+ source = p;
+ }
+ }
+
+ if (p > source) {
+ rest = BreakLine(lastFamilyPtr, flags, source, p - source,
+ &widthLeft);
+ }
+
+ if (rest == NULL) {
+ curByte = numBytes;
+ } else {
+ curByte = rest - sourceOrig;
+ }
+ curX = maxLength - widthLeft;
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+
+ *lengthPtr = curX;
+ return curByte;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * BreakLine --
+ *
+ * Determine where the given line of text should be broken so that it
+ * fits in the specified range. Before calling this function, the
+ * font values and graphics port must be set.
+ *
+ * Results:
+ * The return value is NULL if the specified range is larger that the
+ * space the text needs, and *widthLeftPtr is filled with how much
+ * space is left in the range after measuring the whole text buffer.
+ * Otherwise, the return value is a pointer into the text buffer that
+ * indicates where the line should be broken (up to, but not including
+ * that character), and *widthLeftPtr is filled with how much space is
+ * left in the range after measuring up to that character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static CONST char *
+BreakLine(
+ FontFamily *familyPtr, /* FontFamily that describes the font values
+ * that are already selected into the graphics
+ * port. */
+ int flags, /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes, /* Maximum number of bytes to consider
+ * from source string. */
+ int *widthLeftPtr) /* On input, specifies size of range into
+ * which characters from source buffer should
+ * be fit. On output, filled with how much
+ * space is left after fitting as many
+ * characters as possible into the range.
+ * Result may be negative if TK_AT_LEAST_ONE
+ * was specified in the flags argument. */
+{
+ Fixed pixelWidth, widthLeft;
+ StyledLineBreakCode breakCode;
+ Tcl_DString runString;
+ long textOffset;
+ Boolean leadingEdge;
+ Point point;
+ int charOffset, thisCharWasDoubleByte;
+ char *p, *end, *typeTable;
+
+ TextFont(familyPtr->faceNum);
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, numBytes,
+ &runString);
+ pixelWidth = Int2Fixed(*widthLeftPtr) + 1;
+ if (flags & TK_WHOLE_WORDS) {
+ textOffset = (flags & TK_AT_LEAST_ONE);
+ widthLeft = pixelWidth;
+ breakCode = StyledLineBreak(Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString), 0, Tcl_DStringLength(&runString),
+ 0, &widthLeft, &textOffset);
+ if (breakCode != smBreakOverflow) {
+ /*
+ * StyledLineBreak includes all the space characters at the end of
+ * line that we want to suppress.
+ */
+
+ textOffset = VisibleLength(Tcl_DStringValue(&runString), textOffset);
+ goto getoffset;
+ }
+ } else {
+ point.v = 1;
+ point.h = 1;
+ textOffset = PixelToChar(Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString), 0, pixelWidth, &leadingEdge,
+ &widthLeft, smOnlyStyleRun, point, point);
+ if (Fixed2Int(widthLeft) < 0) {
+ goto getoffset;
+ }
+ }
+ *widthLeftPtr = Fixed2Int(widthLeft);
+ Tcl_DStringFree(&runString);
+ return NULL;
+
+ /*
+ * The conversion routine that converts UTF-8 to the target encoding
+ * must map one UTF-8 character to exactly one encoding-specific
+ * character, so that the following algorithm works:
+ *
+ * 1. Get byte offset of where line should be broken.
+ * 2. Get char offset corresponding to that byte offset.
+ * 3. Map that char offset to byte offset in UTF-8 string.
+ */
+
+ getoffset:
+ thisCharWasDoubleByte = 0;
+ if (familyPtr->isMultiByteFont == 0) {
+ charOffset = textOffset;
+ } else {
+ charOffset = 0;
+ typeTable = familyPtr->typeTable;
+
+ p = Tcl_DStringValue(&runString);
+ end = p + textOffset;
+ thisCharWasDoubleByte = typeTable[*((unsigned char *) p)];
+ for ( ; p < end; p++) {
+ thisCharWasDoubleByte = typeTable[*((unsigned char *) p)];
+ p += thisCharWasDoubleByte;
+ charOffset++;
+ }
+ }
+
+ if ((flags & TK_WHOLE_WORDS) == 0) {
+ if ((flags & TK_PARTIAL_OK) && (leadingEdge != 0)) {
+ textOffset += thisCharWasDoubleByte;
+ textOffset++;
+ charOffset++;
+ } else if (((flags & TK_PARTIAL_OK) == 0) && (leadingEdge == 0)) {
+ textOffset -= thisCharWasDoubleByte;
+ textOffset--;
+ charOffset--;
+ }
+ }
+ if ((textOffset == 0) && (Tcl_DStringLength(&runString) > 0)
+ && (flags & TK_AT_LEAST_ONE)) {
+ p = Tcl_DStringValue(&runString);
+ textOffset += familyPtr->typeTable[*((unsigned char *) p)];
+ textOffset++;
+ charOffset++;
+ }
+ *widthLeftPtr = Fixed2Int(pixelWidth)
+ - TextWidth(Tcl_DStringValue(&runString), 0, textOffset);
+ Tcl_DStringFree(&runString);
+ return Tcl_UtfAtIndex(source, charOffset);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawChars --
+ *
+ * Draw a string of characters on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawChars(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for drawing characters. */
+ Tk_Font tkfont, /* Font in which characters will be drawn;
+ * must be the same as font used in GC. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. All Tk meta-characters
+ * (tabs, control characters, and newlines)
+ * should be stripped out of the string that
+ * is passed to this function. If they are
+ * not stripped out, they will be displayed as
+ * regular printing characters. */
+ int numBytes, /* Number of bytes in string. */
+ int x, int y) /* Coordinates at which to place origin of
+ * string when drawing. */
+{
+ 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);
+
+ if (TkSetMacColor(gc->foreground, &macColor) == true) {
+ RGBForeColor(&macColor);
+ }
+ ShowPen();
+ FillRect(&stippleMap->bounds, &tcl_macQdPtr->white);
+ MultiFontDrawText(fontPtr, source, numBytes, 0, 0);
+
+ SetGWorld(destPort, NULL);
+ CopyDeepMask(&((GrafPtr) bufferPort)->portBits, stippleMap,
+ &((GrafPtr) destPort)->portBits, &stippleMap->bounds,
+ &stippleMap->bounds, &((GrafPtr) destPort)->portRect,
+ srcOr, NULL);
+
+ /* TODO: this doesn't work quite right - it does a blend. you can't
+ * draw white text when you have a stipple.
+ */
+
+ Tk_FreePixmap(display, pixmap);
+ ckfree(stippleMap->baseAddr);
+ ckfree((char *)stippleMap);
+ } else {
+ if (TkSetMacColor(gc->foreground, &macColor) == true) {
+ RGBForeColor(&macColor);
+ }
+ ShowPen();
+ MultiFontDrawText(fontPtr, source, numBytes, macWin->xOff + x,
+ macWin->yOff + y);
+ }
+
+ TextFont(txFont);
+ TextSize(txSize);
+ TextFace(txFace);
+ RGBForeColor(&origColor);
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * MultiFontDrawText --
+ *
+ * Helper function for Tk_DrawChars. Draws characters, using the
+ * various screen fonts in fontPtr to draw multilingual characters.
+ * Note: No bidirectional support.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ * Contents of fontPtr may be modified if more subfonts were loaded
+ * in order to draw all the multilingual characters in the given
+ * string.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+MultiFontDrawText(
+ MacFont *fontPtr, /* Contains set of fonts to use when drawing
+ * following string. */
+ CONST char *source, /* Potentially multilingual UTF-8 string. */
+ int numBytes, /* Length of string in bytes. */
+ int x, int y) /* Coordinates at which to place origin *
+ * of string when drawing. */
+{
+ FontFamily *lastFamilyPtr, *thisFamilyPtr;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ Tcl_UniChar ch;
+
+ TextSize(fontPtr->size);
+ TextFace(fontPtr->style);
+
+ lastFamilyPtr = fontPtr->subFontArray[0].familyPtr;
+
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
+ if (thisFamilyPtr != lastFamilyPtr) {
+ if (p > source) {
+ TextFont(lastFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source,
+ p - source, &runString);
+ MoveTo((short) x, (short) y);
+ DrawText(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ x += TextWidth(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ source = p;
+ }
+ lastFamilyPtr = thisFamilyPtr;
+ }
+ p = next;
+ }
+ if (p > source) {
+ TextFont(thisFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source,
+ p - source, &runString);
+ MoveTo((short) x, (short) y);
+ DrawText(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkMacIsCharacterMissing --
+ *
+ * Given a tkFont and a character determines whether the character has
+ * a glyph defined in the font or not. Note that this is potentially
+ * not compatible with Mac OS 8 as it looks at the font handle
+ * structure directly. Looks into the character array of the font
+ * handle to determine whether the glyph is defined or not.
+ *
+ * Results:
+ * Returns a 1 if the character is missing, a 0 if it is not.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkMacIsCharacterMissing(
+ Tk_Font tkfont, /* The font we are looking in. */
+ unsigned int searchChar) /* The character we are looking for. */
+{
+ MacFont *fontPtr = (MacFont *) tkfont;
+ FMInput fm;
+ FontRec **fontRecHandle;
+
+ fm.family = fontPtr->subFontArray[0].familyPtr->faceNum;
+ fm.size = fontPtr->size;
+ fm.face = fontPtr->style;
+ fm.needBits = 0;
+ fm.device = 0;
+ fm.numer.h = fm.numer.v = fm.denom.h = fm.denom.v = 1;
+
+#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
+ fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontResult;
+#else
+ fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontHandle;
+#endif
+ return *(short *) ((long) &(*fontRecHandle)->owTLoc
+ + ((long)((*fontRecHandle)->owTLoc + searchChar
+ - (*fontRecHandle)->firstChar) * sizeof(short))) == -1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Initializes the memory for a MacFont that wraps the platform-specific
+ * data.
+ *
+ * The caller is responsible for initializing the fields of the
+ * TkFont that are used exclusively by the generic TkFont code, and
+ * for releasing those fields before calling TkpDeleteFont().
+ *
+ * Results:
+ * Fills the MacFont structure.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitFont(
+ Tk_Window tkwin, /* For display where font will be used. */
+ int faceNum, /* Macintosh font number. */
+ int size, /* Point size for Macintosh font. */
+ int style, /* Macintosh style bits. */
+ MacFont *fontPtr) /* Filled with information constructed from
+ * the above arguments. */
+{
+ Str255 nativeName;
+ FontInfo fi;
+ TkFontAttributes *faPtr;
+ TkFontMetrics *fmPtr;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ short pixels;
+
+ if (size == 0) {
+ size = -GetDefFontSize();
+ }
+ pixels = (short) TkFontGetPixels(tkwin, size);
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(gWorld, NULL);
+ TextFont(faceNum);
+ TextSize(pixels);
+ TextFace(style);
+
+ GetFontInfo(&fi);
+ GetFontName(faceNum, nativeName);
+
+ fontPtr->font.fid = (Font) fontPtr;
+
+ faPtr = &fontPtr->font.fa;
+ faPtr->family = GetUtfFaceName(nativeName);
+ faPtr->size = TkFontGetPoints(tkwin, size);
+ faPtr->weight = (style & bold) ? TK_FW_BOLD : TK_FW_NORMAL;
+ faPtr->slant = (style & italic) ? TK_FS_ITALIC : TK_FS_ROMAN;
+ faPtr->underline = ((style & underline) != 0);
+ faPtr->overstrike = 0;
+
+ fmPtr = &fontPtr->font.fm;
+ fmPtr->ascent = fi.ascent;
+ fmPtr->descent = fi.descent;
+ fmPtr->maxWidth = fi.widMax;
+ fmPtr->fixed = (CharWidth('i') == CharWidth('w'));
+
+ fontPtr->size = pixels;
+ fontPtr->style = (short) style;
+
+ fontPtr->numSubFonts = 1;
+ fontPtr->subFontArray = fontPtr->staticSubFonts;
+ InitSubFont(fontPtr, faceNum, &fontPtr->subFontArray[0]);
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseFont --
+ *
+ * Called to release the Macintosh-specific contents of a TkFont.
+ * The caller is responsible for freeing the memory used by the
+ * font itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseFont(
+ MacFont *fontPtr) /* The font to delete. */
+{
+ int i;
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ ReleaseSubFont(&fontPtr->subFontArray[i]);
+ }
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * InitSubFont --
+ *
+ * Wrap a screen font and load the FontFamily that represents
+ * it. Used to prepare a SubFont so that characters can be mapped
+ * from UTF-8 to the charset of the font.
+ *
+ * Results:
+ * The subFontPtr is filled with information about the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+InitSubFont(
+ CONST MacFont *fontPtr, /* Font object in which the SubFont will be
+ * used. */
+ int faceNum, /* The font number. */
+ SubFont *subFontPtr) /* Filled with SubFont constructed from
+ * above attributes. */
+{
+ subFontPtr->familyPtr = AllocFontFamily(fontPtr, faceNum);
+ subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseSubFont --
+ *
+ * Called to release the contents of a SubFont. The caller is
+ * responsible for freeing the memory used by the SubFont itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseSubFont(
+ SubFont *subFontPtr) /* The SubFont to delete. */
+{
+ FreeFontFamily(subFontPtr->familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * AllocFontFamily --
+ *
+ * Find the FontFamily structure associated with the given font
+ * family. The information should be stored by the caller in a
+ * SubFont and used when determining if that SubFont supports a
+ * character.
+ *
+ * Results:
+ * A pointer to a FontFamily. The reference count in the FontFamily
+ * is automatically incremented. When the SubFont is released, the
+ * reference count is decremented. When no SubFont is using this
+ * FontFamily, it may be deleted.
+ *
+ * Side effects:
+ * A new FontFamily structure will be allocated if this font family
+ * has not been seen.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static FontFamily *
+AllocFontFamily(
+ CONST MacFont *fontPtr, /* Font object in which the FontFamily will
+ * be used. */
+ int faceNum) /* The font number. */
+{
+ FontFamily *familyPtr;
+ int i;
+
+ familyPtr = fontFamilyList;
+ for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if (familyPtr->faceNum == faceNum) {
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
+
+ familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ memset(familyPtr, 0, sizeof(FontFamily));
+ familyPtr->nextPtr = fontFamilyList;
+ fontFamilyList = familyPtr;
+
+ /*
+ * Set key for this FontFamily.
+ */
+
+ familyPtr->faceNum = faceNum;
+
+ /*
+ * An initial refCount of 2 means that FontFamily information will
+ * persist even when the SubFont that loaded the FontFamily is released.
+ * Change it to 1 to cause FontFamilies to be unloaded when not in use.
+ */
+
+ familyPtr->refCount = 2;
+ familyPtr->encoding = GetFontEncoding(faceNum, 1, &familyPtr->isSymbolFont);
+ familyPtr->isMultiByteFont = 0;
+ FillParseTable(familyPtr->typeTable, FontToScript(faceNum));
+ for (i = 0; i < 256; i++) {
+ if (familyPtr->typeTable[i] != 0) {
+ familyPtr->isMultiByteFont = 1;
+ break;
+ }
+ }
+ return familyPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FreeFontFamily --
+ *
+ * Called to free a FontFamily when the SubFont is finished using it.
+ * Frees the contents of the FontFamily and the memory used by the
+ * FontFamily itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FreeFontFamily(
+ FontFamily *familyPtr) /* The FontFamily to delete. */
+{
+ FontFamily **familyPtrPtr;
+ int i;
+
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ Tcl_FreeEncoding(familyPtr->encoding);
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree((char *) familyPtr->fontMap[i]);
+ }
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which physical screen font is necessary to use to
+ * display the given character. If the font object does not have
+ * a screen font that can display the character, another screen font
+ * may be loaded into the font object, following a set of preferred
+ * fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+FindSubFontForChar(
+ MacFont *fontPtr, /* The font object with which the character
+ * will be displayed. */
+ int ch) /* The Unicode character to be displayed. */
+{
+ int i, j, k;
+ char *fallbackName;
+ char **aliases;
+ SubFont *subFontPtr;
+ FontNameMap *mapPtr;
+ Tcl_DString faceNames;
+ char ***fontFallbacks;
+ char **anyFallbacks;
+
+ if (FontMapLookup(&fontPtr->subFontArray[0], ch)) {
+ return &fontPtr->subFontArray[0];
+ }
+
+ for (i = 1; i < fontPtr->numSubFonts; i++) {
+ if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
+ return &fontPtr->subFontArray[i];
+ }
+ }
+
+ /*
+ * Keep track of all face names that we check, so we don't check some
+ * name multiple times if it can be reached by multiple paths.
+ */
+
+ Tcl_DStringInit(&faceNames);
+
+ aliases = TkFontGetAliasList(fontPtr->font.fa.family);
+
+ subFontPtr = NULL;
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) {
+ /*
+ * If the base font has a fallback...
+ */
+
+ goto tryfallbacks;
+ } else if (aliases != NULL) {
+ /*
+ * Or if an alias for the base font has a fallback...
+ */
+
+ for (k = 0; aliases[k] != NULL; k++) {
+ if (strcasecmp(aliases[k], fallbackName) == 0) {
+ goto tryfallbacks;
+ }
+ }
+ }
+ }
+ continue;
+
+ /*
+ * ...then see if we can use one of the fallbacks, or an
+ * alias for one of the fallbacks.
+ */
+
+ tryfallbacks:
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName,
+ ch, &faceNames);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ /*
+ * See if we can use something from the global fallback list.
+ */
+
+ anyFallbacks = TkFontGetGlobalClass();
+ for (i = 0; anyFallbacks[i] != NULL; i++) {
+ fallbackName = anyFallbacks[i];
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName, ch,
+ &faceNames);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * Try all face names available in the whole system until we
+ * find one that can be used.
+ */
+
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ fallbackName = mapPtr->utfName;
+ if (SeenName(fallbackName, &faceNames) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, fallbackName, ch);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ end:
+ Tcl_DStringFree(&faceNames);
+
+ if (subFontPtr == NULL) {
+ /*
+ * No font can display this character. We will use the base font
+ * and have it display the "unknown" character.
+ */
+
+ subFontPtr = &fontPtr->subFontArray[0];
+ FontMapInsert(subFontPtr, ch);
+ }
+ return subFontPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLookup --
+ *
+ * See if the screen font can display the given character.
+ *
+ * Results:
+ * The return value is 0 if the screen font cannot display the
+ * character, non-zero otherwise.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FontMapLookup(
+ SubFont *subFontPtr, /* Contains font mapping cache to be queried
+ * and possibly updated. */
+ int ch) /* Character to be tested. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapInsert --
+ *
+ * Tell the font mapping cache that the given screen font should be
+ * used to display the specified character. This is called when no
+ * font on the system can be be found that can display that
+ * character; we lie to the font and tell it that it can display
+ * the character, otherwise we would end up re-searching the entire
+ * fallback hierarchy every time that character was seen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontMapInsert(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int ch) /* Character to be added to cache. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated HFONT can (1) or cannot (0) display the
+ * characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int row) /* Index of the page to be loaded into
+ * the cache. */
+{
+ FMInput fm;
+ FontRec *fontRecPtr;
+ short *widths;
+ int i, end, bitOffset, isMultiByteFont;
+ char src[TCL_UTF_MAX];
+ unsigned char buf[16];
+ int srcRead, dstWrote;
+ Tcl_Encoding encoding;
+ Handle fHandle;
+ short theID;
+ ResType theType;
+ Str255 theName;
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ encoding = subFontPtr->familyPtr->encoding;
+
+ fm.family = subFontPtr->familyPtr->faceNum;
+ fm.size = 12;
+ fm.face = 0;
+ fm.needBits = 0;
+ fm.device = 0;
+ fm.numer.h = 1;
+ fm.numer.v = 1;
+ fm.denom.h = 1;
+ fm.denom.v = 1;
+
+#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
+ fHandle = FMSwapFont(&fm)->fontHandle;
+#else
+ fHandle = FMSwapFont(&fm)->fontHandle;
+#endif
+ GetResInfo(fHandle, &theID, &theType, theName);
+ isMultiByteFont = subFontPtr->familyPtr->isMultiByteFont;
+ if( theType=='sfnt' ) {
+ /*
+ * Found an outline font which has very complex font record.
+ * Let's just assume *ALL* the characters are allowed.
+ */
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i,
+ src),
+ TCL_ENCODING_STOPONERROR, NULL, (char *) buf,
+ sizeof(buf),
+ &srcRead, &dstWrote, NULL) == TCL_OK) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1
+ << (bitOffset & 7);
+ }
+ }
+ } else {
+ /*
+ * Found an old bitmap font which has a well-defined record.
+ * We can check the width table to see which characters exist.
+ */
+
+ fontRecPtr = *((FontRec **) fHandle );
+ widths = (short *) ((long) &fontRecPtr->owTLoc
+ + ((long) (fontRecPtr->owTLoc - fontRecPtr->firstChar)
+ * sizeof(short)));
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ if (Tcl_UtfToExternal(NULL, encoding, src,
+ Tcl_UniCharToUtf(i, src),
+ TCL_ENCODING_STOPONERROR, NULL, (char *) buf, sizeof(buf),
+ &srcRead, &dstWrote, NULL) == TCL_OK) {
+
+ if (((isMultiByteFont != 0) && (buf[0] > 31))
+ || (widths[buf[0]] != -1)) {
+ if ((buf[0] == 0x11) && (widths[0x12] == -1)) {
+ continue;
+ }
+
+ /*
+ * Mac's char existence metrics are only for one-byte
+ * characters. If we have a double-byte char, just
+ * assume that the font supports that char if the font's
+ * encoding supports that char.
+ */
+
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1
+ << (bitOffset & 7);
+ }
+ }
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(
+ MacFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ char *faceName, /* Desired face name for new screen font. */
+ int ch, /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr) /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ SubFont *subFontPtr;
+ char **aliases;
+ int i;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SeenName(
+ CONST char *name, /* The name to check. */
+ Tcl_DString *dsPtr) /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified physical screen font has not already been loaded
+ * into the font object, determine if the specified physical screen
+ * font can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont, owned
+ * by the font object. This SubFont can be used to display the given
+ * character. The SubFont represents the screen font with the base set
+ * of font attributes from the font object, but using the specified
+ * font name. NULL is returned if the font object already holds
+ * a reference to the specified physical font or if the specified
+ * physical font cannot display the given character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(
+ MacFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ CONST char *faceName, /* Desired face name for new screen font. */
+ int ch) /* The Unicode character that the new
+ * screen font must be able to display. */
+{
+ int i;
+ SubFont subFont;
+ short faceNum;
+
+ if (GetFamilyNum(faceName, &faceNum) == 0) {
+ return NULL;
+ }
+
+ /*
+ * Skip all fonts we've already used.
+ */
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ if (faceNum == fontPtr->subFontArray[i].familyPtr->faceNum) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Load this font and see if it has the desired character.
+ */
+
+ InitSubFont(fontPtr, faceNum, &subFont);
+ if (((ch < 256) && (subFont.familyPtr->isSymbolFont))
+ || (FontMapLookup(&subFont, ch) == 0)) {
+ ReleaseSubFont(&subFont);
+ return NULL;
+ }
+
+ if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
+ SubFont *newPtr;
+
+ newPtr = (SubFont *) ckalloc(sizeof(SubFont)
+ * (fontPtr->numSubFonts + 1));
+ memcpy((char *) newPtr, fontPtr->subFontArray,
+ fontPtr->numSubFonts * sizeof(SubFont));
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+ fontPtr->subFontArray = newPtr;
+ }
+ fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
+ fontPtr->numSubFonts++;
+ return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetFamilyNum --
+ *
+ * Determines if any physical screen font exists on the system with
+ * the given family name. If the family exists, then it should be
+ * possible to construct some physical screen font with that family
+ * name.
+ *
+ * Results:
+ * The return value is 0 if the specified font family does not exist,
+ * non-zero otherwise. *faceNumPtr is filled with the unique face
+ * number that identifies the screen font, or 0 if the font family
+ * did not exist.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+GetFamilyNum(
+ CONST char *faceName, /* UTF-8 name of font family to query. */
+ short *faceNumPtr) /* Filled with font number for above family. */
+{
+ FontNameMap *mapPtr;
+
+ if (faceName != NULL) {
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ if (strcasecmp(faceName, mapPtr->utfName) == 0) {
+ *faceNumPtr = mapPtr->faceNum;
+ return 1;
+ }
+ }
+ }
+ *faceNumPtr = 0;
+ return 0;
+}
+
+static int
+GetFamilyOrAliasNum(
+ CONST char *faceName, /* UTF-8 name of font family to query. */
+ short *faceNumPtr) /* Filled with font number for above family. */
+{
+ char **aliases;
+ int i;
+
+ if (GetFamilyNum(faceName, faceNumPtr) != 0) {
+ return 1;
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (GetFamilyNum(aliases[i], faceNumPtr) != 0) {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetUtfFaceName --
+ *
+ * Given the native name for a Macintosh font (in which the name of
+ * the font is in the encoding of the font itself), return the UTF-8
+ * name that corresponds to that font. The specified font name must
+ * refer to a font that actually exists on the machine.
+ *
+ * This function is used to obtain the UTF-8 name when querying the
+ * properties of a Macintosh font object.
+ *
+ * Results:
+ * The return value is a pointer to the UTF-8 of the specified font.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static Tk_Uid
+GetUtfFaceName(
+ StringPtr nativeName) /* Pascal name for font in native encoding. */
+{
+ FontNameMap *mapPtr;
+
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ if (pstrcmp(nativeName, mapPtr->nativeName) == 0) {
+ return mapPtr->utfName;
+ }
+ }
+ panic("GetUtfFaceName: unexpected nativeName");
+ return NULL;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * GetFontEncoding --
+ *
+ * Return a string that can be passed to Tcl_GetTextEncoding() and
+ * used to convert bytes from UTF-8 into the encoding of the
+ * specified font.
+ *
+ * The desired encoding to use to convert the name of a symbolic
+ * font into UTF-8 is macRoman, while the desired encoding to use
+ * to convert bytes in a symbolic font to UTF-8 is the corresponding
+ * symbolic encoding. Due to this dual interpretatation of symbolic
+ * fonts, the caller can specify what type of encoding to return
+ * should the specified font be symbolic.
+ *
+ * Results:
+ * The return value is a string that specifies the font's encoding.
+ * If the font's encoding could not be identified, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static Tcl_Encoding
+GetFontEncoding(
+ int faceNum, /* Macintosh font number. */
+ int allowSymbol, /* If non-zero, then the encoding string
+ * for symbol fonts will be the corresponding
+ * symbol encoding. Otherwise, the encoding
+ * string for symbol fonts will be
+ * "macRoman". */
+ int *isSymbolPtr) /* Filled with non-zero if this font is a
+ * symbol font, 0 otherwise. */
+{
+ Str255 faceName;
+ int script, lang;
+ char *name;
+
+ if (allowSymbol != 0) {
+ GetFontName(faceNum, faceName);
+ if (pstrcasecmp(faceName, "\psymbol") == 0) {
+ *isSymbolPtr = 1;
+ return Tcl_GetEncoding(NULL, "symbol");
+ }
+ if (pstrcasecmp(faceName, "\pzapf dingbats") == 0) {
+ *isSymbolPtr = 1;
+ return Tcl_GetEncoding(NULL, "macDingbats");
+ }
+ }
+
+ *isSymbolPtr = 0;
+
+ script = FontToScript(faceNum);
+ lang = GetScriptVariable(script, smScriptLang);
+ name = NULL;
+ if (script == smRoman) {
+ name = TkFindStateString(romanMap, lang);
+ } else if (script == smCyrillic) {
+ name = TkFindStateString(cyrillicMap, lang);
+ }
+ if (name == NULL) {
+ name = TkFindStateString(scriptMap, script);
+ }
+ return Tcl_GetEncoding(NULL, name);
+}
diff --git a/tcl/mac/tkMacHLEvents.c b/tcl/mac/tkMacHLEvents.c
new file mode 100644
index 00000000000..40758dc34b0
--- /dev/null
+++ b/tcl/mac/tkMacHLEvents.c
@@ -0,0 +1,441 @@
+/*
+ * 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, "::tk::mac::OpenDocument", &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_DStringAppend(&command, "::tk::mac::OpenDocument", -1);
+ for (index = 1; index <= count; index++) {
+ int length;
+ Handle fullPath;
+
+ err = AEGetNthPtr(&fileSpecList, index, typeFSS,
+ &keyword, &type, (Ptr) &file, sizeof(FSSpec), &actual);
+ if ( err != noErr ) {
+ continue;
+ }
+
+ err = FSpPathFromLocation(&file, &length, &fullPath);
+ HLock(fullPath);
+ Tcl_ExternalToUtfDString(NULL, *fullPath, length, &pathName);
+ HUnlock(fullPath);
+ DisposeHandle(fullPath);
+
+ Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
+ Tcl_DStringFree(&pathName);
+ }
+
+ Tcl_GlobalEval(interp, Tcl_DStringValue(&command));
+
+ Tcl_DStringFree(&command);
+ return noErr;
+}
+
+static pascal OSErr
+PrintHandler(
+ AppleEvent *theAppleEvent,
+ AppleEvent *reply,
+ 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') {
+ Tcl_DString encodedText;
+ 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);
+ Tcl_ExternalToUtfDString(NULL, *theDesc.dataHandle, length,
+ &encodedText);
+ tclErr = Tcl_GlobalEval(interp, Tcl_DStringValue(&encodedText));
+ Tcl_DStringFree(&encodedText);
+ 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,
+ Tcl_GetStringResult(interp),
+ strlen(Tcl_GetStringResult(interp)));
+ } else {
+ AEPutParamPtr(reply, keyErrorString, typeChar,
+ Tcl_GetStringResult(interp),
+ strlen(Tcl_GetStringResult(interp)));
+ AEPutParamPtr(reply, keyErrorNumber, typeInteger,
+ (Ptr) &tclErr, sizeof(int));
+ }
+ }
+
+ AEDisposeDesc(&theDesc);
+
+ 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/tcl/mac/tkMacInit.c b/tcl/mac/tkMacInit.c
new file mode 100644
index 00000000000..c79ef140a19
--- /dev/null
+++ b/tcl/mac/tkMacInit.c
@@ -0,0 +1,228 @@
+/*
+ * tkMacInit.c --
+ *
+ * This file contains Mac-specific interpreter initialization
+ * functions.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 the interp's result.
+ *
+ * Side effects:
+ * Sets "tk_library" Tcl variable, runs initialization scripts
+ * for Tk.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(
+ Tcl_Interp *interp) /* Interp to initialize. */
+{
+ CONST char *libDir, *tempPath;
+ Tcl_DString path, ds;
+ int result;
+
+ static char initCmd[] = "if {[info proc tkInit]==\"\"} {\n\
+proc tkInit {} {\n\
+proc sourcePath {file} {\n\
+ global tk_library\n\
+ if {[catch {uplevel #0 [list source [file join $tk_library $file.tcl]]}] == 0} {\n\
+ return\n\
+ }\n\
+ if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
+ return\n\
+ }\n\
+ rename sourcePath {}\n\
+ set msg \"Can't find $file resource or a usable $file.tcl file\"\n\
+ append msg \" perhaps you need to install Tk or set your\"\n\
+ append msg \" TK_LIBRARY environment variable?\"\n\
+ error $msg\n\
+}\n\
+sourcePath tk\n\
+sourcePath dialog\n\
+sourcePath focus\n\
+sourcePath optMenu\n\
+sourcePath palette\n\
+sourcePath tearoff\n\
+if {[catch {package require msgcat}]} {sourcePath msgcat}\n\
+sourcePath bgerror\n\
+sourcePath msgbox\n\
+sourcePath comdlg\n\
+rename sourcePath {}\n\
+rename tkInit {}\n\
+} }\n\
+tkInit";
+
+ Tcl_DStringInit(&path);
+ Tcl_DStringInit(&ds);
+
+ /*
+ * 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 = TclGetEnv("TK_LIBRARY", &ds);
+ }
+ if ((libDir == NULL) || (libDir[0] == '\0')) {
+ tempPath = TclGetEnv("EXT_FOLDER", &ds);
+ if ((tempPath != NULL) && (tempPath[0] != '\0')) {
+ Tcl_DString libPath;
+ CONST char *argv[3];
+
+ argv[0] = tempPath;
+ argv[1] = "Tool Command Language";
+ Tcl_DStringInit(&libPath);
+ Tcl_DStringAppend(&libPath, "tk", -1);
+ argv[2] = Tcl_DStringAppend(&libPath, TK_VERSION, -1);
+ libDir = Tcl_JoinPath(3, argv, &path);
+ Tcl_DStringFree(&libPath);
+ }
+ }
+ 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);
+ Tcl_DStringFree(&ds);
+
+ 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;
+ CONST char **argv = NULL, *name, *p;
+ int nameLength = -1;
+ 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) {
+ nameLength = p - name;
+ }
+ } else {
+ name = NULL;
+ }
+ }
+ if ((name == NULL) || (*name == 0) || (nameLength == 0)) {
+ name = "tk";
+ nameLength = -1;
+ }
+ Tcl_DStringAppend(namePtr, name, nameLength);
+ 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(
+ CONST char *msg, /* Message to be displayed. */
+ CONST 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/tcl/mac/tkMacInt.h b/tcl/mac/tkMacInt.h
new file mode 100644
index 00000000000..5d8eedd0c9b
--- /dev/null
+++ b/tcl/mac/tkMacInt.h
@@ -0,0 +1,233 @@
+/*
+ * 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
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Include platform specific public interfaces.
+ */
+
+#ifndef _TKMAC
+#include "tkMac.h"
+#endif
+
+#ifndef _TKPORT
+#include "tkPort.h"
+#endif
+
+#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 tkMac.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
+
+#include "tkIntPlatDecls.h"
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * mac specific procedures exported from the DLL
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKMACINT */
diff --git a/tcl/mac/tkMacKeyboard.c b/tcl/mac/tkMacKeyboard.c
new file mode 100644
index 00000000000..381272a0c34
--- /dev/null
+++ b/tcl/mac/tkMacKeyboard.c
@@ -0,0 +1,648 @@
+/*
+ * tkMacKeyboard.c --
+ *
+ * Routines to support keyboard events on the Macintosh.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+ int c;
+ char virtualKey;
+ int newKeycode;
+ unsigned long dummy, newChar;
+
+ if (!initialized) {
+ InitKeyMaps();
+ }
+
+ virtualKey = (char) (keycode >> 16);
+ c = (keycode) & 0xffff;
+ if (c > 255) {
+ return NoSymbol;
+ }
+
+ /*
+ * When determining what keysym to produce we firt check to see if
+ * the key is a function key. We then check to see if the character
+ * is another non-printing key. Finally, we return the key syms
+ * for all ASCI chars.
+ */
+ if (c == 0x10) {
+ hPtr = Tcl_FindHashEntry(&vkeyTable, (char *) virtualKey);
+ if (hPtr != NULL) {
+ return (KeySym) Tcl_GetHashValue(hPtr);
+ }
+ }
+ hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
+ if (hPtr != NULL) {
+ return (KeySym) Tcl_GetHashValue(hPtr);
+ }
+
+ /*
+ * Recompute the character based on the Shift key only.
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetString --
+ *
+ * Retrieve the string equivalent for the given keyboard event.
+ *
+ * Results:
+ * Returns the UTF string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkpGetString(
+ TkWindow *winPtr, /* Window where event occurred: needed to
+ * get input context. */
+ XEvent *eventPtr, /* X keyboard event. */
+ Tcl_DString *dsPtr) /* Uninitialized or empty string to hold
+ * result. */
+{
+ register Tcl_HashEntry *hPtr;
+ char string[3];
+ char virtualKey;
+ int c, len;
+
+ if (!initialized) {
+ InitKeyMaps();
+ }
+
+ Tcl_DStringInit(dsPtr);
+
+ virtualKey = (char) (eventPtr->xkey.keycode >> 16);
+ c = (eventPtr->xkey.keycode) & 0xffff;
+
+ if (c < 256) {
+ string[0] = (char) c;
+ len = 1;
+ } else {
+ string[0] = (char) (c >> 8);
+ string[1] = (char) c;
+ len = 2;
+ }
+
+ /*
+ * Just return NULL if the character is a function key or another
+ * non-printing key.
+ */
+ if (c == 0x10) {
+ len = 0;
+ } else {
+ hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
+ if (hPtr != NULL) {
+ len = 0;
+ }
+ }
+ return Tcl_ExternalToUtfDString(NULL, string, len, dsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGetModifierMapping --
+ *
+ * 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.
+ * FIXME - This is no longer true. This function is now used in
+ * "event generate" so we really should make it work.
+ *
+ * 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 <<16);
+ }
+
+ return keycode;
+}
+
+/*
+ * 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.
+ */
+
+void
+TkpSetKeycodeAndState(tkwin, keySym, eventPtr)
+ Tk_Window tkwin;
+ KeySym keySym;
+ XEvent *eventPtr;
+{
+ Display *display;
+ int state;
+ KeyCode keycode;
+
+ display = Tk_Display(tkwin);
+
+ if (keySym == NoSymbol) {
+ keycode = 0;
+ } else {
+ keycode = XKeysymToKeycode(display, keySym);
+ }
+ if (keycode != 0) {
+ for (state = 0; state < 4; state++) {
+ if (XKeycodeToKeysym(display, keycode, state) == keySym) {
+ if (state & 1) {
+ eventPtr->xkey.state |= ShiftMask;
+ }
+ if (state & 2) {
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ eventPtr->xkey.state |= dispPtr->modeModMask;
+ }
+ break;
+ }
+ }
+ }
+ eventPtr->xkey.keycode = keycode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetKeySym --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkpGetKeySym(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) {
+ TkpInitKeymapInfo(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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitKeymapInfo --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitKeymapInfo(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);
+}
diff --git a/tcl/mac/tkMacLibrary.r b/tcl/mac/tkMacLibrary.r
new file mode 100644
index 00000000000..7cc5a77026b
--- /dev/null
+++ b/tcl/mac/tkMacLibrary.r
@@ -0,0 +1,73 @@
+/*
+ * 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$
+ */
+
+#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
+# define RELEASE_CODE 0x00
+#else
+# define MINOR_VERSION TK_MINOR_VERSION * 16
+# define RELEASE_CODE TK_RELEASE_SERIAL
+#endif
+
+#define RELEASE_CODE 0x00
+
+resource 'vers' (1) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
+ TK_PATCH_LEVEL,
+ TK_PATCH_LEVEL ", by Ray Johnson & Jim Ingham" "\n" "© 2001 Tcl Core Team"
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
+ TK_PATCH_LEVEL,
+ "Tk Library " TK_PATCH_LEVEL " © 1993-2001"
+};
+
+/*
+ * 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."
+};
diff --git a/tcl/mac/tkMacMDEF.c b/tcl/mac/tkMacMDEF.c
new file mode 100644
index 00000000000..136f1ba8cab
--- /dev/null
+++ b/tcl/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/tcl/mac/tkMacMDEF.r b/tcl/mac/tkMacMDEF.r
new file mode 100644
index 00000000000..a38927468d0
--- /dev/null
+++ b/tcl/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 48E7 1030 4FEF FFEE 266F 0022 247C" /* NuHÁ.0OÔÓ&o."$| */
+ $"4D44 4546 594F 2EB8 0B54 2E9F 554F 3EB8" /* MDEFYO.½.T.üUO>½ */
+ $"0A0A 3F5F 0004 554F 3EB8 0A0C 3F5F 0006" /* ..?_..UO>½..?_.. */
+ $"3038 0B5C 48C0 0C80 FFFF FFFF 6612 2078" /* 08.\H¿.Äf. x */
+ $"0B5C 2050 2F68 0006 0008 2F68 000A 000C" /* .\ P/h..../h.... */
+ $"302F 0032 48C0 0C80 0000 0001 6602 3613" /* 0/.2H¿.Ä....f.6. */
+ $"3F2F 0032 2F2F 0030 2F2F 0030 2F2F 0030" /* ?/.2//.0//.0//.0 */
+ $"2F0B 486F 0012 4E92 2F17 21DF 0B54 3F2F" /* /.Ho..Ní/.!þ.T?/ */
+ $"0004 31DF 0A0A 3F2F 0006 31DF 0A0C 302F" /* ..1þ..?/..1þ..0/ */
+ $"0032 48C0 0C80 0000 0001 6638 3013 48C0" /* .2H¿.Ä....f80.H¿ */
+ $"3203 48C1 B280 672C 3038 0B5C 48C0 0C80" /* 2.H¡¾Äg,08.\H¿.Ä */
+ $"FFFF FFFF 671E 2078 0B5C 2050 216F 0008" /* g. x.\ P!o.. */
+ $"0006 216F 000C 000A 21EF 0008 09FA 21EF" /* ..!o....!Ô..™!Ô */
+ $"000C 09FE 4FEF 0012 4CDF 0C08 4E74 0012" /* ..œOÔ..Lþ..Nt.. */
+};
diff --git a/tcl/mac/tkMacMenu.c b/tcl/mac/tkMacMenu.c
new file mode 100644
index 00000000000..c75d0985377
--- /dev/null
+++ b/tcl/mac/tkMacMenu.c
@@ -0,0 +1,4607 @@
+/*
+ * 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 "tkMacInt.h"
+#include "tkMenu.h"
+#include "tkMenuButton.h"
+#include "tkColor.h"
+#include "tkMacInt.h"
+#undef Status
+#include <Menus.h>
+#include <OSUtils.h>
+#include <Palettes.h>
+#include <Resources.h>
+#include <string.h>
+#include <ToolUtils.h>
+#include <Balloons.h>
+#include <Appearance.h>
+#include <Devices.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 char elipsisString[TCL_UTF_MAX + 1];
+ /* The UTF representation of the elipsis (Š)
+ * character. */
+static int helpItemCount; /* The number of items in the help menu.
+ * -1 means that the help menu is
+ * unavailable. This does not include
+ * the automatically generated separator. */
+static int inPostMenu; /* We cannot be re-entrant like X
+ * windows. */
+static short lastMenuID; /* To pass to NewMenu; need to figure out
+ * a good way to do this. */
+static unsigned char lastCascadeID;
+ /* Cascades have to have ids that are
+ * less than 256. */
+static MacDrawable macMDEFDrawable;
+ /* Drawable for use by MDEF code */
+static MDEFScrollFlag = 0; /* Used so that popups don't scroll too soon. */
+static int menuBarFlags; /* Used for whether the menu bar needs
+ * redrawing or not. */
+static TkMenuDefUPP menuDefProc = NULL ;
+ /* The routine descriptor to the MDEF proc.
+ * The MDEF is needed to draw menus with
+ * non-standard attributes and to support
+ * tearoff menus. */
+static struct TearoffSelect {
+ TkMenu *menuPtr; /* The menu that is torn off */
+ Point point; /* The point to place the new menu */
+ Rect excludeRect; /* We don't want to drag tearoff highlights
+ * when we are in this menu */
+} tearoffStruct;
+
+static RgnHandle totalMenuRgn = NULL;
+ /* Used to update windows which have been
+ * obscured by menus. */
+static RgnHandle utilRgn = NULL;/* Used when creating the region that is to
+ * be clipped out while the MDEF is active. */
+
+static TopLevelMenubarList *windowListPtr;
+ /* A list of windows that have menubars set. */
+static MenuItemDrawingUPP tkThemeMenuItemDrawingUPP;
+ /* Points to the UPP for theme Item drawing. */
+
+
+/*
+ * 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 GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Tcl_DString *dStringPtr));
+static void GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *modWidthPtr,
+ int *textWidthPtr, int *heightPtr));
+static void GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+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 SetMenuTitle _ANSI_ARGS_((MenuHandle menuHdl,
+ Tcl_Obj *titlePtr));
+static void AppearanceEntryDrawWrapper _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Rect * menuRectPtr, TkMenuLowMemGlobals *globalsPtr,
+ Drawable d, Tk_FontMetrics *fmPtr, Tk_Font tkfont,
+ int x, int y, int width, int height));
+pascal void tkThemeMenuItemDrawingProc _ANSI_ARGS_ ((const Rect *inBounds,
+ SInt16 inDepth, Boolean inIsColorDevice,
+ SInt32 inUserData));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacUseID --
+ *
+ * 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_ResetResult(interp);
+ 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);
+#if 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. This is primarily used to do a substitution
+ * between "..." and "Š".
+ *
+ * Results:
+ * itemText points to the new text for the item.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetEntryText(
+ TkMenuEntry *mePtr, /* A pointer to the menu entry. */
+ Tcl_DString *dStringPtr) /* The DString to put the text into. This
+ * will be initialized by this routine. */
+{
+ Tcl_DStringInit(dStringPtr);
+ if (mePtr->type == TEAROFF_ENTRY) {
+ Tcl_DStringAppend(dStringPtr, "(Tear-off)", -1);
+ } else if ((mePtr->imagePtr != NULL) && (mePtr->compound == COMPOUND_NONE)) {
+ Tcl_DStringAppend(dStringPtr, "(Image)", -1);
+ } else if ((mePtr->bitmapPtr != NULL) && (mePtr->compound == COMPOUND_NONE)) {
+ Tcl_DStringAppend(dStringPtr, "(Pixmap)", -1);
+ } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) {
+ /*
+ * The Mac menu manager does not like null strings.
+ */
+
+ Tcl_DStringAppend(dStringPtr, " ", -1);
+ } else {
+ int length;
+ char *text = Tcl_GetStringFromObj(mePtr->labelPtr, &length);
+ char *dStringText;
+ int i;
+
+ for (i = 0; *text; text++, i++) {
+ if ((*text == '.')
+ && (*(text + 1) != '\0') && (*(text + 1) == '.')
+ && (*(text + 2) != '\0') && (*(text + 2) == '.')) {
+ Tcl_DStringAppend(dStringPtr, elipsisString, -1);
+ i += strlen(elipsisString) - 1;
+ text += 2;
+ } else {
+ Tcl_DStringSetLength(dStringPtr,
+ Tcl_DStringLength(dStringPtr) + 1);
+ dStringText = Tcl_DStringValue(dStringPtr);
+ dStringText[i] = *text;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindMarkCharacter --
+ *
+ * Finds the Macintosh mark character based on the font of the
+ * item. We calculate a good mark character based on the font
+ * that this item is rendered in.
+ *
+ * We try the following special mac characters. If none of them
+ * are present, just use the check mark.
+ * '' - Check mark character (\022)
+ * '€' - Mac Bullet character (\245)
+ * '' - Filled diamond (\023)
+ * '×' - Hollow diamond (\327)
+ * '‹' = Mac Long dash ("em dash") (\321)
+ * '-' = short dash (minus, "en dash");
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New item is added to platform menu
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char
+FindMarkCharacter(
+ TkMenuEntry *mePtr) /* The entry we are finding the character
+ * for. */
+{
+ char markChar;
+ Tk_Font tkfont;
+
+ tkfont = Tk_GetFontFromObj(mePtr->menuPtr->tkwin,
+ (mePtr->fontPtr == NULL) ? mePtr->menuPtr->fontPtr
+ : mePtr->fontPtr);
+
+ if (!TkMacIsCharacterMissing(tkfont, '\022')) {
+ markChar = '\022'; /* Check mark */
+ } else if (!TkMacIsCharacterMissing(tkfont, '\245')) {
+ markChar = '\245'; /* Bullet */
+ } else if (!TkMacIsCharacterMissing(tkfont, '\023')) {
+ markChar = '\023'; /* Filled Diamond */
+ } else if (!TkMacIsCharacterMissing(tkfont, '\327')) {
+ markChar = '\327'; /* Hollow Diamond */
+ } else if (!TkMacIsCharacterMissing(tkfont, '\321')) {
+ markChar = '\321'; /* Long Dash */
+ } else if (!TkMacIsCharacterMissing(tkfont, '-')) {
+ markChar = '-'; /* Short Dash */
+ } else {
+ markChar = '\022'; /* Check mark */
+ }
+ 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;
+ }
+
+ markChar = 0;
+ if ((mePtr->type == RADIO_BUTTON_ENTRY)
+ || (mePtr->type == CHECK_BUTTON_ENTRY)) {
+ if (mePtr->indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ markChar = FindMarkCharacter(mePtr);
+ }
+ }
+ SetItemMark(macMenuHdl, mePtr->index + 1, markChar);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ Tcl_Obj *titlePtr) /* The C string to set the title to. */
+{
+ int oldLength, newLength, oldHandleSize, dataLength;
+ Ptr menuDataPtr;
+ char *title = (titlePtr == NULL) ? ""
+ : Tcl_GetStringFromObj(titlePtr, NULL);
+
+ menuDataPtr = (Ptr) (*menuHdl)->menuData;
+
+ if (strncmp(title, menuDataPtr + 1, menuDataPtr[0]) != 0) {
+ newLength = strlen(title) + 1;
+ oldLength = menuDataPtr[0] + 1;
+ oldHandleSize = GetHandleSize((Handle) menuHdl);
+ 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
+ * the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information get set for mePtr; old resources
+ * get freed, if any need it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpConfigureMenuEntry(
+ 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->labelPtr);
+ }
+ }
+ }
+ }
+
+ /*
+ * We need to parse the accelerator string. If it has the strings
+ * for Command, Control, Shift or Option, we need to flag it
+ * so we can draw the symbols for it. We also need to precalcuate
+ * the position of the first real character we are drawing.
+ */
+
+ if (0 == mePtr->accelLength) {
+ ((EntryGeometry *)mePtr->platformEntryData)->accelTextStart = -1;
+ } else {
+ char *accelString = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ char *accel = accelString;
+ mePtr->entryFlags |= ~ENTRY_ACCEL_MASK;
+
+ while (1) {
+ if ((0 == strncasecmp("Control", accelString, 6))
+ && (('-' == accelString[6]) || ('+' == accelString[6]))) {
+ mePtr->entryFlags |= ENTRY_CONTROL_ACCEL;
+ accelString += 7;
+ } 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) 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) {
+ char *name = (mePtr->namePtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+
+ if (strcmp(Tk_PathName(menuPtr->tkwin), name) == 0) {
+ if (mePtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+
+ /*
+ * 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 {
+ Tcl_DString itemTextDString;
+ int destWrote;
+
+ GetEntryText(mePtr, &itemTextDString);
+ Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString), 0, NULL,
+ (char *) &itemText[1],
+ 231, NULL, &destWrote, NULL);
+ itemText[0] = destWrote;
+
+ AppendMenu(macMenuHdl, "\px");
+ SetMenuItemText(macMenuHdl, base + index, itemText);
+ Tcl_DStringFree(&itemTextDString);
+
+ /*
+ * Set enabling and disabling correctly.
+ */
+
+ if (parentDisabled || (mePtr->state == ENTRY_DISABLED)) {
+ DisableItem(macMenuHdl, base + index);
+ } else {
+ EnableItem(macMenuHdl, base + index);
+ }
+
+ /*
+ * Set the check mark for check entries and radio entries.
+ */
+
+ SetItemMark(macMenuHdl, base + index, 0);
+ if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ CheckItem(macMenuHdl, base + index, (mePtr->entryFlags
+ & ENTRY_SELECTED) && mePtr->indicatorOn);
+ if (mePtr->indicatorOn
+ && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ SetItemMark(macMenuHdl, base + index,
+ FindMarkCharacter(mePtr));
+ }
+ }
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ if ((mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ MenuHandle childMenuHdl =
+ ((MacMenu *) mePtr->childMenuRefPtr
+ ->menuPtr->platformData)->menuHdl;
+
+ if (childMenuHdl == NULL) {
+ childMenuHdl = ((MacMenu *) mePtr->childMenuRefPtr
+ ->menuPtr->platformData)->menuHdl;
+ }
+ if (childMenuHdl != NULL) {
+ if (TkMacHaveAppearance() > 1) {
+ SetMenuItemHierarchicalID(macMenuHdl, base + index,
+ (*childMenuHdl)->menuID);
+ } else {
+ SetItemMark(macMenuHdl, base + index,
+ (*childMenuHdl)->menuID);
+ SetItemCmd(macMenuHdl, base + index, CASCADE_CMD);
+ }
+ }
+ /*
+ * If we changed the highligthing of this menu, its
+ * children all have to be reconfigured so that
+ * their state will be reflected in the menubar.
+ */
+
+ if (!(mePtr->childMenuRefPtr->menuPtr->menuFlags
+ & MENU_RECONFIGURE_PENDING)) {
+ mePtr->childMenuRefPtr->menuPtr->menuFlags
+ |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu,
+ (ClientData) mePtr->childMenuRefPtr->menuPtr);
+ }
+ }
+ }
+
+ if ((mePtr->type != CASCADE_ENTRY)
+ && (ENTRY_COMMAND_ACCEL
+ == (mePtr->entryFlags & ENTRY_ACCEL_MASK))) {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ SetItemCmd(macMenuHdl, base + index, 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) {
+ AppendResMenu(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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 == ENTRY_DISABLED) {
+ 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 == ENTRY_DISABLED) {
+ 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);
+ WindowRef frontNonFloating;
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontNonFloating = FrontNonFloatingWindow();
+ } else {
+ frontNonFloating = FrontWindow();
+ }
+
+ if ((macWindowPtr == NULL) || (macWindowPtr != frontNonFloating)) {
+ 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 {
+ char *accel = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+
+ if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
+ *textWidthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
+ } else {
+ int emWidth = Tk_TextWidth(tkfont, "W", 1) + 1;
+ if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
+ int width = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
+ *textWidthPtr = emWidth;
+ if (width < emWidth) {
+ *modWidthPtr = 0;
+ } else {
+ *modWidthPtr = width - emWidth;
+ }
+ } else {
+ 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, 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)) {
+ if (mePtr->indicatorOn
+ && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ int baseline;
+ short markShort;
+
+ baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+ GetItemMark(((MacMenu *) menuPtr->platformData)->menuHdl,
+ mePtr->index + 1, &markShort);
+ if (markShort != 0) {
+ char markChar;
+ char markCharUTF[TCL_UTF_MAX + 1];
+ int dstWrote;
+
+ markChar = (char) markShort;
+ Tcl_ExternalToUtf(NULL, NULL, &markChar, 1, 0, NULL,
+ markCharUTF, TCL_UTF_MAX + 1, NULL, &dstWrote, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, markCharUTF,
+ dstWrote, x + 2, baseline);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuBackground --
+ *
+ * If Appearance is present, draws the Appearance background
+ *
+ * Results:
+ * Nothing
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DrawMenuBackground(
+ Rect *menuRectPtr, /* The menu rect */
+ Drawable d, /* What we are drawing into */
+ ThemeMenuType type /* Type of menu */
+ )
+{
+ if (!TkMacHaveAppearance()) {
+ return;
+ } else {
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(d);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacSetUpClippingRgn(d);
+ DrawThemeMenuBackground (menuRectPtr, type);
+ SetGWorld(saveWorld, saveDevice);
+ return;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawSICN --
+ *
+ * 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)) {
+ RGBForeColor(&foreColor);
+ }
+
+ if (TkSetMacColor(gc->background, &backColor)) {
+ 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 */
+{
+ int activeBorderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ if (mePtr->type == CASCADE_ENTRY) {
+ /*
+ * Under Appearance, we let the Appearance Manager draw the icon
+ */
+
+ if (!TkMacHaveAppearance()) {
+ if (0 == DrawSICN(SICN_RESOURCE_NUMBER, CASCADE_ARROW, d, gc,
+ x + width - SICN_HEIGHT, (y + (height / 2))
+ - (SICN_HEIGHT / 2))) {
+ XPoint points[3];
+ Tk_Window tkwin = menuPtr->tkwin;
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ points[0].x = width - activeBorderWidth
+ - MAC_MARGIN_WIDTH - CASCADE_ARROW_WIDTH;
+ points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2;
+ points[1].x = points[0].x;
+ points[1].y = points[0].y + CASCADE_ARROW_HEIGHT;
+ points[2].x = points[0].x + CASCADE_ARROW_WIDTH;
+ points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2;
+ Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points,
+ 3, DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT);
+ }
+ }
+ }
+ } else if (mePtr->accelLength != 0) {
+ int leftEdge = x + width;
+ int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+ char *accel;
+
+ accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+
+ if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
+ leftEdge -= ((EntryGeometry *) mePtr->platformEntryData)
+ ->accelTextWidth;
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
+ mePtr->accelLength, leftEdge, baseline);
+ } else {
+ EntryGeometry *geometryPtr =
+ (EntryGeometry *) mePtr->platformEntryData;
+ int length = mePtr->accelLength - geometryPtr->accelTextStart;
+
+ leftEdge -= geometryPtr->accelTextWidth;
+ if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
+ leftEdge -= geometryPtr->modifierWidth;
+ }
+
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel
+ + geometryPtr->accelTextStart, length, leftEdge, baseline);
+
+ if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
+ leftEdge -= COMMAND_ICON_WIDTH;
+ DrawSICN(SICN_RESOURCE_NUMBER, COMMAND_ICON, d, gc,
+ leftEdge, (y + (height / 2)) - (SICN_HEIGHT / 2) - 1);
+ }
+
+ 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, menuFont;
+ 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.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &fontMetrics);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (globalsPtr->menuTop + mePtr->y + mePtr->height
+ < menuClipRect.top) {
+ continue;
+ } else if (globalsPtr->menuTop + mePtr->y
+ > menuClipRect.bottom) {
+ continue;
+ }
+ /* ClipRect(&menuClipRect); */
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = &fontMetrics;
+ tkfont = menuFont;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
+ (Drawable) &macMDEFDrawable, fmPtr, tkfont,
+ menuRectPtr->left + mePtr->x,
+ globalsPtr->menuTop + mePtr->y,
+ (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
+ menuPtr->totalWidth - mePtr->x : mePtr->width,
+ menuPtr->entries[i]->height);
+ }
+ globalsPtr->menuBottom = globalsPtr->menuTop
+ + menuPtr->totalHeight;
+ if (!EmptyRgn(utilRgn)) {
+ SetClip(utilRgn);
+ SetEmptyRgn(utilRgn);
+ }
+ 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)) {
+ /* if (!TkMacHaveAppearance()) { */
+ RGBForeColor(&foreColor);
+ /* } */
+ }
+ if (TkSetMacColor(menuPtr->textGC->background,
+ &backColor)) {
+ /* 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 == ENTRY_DISABLED)) {
+ newItem = -1;
+ } else {
+ TkMenuEntry *cascadeEntryPtr;
+ int parentDisabled = 0;
+
+ for (cascadeEntryPtr
+ = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr
+ = cascadeEntryPtr->nextCascadePtr) {
+ char *name;
+
+ name = Tcl_GetStringFromObj(
+ cascadeEntryPtr->namePtr, NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin))
+ == 0) {
+ if (cascadeEntryPtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+ if (parentDisabled) {
+ newItem = -1;
+ } 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];
+ if (mePtr->fontPtr == NULL) {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ menuPtr->fontPtr);
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ mePtr->fontPtr);
+ }
+ Tk_GetFontMetrics(tkfont, &fontMetrics);
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
+ (Drawable) &macMDEFDrawable, &fontMetrics, tkfont,
+ menuRectPtr->left + mePtr->x,
+ globalsPtr->menuTop + mePtr->y,
+ (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
+ menuPtr->totalWidth - mePtr->x : mePtr->width,
+ mePtr->height);
+ }
+ if (newItem != -1) {
+ int oldActiveItem = menuPtr->active;
+
+ mePtr = menuPtr->entries[newItem];
+ if (mePtr->state != ENTRY_DISABLED) {
+ TkActivateMenuEntry(menuPtr, newItem);
+ }
+ if (mePtr->fontPtr == NULL) {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ menuPtr->fontPtr);
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ mePtr->fontPtr);
+ }
+ Tk_GetFontMetrics(tkfont, &fontMetrics);
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
+ (Drawable) &macMDEFDrawable, &fontMetrics, tkfont,
+ menuRectPtr->left + mePtr->x,
+ globalsPtr->menuTop + mePtr->y,
+ (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
+ menuPtr->totalWidth - mePtr->x : mePtr->width,
+ mePtr->height);
+ }
+
+ tkUseMenuCascadeRgn = 1;
+ MenuSelectEvent(menuPtr);
+ Tcl_ServiceAll();
+ tkUseMenuCascadeRgn = 0;
+ if (mePtr->state != ENTRY_DISABLED) {
+ TkActivateMenuEntry(menuPtr, -1);
+ }
+ *whichItem = newItem + 1;
+ }
+ globalsPtr->menuDisable = ((*menu)->menuID << 16) | (newItem + 1);
+
+ if (scrollDirection == UP_SCROLL) {
+ scrollAmt = menuClipRect.bottom - hitPt.v;
+ if (scrollAmt < menuRectPtr->bottom
+ - globalsPtr->menuBottom) {
+ scrollAmt = menuRectPtr->bottom - globalsPtr->menuBottom;
+ }
+ if (!hasTopScroll && ((globalsPtr->menuTop + scrollAmt)
+ < menuRectPtr->top)) {
+ SetRect(&updateRect, menuRectPtr->left,
+ globalsPtr->menuTop, menuRectPtr->right,
+ globalsPtr->menuTop + SICN_HEIGHT);
+ EraseRect(&updateRect);
+ DrawSICN(SICN_RESOURCE_NUMBER, UP_ARROW,
+ (Drawable) &macMDEFDrawable,
+ menuPtr->textGC, menuRectPtr->left
+ + 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) {
+ Tk_Font menuFont;
+ RgnHandle updateRgn = NewRgn();
+ ScrollRect(&menuClipRect, 0, scrollAmt, updateRgn);
+ updateRect = (*updateRgn)->rgnBBox;
+ DisposeRgn(updateRgn);
+ globalsPtr->menuTop += scrollAmt;
+ globalsPtr->menuBottom += scrollAmt;
+ if (globalsPtr->menuTop == menuRectPtr->top) {
+ updateRect.top -= SICN_HEIGHT;
+ }
+ if (globalsPtr->menuBottom == menuRectPtr->bottom) {
+ updateRect.bottom += SICN_HEIGHT;
+ }
+ ClipRect(&updateRect);
+ EraseRect(&updateRect);
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &fontMetrics);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (globalsPtr->menuTop + mePtr->y + mePtr->height
+ < updateRect.top) {
+ continue;
+ } else if (globalsPtr->menuTop + mePtr->y
+ > updateRect.bottom) {
+ continue;
+ }
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = &fontMetrics;
+ tkfont = menuFont;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
+ (Drawable) &macMDEFDrawable, fmPtr, tkfont,
+ menuRectPtr->left + mePtr->x,
+ globalsPtr->menuTop + mePtr->y,
+ (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
+ menuPtr->totalWidth - mePtr->x : mePtr->width,
+ menuPtr->entries[i]->height);
+ }
+ }
+
+ SetClip(utilRgn);
+ SetEmptyRgn(utilRgn);
+ RGBForeColor(&origForeColor);
+ RGBBackColor(&origBackColor);
+
+ /*
+ * If the menu is a tearoff, and the mouse is outside the menu,
+ * we need to draw the drag rectangle.
+ *
+ * In order for tearoffs to work properly, we need to set
+ * the active member of the containing menubar.
+ */
+
+ menuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ Tk_PathName(menuPtr->tkwin));
+ if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) {
+ char *name;
+ for (parentEntryPtr = menuRefPtr->parentEntryPtr;
+ parentEntryPtr != NULL
+ ; parentEntryPtr = parentEntryPtr->nextCascadePtr) {
+ name = Tcl_GetStringFromObj(parentEntryPtr->namePtr,
+ NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) != 0) {
+ break;
+ }
+ }
+ if (parentEntryPtr != NULL) {
+ TkActivateMenuEntry(parentEntryPtr->menuPtr,
+ parentEntryPtr->index);
+ }
+ }
+
+ if (menuPtr->tearoff) {
+ scratchRect = *menuRectPtr;
+ if (tearoffStruct.menuPtr == NULL) {
+ scratchRect.top -= 10;
+ scratchRect.bottom += 10;
+ scratchRect.left -= 10;
+ scratchRect.right += 10;
+ }
+
+ 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 {
+ int delta;
+ menuRectPtr->top = hitPt.h;
+ if (oldItem >= 0) {
+ menuRectPtr->top -= menuPtr->entries[oldItem]->y;
+ }
+
+ if (menuRectPtr->top < GetMBarHeight()) {
+ /* Displace downward if the menu would stick off the
+ * top of the screen.
+ */
+
+ menuRectPtr->top = GetMBarHeight() + SCREEN_MARGIN;
+ } else {
+ /*
+ * Or upward if the menu sticks off the
+ * bottom end...
+ */
+
+ delta = menuRectPtr->top + menuPtr->totalHeight
+ - maxMenuHeight;
+ if (delta > 0) {
+ menuRectPtr->top -= delta;
+ }
+ }
+ }
+ 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;
+ }
+ globalsPtr->menuTop = *whichItem;
+ globalsPtr->menuBottom = menuRectPtr->bottom;
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppearanceEntryDrawWrapper --
+ *
+ * This routine wraps the TkpDrawMenuEntry function. Under Appearance,
+ * it routes to the Appearance Managers DrawThemeEntry, otherwise it
+ * just goes straight to TkpDrawMenuEntry.
+ *
+ * Results:
+ * A menu entry is drawn
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+AppearanceEntryDrawWrapper(
+ TkMenuEntry *mePtr,
+ Rect *menuRectPtr,
+ TkMenuLowMemGlobals *globalsPtr,
+ Drawable d,
+ Tk_FontMetrics *fmPtr,
+ Tk_Font tkfont,
+ int x,
+ int y,
+ int width,
+ int height)
+{
+ if (TkMacHaveAppearance() > 1) {
+ MenuEntryUserData meData;
+ Rect itemRect;
+ ThemeMenuState theState;
+ ThemeMenuItemType theType;
+
+ meData.mePtr = mePtr;
+ meData.mdefDrawable = d;
+ meData.fmPtr = fmPtr;
+ meData.tkfont = tkfont;
+
+ itemRect.top = y;
+ itemRect.left = x;
+ itemRect.bottom = itemRect.top + height;
+ itemRect.right = itemRect.left + width;
+
+ if (mePtr->state == ENTRY_ACTIVE) {
+ theState = kThemeMenuSelected;
+ } else if (mePtr->state == ENTRY_DISABLED) {
+ theState = kThemeMenuDisabled;
+ } else {
+ theState = kThemeMenuActive;
+ }
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ theType = kThemeMenuItemHierarchical;
+ } else {
+ theType = kThemeMenuItemPlain;
+ }
+
+ DrawThemeMenuItem (menuRectPtr, &itemRect,
+ globalsPtr->menuTop, globalsPtr->menuBottom, theState,
+ theType, tkThemeMenuItemDrawingUPP,
+ (unsigned long) &meData);
+
+ } else {
+ TkpDrawMenuEntry(mePtr, d, tkfont, fmPtr,
+ x, y, width, height, 0, 1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tkThemeMenuItemDrawingProc --
+ *
+ * This routine is called from the Appearance DrawThemeMenuEntry
+ *
+ * Results:
+ * A menu entry is drawn
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+pascal void
+tkThemeMenuItemDrawingProc (
+ const Rect *inBounds,
+ SInt16 inDepth,
+ Boolean inIsColorDevice,
+ SInt32 inUserData)
+{
+ MenuEntryUserData *meData = (MenuEntryUserData *) inUserData;
+
+ TkpDrawMenuEntry(meData->mePtr, meData->mdefDrawable,
+ meData->tkfont, meData->fmPtr, inBounds->left,
+ inBounds->top, inBounds->right - inBounds->left,
+ inBounds->bottom - inBounds->top, 0, 1);
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacHandleTearoffMenu() --
+ *
+ * This routine sees if the MDEF has set a menu and a mouse position
+ * for tearing off and makes a tearoff menu if it has.
+ *
+ * Results:
+ * menuPtr->interp will have the result of the tearoff command.
+ *
+ * Side effects:
+ * A new tearoff menu is created if it is supposed to be.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacHandleTearoffMenu(void)
+{
+ if (tearoffStruct.menuPtr != NULL) {
+ Tcl_DString tearoffCmdStr;
+ char intString[TCL_INTEGER_SPACE];
+ short windowPart;
+ WindowRef whichWindow;
+
+ windowPart = FindWindow(tearoffStruct.point, &whichWindow);
+
+ if (windowPart != inMenuBar) {
+ Tcl_DStringInit(&tearoffCmdStr);
+ Tcl_DStringAppendElement(&tearoffCmdStr, "tk::TearOffMenu");
+ 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;
+ Tk_3DBorder border;
+
+ if ((menuPtr->menuType != MASTER_MENU) || (FixMDEF() != NULL)) {
+ return;
+ }
+
+ margin = (fmPtr->ascent + fmPtr->descent)/2;
+ points[0].x = x;
+ points[0].y = y + height/2;
+ points[1].y = points[0].y;
+ segmentWidth = 6;
+ maxX = width - 1;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+
+ while (points[0].x < maxX) {
+ points[1].x = points[0].x + segmentWidth;
+ if (points[1].x > maxX) {
+ points[1].x = maxX;
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+ points[0].x += 2*segmentWidth;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ TkMenu *menuPtr = mePtr->menuPtr;
+ int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
+ GC indicatorGC;
+ Tk_3DBorder bgBorder, activeBorder;
+ const Tk_FontMetrics *fmPtr;
+ Tk_FontMetrics entryMetrics;
+ 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 == ENTRY_ACTIVE) && !strictMotif) {
+ gc = mePtr->activeGC;
+ if (gc == NULL) {
+ gc = menuPtr->activeGC;
+ }
+ } else {
+ TkMenuEntry *cascadeEntryPtr;
+ int parentDisabled = 0;
+
+ for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ char *name = (cascadeEntryPtr->namePtr == NULL) ? ""
+ : Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL);
+
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
+ if (cascadeEntryPtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
+ gc = mePtr->disabledGC;
+ if (gc == NULL) {
+ gc = menuPtr->disabledGC;
+ }
+ } else {
+ gc = mePtr->textGC;
+ if (gc == NULL) {
+ gc = menuPtr->textGC;
+ }
+ }
+ }
+
+ indicatorGC = mePtr->indicatorGC;
+ if (indicatorGC == NULL) {
+ indicatorGC = menuPtr->indicatorGC;
+ }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL)
+ ? menuPtr->borderPtr : mePtr->borderPtr);
+ if (strictMotif) {
+ activeBorder = bgBorder;
+ } else {
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL)
+ ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
+ }
+
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = menuMetricsPtr;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ /*
+ * Need to draw the entire background, including padding. On Unix,
+ * for menubars, we have to draw the rest of the entry taking
+ * 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, menuFont;
+ Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
+ int x, y, height, modifierWidth, labelWidth, indicatorSpace;
+ int windowWidth, windowHeight, accelWidth, maxAccelTextWidth;
+ int i, j, lastColumnBreak, maxModifierWidth, maxWidth, nonAccelMargin;
+ int maxNonAccelMargin, maxEntryWithAccelWidth, maxEntryWithoutAccelWidth;
+ int entryWidth, maxIndicatorSpace, borderWidth, activeBorderWidth;
+ TkMenuEntry *mePtr, *columnEntryPtr;
+ EntryGeometry *geometryPtr;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ x = y = borderWidth;
+ indicatorSpace = labelWidth = accelWidth = maxAccelTextWidth = 0;
+ windowHeight = windowWidth = maxWidth = lastColumnBreak = 0;
+ maxModifierWidth = nonAccelMargin = maxNonAccelMargin = 0;
+ maxEntryWithAccelWidth = maxEntryWithoutAccelWidth = 0;
+ maxIndicatorSpace = 0;
+
+ /*
+ * On the Mac especially, getting font metrics can be quite slow,
+ * so we want to do it intelligently. We are going to precalculate
+ * them and pass them down to all of the measuring and drawing
+ * routines. We will measure the font metrics of the menu once.
+ * If an entry does not have its own font set, then we give
+ * the geometry/drawing routines the menu's font and metrics.
+ * If an entry has its own font, we will measure that font and
+ * give all of the geometry/drawing the entry's font and metrics.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mePtr->fontPtr == NULL) {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ if ((i > 0) && mePtr->columnBreak) {
+ if (maxIndicatorSpace != 0) {
+ maxIndicatorSpace += 2;
+ }
+ for (j = lastColumnBreak; j < i; j++) {
+ columnEntryPtr = menuPtr->entries[j];
+ geometryPtr =
+ (EntryGeometry *) columnEntryPtr->platformEntryData;
+
+ columnEntryPtr->indicatorSpace = maxIndicatorSpace;
+ columnEntryPtr->width = maxIndicatorSpace + maxWidth
+ + 2 * activeBorderWidth;
+ geometryPtr->accelTextWidth = maxAccelTextWidth;
+ geometryPtr->modifierWidth = maxModifierWidth;
+ columnEntryPtr->x = x;
+ columnEntryPtr->entryFlags &= ~ENTRY_LAST_COLUMN;
+ if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
+ geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
+ - maxEntryWithAccelWidth;
+ if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
+ geometryPtr->nonAccelMargin = maxNonAccelMargin;
+ }
+ } else {
+ geometryPtr->nonAccelMargin = 0;
+ }
+ }
+ x += maxIndicatorSpace + maxWidth + 2 * borderWidth;
+ windowWidth = x;
+ maxWidth = maxIndicatorSpace = maxAccelTextWidth = 0;
+ maxModifierWidth = maxNonAccelMargin = maxEntryWithAccelWidth = 0;
+ maxEntryWithoutAccelWidth = 0;
+ lastColumnBreak = i;
+ y = borderWidth;
+ }
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &entryWidth, &height);
+ mePtr->height = height;
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ GetTearoffEntryGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &entryWidth, &height);
+ mePtr->height = height;
+ } else {
+ /*
+ * For each entry, compute the height required by that
+ * particular entry, plus three widths: the width of the
+ * label, the width to allow for an indicator to be displayed
+ * to the left of the label (if any), and the width of the
+ * accelerator to be displayed to the right of the label
+ * (if any). These sizes depend, of course, on the type
+ * of the entry.
+ */
+
+ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &labelWidth,
+ &height);
+ mePtr->height = height;
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr,
+ &modifierWidth, &accelWidth, &height);
+ nonAccelMargin = 0;
+ } else if (mePtr->accelLength == 0) {
+ nonAccelMargin = mePtr->hideMargin ? 0
+ : Tk_TextWidth(tkfont, "m", 1);
+ accelWidth = modifierWidth = 0;
+ } else {
+ labelWidth += Tk_TextWidth(tkfont, "m", 1);
+ GetMenuAccelGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &modifierWidth, &accelWidth, &height);
+ if (height > mePtr->height) {
+ mePtr->height = height;
+ }
+ 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 * activeBorderWidth;
+ }
+ mePtr->y = y;
+ y += menuPtr->entries[i]->height + borderWidth;
+ if (y > windowHeight) {
+ windowHeight = y;
+ }
+ }
+
+ for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
+ columnEntryPtr = menuPtr->entries[j];
+ geometryPtr = (EntryGeometry *) columnEntryPtr->platformEntryData;
+
+ columnEntryPtr->indicatorSpace = maxIndicatorSpace;
+ columnEntryPtr->width = maxIndicatorSpace + maxWidth
+ + 2 * activeBorderWidth;
+ geometryPtr->accelTextWidth = maxAccelTextWidth;
+ geometryPtr->modifierWidth = maxModifierWidth;
+ columnEntryPtr->x = x;
+ columnEntryPtr->entryFlags |= ENTRY_LAST_COLUMN;
+ if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
+ geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
+ - maxEntryWithAccelWidth;
+ if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
+ geometryPtr->nonAccelMargin = maxNonAccelMargin;
+ }
+ } else {
+ geometryPtr->nonAccelMargin = 0;
+ }
+ }
+ windowWidth = x + maxIndicatorSpace + maxWidth
+ + 2 * activeBorderWidth + borderWidth;
+ windowHeight += borderWidth;
+
+ /*
+ * The X server doesn't like zero dimensions, so round up to at least
+ * 1 (a zero-sized menu should never really occur, anyway).
+ */
+
+ if (windowWidth <= 0) {
+ 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 indicatorSpace = mePtr->indicatorSpace;
+ int leftEdge = x + indicatorSpace;
+ int imageHeight, imageWidth;
+ int textHeight, textWidth;
+ int haveImage = 0, haveText = 0;
+ int imageXOffset = 0, imageYOffset = 0;
+ int textXOffset = 0, textYOffset = 0;
+
+ /*
+ * Work out what we will need to draw first.
+ */
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight);
+ haveImage = 1;
+ }
+ if (!haveImage || (mePtr->compound != COMPOUND_NONE)) {
+ if (mePtr->labelLength > 0) {
+ Tcl_DString itemTextDString;
+ textHeight = fmPtr->linespace;
+ GetEntryText(mePtr, &itemTextDString);
+ textWidth = Tk_TextWidth(tkfont,
+ Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString));
+ Tcl_DStringFree(&itemTextDString);
+ haveText = 1;
+ }
+ }
+
+ /*
+ * Now work out what the relative positions are.
+ */
+
+ if (haveImage && haveText) {
+ int fullWidth = (imageWidth > textWidth ? imageWidth : textWidth);
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = imageHeight/2 + 2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = -textHeight/2;
+ break;
+ }
+ case COMPOUND_BOTTOM: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = -imageHeight/2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = textHeight/2 + 2;
+ break;
+ }
+ case COMPOUND_LEFT: {
+ textXOffset = imageWidth + 2;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_RIGHT: {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = textWidth + 2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = 0;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ }
+
+ /*
+ * Draw label and/or bitmap or image for entry.
+ */
+
+ 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 + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ } else {
+ Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
+ imageHeight, d, leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ }
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0,
+ (unsigned) imageWidth, (unsigned) imageHeight,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset), 1);
+ }
+ if ((mePtr->compound != COMPOUND_NONE) || !haveImage) {
+ if (mePtr->labelLength > 0) {
+ Tcl_DString itemTextDString, convertedTextDString;
+ int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+
+ GetEntryText(mePtr, &itemTextDString);
+
+ /* Somehow DrawChars is changing the colors, it is odd, since
+ it works for the Apple Platinum Appearance, but not for
+ some Kaleidoscope Themes... Untill I can figure out what
+ exactly is going on, this will have to do: */
+
+ TkMacSetUpGraphicsPort(gc);
+ MoveTo((short) leftEdge + textXOffset,
+ (short) baseline + textYOffset);
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString), &convertedTextDString);
+ DrawText(Tcl_DStringValue(&convertedTextDString), 0,
+ Tcl_DStringLength(&convertedTextDString));
+
+ /* Tk_DrawChars(menuPtr->display, d, gc,
+ tkfont, Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString),
+ leftEdge, baseline); */
+
+ Tcl_DStringFree(&itemTextDString);
+ }
+ }
+
+ if (mePtr->state == ENTRY_DISABLED) {
+ if (menuPtr->disabledFgPtr == NULL) {
+ if (!TkMacHaveAppearance()) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
+ (unsigned) width, (unsigned) height);
+ }
+ } else if ((mePtr->image != NULL)
+ && (menuPtr->disabledImageGC != None)) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
+ (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 == ENTRY_ACTIVE)
+ && (mePtr->activeBorderPtr != None))
+ || ((mePtr->state != ENTRY_ACTIVE) && (mePtr->borderPtr != None))) {
+ if (mePtr->state == ENTRY_ACTIVE) {
+ 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;
+ int haveImage = 0, haveText = 0;
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
+ haveImage = 1;
+ } else {
+ *heightPtr = 0;
+ *widthPtr = 0;
+ }
+
+ if (haveImage && (mePtr->compound == COMPOUND_NONE)) {
+ /* We don't care about the text in this case */
+ } else {
+ /* Either it is compound or we don't have an image */
+ if (mePtr->labelPtr != NULL) {
+ Tcl_DString itemTextDString;
+ int textWidth;
+ GetEntryText(mePtr, &itemTextDString);
+ textWidth = Tk_TextWidth(tkfont,
+ Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString));
+ Tcl_DStringFree(&itemTextDString);
+
+ if ((mePtr->compound != COMPOUND_NONE) && haveImage) {
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ /* Add text and padding */
+ *heightPtr += fmPtr->linespace + 2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ /* Add text and padding */
+ *widthPtr += textWidth + 2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ /* We don't have an image or we're not compound */
+ *heightPtr = fmPtr->linespace;
+ *widthPtr = textWidth;
+ }
+ } else {
+ /* An empty entry still has this height */
+ *heightPtr = fmPtr->linespace;
+ }
+ }
+ *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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#if __MWERKS__ != 0x2400
+#define MDEF_PROC_OFFSET 0x24
+#else
+#define MDEF_PROC_OFFSET 0x20
+#endif
+
+static Handle
+FixMDEF(void)
+{
+#if 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)) + MDEF_PROC_OFFSET), &menuDefProc, 4);
+ return MDEFHandle;
+ } else {
+ return NULL;
+ }
+#else
+ return NULL;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuInit --
+ *
+ * Initializes Mac-specific menu data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates a hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuInit(void)
+{
+ lastMenuID = 256;
+ Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
+ currentMenuBarOwner = NULL;
+ tearoffStruct.menuPtr = NULL;
+ currentAppleMenuID = 0;
+ currentHelpMenuID = 0;
+ currentMenuBarInterp = NULL;
+ currentMenuBarName = NULL;
+ windowListPtr = NULL;
+
+ /*
+ * Get the GC that we will use as the sign to the font
+ * routines that they should not muck with the foreground color...
+ */
+
+ if (TkMacHaveAppearance() > 1) {
+ XGCValues tmpValues;
+ TkColor *tmpColorPtr;
+
+ tmpColorPtr = TkpGetColor(NULL, "systemAppearanceColor");
+ tmpValues.foreground = tmpColorPtr->color.pixel;
+ tmpValues.background = tmpColorPtr->color.pixel;
+ ckfree((char *) tmpColorPtr);
+
+ tkThemeMenuItemDrawingUPP = NewMenuItemDrawingProc(tkThemeMenuItemDrawingProc);
+ }
+ FixMDEF();
+
+ Tcl_ExternalToUtf(NULL, NULL, "\311", /* Š */
+ -1, 0, NULL, elipsisString,
+ TCL_UTF_MAX + 1, NULL, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuThreadInit --
+ *
+ * Does platform-specific initialization of thread-specific
+ * menu state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuThreadInit()
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPreprocessMacMenu --
+ *
+ * Handle preprocessing of menubar if it exists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All post commands for the current menubar get executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacPreprocessMenu()
+{
+ TkMenuReferences *mbRefPtr;
+ int code;
+
+ if ((currentMenuBarName != NULL) && (currentMenuBarInterp != NULL)) {
+ mbRefPtr = TkFindMenuReferences(currentMenuBarInterp,
+ currentMenuBarName);
+ if ((mbRefPtr != NULL) && (mbRefPtr->menuPtr != NULL)) {
+ Tcl_Preserve((ClientData)currentMenuBarInterp);
+ code = TkPreprocessMenu(mbRefPtr->menuPtr->masterMenuPtr);
+ if ((code != TCL_OK) && (code != TCL_CONTINUE)
+ && (code != TCL_BREAK)) {
+ Tcl_AddErrorInfo(currentMenuBarInterp,
+ "\n (menu preprocess)");
+ Tcl_BackgroundError(currentMenuBarInterp);
+ }
+ Tcl_Release((ClientData)currentMenuBarInterp);
+ }
+ }
+}
diff --git a/tcl/mac/tkMacMenu.r b/tcl/mac/tkMacMenu.r
new file mode 100644
index 00000000000..feb3a5f05ee
--- /dev/null
+++ b/tcl/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/tcl/mac/tkMacMenubutton.c b/tcl/mac/tkMacMenubutton.c
new file mode 100644
index 00000000000..75396fc6952
--- /dev/null
+++ b/tcl/mac/tkMacMenubutton.c
@@ -0,0 +1,483 @@
+/*
+ * 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.
+ */
+
+Tk_ClassProcs tkpMenubuttonClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkMenuButtonWorldChanged, /* worldChangedProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, fullWidth, fullHeight;
+ int imageXOffset, imageYOffset, textXOffset, textYOffset;
+ int haveImage = 0, haveText = 0;
+ 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 == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) {
+ gc = mbPtr->disabledGC;
+ } else if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
+ gc = mbPtr->activeTextGC;
+ } else {
+ gc = mbPtr->normalTextGC;
+ }
+ border = mbPtr->normalBorder;
+
+ if (mbPtr->image != None) {
+ Tk_SizeOfImage(mbPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+ haveText = (mbPtr->textWidth != 0 && mbPtr->textHeight != 0);
+
+ /*
+ * 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);
+
+ imageXOffset = 0;
+ imageYOffset = 0;
+ textXOffset = 0;
+ textYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) mbPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (mbPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + mbPtr->padY;
+ } else {
+ imageYOffset = mbPtr->textHeight + mbPtr->padY;
+ }
+ fullHeight = height + mbPtr->textHeight + mbPtr->padY;
+ fullWidth = (width > mbPtr->textWidth ? width :
+ mbPtr->textWidth);
+ textXOffset = (fullWidth - mbPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ if (mbPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + mbPtr->padX;
+ } else {
+ imageXOffset = mbPtr->textWidth + mbPtr->padX;
+ }
+ fullWidth = mbPtr->textWidth + mbPtr->padX + width;
+ fullHeight = (height > mbPtr->textHeight ? height :
+ mbPtr->textHeight);
+ textYOffset = (fullHeight - mbPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ fullWidth = (width > mbPtr->textWidth ? width :
+ mbPtr->textWidth);
+ fullHeight = (height > mbPtr->textHeight ? height :
+ mbPtr->textHeight);
+ textXOffset = (fullWidth - mbPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - mbPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+
+
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ mbPtr->indicatorWidth + fullWidth, fullHeight,
+ &x, &y);
+
+ if (mbPtr->image != NULL) {
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height, Tk_WindowId(tkwin),
+ x + imageXOffset, y + imageYOffset);
+ }
+ if (mbPtr->bitmap != None) {
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, Tk_WindowId(tkwin),
+ gc, 0, 0, (unsigned) width, (unsigned) height,
+ x + imageXOffset, y + imageYOffset, 1);
+ }
+ if (haveText) {
+ Tk_DrawTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc,
+ mbPtr->textLayout, x + textXOffset, y + textYOffset ,
+ 0, -1);
+ Tk_UnderlineTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc,
+ mbPtr->textLayout, x + textXOffset, y + textYOffset ,
+ mbPtr->underline);
+ }
+ } else {
+ if (mbPtr->image != NULL) {
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height, Tk_WindowId(tkwin),
+ x + imageXOffset, y + imageYOffset);
+ } else if (mbPtr->bitmap != None) {
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, Tk_WindowId(tkwin),
+ gc, 0, 0, (unsigned) width, (unsigned) height,
+ x + imageXOffset, y + imageYOffset, 1);
+ } 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 + textXOffset, y + textYOffset,
+ 0, -1);
+ Tk_UnderlineTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc,
+ mbPtr->textLayout, x + textXOffset, y + textYOffset ,
+ mbPtr->underline);
+ }
+ }
+
+#if 0 /* this is the original code */
+ /*
+ * 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);
+ }
+#endif
+
+ /*
+ * If the menu button is disabled with a stipple rather than a special
+ * foreground color, generate the stippled effect.
+ */
+
+ if ((mbPtr->state == STATE_DISABLED)
+ && ((mbPtr->disabledFg != NULL) || (mbPtr->image != NULL))) {
+ XFillRectangle(mbPtr->display, Tk_WindowId(tkwin),
+ mbPtr->disabledGC, mbPtr->inset, mbPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset));
+ }
+
+ /*
+ * Draw the cascade indicator for the menu button on the
+ * right side of the window, if desired.
+ */
+
+ 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->highlightWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(mbPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ if (mbPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(mbPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, mbPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, 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=0, height=0, textwidth=0, textheight=0, mm, pixels, noimage=0;
+
+ 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 {
+ noimage=1;
+ }
+
+ if ( noimage || mbPtr->compound != COMPOUND_NONE ) {
+ Tk_FreeTextLayout(mbPtr->textLayout);
+ mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->text,
+ -1, mbPtr->wrapLength, mbPtr->justify, 0, &mbPtr->textWidth,
+ &mbPtr->textHeight);
+ textwidth = mbPtr->textWidth;
+ textheight = mbPtr->textHeight;
+ if (mbPtr->width > 0) {
+ textwidth = mbPtr->width * Tk_TextWidth(mbPtr->tkfont, "0", 1);
+ }
+ if (mbPtr->height > 0) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(mbPtr->tkfont, &fm);
+ textheight = mbPtr->height * fm.linespace;
+ }
+ textwidth += 2*mbPtr->padX;
+ textheight += 2*mbPtr->padY;
+ }
+
+ switch ((enum compound) mbPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ height += textheight + mbPtr->padY;
+ width = (width > textwidth ? width : textwidth);
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ height = (height > textheight ? height : textheight);
+ width += textwidth + mbPtr->padX;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ height = (height > textheight ? height : textheight);
+ width = (width > textwidth ? width : textwidth);
+ break;
+ }
+ case COMPOUND_NONE: {
+ if (noimage) {
+ height = textheight;
+ width = textwidth;
+ }
+ break;
+ }
+ }
+
+ 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/tcl/mac/tkMacMenus.c b/tcl/mac/tkMacMenus.c
new file mode 100644
index 00000000000..83209c6a1a5
--- /dev/null
+++ b/tcl/mac/tkMacMenus.c
@@ -0,0 +1,355 @@
+/*
+ * 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" /* Needed for FSpLocationFromPath */
+#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;
+ TkDisplay *dispPtr;
+
+ 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:
+ GetMenuItemText(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 */
+ if (TkMacHaveAppearance() >= 0x110) {
+ window = TkMacGetXWindow(FrontNonFloatingWindow());
+ } else {
+ window = TkMacGetXWindow(FrontWindow());
+ }
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ TkGenWMDestroyEvent(tkwin);
+ break;
+ case kQuitItem:
+ /* Exit */
+ if (optionKeyPressed || gInterp == NULL) {
+ Tcl_Exit(0);
+ } else {
+ 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(-");
+ AppendResMenu(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;
+ TkDisplay *dispPtr;
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ window = TkMacGetXWindow(FrontNonFloatingWindow());
+ } else {
+ window = TkMacGetXWindow(FrontWindow());
+ }
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
+ if (tkwin == NULL) {
+ return;
+ }
+
+ event.type = VirtualEvent;
+ event.serial = Tk_Display(tkwin)->request;
+ 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()
+{
+ int result;
+ CONST char *path;
+ char openCmd[] = "tk_getOpenFile -filetypes {\
+ {{TCL Scripts} {.tcl} TEXT} {{Text Files} {} TEXT}}";
+
+ if (gInterp == NULL) {
+ return;
+ }
+
+ if (Tcl_Eval(gInterp, openCmd) != TCL_OK) {
+ return;
+ }
+
+ path = Tcl_GetStringResult(gInterp);
+
+ if (strlen(path) == 0) {
+ return;
+ }
+
+ result = Tcl_EvalFile(gInterp, path);
+ if (result == TCL_ERROR) {
+ Tcl_BackgroundError(gInterp);
+ }
+}
diff --git a/tcl/mac/tkMacPort.h b/tcl/mac/tkMacPort.h
new file mode 100644
index 00000000000..024dc8223c5
--- /dev/null
+++ b/tcl/mac/tkMacPort.h
@@ -0,0 +1,162 @@
+/*
+ * tkMacPort.h --
+ *
+ * This file is included by all of the Tk C files. It contains
+ * information that may be configuration-dependent, such as
+ * #includes for system include files and a few other things.
+ *
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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>
+#include "tkIntXlibDecls.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.
+ */
+
+#ifndef panic /* In a stubs-aware setting, this could confuse the #define */
+EXTERN void panic _ANSI_ARGS_(TCL_VARARGS(char *, string));
+#endif
+#ifndef strcasecmp
+EXTERN int strcasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2));
+#endif
+#ifndef strncasecmp
+EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2, size_t n));
+#endif
+/*
+ * 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 them out.
+ */
+
+#define TkFreeWindowId(dispPtr,w)
+#define TkInitXId(dispPtr)
+#define TkpButtonSetDefaults(specPtr) {}
+#define TkpCmapStressed(tkwin,colormap) (0)
+#define TkpFreeColor(tkColPtr)
+#define TkSetPixmapColormap(p,c) {}
+#define TkpSync(display)
+
+/*
+ * The following macro returns the pixel value that corresponds to the
+ * RGB values in the given XColor structure.
+ */
+
+#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.
+ * This should perhaps use the real size of an XID.
+ */
+
+#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),(int *)(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
+
+/*
+ * The following declaration is used to get access to a private Tcl interface
+ * that is needed for portability reasons.
+ */
+
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
+
+#endif /* _TKMACPORT */
diff --git a/tcl/mac/tkMacProjects.sea.hqx b/tcl/mac/tkMacProjects.sea.hqx
new file mode 100644
index 00000000000..209db471743
--- /dev/null
+++ b/tcl/mac/tkMacProjects.sea.hqx
@@ -0,0 +1,3755 @@
+(This file must be converted with BinHex 4.0)
+:%A4V6@&M8(*[DQ9MG(-ZFf9K!%&38%aKGA0d)3!!!55`!!'FbmEa8h4eCQC*G#!
+SBbNa16Nh,6)`-$%J3@aKC'4TEL"6HA0dC@ec,#"*EQ-Z,#"SG(4`1Lm[Gj!$,Q&
+XB@4ND@jcHA-ZBfpY,e0dG@CQ5A3[$3SD!!83!!%NX!#3!h)!!3#3!h*$LJfPT9*
+PFf9bGQ9NTD8!TC!%!3!!1!"%Y[&1mlEa6e`!N!d)([`!N!21!#T5+!!")q)!!Ld
+q)%*eD@aN!!#6j`"h!!-"K3)M!F$rN!3$([rirr$,4!!!J!#3"k@3"!%!!$8!4,3
+GFA1ieiZ4!*!$FJ!")jN!N!0b!!A&[!!!!5F!+P"#!!%LFJ!',6iJG'X!!&%D!(d
+!%!(C!IS"`2q3"!)HrrMrm-Y!!!#!!*!(TC!%!3!!1J#!Y+(T3,G0'[)!N!21!!!
+0p`#3!mi!#TmI!!#ULJ!!$()!N!32!&4VAde%48BZci!!!%#b68e3FN0A588"!2q
+3"!#3#S"`!*!'3X(8V`#MIfe6h,C[6F[BU8PkVQmm&A9!cS#KIR"DLBeM9H,PPS9
+d$9l$pX31ecFM`r`D9A%EPU'2`AfrXQc3kZLVbRrdF`ZFFdJTQa6FP4TP[+DkdKd
+$UL5rmEZA21frG`99bH&Rc3X-)&5'bmT3#bhE*GM,D2h8md6[acq`JM[fj)P2i,b
+Y9q)BrZ)45'D(mZBINfb*PEL)kXC15Kp82)Z+R-6-jSbG'A-$6RfjrM#H1rHJCSe
+1j(-'6DT5f06B4Vm$i0PlE02VVDF&!LJh3&Sd9X*IL,`M,S$%&3!R14*QPjmC2V+
+m2*P29-k0@f9H$S,11pmb9fIRC04*pH!2-@"KccLRSaH4,+4akTVqJI1S"PjAcPV
+0bIaF`3)KVU!82phDS5TPm+A8Q%X60rCDlEV-FFe!(*@qJqT)kNSc&J%4HBC[cD5
+Vr)rTBlQE$ebD(mj&pSj0U,CN+EVk,Z6p@HH16KJ0hZi&!kjeL#6T#aPmcX`3Y+6
+58Z*[I5@`QYfrLE&m&qY9$hK4!)mj`hf0,d-)ie'bEXSLlc1Y)NRqF"TrMPUl%(r
+AHkhjeZ'&EZ2dA3R[%c%3PGfjAUP0G2"i'@C$U*Ic[QXZK"JSp8bMk1[$JXNi0""
+cDX*5%bQI,D1dPb`Ck-D98a$T@*rK$(Q6(6EMa`3(m96#MAGDTF--MKp0'hVr19!
+ZI!4-(ae#[H8MJDIAr'bKe'D#dmkNrJXr`(@EJ6MD6ZAHddVS`b*a"4#XXVSX9CD
+Z(['rf0c9bH2VP%%Y*lQY'b(jMJl4Gc8"L9KLJK`,B5k`J&DPNE*DXaY#k!kbj@H
+k66eAAkIG`@@JVC-Hc&Q&l'MKiT'R92,*G%Y&NfYrR*kD1$EJKBHZCS$S85YG',h
+b8KS#'8+QilL&1XNF*b"9-jH'bfmMYfamFTc542UAX)!ST@!`3-bBS6blR80FNMV
+#,LkDp(N'bDX9CKU@L0ZmNTUD#h'SfElJIEcBkF9c(QdZ@CQ9Fki,+@,AN!#XY+!
+T14FHXHKa"N%#p@9,6Db2La"Dl@J,)'lA,'im%S@KYNR02k)"G!2[#JcSfbd8,"L
+"h4[D$FRV&A"N%UT"l2j0i',-iB+EapaR&p#,l!@MI1d[E2XKK5@#P$(j,b+!RZI
+Eej+'!d#+JZV@$`,GN!!@H1mS@-PU&[p9h61Q%VR$,HB)&hX9DShiq@%Cf`6@1+M
+C*Cd#qKD-"*hiV[$plpikJ"2d4fH*f+V0VHPc-Y1`E)Z*!Tl8dlDkb62Se8dJLqp
+"3V8A4&G%b'c*fQ&q"bU5m'4JFD14D,R5k8'k#e(`ZhX@JCb9pYXIRF$U9JdV5e6
+F))XC*rZIG5)i3eXlXLchH+-1(i-H66q*jim$@@(CF22+dK6UFkPVi0VfIUaaViR
+J5MYYdr%d&4F`5cVU2lYm*)ZrjN'dA@1pUZF!L!XiZcqGI"JX&V1@AXlC[dLR3Na
+Xf4N'!2[8q*X1qJM1hFBU6SYSPKbN%'ZN-KfC2m"hDBN05hH3!2FcQe+(SYX6[cf
+l6PCTdeJVQQb84!Nl1"GE-Ym85"Q4KLUmhHSA@0L'%Di`p$f6,I[R`P#$3U3IZqj
+KBcTe5f#b2$CUa4f0QSR$fN4*hC5D$3VXXRGe%RN`mA#A*lQ5K44I$H@*'cNMd8!
+23F"$5J4D,SYqJB4*-YV'rpb$6Nh64@`i)RDE9Ieer59VU)$BA#%!SlFd"PFNY1(
+ie[$kGB"V-!FD[02GAYbJQ*J6NA+m'48"U,IEEZ0T+P2F&NSh*B(-S6k9$m%iY(j
+8LVTMMSFE$lc)9(LG5Z9Z%"C0mFL[d!m*19lF%54bIDf`deAZkL0#+,1[KSpBK9T
+i*-kK0*NRe'LlTDE`34LeIdHT0IQ,LK"jY&dd1JDGR8QpPUp+2i3YXN8JdrKkG2P
+UAde4N5p9"d`1FQ+q,X@qd,erqe33I3XSpr"N5)rRJ1M6AY%*fNc1p!Q`QGT)rc'
+Hp6TrL%,F@4Paq3I2Ee6AK*mT+mCMG+@p98MR-U,M`raQIdp("*(8bJ0amqV,qF9
+[2&!adUa)d,V'2TqmBC&!e'8K3CP)+-i#YV3jCmTr8k&,[GakD'$KqI)E!"clSd)
+",d)er(VYBT*)+fF'0[bq#R8e@)aGlprLGZQJ$C4XrfY!QmhCS2MF-0Bcl`-V$9H
+p9$G6fA&0-"i*E%4m6'i+Fmp29N`K5#m4r!Xa1&TLA6PZR&UAcHkYFjk%2GiqJT[
+M+XBB[q*U)Ik*BY&(NM*5Kjbq@r)#[3+,ZZ+Z6iR6E,HSBQJZ&!1CXmeU3kY0T+2
+3#22B)#BPN!$QQ3V(JN#d[P-T!kke&*hLkm`54)*Vr$,&&PmcD1eI+AJb56*h$)@
+9L,dl)*2kHjfZb2P#T`B4c3HFDG+L"&`BQ-cQ@)'2)TG%Gj0JT"L)*#dJ4RXA64F
+*m[,eIIrdDdT8IT6T4C+U!+e3IFGjU965@RZAbRU58C!![a0ZfE+3!!I@TrdhM6!
+ie",%ieflZ"*Z16I*-$fJiVqSaZl3VeIh5K[2###Cj+$ALj,G3e`'(AdJ18MSU!H
+QRqJTiNLAaPPpqZ!NEY1Cd+NGiHE'&ip-Cap"mfb)c-'R"(50VjjU(B*VATqX8KD
+`N!!1FB+UCq$@&6+FLbMLK9`ch+C*l#DBQJ0M9VRfP+*FSeF&DMdjXDr3mLUcJ0K
+IV5VrPY&e*d2pF#*b$fRIc'[5b,pmMlijArmjd)l4+)AlJ3BQ%439K58RCNM8M[*
+KN!!AYC3jINkY1+%eqc41HpdN3NjbG("$U2'NBRV@2ZbSfHcm`AZ8`BDl3k4'9+C
+)GUrYTU$p)'R-#C'ZGEL&bT0M`"$F6jP)fUjZ*drD`F3ff*[1rEcm4a2pD%$M!#H
+XB)SDJbL($XP%4STHp&5K(T0BYSL*KVd%DGcqD,k&rI`'1NH)UiYP(M`B@lT'Z3)
+mQ@SlU-C,ja@GDcS-9rkCU51-FF9,e)QlBA9X$H-RFYBrN!#E%lZ)pTN+EdQ4EVq
+d-`SAlDX8Q+Xp-$C#cP%'a%)c)FjKb)0-i$bLI6k!)6,G[,NU,#IbfVlK'@*C@Pi
+V%D-$Gr`TG20(Rc4Di%S`h,8qi'fZ&@%b)(ci!d)m6K4C[IK-9CjT9qjU,NNCZ45
+UMP$%[eL@9-R0mk22hJM)rD#4(PK%$DBrpb-q&q'#44'`J*YMYI6Q82Rh#pVbrdI
+V8jq%b[%L-TY,P55&Cbp('DD6!')I5UEF!d*TVb)SfQCN6[(Zp*(fmMQ(@UC9jlr
+$-0EE185CTUJA1l(alHPUNYDNHc-01%N%$"a%%pViUIeGT`j,2R)FeMaR$"6LQMj
+c0q3BIl`b)0eL*eXUeV*HpZ&'UqXN)SHL2'caNXB9mq@'[pZ2r)9BRL%r3XpC@L4
+GVFlBr+h,RUb5Zi*PGE(G68+)@NjqDShF,(9A*Qcm(hP86jL9b0$DZVqld$SILM8
+EAUVj31,1fmD'GX&Q"`V@+GJM$DpAGTH%&R`i1S+"+EG$k@K!Q"aTAeQZ(!9pi@m
+m*F69b1T%eCH-99krb5)-+cN1$ll#NQh-lUKc)UZYIRNNCNad,bfJ,JKr)U6B+,J
+N'eYDSYNR$bDJXe,V1FmfZpl3D2lH`[Na,R-)F6L'fqQaI+qJ0ICifSXh#S1YBBQ
+a6h1HDfN2bV-(YZih66f,d`ZRbT!!r'3+*qLbSm!@0[&ji!-h9lk58-rSH$CQZF"
+ABL0+bQ*US5ha"Ba#16GEKE)IX@6Rd[S%ED,hZ2,-@'V%l3Y@UVI"5R#"dX"jIll
+-)9XEM&D!`#1iRqirEcT*9`A$QSrX"[Vfa!liiG%d"U,1jY9ZqKD'fRiPDmr2i9G
+)dlbb918k36MKbJ)P)f9m6J3dkkEH(bkL'@Xr#cb+P*ALhCe*1,M,r`1-R!C[XB2
+6l1YUK03!D@Z!@Y)pr63UXl%@G08dUffKLUY"m$VZ#j,h-Cd+-AfXkPj2QJG@(r+
+EZD"SH[EjNAdRZT&k+a!rp+$riFU2C62(3TUJ1dNKSDKGLd#MR(4)q0+E-XEK"c,
+3+h&!k`ah+A6L8LUK6c"6e,MYh*@pYAp@f3cH5`VEQHHFQH#C"'(&Z%!JM''$KNB
+(!'eMRm(f8YCA1"Q-GU-bkA9F$qI@MrR(ZQD6-TDaC%a*e+,PTB#Z4P3DephTcqJ
++YN5+2f'Uc9'FT&Eh(+*@XMR$4`iV49$paR-B"[LFVjRm-P9B`PGLqNP#c`iqK!i
+GqcI9pcj&T65V-5U`ZrpQ1Kj@*!dXf*NrD5kX1hidjf)Ce33!!+@3"!%!!$i!%,J
+Mh!Hi)p`(!!!"*`!!(DB!N!21!!jeF`!!m%d!!!p0!*!%$`"8Dep04%9',Xq!,RK
+YE!!!Fm&849K83eG*43%!rj!%!*!+J!#3"d,"e1NPL5MYp5pUM%kH11F,XKaiHpM
+53,,rL([aBbd'mTN,#*aC8eh,CGD[&aYPM@d+%3D`-!l4$[A$*'i1Em'CVV,9p5N
+eQ0CiS9rNj0K6H`1NHHkAV%j6*pMKkh%rLRcjAc+h'%+08j[J*9(Up++VK)4mC,i
+B)"ETC%j,,r5dH*AD4(#fDaX-J"TJmlRS*q&f[@,U)$RAZcB#jTGN"Ehk+V*jMHZ
+L&)Eh&TZA'mUCU9EbhRDclN$042lX*[i!lRJJ-K[,Q[-*c6e&NEBM'`e`L#&V&2C
+RmJ`'@TS"8m@dS2(HfKLQAfL2FKfJSq[Nd1pM&64j#G4b@(Z&T),(&k(*3TKQGQp
+i0)*Q@b&jZ*JH,rI-!22$4cq0PjCM(VC'GNTX!+1&A0Tc1K*-J9p5ach$RL$kXLl
+PNIDF()AmR8falql5IYdT5#%iE%RX,fd3QCZ3!&`JZ8I"FpQE&khPd*0HED)29*+
+%RqJDMHYl1A52X*p1N!#XX`EMd,F-QECb52ApR#66Li1`Z"-4G`Brq,Y4e)XNhhl
+@3&5NE($9-6HDQJABQVYi(%@B1!#+aJ3$6B"-BfZJl(Y#c4"5S2mNaA1YKKk$2QA
+ASRbGCV)8$Gr@L+4)afL6dT*daGQ,eCR5eSRYa0R(fZqR0MZYZEVDb'$"ap1bPSZ
+lp#8qdJa+!Q@#lcVCJa0m4q$@6LG+TURV2i'DpV9*#UMhlhQK+YVAHY3qC"(qr2p
+M$ANcJibb9k3m)36[Rr9-'mBcGC%G*1h2k1kH1604D2ebHJ8%qli1jFd3i"p#VAe
+%+8`paS&*e#pF$4Jqa@',T94T`-q-$QTfGShl,UTbN!!5ZXaHMQZiQJQ6jmXD+05
+lLSq61MF)0[RDf1a50BI1`"GNE1d*#kUiHB@'6+JXND*TA$*14D0iMD!19ZdV9i@
+[19Zc3!6C%YFkk!Jf*!KIXSR*pG90"h1G5H2Gp-JTVdl%5iHBcER+5AkHhEabhK&
+V9ZY`"blHK"ZCBrlXEHNe%25ANRSCDE&VRK4+)H38eD!pc)bKbYRM@XiqU**bfA9
+q'D'%H+1)-Hh3*iG%QV)8QjG)mm3fPDLK'r95arDjUqA43(5i&9&QPPf'JXdP1,M
+6qfc,bDN9GS[*C!5KVB&"-1MKN!#,Ki2i0I6&l3)XYPJrP5JV&$6'+`NA-X08cU9
+Tk'EcIV2ET28R4djLLJEeJD)QM,3J'!CU9@4Jr@Ilm-N['X9e@+p&3"la-1(,SS'
+-D!9iE@Gb(8fl-VTVM!P*(ia@5#!f`&dl8hhM!Sh(mU,E-ar6d[3I!HQQ*AMGCia
+89cF%2qdKje,5&ejaK6HP2l%2D-Se6pD`LPULk5ZYV1N5IU(Q1`9E[6kf8EGXQd4
+RN!!@dDk8S5A-mHVZ8jGNTij%Z&2UJSKd%[,ccUC%!A#!qJVKHV8FQ#'Ij#[SP3$
+F-,%&HQ'&RJFpNUQal"&VR*H!`34Q9Me8G+"'!BEMH(*NVAcpd@"G%pXF5(l)[RV
+"c5CL@#md9*Gf-'U8I0+M@@mIb&&40pkPUX4BdD16De*SdB8!DA+#"rj1'D56R4)
+bQq&0%1Z`3SPDl)*CbFPhRDLe!ir%q36#Sq"SS6XHiP[PjikM+"1V5R3&QNrXEiE
+jpebfAC'Fq&T*4U`+XhR-L(I+`YY8(mL#&Vj4KDjY%"J1i&qf2qC2[N%qTp2dTT!
+!AkilL))(YRhRlMaBLV@G(6Uc#f5!(Y2LZe@6Tk`GM4("QC-@G"+Q$1)Pe@PVGGf
+UQ6'ld'CU3#HB"),*i9jBhNa!"FX0QXAjH%hTda0,)2GV6bY&2TlVi-pa5miE(X'
+*)qSajpMSf@mqF[FYBL5f$5KV`&!'+42c`(2M6VlDmG-VC@UYlkLr@Z(h`'Q))FG
+Yj0LSmVU9@*!!qqk`,3e-Hq`KkSIjk#i'&PJZ@i[h9+L1GXhH`02kjEA[MrM&T"9
+m+3L)Q*PpAb$Y33C$i-D,j0hj[$HIeBmQ!afPP!18X9M&**Jf&5RCM,aU3QLDk$r
+2R*AiTik`C['DqP#9dSm5SNY!KklcBRQE28U1h%EpK9bSbf[5)VSK*@b!U5XD%'m
+'AU$$C!!JfS'U,#Ml[Br3ddk6ID"V(1$$!-jSE#`)IV-fRA*lpM0GHKi,0V#ADHb
+Ir+@fp8qGp804T`QE%9aL+)2qYJ)3RQI%H!rR1Vh0$fbAVMjD$R8a1TKZC%M"*"%
+q$S)*365P-Z*VZHdb$8caF-9j$a$,[V!&QZf%BS6pVq,[R`Q%iKKEN!#Y+5F`-1k
+R%*!!M4X3lRR-jm&YdZmI"Cc`56L@C%f-1KUA*kRKm0@)fMXij$HYie*fEC305Ki
+VA4%8iRr9qm1[2MX9GPh%("()hNa+a))YP3`RMFV@'%Cl0GMBhi`cH5"`'&iq8M+
+`21j,bLPQYXZmCVFJ8)QA6(D8Mq4He!dJpQ$(20![M"BbXKC3iq@Uf[!5SMHJ0#B
+CSApL&V)J!RaVK6(6A1'E`)DmirXRXR6jme[&-T5&#k'2GFCGe,(L2K46F0Hkk8+
+`Ti3J,V&frBXXH(d$#G3,2%GTb2pQD@,-X@j0$YSENkK3i%$'cj'-C+!X1rcc$UN
+%$R(b1K'A@36*GH9,R`JJAa`JcV$1fr4l1QQk9beZB)m#VpT[YQYr6ERJef63m9L
+%a5b1r6!!N9IhC`'8C$KT-qkEZ1a2mrUkM&5YeThp6A1)2%i"R&ZMkAIm`f&6iFD
+`'d1mMiT6FdcMFQF#icfAaqdmK!ZB[0Jh*)QB8DkiT4UK6CB4lBrimL$aZj`(!Qf
+0a!J3D,ka5kPBeBh!c$3eK&UAYifQ9kUiM+T&,d)m8i(kflkN84p1FC!!ajl'a[(
+2RMfq9[h)&aDrGJACZGXD*I3F3kUIiaETMrdE6+,Qac)'ii"q62[PYdi%5qGIjS@
+XUp!D*M9F2*qKJfpYJlaFa1q`r,QM264YkG*`(Sad*LPT(Dhb5*!!r#lB,`Q%[59
+L+!mma)iG,[q*6lLVMRCQDja5Ilf9HVIqZ`Rq'9T0be+e+h@Xc5I$-2lL8-(A+JR
+Zr+r"Vl#ea(VD3lCECN'Td,V%8P0Ib[Ph2k@*f!p@d`irqREX3Gll3HMfiVcr1G)
+C"4Fdk+-%2D(mM`4Sr0BcM$b!I,C34rH"FMSaNcFRNCji01H6+X5T4IZ(a1+rE9C
+H-kAPq%dEa)aBHT!!+5rYm19TaDAAiU+0BZ5Mb`*2$#C21`Ma,Y`m(I0kNcMH3b'
+T+EK-pN)N2EchID)irEc&@m!BFP9X`Eh5jIb9d"YXk&1KAT!!QfGadQ'3!&GZJ))
+9)h$ZLIj@ma,)VLkcPdAB0d&#3a[$G6Ee0hmbai(X#k&AD)mmG1G*V%[!h(dEqJk
+XfmGCda8URc"XY)2C`DY*)pXm%@5,!DN5XYSK)p#q0)D+*6ULI!(YNMRBP&,pFeP
+E!9XfX"@-8a"[iBAH4YkJ[m,*!pYTqC)A5N$URKaIqd&Q)R$lGFMeSM`S#TmNN`m
+b"03I)$9Q!3hBD#m'S89RefhFeVJ#a6SU@JEZKYPI'b)S8!Rqrpj6TF@IrVmXCpC
+aj+Pq)&1[B$*UPPlRCD4HY8cTHVLHjMa8E0cDYJp"45rXV94[[-(jlB8,FT(1M3k
+eML--TJ+*1N(h22BXM4)YGak3!((cbh4eeN)CN!"r)kpDfRS[ARN*[+VNAibQrK'
+UhaDA4Y%rCeFYN!"0`(2P%LT[m`Dq!G'![fCQ!dF(Kc@6j$QqJ"JF@Mq,2KVm3m2
+QbDTU2QPrQNIkP&qJHX*GDM4l*9P)([+bChHr8ZIUR@aZl$'HaRFN"R-$QbPp-[&
+*S8HIPdGE'[P(h,UFI-Jk8'S9mYpP*e2HkeV0kU&9@89a[!"dpMqaS'MNjj'E#JF
+3!cbpMmq*3!XA8G"6RhfIaUSIDpa%8$qQ,AGP'Gk'aFK*PGkA#Miqh*!!#`V0*JL
+9`[Xfm$J0M$#BFXTRMU**S+*4P16F*Jk%T,%,2S3QApqAR!M[[Y%`Z,f[h6)b+e9
+8JDXa1JN[3I99!dN+lNUXHedB93K3%"dq+b1rhjpTkhF!53E&'c[,'aB))lV`)#T
+lKZB,3JUB+35BfC+4FV#L*+$*)`MK'NmbSZZ[df[!Yl8GbrQ#95j"6"VYdc,"qeS
+6Lr@Y'eE#CkUraU!&,i,eF3qhiF!X0DN'l)Q,C,cV@9T1PChl+N2'kbM$E,@,r-%
+Y3L0KYJ+h6a#eIGVYaGXb5R[9T)9d2)+8Y+64!-ak2X39dGj$l34FqNfC5%N-aeC
+d)JN(b1r6l68"5IVdmA+jdmk(Mb-e-3dm9Y$karR6`1RBp(FT8R-#&9"Y5a-6*-4
+FfdbcADqa!5)2fA8@HNN"JHj$Jem8$@#B#'"aPNHSq0jl#[2&c5%eT9%ICi)*bQT
+MCeDlai8p5)X*U&l990A'M[L`)86XididT6+MFDHpa%T*5,54+c(@@0[L1k30C@T
+GJdFY3)%jIUd)R!C+I%d&Y"$&+KXJQpM-l#IVNklla%2NA(,ipE"kiLY2Y2YRiI'
+h+5&p+eAhc%5YH5S5!GZD2JbNr-VYalj(6fGl*Pe-4E&`-![rJjTa#j5PTJ,aD#Z
+b+c2mB[aa(1U-PaEVUp$NXIMUf)e0BDB#bLP2i0Q&PUd[d4PVDkIMGEbkr"AAKq@
+KiI@LCq'`!`B8&r28'2XMq*Frh$8LSUN%UZLlB36piZDNqAYrjK5,-5XSRmNUV[,
+8q#8GVU&f$hEFZqSmVCB9Q*p9)CfD5`id#cp@I%98`Y6$QLah$63fmRS[$JRaba0
+B(2*@#`hZ6TX@%UecE0J&!`VeRa3kDAm%4%)kAB6D'8NRI$KEDZ&SFi3D86LAdLr
+h!TH2mI*Bh3M1%-3Q0$3[XZ2`r`"Lf45V1#@4DBbkGrLebcC[S+H(BrEk$FJrZAb
+M8Yr5c8Qc#mjeQM5B-Br!%0QP6kE5c*ME@Q"HN!$MA$aQLkf6'@Yj%kL`)Vbi,6#
+3!(9cA[I5f`fUAS!eI%k[,)9+Q%kGZ%1e#%GJ$Qjkd)2rbX4%llkAf@eJh+,c@l5
+CB$dUpE6@FAP614b)9)08G0HbCXb3!,HrT,%F!1N5dkEq@i)b))mN'bRJd4KUXYr
+#cNU`&-!Cc"XU+he@PR5rbQK,9hrLDH8rB3XYpY)Blm#I*L!&''VDGf6!MJ2Ml[E
+c"(hYXh8YZJ3raeM-PQ-9USfdij2lI3TZ30'PE%'3!#519jQba!SN@A!1K"PJchi
+5"6%hBD,TBP32lPBkr%L&kPZJkaIRkAZMBBrM!+@3"!%!!$i!J,5KkFDiRKDr!!!
+0p`!!G6N!N!21!!kc(`!(VHF!!&Fa!*!%$`"8DdaTBR*KFQPPFbl2J!!!3,*069"
+b3eG*43%!rj!%!*!+J(!!N!C#`G8+aDHS%N*S,kG02Yl8q&c')(UPE"KHXQ&Zc%i
+kaUL,pP3blM$fb62q9pN5L8GTM(GYT9jP$M*N69HMfMM(&jrI'D)`ZGQDIB6dIJG
+PJ$bX2*BViH,kVhGJ-2Sa)GPS`BZHaT[L`mVB*&l$#Ye)rRe5CId1$SrYJIXd(cm
+h$4Se$M4DKrm[U%G3JIqFkej&PDLl2%`9I%3akEiP2H%&0T6TJEMC*30miS[+El!
+,`"+0HZ%q@5%l$G+Tc"@`D0K*N!#H%1T5[FJaT%dIb%AM[5Rd"8rr,,ShK#@YIU5
+3!(5V)9+M*HN5rLF-3S)l2J)Z3`Re2M@aZUC8iKM+p3emM$5hP(-*m&A0Gj%qaM8
+2IGPd1,[1P!ND&'(cb1'eUQ)2qM""4KJak5V$fQ")mUZ99!DXA%0`)!Q'jU!N$0#
+I!HClPSMdmI&A6Lb+M,5)KP6)*j26PS@C1BcEK[Q@X40ZX3!MXJSaQXFHJ%lN,-i
+m0Z[3A"Dh[-pB1L-M&%lemcacAjbl$(bHL%#6Y'0hL9rk3(aa+KFVZAbMZQV$U'H
+FARU#cNeBKcR9BcqqUARkC,k,X%5ea"Y&-%f#DVR"F@Eq"%Z8VUp2i@Z2`!)8'36
+[DS!e"!S+2a0lMTYar)L+YM'"UQYI%3q1Bm-kGB%'`q1Xh#U6H2l9d#[CBha(9+8
+4VVPkQ-ipr66"[-mZPY-Yc3BPA9'c40*1,eMmUrjY%irj*eJ`Pj)AbCbEFSc[NcG
+"p%N2(!24Ll[!`rbmiA-p"98JX"#P1Cl#bZCNMDc(!+q&'HFcA'&mhR%e(#&4M3#
+dY)MLd,p(jk+1ZICahbSVF!l(5k9bAUcX13&VIIcKID5$@fdrqq81jhX!@NXm3kh
+9QP$q@fb&("ZG@YrcRKi*!6NhJU$Q*m90'IcUheJi8GVUSpPrN3TUB0Q#R%QqJC1
+ESYN!dIeAFC9bSK+8hXZ)5Jq8L3VY-%V1"4m%1m!Ejr&&YNiEkAJG@pTQeMI`&E&
+(0K)%b+(LQ4!!ZQq2%!kVL"XHA`XLUIk"&Fd9IaRlT(JDNH#8PE-*)pX44c6"fK0
+r$b%@3GVk&&bEN6@CU#liT-q&@I+Vj(Yk5F(bZ33r&S,JKp3YdMC3E@"%1RN3D#)
+p-pll+9e#b(ieJ5M[)IXK&h!8Sb468KEc"'qKckbB8BHXcfiihZ*JA&apaBr6M6D
+DGIDA9aklEp64"N%R8H!4@V8im@"@GhKc)PfR8P"AYlK$1q@Y(6L(Qk3TAUeP5kI
+c'M'H58!qD[)i[Ym&,h!YNJ#'8614iY[*c*J3!!G+iVKdqH9haAKBrDp@!Km&R'X
+APND4T3&LFiVF(F%RDhZ2V6H+mF*XrJaQ1"9F)Pf@MIlc`h5-YHUhFe%ch0[6)Mb
++G0rfm5TF#If),5YiRL,jhYSI(MPec"P&lYYZ9rmHejL@D@f[r5L4NaR4CAri5A4
+qKV-G)lbG`5YE&!)NE*&pUXTd9C8%H1j'[dePPD*$'FDca5'3!,Il@M#REdahN!$
+3pbCbHl8*TYF#AA4l#A&Je4#)e$BkE1`N2MZXF`eacR9c5(U'N@%lIrl"e$T"Ui6
+d#Vq2)j3U"4D8G[Jl&%[-RJN(M64!Cd)j&Fi#DI#SVYDIY$AHr@,S4K[MI2!Ikhr
+AHYBa[,EbmK+GLDlrJ*5i5,5[e6MG0MGS@GG[CVLX$1Q(Y0rH,jq!XX-pdVidd$%
+0U"`G'6PDeFb6lbDbQhP82'BiZ[hH89KKXQTm+b+Y,rT#[L4YGQB0!D'aV,kcPZ1
+`$aMQMi-j@Eh+p"H@%m&*kR`ZV-Na1kcc4fH4C&i)U6Nm)Br@4i'1iK-'mG8ra[m
+@*8dIN!"@mEf+[m8##)[mFTA6YVR8QTKS1UXLc2I'2RQeD6)&T"[J(r!Z#eM9$Tq
+LAQrY256TN!#,JL[K`f9,48@mrTDdPc*EJQPL2@&$B[BQrpXTfGlJCH)6%*&S,*@
+*CPTrQDVUlh!Ji4A9d*RUpeCipkQ[Ta0)8aj9eNKCLrB'#"a-PTH'CB`J1,jZ1[D
+!mKT-D9[j+!([Q'4qSFm!@*N+bVL@Q&C3PG$2(QXAC'FaEIhrCCHDH,A516`j(6&
+!*-&%LfIZ,1l`%1m9E@QiqfaZ&f@Mcr(Tl`Y%8dP+Uh04#Te4&if656Z#fYHa%VS
++b1m+3ZmUem[U"kL)ZY`ST)$V*Nf8S&prATGMPClcP!3@"UcT+3BNmc1,+)45Icj
+'F&Ca)ZFp5c*mD8rMKHh`*DJPG[1-$f5BYCP9,Lcm*Dl,HfQBRrV4VTT"*`jEq1J
+8&[bRV1l`h+Y2BG'&QR3RM`T"C#G'3eMBqJ@*5ZA&YfppUQXRT(*dhV4ed$Vh),Y
+4mAr"GAM8jpqAf-bd4F$[XhR#a!CmFAbG#Gmq6#,E0lT#)Y8[X*DrN8J,N5HP5CP
+5aH'3!"LjqfiR+eA"[(Eh"Cd45JiQRid1YqN+jR%DT+Z%`PkKbm[ajp!HhhAe&-e
+fC*eJEF$Yh0R1Nqj@#EBSbZj1&22h0D+H&CU[*HiLp6PmXNUN4GF@pJD[0iLYmKB
+9APKRHHVMJm&DemD2f'$+QrV3L3HBN!$Z3FV-G8Z!l4+chF4`d93"+MA!1k)'d!d
+$I0Ehe,XTG)9+-YC+9a+FSIH6Ljii5#SRG1PmUF$jjq*Yq3Ei5-1&)EIekXVb!NT
+KBK$XbQYCSe6BIU2!#"R*qAM6TR"5$`lmhBD"&cmLkMUNE"ApB1r%2T*45MB$#)a
+Y,5UR40JSYj0,rS`I&P[E@Ta&+1"YGM(LG$mrPl`6J4Q3!*Cdf2UBTEl28C%pj-d
+98A5#pJUc"@UcibLSNkjajVkT0"0Kr'8*BKP89elXHl'TYQjir8LAh22PS0i@%dU
+i'31%)eFU!)4Y+j[2XlL0"4"#fpC0m@q#X)`V'@)HA""HZBQ#l#Bj8EdMfPra3r@
+NR9EEU+cU9aS#Q6S+%%3AbGE"iN-*(U6r9MC5#)dc3"+V&KpdrD9#CiBb[(Lb6c4
+5!ED&Tmd'22G@8laIRq1A"FFc5q-1m(3T94l6LYHQq`mKG([I"f%SFE-(qeJd@E*
+kR@+L6ESG%N2-D'GI`%VaL"h,`0!Bm!-6jY*PV&L2B`83ej0S[#C2Ak'X4RjjYNC
+M85pC*fT0Jk!1&#'Zah!i,hK!S['%RR'aVE[SK1m!1Y@H5$K2hbGA$'#!ajA!q'5
+K$@8-SpVD9fLGI&Mcp8M[1DLF6V6,r[r%M(dF(p"D#d8R#6$Z-H&edj'HZ&CLYjR
+TEjFr&cBKal*h91+Lp"'"E&#1U`ml'%L%GHMS&XZQrF*4Ikp$IbZLA@XF"r!B%5X
+Vm%jZalQPSr#j[DMHiY**FCph'[Rd9M2dmZ@Z#e9BjRVY'XYV[jIK0p9`dIRm#Km
+,R#U3!,UR&P`C-8c%,P2fk9#M`,RDX!4SKDK'`M#,KFX6E-+'R0e(F%FHHDmEQl#
+#2+cIh2VLP)Qq+JdFBhLCUVe'k60%LGU,B#mBKrRL1$c&*SJU+lpHKKpKLj((JE*
+&RMDQ4("(3,r6XhA5#`+,+2bqV2b[5AS'XBY8#YSL80XUPC0ZA2Q2-DKaS8%T8c5
+2%r(M"VEIL1E,F+jL"jMPjL),QQJCReCRPk@MjLJPGQH")"p(hja[h-(c4!G@3Yh
+C3*SdQhB"VedX'4J-#`@++5)+`*9`F'-R-T)K*rPQ2!Ppk*SbX`Lh"eJ&MYm2V%T
+Raac6Sff)21kIUCj9*4%c@l!14Y4Y8`Vj2!9LXbJ%8e@[UQ0"!ea1*Sc9Iq@5Y9+
+(Z,B)YF'F-+2V1md#ihEA5YJeQFc+&6KC[Sp)+3E0rqmFRTMh$@lZ3D#(!4k&mD#
+c5Aib-*-4Shp$Z$0U)K81mm+bf#AUUHj'bcASp4c)c3,))RL`62)bq@2J#BcM5%c
+@XSL8CC!!I'IZ`HRCQDX&'+YZBj2BQ*+cCJhY5Bl1"kf$d6bkZ%Y2PBX&'()lJpB
+p+dpi2+19idEL+!"eD$m4#dT$c+V8aL86QeMJXIqa0B*#eQP#Y)[ej*6V0YSdkCm
+B1p*'PI+NjfIh"1ZGFhj10GAfGCHDmd#IeU%C8X*YVbp)q-#K!6[KP5bTfXJ`,l$
+,NBHrdK`iccMABHd"FY@'FEmG(%LlHSACiCH2lH8,,6E2MM5C[ZND+lG8VLJS8VR
+,"bZ4ELQjdj8dhAcX&#QQNlGrQCNi6dX,(i,d[ZF'-5&i9VR-cB+4p11SSdTiS%Q
+Y*,9`[Ca*(lc`Tm+08Q9e+1!JjkBbDr3j*cI&J!-fCLMpi,6))dP%XAfdl,,8Djr
+'c,2C'd!ZVebc'U6)%e"rSiAdjqjbISXfJ8ML83QiB6IGq%['ql+!iAaVp5*dLEb
+I64'N[UIUhpCfI`8mKIrYD#XLr'hAIf&5SF!KJl"Km8jb1%HMHf,qq[T*4J9Ar,D
+$!jk3!+3)aX9$"''LGeJklrjPc,Q$j%bT%DII-GMiUjeV&"*E8Umhb563"%h'e0#
+k"KG$dY8f#4*NDp0r[e!NG'heTVpMN!#ND%5"Pr+AE$0Y4&5f91$h5Y'aYV9K%qZ
+3!$ih!Kc)))59HTHcT5qGhRGQHeGA'4m%@95UhEU6i-0,jVG5A((9RSm`$S8[UlN
+a*(@IMCfa!k)V(Bmep8[Ucldi)h)222YZcZCpje)S5+j1Nklr12C!GYGUZZbUm5,
+QIiR[fkM'fTq6hchcKF,G0[(52'AFA5Mq$1MNqlm#-,(i,BU$lKZibT!!eM%fpk-
+aU#6X!PDPI,Ci@UkqMi5XBS3@#`Hq0*VkM!pZ["aMGX@P`FhpM0&ih0eH#$)6e[&
+U00kI+'H0Y*,6ZH2X2dF*EepLJKZJrKDqFMqjTT!!TFV-(Y$L@Dd+6PfYcqiA&-N
+$M[0B3rN$R%@'@CR2Pp"k1`mI*C''@N1(IJGY0Dej0YVIA"211YiqNZQem#IS#k[
+)G)I%UlhQrXYEeE5Kbl)k-dHlKM%J9IDl1i8pZ&B`pZeL(P3c!`%rlda%Q2S0$K2
+5S2UffF[J-Z&La*4I"Zlh4UEcIVd48J'-3R%'fF,Z)34mSa%lk20d#)9e8A[qKH5
+X#D`h)ha,NfDbp21,Fh*X*-1@'BMYKrZPf,X[C4Sma#arH2F85Il*jeJpL2@SrNr
+MNNeI%0`P3l-%UDC&QM8Gi6M*#RQ*0UfeZ6N"N`PCMRK)UARi45-VGJ(BL5`ULk(
+r-f'3!+MQLa85L$kf6p0QN`LV+SmSbY%5$b!EBk`kUD4me&h-fDR4[#NSI$lU`I6
+6XAH$m(*1bh!Q8rDLEJI,CFqI9%[8'!4T#-A#ZB4fDH'+#S3Y4PXJU$dB,Z0e`10
+Zh2Rj,mjDa@'-Mh5ILMmYjGbf09"prDFRcDX9e+fSeUC)rRCrD`L`BL-EH`TYb9h
+hq9FdJ*P`4`JU[1@Rb$!115E&K3Pa-MK@T5+TBFr9)!&0@JF&3c@iJK3ieJpN%!X
+JpaKNAMe639BKcPbF'GAUDM0"D2ULi)F1iG-RM'hfKdbc%J-eHYRCPFNhDm5*T*6
+VBf[Bd@9GmrXJL34i#$*T5%m1eTkCVZ1q`bNQT0fFSbKJ0GPh8J[FmPV8j-FcM[c
+[iQr8K[e6e$"$p,Z1M5aK-aAjEDAVejR93@,qC,Y`5'3V$KL![I'YJ$DEGBNYLeK
+Nl2jNJNG1bJa@*V"@"+AE5Lhd*!q(X2i*k0jPDp-)p#d3pf83"4JLrJD&'Pq*L#!
+QQ$$)VU!JE&%$58S-bl*[lcHEm0VDF9@0ef+6$(qAhG@+K+'qYG42LJ(N[CS[[FR
+U1K,D)b)l[hCqmRl3qYN,BV6D`$T$j'VMCr4Y814YPd%+%%%GMC1Pb[CVfb8&bf4
+5H"-+kM'U'-3NRUd-+KjH01(qe)P"(6ij!0D0M(@SLhl)ICAUrSE9P8mdDL4al,q
+"bEEC832(MdDh-%'b&M+HBH0kRX`AX+l+#jAD-3-(N!$XRE3$bFJA*-AJ+"1kQ@U
+bK[SMZCT)8iDa2L8QFK![(qkF"mUBd9DT5#"*8Rj,%6Y8*c$0T0XRf))0Q"r$[0f
+)c@d-$LT,8HJb[H(hb@"6Z8@a5j3rSfrEr6*"35IdXR*XbY+3!0bcZj!!drim6&!
+F[Fmfi`@)#1XGhb9$38FdI,j9Dq16#S8DM#mlfkAck`amC*AAIQI&S*1bh($$&pp
+l1kZS)LaLbbKp-Q%k-)DBkRTZJN1L'41$AfPYb6YJJ`V@`h'B*"EEbLErGlkk"Xj
+VkSPBk#T##%A02$3TE*hE2ajh-38[,-jSi,hj`jqEIUhKG-8C4'S!3RclI6T#Kc6
+%VEDDc8%BZjErAhfR1(91lV44&2+J[NL!fNeThe4@ceQ3!()+cfB4CP8T4h"eXKD
+@$Cha$UY&ecjp"N)JDLAaX%4@TkMi)9S"T'H&e9AE,JS1YT1A34MShCLZAm6BUMk
+N@cCcY`@1[T`'j,LFfiYhd5UM)qRKm5C2GDrr1$&BFb@05M)$hX()j1bKB#pTUP%
+5U`(1DkRff$&P5BBD`j&4KK[k-9L$(VL3!#c80[YmF%TqVMRlCk,%UR-&pjU,3X)
+cJkKUjJD5A89Xj-P@1Q`A2Tp'Kh2X-YN5rGmceV'P652Z+(QYHDXQ4$Q-U!k@*D'
+ef30Sej1HDXmC[CRSRT!!cQMQAKG+!qc0%dF9[X[1SlR0&Yr#P3$PX2qJeZZBTc[
+kckMAJBdNZGVB0dZJbq,F$HSp'5,AMCTT+4&4mm$be#Va`@[@(55Ei65ba1JN0*5
+8V`GkBL9aArTVI9BE,6H!%ai&Y`C*KFcrZ[hA2@qBJ-(RYhkFiY5kHC,q3"CDUfH
+Y`f2CYU2%q-URlra4#)e@RfJ`Ul[*A0ZfDh8162EeD+##4#BLr,`3[XBH#CF(lCG
+8TUhrK1JqVa93-Q@E8Dph&B+9FTF&Ld$5BC-"VqR1R6j1Y4c+,JGpU2pJ22[V95A
+GQk90f!fB21G-$Ir+A#*49%5!P"4TcUkF)Ui&Q#8f(6RGb(JDFAlFkB`Mhe#65Zq
+M'3f*aj!!aUR'eLJ"E!)U#@10Nlf1Pm8Z[l5q(Eh-dU0SGl`qraaJN!#CqLCK3cG
+,#NJFP9cYU-ZYY4k$2rEdjphN%JVYKY'AP@mAF"m(fk*XTKN5+LCGYXD-Vp1jFM3
+[%45UIm"@&acZ!PDJFHfp,H1+@cJF%d0*p[2B1lHEjb5r63M'Jhpj49,YVAk2DAJ
+22EkVr,qkRN8ING,%i9Gr0ZZRQ3iN%2)DTSKbl1fQ"+c$8X!CC$BHmLEeD-+QD"I
+DZ1PUKAePb,ABrTNBhNQ`-hF+JmS26G),Y(mFbDrk#qraPCUG1KP4emVdQ%JcLGH
+jG-!0CEQ@p(p4YS1qi-4'j-iEBBaMlLd*U6jd1[eACS&iImK8,6"`B*3LK($pdLS
+H`Z`"cTk+iJIhZT0YDA`*LBMV5G5p`q[@2*jk,A(r65ep#I$4EVMGU*695k#+R#B
+ZS&aeXa-05r0Q1q$jlfb$`@524)4k`,!YAFCXpiTTM&VV[[*,@deRQ891UFHfIjc
+UR(pT"YMZ&556N!!P)S%88TkGX0DDrf#h`qm%0IJiUX86KU(I51,l9$Cq!$RU6De
+ab$f'$MQ1IkNk0*@HT$pi!L!%r&4#2AbB8dbcc#b5ShTKQ$%NE%QA@8R,EMcSDS9
+i)Y%pH9S0[Cp)##X(&I%JP%X&N!$%QpcjT#hXcATMZUCTI0C$IDp-%Y@(h9)"AI%
+61R`+l58Re)S8Y*&FRI!Ck+ANQA5@#b@E"d,3Y-B`[&A[b[C9kHifSH1VZ)Y3LNj
+f-V)CJZ),`G#eB-$SiG*XcrL&`L!4$Jj*2$h6EdS314NBre-H$*k5pH)9jf"RTY6
+U5rrAklhf60`090qV*MY6X6bLQ(2LGNqj2M)T4kMKBmrC)k("D1YHR3PHT-6J#[I
+0bA,46YI5DEA*DIFh#XK$Me,Y6l2Mb!(UD!G'#&Qp[)h%d)9P,Gk8E4FDN!$f56T
+aM*JTi6+K1qM%9Njd!rHAdL1(+3%lXNN+2Nf3!)-hTbQm"ETb3"I#fJ2-XZcR&@a
+NV2,6'AjHMMX4mpfD(LkK,*3,P2M6krR6SFQBr'h*LEPkT-F*2GHDP5T!`([+#[i
+&k'irr2b-klmYQRj!Lpaihrm*&ElE+,cclpmCSB[c#KZib&cSeUU'"fhDB2)r#C!
+!F&,ZGJrar%d)iMFhV9&1l0(R!T5+$h!F+CNbV2$CX"BlF52+c@&3QaaNK%8QMpH
+&*p44RBh$`PKTe"LlpR8f,@ZmV-%KXKXkdAL$*VjpE)(A$p%rpIT(iV02V%K'E'2
+["RZTVm(YHf!0p5KTkLmJ%VY,"c*I#*KP5ZmCl-V,K&Vd(ZD2piX9FL)!1Q&19Zh
+J`L)@-YMaX&E8S[kK0a)hDijQNiBjb0RCKN8VHpa*B5e[FErLUmLQPp1Jr4"UJA@
+"LrpCQ(IdB3TeN!!*28T+6Uj8I2NPq9b09qZ#cJJEJHBUj-kVTCBCQ(H2H$``)jf
+l#p51QDlV)JmDad%FGQZSrLK,)i,Q$IPIFT!!j-1[)HM2P&$rDT-!i`,UcYdI0h&
+dC)6l5e!rjcP3S9$K32ph*mf"$Z%RUi4KEN0+ii"3q+c4@DLr(FYfUiE&@q1h",G
+A"jiD&`d+V5%CHE'Vi,MZ3SVTi5j%R3#Y$6r`Bbf(8Zf)"FjqYLj%c&[NF&hdYBr
+&N!#f"IGC6[miVQm2FepHrIU`H),'c#E4p-kXY*hde1+106bqP4VbH6+KSUPVR2U
+!JVK1h8U[q04-aD64B0r6#I8SQcJL@k-S*!9&+D"b%)D[p-h)5KJZN!"*YNJ#&`8
+Ha,lHL[KQ)3(''8+5H8NG1&F'2S,r[66caX6L*S#69V3LaEjXh[30q&6"(M%MMZf
+iQ#lmpYL(mIS-QqEelFp%ImFSVF"(ZZk1l`3LX-URXiGqee*pMTif4,hc!mP`UZY
+IGr)d4((Jam4L4XHBBqd)1@@,8C9LRN@%r0q4p$3*86i#0IQqcj)e3QJ&6Gqi#hE
+%V#KVhJ%9pl!rNaE3&iL+8cQcT`&j1a--kNK@UKjV,I)P+AckRdNSLH)SZqe2P9Y
+p@B6h+rfcZj!!H'hB!mk4hSRAimZE[K[h'eUlb3!(XI4[aGr9id2L[0NJV'[jlXQ
+2$i')&hq9E#!Mq6Y[%CMj$5mp&QZ1'cAT,mFM#HdQrCN0aD(FNae8m`(Hc4p4ql4
+@bac1d)Aie@pJI@l*F2Kc(8''qiUY+HkP"*23fEHIld(8S1cRTjcCR%8*rQA(2UZ
+6a4aT5jk-P0ar"K`AAfB,1U`EZdRq!)T`HX#@A(9UZCh&N!!BGZ8Ul(&SdT%),@0
+`**IXQ)'S+3S1!!LHF%6Q920XAifCUbr!S&&*MX[6J'cQAU`0$0Ck[Z2m"$D(I56
+j(e1NqX"V8Eca4$f5YTkV@bp'fb2T9AVL2Dd$hI3eEkd"Jj0MVNMARak`q6YBFTU
+aLkHVf3#XaBRE&-!M0iM,aal3Fjj4Ke8I,re##Er(H*6Pi8@DQq)(4J-kbpfe,A*
+cMH'BqbQKXAcJ"STQf3mR9h1`F2"6"lm%E*dNK"J3[@pGVR3I&M0c48S(FBTJj*+
+R0XkBUhr%*k3*QC(6eS`YdL1&Y+YDJ4)+YlCMQpb&$SqAT%4cBch*[[+3!,HRh)Q
+j63S8$28RDGTIe0j%*e1Ic"2`43N8Qpe,@3!lRJ-GX[NB*@)Qd3c3Al'@,kXX)e"
+EEVT@l+%-Y8$3DVd)&64@d&R9VjENS!'-hk$!N!!X9RF8T[p"#[41HiSDCQ1P62l
+3ATSq$XBC!YGY8&3XDlb6[qD[@HlHq3IeCl$,r"FPe!pSE1'3!,PRdNU"A0"mjJ2
+,2BdG83a)2U%S4VMcTjA@TXKXV#Ur85%fGPQAeLhkh&+Z'#kT!r#ffeqT9rSc6Xk
+,FIm9Z@-,Fe"NEQq%AdTfIdNc8I',f)UXRNhFI#rPlV5&[CB0N!!9l2f@Rp@3!%d
+9eaXM%`E9aP[pB)F90"kP[XabmJb$9N$j+j!!LJ`@-bL)V[6h8+hhUklT#X$kL"k
+EbGMmUP+mGjm#&52ej38-R%hpBQe'U8Q)Qj+!dKRRr"ke9E(%-5-TEGRpM4248dE
+U,C*3Nl$QicTm[6$CeEq*NXJB1%'UNARSha`$c5(Q%q`NbhKqB!(ZU3Zq0lS5S`D
+8jIRjlkHS-aBCa4YiGB"ifY%BJR'Ed6C69T0qJSh0"T!!HCHjHM&"Em*'crDH'*Q
+Qek8I[3RU@%(+XX(F#+dc083AE6R(D+++#6TFiX[BNXUE0@U(dRNHfECh[iK6)@3
+#DhJ#r(VZ"G*hQ0V)2I3-6FU1eXcPrZ#m'Yl38qCM'[RBXG5`*A'6J@G&@!*AYbQ
+BBBAYF25j1lXh[5e4hSLIPU)XAXm@&D5(@GkNKVaFp'330VLB(pccM+kUiLqJAC-
+6b5ZMI1jD!)&!ISlj2Lj!&#MFfdJ"VJ`i"Kj4TAC+#T[+Dj4e)1a6d[(3D-AYrr%
+3maV[9UA[Y2Kf4'8HG6Ac9SNeh"8(LphZF*!!@29kf$d$fTp#EJkI3'5peLF&bDP
+-2bBdTkV9NI&pQ!-BKe@@Fbdh3QIXMf"mq`Hh$@BUGXb2QQUK4r1*LeK$m$DTrPC
+Fqlq24$fh6V9MQQ3V1@``IADUT-*AJ5eRDVAq1L@$Te2-`J[GrD&EHPh!*ZEe6[#
+ZVSc$AJZb"ZBp$%+AK$DdamZTLK1Z@FRdS@0Y*(qp3Lhq"JXI9YdQKfQkk@TpTDC
+em6A2Hch`4INiQl@mj2ZBhZ3T21BD-Zj@S30EhrHS#C`6%aN94H![D*-EhRZ+'64
+dVb%kplH)0%BAE(Llff4Db[*HCaMDATlE(9qbBG$5HC1V[@U$ZkT(@!m+'Nf"2hq
+$Ff1%9fHBcFD!8eTX4V60M[&3R2Z6bkS)lDXIp3X`e2E)(!UrKZjme5`NY30YLBK
+SH3k!c!'RbX)&I)p@M@HBN!$#LT!!l3))C!hh[[LP#jDV'GNDdRh!2F@N6c[fpGM
+NINSmCEj1aY`G3aIH4TGQH$(I&8GN,KjEZLFSCX(Z-d)Y"cpA6ff4TJNR#Ka4eT6
+TQr!G-jRC4r90Qhh43M*&Ad'"KZj@`@T[d9bUiqlUb*hSFqcVcZA2+XULFC@(!b9
+eD9Kl,!BFdXZ`13DQZ)KRF5Y9Lp3'd@6pj,GdUa%*m4p"rB)eR&bU2R-aT5"@8mJ
+hPLPMR"14erlfM9ZIAmQ!+Hfi&qQh0mU3!,'SPiQ$*HXj+Y!,aXdQCIA'j"BS2pI
+mjG3FZllH&cC)`D(1brYrQ!eAQdA!L#*Fm[c%MfQ9$qq+J1G)ef#%"rfm8`Qjr%4
+$3++B'aRFJF%SeY`Kl`AJZ[DpD,(5406ICRj(IjJ,XUM#$Vph`-[)mlf[+HF65(Z
+,PpE&8@91'LEJB3(EqP!G0XB""PA!8%D4CPAqmB)m'@RE%qd&[4R,6XVr!2fBHLl
+bMHL*CEm4mcQEZbi&,ea@F,YPU`89b&JCFAH9)C9c0jBE[-#jqKQj+EY%"iQidZm
+b23#[q3aji#TYA3pE1lZI5Q*J'erebPJa`3(#'Lb*pbiZF&9YBl@PQ,0##2U*YQf
+XIS+dQ*Lp8054q8QZP6dNLUJQBNd8e([3B*H6mLB"R9SpY-B&V(M#P"@4a8U")a6
+r&X,UBVi4pAe+1LhYH`kCbf[fh4GQ!e%Ke9Y8cQ0eSVI'd0E%UBT("9BH1[5LGAh
+@Y#'1G+*D$1SpGEipJQrEiCKB'H6*prd@iUpHd8PQd*D(JFVFmS%IFfEB-*j[YAi
+2JrUl"YFfl1P,,5)Ym$"P2b",h*!!`F9(0DXZc5c*Ai`@q[Qk,[13!+mCFD+p6%a
+(Q4f'QSC2b6FRIMmUh-,4IiND$TCh0pecM0Z@F[2,e#E($G@"0rAR1X1%birpCFH
+Nb6lAN!#Bh+PY%,*8P@4R[R"E"I#1`84[f-iGEa`(d2+6M`Tm)kC'kMR3N!$,$Ff
+'SU0%LC!!r01[1ddDjeR2DjV5rSqTbm3DN!!-d`rC!RiJG@*LCpKDB)'C8&Y3[RC
+"IXdBm`qa!E5'AY4@CQ&qqQKN-,!hK,L'B0l)m!I0&@!@[V#[ZifM1Gdh3Aj$EdS
+[3+E2DZ%6)VL2$k)HGqmRXhi0fXqr$imB8*BU&fZTk")QZHYUV'4YbXQ"Xd(h4C%
+88TqNRd8Ik`"P4+cUJYiDG)Cib6VJ2'IMP&LjNI2CZKZL[9qh&!DkQ4f[d9Z'Vp+
+G5Eh)&dXH"mb"lF`1Ih22'RQ'c0(9()LNEDqbJHDr-Qq[6$+eIImd0U#'Ii0S`hF
+BA#4"lD0E$hSR6VJN)XYC9$96`)ePR@`SHZjdlc0!K01VJDG#9VprQ2Q5cTV1"ZQ
+T"S9`GhBJipj)L)+S6aXdB`I2P$r%"+Yh*$k9XmpHfa$Im(9JN[SIAeAIk0iH8m(
+pa$d6#!ILQ+TTl59i#V!mm3[BpYBr@#T0E!DMLGe`LE`0r+jcAJ'2F#1QRbYHJUH
+PlG3V1`*[R0JMf'@NY@T'AKMe(d$KHRcGEU[FPBSe8cKikqc)0hSXbQl2EF)l3c5
+0`8ch+DHcVDXU5dmFUGRD,BXri6IrfaZr+`'[[k*`kMQ)J0mK#R`YkE[fX#lp%P)
+Y`GY&mRYkqc[0KZ'D+ZCP,fVH&L8rJDN&HJp,Q&lN+!F$+jpL1rpUA@C2fR%l%lB
+ej'XC)0FQ,ZK[qK%D3XhYmk32"Y2VjHXc)*lGfD&eE%dUSJdrq+&MEFHX94D%[5V
+r[V2cJ5QE!IGrrFUh3S4i8'ZM3SSRNQV4*V!4*CFGqBTbF[RRPDdSaQ)@8rqri&!
+TU-"p$`SI[SAS40(*CLKME-VbL"KII2ZF1q5qA$4bm4)j)kSil,hmqc('B&D@2I9
+1T3e`iQjC"E'[bMe`[I10Fe!"Y0diH(1+*1h2IILXNXlH@qD'T-6`2Pia"hK)Hak
+`Jq(TLrl!9F3B'AGN0[)3+j[q`ZEl6F4XUdql'058pZZDh#S,aam'lT(Qjp`FQhB
+a50b8!Eaf@T6NhX#Z-hja9LfbT3Y5!plm-*&DZ)A2,RlE13!4r"j9I9"Xm"C&#d`
+LIlc0&1(SH[peRrSDmYMpYfQ)EQj!AfL'$IeFIbb#pJrd1if[ff14'L'2!Xl96[6
+4rFA6TB'i0aJIBdK6eJ&&B+MlCa*%k0K(PQLdkrZC4m`qJGS$QZLLl,Q-)@iPdpU
+[1[X8MhSF#$,ZBqZjkYQ9'LDCda+YKCLreASjPC%`VElM"6D'LZTc!%B%K%IfeCQ
+Q8"0($k%LP!HBfTk51(jfFEM2mI,PXF*INdj&4rJ%2$UB8PIJ1MVHkJ@qUVpV591
+$j!#YNH9%k&1%FZX9Ma&a`qfVrRX1$Ja)H%8N!kTK)-hX@fCQZb)G&TLPc9P8P0V
+i`)!12$*%IY[j[Y+BfiSb)Bb&Kb(98R$KR`FHlULNIc+YL)8(AF8JTaVfU)@R1j!
+!XR%Gr(L4j4Me*HIDSFYq0FE3S+lX'hYCB%8j(%r$V-8*!GSp4Q*fkkN%1N3p2QX
+I*m0`F2G50,#p@hV423Q4#kiIc6N,JXJP2qGe8#`VN!$Hi@NY#mUZXAX@55iNbe#
++EA!(rTlp9S@)iE2qTHQ4peEhE#N#P-B"EX$!Ih#9)r5LDMe,q[-l*kbT())diF+
+f+9+EaVG'dCFV[X4BAi!1Dk5Cjr%&!eM`Z+H6!fKcipqaVD9EMC!!(XYHQ3rD#,*
+AcmeBlHj2G,IFT!#+0'Y3&TSRd$ei4%I"5l2DIXFL0p5*JSd#iiXX1rl&RScF3Kk
+D1KhTkR9H&hb5MMXLL[JaUj,KPj!!ZJAJl"a"mH%QVr+G9J#Ml(Pi[J+d-$RP[h&
+IPeFRi621aX1'H(#liLkGM%hG-[ib%U*UZ!lrpqRXM*)b59eBiRk-N[C(m$X,l3b
+4r`M&lHI$&&)mXjL#(dFG[J%6h88L*NBrl4i+j*!!HG"+j!mZaHri`qDS%UCHV'C
+MVr'b5Bf#I%'C%dhU6'jZ2,I(,B!jc4j`NEZ9Z"MDXim,D4!FK"['FrIrfU21Y!'
+Ui!,GK#1L(G3*qm$CBYH1iE@&U,@NR,Ja-NVcR%"KD$H5fBk'bH+bAHe$'J,ZQTS
+!UACNXTMdGSNi(4blFjSe-mSPP3%&dA2YV2[3(%B9E(&FD#99PkZmA'Ka,3j-1[-
+ZrV[Hi(eXberTpbjfNhD"XeE[*ZQ4(Rk'HN#CBAM)$H,iQ+bBqL,[N!$Shd9LTql
+k4d&%CJE%2XYlSC63@dAai41*p8HkQ5CB2@-Hkk921ffR$i4HPmAc9TSYJpM'40c
+Fmc&A"SDK&PTZU%R5HRIb#NF'M'[&9L8fiDEc%9h3VA`q4r&&N!!C%'JppQNYYaL
+b2(0qRC8-#S,*Y3TikNG%e@,fe![L3ThQ11EQqB25D42r0X!PDZ)p2qASQQHqlqf
+Qm'[e1Pk+-$Sq!!e)*`XiafaJC9SKT+('i[0l+Sj"[*b3!)l-ekiAm@ABe`d@drZ
+HR*1*AMekqf1+9f@PH$eQJ6IH"*e$T,rq$)Bbb!U%fJU+P+U,VrJXk1'Vhif'K%S
+9'1bULTi$Z01@,HL)ffF'%&[Cb-@2ji5P2jCHS@lV1YVH%q#hBB#q#R(qdVeXK!Z
+kqNIrPp9M'5Qif3jZ"cRl&YmKZ8QI%%TeL*34cc@MDhImpc*4"2kfIDkf*GG[Q*I
+[5qPZ1%e)mm8"qI&aAY$LP-Gp6DXrbqSrSe*96Rm"AFBKX,#*Dj(*l4f3!!fq'm&
+VMTFH9NrM'PJ1-PZ8lMRhiQ&NhU%6AU%Q0'HQm"NLR)T*@f4FCVCMXcUCbb)X8QQ
+lXF$a3Lj&%8GQ3(DYNGAN32(`d@Q9N!$m@f$6'IXj9lEE"-4*h+HS+'SebeVclI-
+Pk"+#1+6XPY)D3j'83[26*D#Ga@d"bGj9Fhi@6)eI+8V+kjGaUK#p#+dq0BZU8JK
+BPlhj8S1,(m)ak"El0F'6RMC*G(iVYbQBpCfa&1E)ec3hKJL)E04HpFBq&H##4eL
+f&6dr6SI%Cl&FB'TlmVVYNXXc)YNN1V0Mrd%6U[1V60f0+$1lKV%-Xi8NR,Kprp$
+MGKM,Kq&CTXRJF*+Y8VS95d,#[[HpU)`eieC6*`@L(@6AR-efl-T`phL8%MC*B["
+3B(Ya(R)5KU)&+3B9'3r4Gbl"Bqll1-2r%%i3f-M125I*[3NkB4T3qZRfDVBq"ec
+9rM`UU4(`eTl+h-RrVJi&9U1AHc*E"TpeJi#*440kGDVhaSVFYR`K0j6m!#el")[
+5!E#Q"ISBA'p)QRqJ$UYi*$X@+#9fEpA6Z-NY84$LC!JH'ljNq32Um[YqR!F'f54
+8ICaA,4U55TRP"3!)41$88%e%!U0@%@$FQ4G0l*XmXT0M'IpNEH(eUe$ccPmc8Rk
+lE,-jdmYPL%2ZqN&I+G)&NA#4hF&a-kciESkckQE-Hhd[[f2A9R9f6&MXdjTYLV$
+cQr91D8bbJq1j0,JP&E,+"VG!d6iZ2e@9(2LR%JNZAHdSr3LXj5FNA*X6cPe,kBp
+'kr%LR`9F-YKR8V(cDq+HArb3!&MK9[%Qfe1"FD2+Q6hC9dAV#JpFRlTQd`K&K-f
+d!erVQ,(CpqJA6S@5dJ#RB5MmPK5S1#hEIUTkV"H4Kj!!0eP`*hMDc+$Zi@di`*b
+#K@UScDmb3#B51c*+5bGhLb2),K3N`1$*bddk5Ee`r4JbUm6L$1LYjR*Z'iVbS1!
+b-H)cXm2CIC-Qb-LqQB(bc`GK3LT8i"1FKj*#PXp@#iJD0$6C43LfGZ1NVNG,f+*
+A%dApqN8[He[QG1+@qKRX6K&JI%0(Z*D%AVUAG[$iLFjL[Y%!50Ijj2#`2#!8!!T
+2S&)"iUcfcSr3LQjZJ-5I)5Hd3fBmd&)KaEKfQaZ5irTSqqfXS%+Q&6IFLM+!8V,
+AA@kDYXhY,H42G%k%4MU8&$Ue-ar"[TG&%`BU"j,eFpSH4&4*BYT8U5cKrJ5hN!#
+cRkmh5-0Ia,#9j2C!rEGbSK1ieAhm*p!KZbpNlm$Z02K-+Y5Qf0Q1KAla8Y0![C(
+brBmAe4TrCH@q`Q2X@2jf2Ql1f'F0`[H#e)-&+8e&52)G'B2He(M0dlSc%h@r#e9
+Alb`H5T3TFbkXrSBS0iFdPr%Y*dD4XJ-Z--ZQb-M+qHYd#cMe1$d)$Ff2jTKJ&qb
+r1(CbaNNbr2`B,G-Q&Aiq%6+-[+p!3i4bVIYU5#i1ZJ39cCl#)fmP,[8G3RpV1Ph
+iPLedFL6`1JF'$6q8XHK[1(%E*DCUTM3D9clrbd"[ip,hDE@S)ha3[+J'a6L'`Tf
+3!-f[CkR,[VUYjb2CRmN95[er4raAmrC*2,S0p@J*aRVQKC8Rje4)(jAHqLc)0L0
+hJ4AU#R"cF@Z5PY"%E2i9ke*L(2rP[,!r*B$&Bp0b$Y))[[Jce+G)ZEp(*Hb`YKl
+I23P8232Jk1jrP&dJ&IGKZj!!$*qYk8-3H5pYE"a--&,8PLKmLY)5ql4pk5BHE&N
+P4T5XF9VT+RX)3hZmL!&LC,50GIFX*T`"6Z5aZP'r36F"jk[hKC(")qM&J0-0MQ5
+2J1lS@-aJ++RMjqjp!!(M@5,cBRUMAp-bB'rdjCk,9P6#1[GL'QSTEjU&,'Z"%E*
+b$"G#5)8`!"Y,qHrb,H!Ab2QQ[#KN'r++!3PUFlP*C6`TSQXcLPaUH@Mq,r)30Y8
+AF#`@Daq)KEM$hrR9ShU-RA0'hHcqIY$8QAqFCi!e5F`YDMPZP%e[QCMI0N("K%4
+Y%K)hcR%%5GR3I%+9q8pEHj&"9e(CeaNVq-Dm`4'GLZI1C*MAXpI90EZr`fF3C,E
+`hV[%)0!dSYEiEdA%Mpk8SM+JG$F&G%X$D"Rher25fSUYQi3Y%)`+*-FGp(HZ&KG
+#@p6`hbETAT&8a&KRF@k&a`6QFSQ)pk+00Se0SG@%UU(NJeCR@(ZUk4QJLSkN*K[
+[N!!h-Zf2UkHjZ)+X0dNj3I0HeF(Y`35JA#98NEpd[4Lr0!2hf$8eQdpLS)6(3Cq
+krIM6ke$i(831`1j6b2D3!(V899TkB604Mqr'VEYA6l%aHL-mjR0l'9GFfX3hF9)
+fa[K+`AJje`*G[9)a@%CAV1V#!ZX`,P2eENNHY90P5Kd#qGE9d@k![PCP2IVC$aJ
+!ANGq!GZHil&8TRpe18,c6*dLkjP-1#B9%qejhe9L"PT9HiRH&L'QabZ(je0GC4$
+TU(P-Nq'#(Ne8[i4%)i5LIIed866S3qH'Nc*4fZ"IAVQHi8F@JlBi)`3[R$X(&6Y
+d(C2F,*@qdH5[NFcSBkDBN[iqk4mc-pEC05XR[$LMaYBqVYXR$NT5KB*&QU@"jrG
+Y#P3GA99`1JmY5)aR8%6BFE#H0-HjHpbi%X4`CB8Bc!MIeDHDB0ZpNfrhS"f9!*`
+S``R60-*IE0c51Yra6[55a9h6IeZq9(GZi#Fc15,KHTI&B)f)%-!C&QHbM(94XpT
+3,A([$ZHK#&+IBil)Q`-N5J418`@9m"R&DNQhC6EljNi3[-Q*hX'$rRNBd6c@J[G
+6A`rH%cDA8[8jHK-!rFSdEfB6f29(ZHY-0-C,HN2hIBD)lci291k93N!YSElKQPj
+*!TS,9Xa8[-KLi@&V&Qcid0D#F6lYPp+*fJ9)mr%B(jS@Md@Cj`GThdJl[!*P+Gi
+"14Um%bm*qT(,6c@I*+cBm0dp1`+1Q3c*Bj4ml$PUJ!GkaCQ#aNZ5rFKkYCq)rMb
+#@ZBPYq6EL[RPTUj0lD'cBPA2fI4R$brE)G*CYFiU[b`UT)cFV0J)ARDLqjdrj@J
+$`@UYllZqYMY8`UKfkhEJTPh[e!K4icX!SdYQ2H$6AaPcl)A%F(!$"UqHhbJkeEr
++`8iJAFbe)!34F!Y$28"Fk2G6!f-%p0XaL6kV'T6dMH2edj6B-5+FNj!!'+5$0cS
+IS$A3K3jQCZ(39YBV$QDS&Uk2h3$fd8!,K*F!'berF`52(VQ18+'#I`5ka-AC+hi
+qZ[p6Am""He#*4'b*jIENNELc'`Z)-3cK)KZ!DT@QciZ'A5VhVJeTKQbpP,p"a%T
+E)"b4a8+Ji0ipAej*-B0qi'Dkb&4FiQ6p-KH%5+Aj3YR%ZcYY3K'!BN(cPq42#(a
+c8RXCR,R!2N8r5$m1D6ZNMj'Zaea9j&HkjI0F(&`2J04'!-6,f1fla@QJhi#m8lq
+EbVP-A8*h4(2AK(,S)Ma"TqEZHKZRT8lk%Z`UK,@mQ[bQi1!i$pU9X"$91kEiE0c
+2Um,1d[@hdjJ4laNl!PYL(*C4Jcc[6!TqP)4$kb,i!-h'6&dQMKA[@BDbhG4A-8N
+eHM(Ni$2Z!LM*(F`Y8@X66[K"DMD*`9YG&RZHEZDN`j-r53XM-bSHDdLJ9AmaqdK
+Ak(dM$*jiDCNq@kS"IRPFXV(J%hNLmj-4M*3VIr&im3ZC0*P@p,Xqi0j36qbNqh(
+-Yd2[i5cM!6(j*IiKh90)cf6)h5ALNUq03aH1ZEaNGciT!LX`UiiL0$V"+a1l@FK
+(MeDl#Hq$!!P$cE4Lk1UUZiiHA*@'9LPHK*3M0c9ZNR,M$TCK#%f1qPdaK%`[##f
+#HGHBN!!F1&$96iGbY8$-e`ICpe4BAS444M&lfGURYkqY6%Y1HCPmerA)diIGEY*
+6"jq)TM@R%cpY([-fB*LIacYAF8be#k`,h3XSDDkD%#k1Y!e6*,hLHC[0MMe,ChI
+m3FUDfmkLjX@EqkNT$QB#Jk5Xap0K*%&NSZce3Y)UIhIiTc-KFIbfLUeXLleJYar
+SZ5fG-XGB-DD%,-dG`2J-m6d*9ClUQZimm*BCapfEdfJB"ANi,8dfGXD+HZ6U-Ie
+Hl[FE9&@$ba4RT%SL1#86U&r-%@GBF!hUiT`X-lq#*p(I!pC-4'P[-VUPqqBC"Na
+!JJpXS8U[MA%!+R"6Z$qD*SdiiLFBi1`6("#f*)1SbTkRjHbIDU9834&k'!TBISk
+3!$bGq)BILAm"[!GqXl5ledL8lB*ZR!$mm68I(UfU$SjSJr()$IR2Vfqi9P84d)8
+CrMBZB4beEX+pA*(5S8`4CR%fY&QRVBeDL%&DQK-&D#f(+&kR9cF+%RL!8-,BCmV
+QT-4KI,05SjjD,VXjN5!3Lf2A4B$CTl8[0jXb-di2Y2VAdN%DQcCSRFV"*YmH!`T
+e,iSc!F!)T#*04,+"PSfq2Z9Q%mC0YjebCp45*C(,qhX3'GdT&"e)eT1bE3R!h%i
+0IqZ68CPPqH0(*`HeZ1![)*I4V+YN0k$(cU#qrc,K-Qa*%UIS!Mr66C0*-fq"kG0
+e-@YL$1dT`-Ha(Gi-cR!P8F8&,V4hid4TGa#"DH,im42aN3b8Kr9[B-8KJ6@$Z8K
+(j[cPA5cFAQN"6UG$ijRh4jC!l2&Jld#Ni'N08X4H@YYHPbY95#-ZCld1XDl6(*1
+h'@dL#a[a*A$pRGqHVJlq`Y-90ra8Q*8q6#ckPm8XK8Peica`VY&LKMD-pk66MV5
++35*p3G@$+k,)Q,R(cQTSF8$JHMXC2k)TI%#jj!r"Iq'99'drNj)Te40[J@i@Gm9
+#Ji"+AE60BQ-#ULdeH9MHS4Xl@8GZ+G!@pY',mI@Zc6LD-,NGJ6Ai#Pq1krV)HpK
+C!D,"dl58fcJ+jB8kL[bV#FPh`hL@45H&Pm5IUT2#kQ(q(!A`4HqIS8KL-,(I)%k
+$"ARP*YTGd"`cGPId6SJ1[-(UUY3+Ul-hd$%%1rBci`6-`0iBpLi0pfK3A8D$)Pf
+4rLF8+1rb3035M8i2e6$*IUbEf*9lAA*mE%p!r013!$fmii'TS2D40$P6Y,9!Sh(
+3#X[qqV$jhNK-,6[FqqE4rH)eA#VPV64T9e'K(S2a6PBba[jIkTr![KYb@XEQ16i
+YS+P9E8kf`'`8j8qfhibIKhPf4U#mB9+rbD$2"Yr,9eSj)0+2j!BcZaa(&C8D5I4
+Q5@jAII4h)I3m[HA@01$53aEU8qC$ZKkN0)`U$RA-m43IH2pll)[pBK(r$`ZU9pE
+iUBERi(bFa0kDB!%pG-Q@"HRBbqCVh,+fUSXd3,&1QB,aC&c!Tk@Ic3Zjm[beIb"
+ZFKrF&l(ReHbZ"-[Z"'Q@Z[cJfa2ibQZeC`)@N5-AZFlacjR0P2A8XAhfI@E-MD)
+HiiX4!cl3Pb#B16VQ5-FeL05Uj9ISMd8@D3#jJrcLRXjm)P""UiNaRK2)FiGdVQC
+H&Ld@r@CLTkFk+1AmAh0ZZcl$9,0XQej,i3DS$mK!d[5F`IE19L4MkEA*%#H(MY[
+(-QGD1kHT4B"PVie98)c(kJSabh'Hll8arj+ajKR4D'FHL8GID1Gk'`KeqD!YrUq
+R!`$[ElIU6qKp6@!m`kD&b+CFbE3'"dAM9kZG%ZGV,Dk3!&T)C$8619-#SUc81hV
+k0!&b9AHmD2-2-eRie#q51R#PUL#0(""Nk0MrAm2Xk@68dH83&FZkA9)VHB&9pj!
+!h)[[kJR!5"AUHEpBi,G&U&900lQc&TeFFfNL0b#H*e&Q)hZ9"9aGXK[4f4jr0&Q
+8JYQI[J0491fdeNAFT2ITQ9LRS*NFH%a4EiG-hp'5KVTE0jC+fVrrCqZ3!1b'h!6
+jkN#rm0N+*ri-#4Iq'D2Z38TYMrih+A2Q9J0Y4i1UX1Skjj3),L%RF#-8P"0I+ir
+KRplYB'T8cZ5KJEMq[+"6GNFIJTj)+[rqUSQYRhAVi141qG6qS"UbFk0%XKA+C*!
+!EPA#MY)Q0!,)L40bNZe'Df[@1Er92hd)aQ&8T&Y!a"N6YQ1LGhdJFe![+!2GBE!
+R8KRUN@fe@0aH&G-%+EA2Yarbi%mr"ZIJ-'cjl)3k[d"V49@&2"9X+NM9*%VhZZR
+hp&Ud(6ANF1m"ZBYaA5!!%[GIeYea*F1U$!I+q3'N5C9XTIGTjZaV4krl1hm@ffl
+2N8NT(`#[aG-&-0YQ-Rm2`d`GGjGl'"1AJhqIQK2MEXbR4CIkEJLI#-L@N!"dN[J
+kIa2D4&G0)M!Rp,P6mR2K6iqFLU`e'5+mQb1X[r(FSl1krib%L#jlpdc9@DlDl5L
+L'refe#+GhiUEqCdE*dmZ5,bRb4'80-+3!+Q0bI3VRiGRbVYiNq4JEjeDVFiDJYR
+V"N@16lldY#(X#jCCC1Q1A9RQU%&hSB*Xk%dE9fp`#I5c4$K1S$FjcIVXfF5-R[(
+%"2j0hNiS3q3Mcd%Q3-`YP!%0V1c'Z'0'E8QbZLj[(Gq3!*b)f+GE1,j1jR*R5QZ
+"I*U'A*2C3I65J*P1bXQab'MPbPLU,LK$"kX60J+1eFr%D3MiPf1pX63d)GH)0LA
+$5*0a6eBEA)NDIZF@XBLjX5Y4L!c5LpV0d$3cYUJh*6CY2i#8ai#TELZ+`bIX%(*
+#`VNc&U2@FI0)BbE9`5&$kUM!a,VL56LTe"0*MJ!kQ4(SV'SX"9`rbQ[jS51TC(@
+Cee+q!(D#&mQb3KMR%P4SdFApd4e+%@Q$BN**Y0SES@,%f+NGMh"jP`rAIc1b&YL
+#3'lAlAL8d+D!bR**[5TlmkhDBF'6#&`N@J+6F+bhcf5q6c*V0GGcGK3Ba2-qFkp
+`$V)(rfPX9&V%pSqYB$`CAqcjU3FXRAVDc,eUb@`4+IY5T)Q+hrN6aeKafK"@D"F
+kP8aXeQ2N'+S&8ZffCPQ-%iqH'H9UHE5k*c$6iRA6&%rZ9'cEc!UrYmcC'*TArf+
+k-9IZXiF(E6[a*'-`&P@#1`6dhE)P[%GSlQa*NNT0dI5j`lHU,kdHQD$Iq%Q$l%L
+*SF-P4!-RG8BdR92-U6*k'LPKYFKQl[Z!",l1k"eJPfb95$VFR&0jXJ'jNP,9M3A
+T,J8KNZZ4Kcqc"P@UA6h14LKl"Y4)e0+B#2,-FjiaKh"AekPlS"mf6'AGDMNe&UL
+Y6j+BcpbM1MfXM$XiNa9("*d`p8DH*CB#M)D2,$"+"YT1+drmb`9VU@K8(HGd&Yi
+H)9+$UYr@E`Bl@F0)I-+'5HJZL05i(LhdD$Gi3EYUfdGR2jc(Y!h$`AZTAH+0!VD
+UD)!feNm9ZQ#H"p'VN[#5e-qqmEAdTcE$IUe%5&!&JN,I,eXDP"qPc"'3!(MP-2E
+YCIjZf2FFh'#*0-be6$2FKl`ci`dIHeN!*kG2C`b2!1mB&Nm2RPIk)Tji(%$H36d
+5bcjr((5[l`qc1V`Bdk@4q*2pF8I$LRTP)6&(Ma)4lbNc2Qbl[iYL+-`Z1(1j$kD
+A1ZcST+'f8+C"NhVV041Tb%P6!dm&["'fqTbNDA`Q(GYZ1QMVf[Ye22Z4TK$Ca5[
+C$4efN6GKc-0!!ST-rj!!Lfephmei&beJZMb%%'rVP$J%PVKXkd-pNrUTIV4!3[i
+ADPGTiiIKpbZYD"#Rhcrm94Nkc&RkL@,#RAX`)N*ebhT9L-C8*'fX*lRf+M&GL)0
+MSI1"NA+4cbRIF(#ZXPPZ59Qd!NdV+@KZEb1J4)4%92k-)&fF6"*c#B9,eS*E,@C
+f,Zc*86pmjJT-@eB29DNbe0A!0kpid'19HC,JK`0p8ed[Z$Bi(e6B6AL3!(!fAkj
+bZ,#@N@DG`'Ncm-rhG"3Bd4PT6p!6VCd9S(H16f$d-4Y55L(Q1DY'j5jk4CDS!-Z
+D#,*'VUMYKUL$+#`Dl*VT39%%-H,J"CVBMBpJTXd2i6HK88GHfaqBi%CDECIIhm2
+XdB&DT5hUNBrp%D&3DHHf@+JMaI9,$B%+pj,3e1,K2$X&cd0r6Q$5-0P@XibEP!H
+p*Jr&T6ia%D`)IHl5e*Z-SK6Cp#h"+jEI0!P86T%C,6ipB%30a'KpB[0cD,GF(mM
+LM`-JBVr8RPa&c,3)8cNP(kG8@cMPRICUXG[6m,(Pq62UYrR2P4-$rajNlSGEk8Z
+NR9qCl)eL08MPqpV[lMGdpUf0aV[VY@IF5qd%cJM*U!l1"D+I04@+ZBiBT$QSCl4
+biep`Ja4hBeC$ef+p,[8&lh+)1S0@rfMjXV3*5BL,54"I+*Zh6Rhpp*C%V!4+",T
++j#Hcm@q,S-&H3+cIhYE#eCeVTrGUcAl-`qef5F0(P6kRS@kK%(m90'jKdKPPQrj
+TbXP4Elh4@%lhreP(l#NQ$(iR8k11EH-l,JcX$`p%YcEULZlheK+&UKphR$j&jJ3
++V!e'"fC2rJFZB%*%V[FSj[EpAjF8l5@Fb6C*1#FaD1#Q2L8mLb%NrLr!5J$$MMV
+4)Y9kYAI%@@66al,cCeq9'`M(hKKq2h#(-*8IUd[Kdr4'MX0!U2Z5I$lrmDqI30m
+,9ZBPc861aFY5YA3ZE%*-XJDE)82Bk##%6F6$FhG2#CpX'jEq)pXEq,)BVIU$"kk
+liN)fBe$9#[6D31$&6U+4!1aQM)S(e+F[2M%[i[)l6)"p%d()ac`TC8*HU(6V$qk
+Zek#C`FF)GKLF2dSFZqcE8@Tej*Z$$&d%@1qlSS3TX+hhQ&FGk!B(8eHR"kUF129
+5pQJem0f99[M1T[K-VX)VX4G+$eak!a6qdE0,EfU0SPbG"h'T1L[UrV$aJl[-CX[
+GU+8+-3![qk1QPUeFHQM8UNp(R1S'l*TaS!K1FFP(ra[Fe2$"RCm9V'f0h%Gjh,E
+I3HdF``PN&Z9mJU+HSKFqZf[E9XZ*T,M0ZM9V6FI6VUkh+cXV)!ZB@NMZZ1SAQmk
+&rdKHjNMMj$#18qepbdE&@0qr8B"-f+rc")SdNTNpU8dh-aRrG&(rCF)S,1p@UBc
+4GJ&FFZlkLHf3!0E(Iq2K+j4ja#VT,HB2Le'EV$G@0hLEpqraJ(d*kI96U@HEKQk
+3!+bAY-34!rj6R"P$6DNEY,f"hcaRp#iePIJ0HrC1BQGBBqaTBa"m$XL%dG(6ia[
+f2d*1!-f2jJ*TBL#FEN`1RjdTE,C$B9$9bIYTqDH4$EU8HeiXSNiMDL(M`SC9!PN
+KMQpr)'ZpLMVb0fl6G89%mKXpMkVH5icqLR6akKq0pSl[@-L$cRLME1LAEaqH1S'
+V5ehZAfDU5-P1dC,`4M55lFpAQ)Ph$PHCrLXBd"8kk`('`Aq@Q[,-564$a9Q0"T-
+T1$Ldqflk`C00LK@!Zd'V+,U(Vh'Rab&hK"k@MTkPN9'b9U5i8156,kLGL[6EM[q
+9Nq`NPb"V@@c53"ABZ-9kE+*JcS'ZGS8FCHB#Nm9!(@ZAM+H!9cXTAb-D$06X1E+
+2D8EI[q-&L$-[B9@Y`0XVE!KY"9I%k,KDl1+52V516%4KF5Z6$CCe'G+XRL9`fFb
+BHbjH*MP10TM0jlXeq)fdQK!X"4kC@V*P2YHXUB&8SD3`NP0iGIrrii`fL)ZaJRG
+ie$HZMEZ)6cX@C'jiN!#9K@C$pd5@Bc2DdmMMQ"HmVX#Cq2XU)ScCaYpl-UqjT0L
+%b*CdXqdXHaR%Z'jM2!`ZaKU0*NcJml%%)f*!9992hec0Kf5K0-E!RQMG,ja[21i
+G!Ji@Z13HQLLqdTQhUkKJdGp"S-(CkK4,EFK%",(JhSD6Y$VC@aYM-IKX0k[cc98
+bZ&[Y0b&B#a3+,"FM,mYe`l`e%Ya',c20%,8ZeFT)'Bmlh")q#NHUI*4fB5FYiNb
+D5P'6)3HKrkPN,a@KI(+83eBpU)hEpjr[LR*d2HmcKbV9"RCBEA&bQq"INhd)41A
+Gk62b8kCJKPh%@PqH4EY-U@PK`QHiXY(bpQT+iP!%X-9SjmEFaP8YbFrXA$SPEe@
+ef%K3NhI'20[-N45@@b-I$4'DPNrEG-q#4p0KXVR3X3$9q-NN$F3`4hhSeC!!8FC
+&F2"0S0j3jaLM*dF##H,Z9#H(e"4MkK1"D5q3!!)L(iN2(p4T$Gr0Ddr9MZDBLZk
+lrT`LYpbbrbBiFJ!$VH9kHe5ADm2rpVK,G3F4+E+,P!0!aqDi#1Tq5hm5LDk61)Z
+0XEq(GFYBj8BIm%4C,(Z&bXa"FkmK`0FqX(q,LK'q8cm')TZQ)8jY"PlHm9f#aYp
+KLTTK3V`G,(5!RPa9@aH"cTeqFZm"2Vciqek[kBdFN!#LG#%qa9F4D%#b8$3IFAj
+%3,eT4,0)f10DT`Rk$JG('2*L9++f)k2bd#TR4N[5)@NGlQGm5%EHC9Yd@3AYFQ(
+F&Np1@h!II*)EX9)frm0+lQBVX3qIDE%b1*@4YMS2[K#Fb6'F,@a4r!AN,FmAhkA
+H[ZCLBCbHCA9pSdC53PpaN`(Ce'TlSE0#U(41G6mEE2SKb@L3!+H`VcX+D%`AG5k
+UY3a62,d-`fdIfJhM-@l4@*&3k5P$c8a4%$!hm0,TGVNN*Q+SipDDQ5jMH@ES6`@
+HXL@SFKL0q46rBT1iY2&jk3$XlfaDHZEZEdr5ci+LL&8GlMp"qAICZK3DqF+m(Fj
+f-j1-R%T(Y%i%*AX*b6Q+ic9k&D,P3J6e),I[GBhZM*L!,j9ErEJ@Td8r9hACEp%
+Sml,q(i&E3@NehpiQ2@K4jDi1D-L3!%M0R1rcQ!lNaJp#kY%Z4S0AU88,hKjPe6#
+H)+[1eVHDi&JK&QlLQa4N,LVrraqjmmbTa5RaeEQSD!aek#krNXZ3!2SXae)5P2"
+dlhVM+8Q3!"0ZpdMQ)mr8i)*2f'%)S!K$C43lLMYL-TkP1L*p!Gcl*mZ@i!VCP8G
+fab-%8KDQ6pd)2#(N-%k`KSV),2EFjXpX*pPR*&#GcL(*f5"DZ@X`cE1%DMUDUMK
+B[["-bT'F(&B4"5LV[f0&BjKKmi,(U22aM6A`kM"bcRpMDkdd[iPZNRS16[#$+!q
+@3@N1b(r-f9S,f@-*Ul3rY'f[-jQb)Fl3drXi$0[BMQa)8X!+cr%K@0fhi$Bi8%9
+fG(E0Qd-bERQF')R*8+,DKf#HhN9dGrBiX`"$0'Z4'UK)%j-E8-B%N@pqXr+GdZC
++3&LQkZB!,r!eYA200CD8epj*8iCZl5+MICCK$qpfM"jTB8T+ZG08XR8KaBJ1@Z1
+(U"jXhr,)1FR9iqaae!@F[ERfD0fR1P3-G4Cr%hfR,3C,d`qQ4Uf1f,)SJ-8`U@Y
+Ua8d#@A#5!MqQbrc0e2XfGd4qX,3#Mq58#qp'!Gl51(LXT42Z@p9(4(JlbFA'3@Z
+'+b%!RJl&Urk8pmL))XICJIY54IIVGR&C)e(CCX'4KlSfNUhk4#VAP-rVJQ0Z5T-
+VQ$fqjmp'G2h+ZQ["ETlKbABUNFMH[51rJI'J"XFcZX0[J8UXJq`XUiT11"md4I"
+3#VC)A8E9@"GSAR@D"VBi11!'4rDirG05l#8VT6+C@`fq4&,2AJjpXb&,i1hrc@F
+4cfrZ*9j'F5YYAm58r[Y($@d0PN`bSFhL0@X"Vp@mIEG"j2"ai"rUIIEe3$8r*HZ
+cm"6+HXh#eJ(Y@IK@B(-#BY9IGrU0TZQ4!$6eL-+MBIBf0UBp`liV4"ilUc#+%@&
+aDX(HEcMA1'NC6JM#Y0C9"Z(A-'T"mU)K@(DUhmjcpfXQR&K*SqIpl*KaQmpLI!B
+NX3+aa&`r!c4aTPS`%"qr-&dGf%r,mj1Yc$G#EN6T+fa#03!P$Z(K1&faFb32ELD
+QBMBVhBY,lGk(V[6I#q"jm84-JrYCe&B@H)eDCET[&'QU,-V3DJ[6N!#iQQBXGUQ
+-,l@T%L,P6ZT-l-%ml@qRp)9mfmCNqpGq$h9e8d[Y(AQKlJd4ii2R@qMJpK+!aRA
+$pRfXQI!QfXDJCr('+m@iA9Fi6$iTNpB3-i`Z3$aG"Pf!ZEI2hYjMr"U(eT!!6V(
+mIRG$RjNhh`+,VG+Tcm[911JaeVY&!GLihdjTe6Idf$Z4)1rd#b-8qf&a,fh[1M5
+1dC+e2e+kS'5Y1GTp[KC$`9r+5kT'+E+*$c4hi`kP$2Ka1#QJ@A1p3"U%U+GUrC0
+A6TlmP+B2@pRSBi9(hfiie4R+25AqpE0211DSI@q(Dh@CIFm+1(%bBp@L6I"29dI
+Yl3m!r-049TYd2d(DErLK,cD"iQqHkYE'ladVAThp5)"jSaCJ)Mhhh2MG3Sm`YS@
+1IfXcRL*aKX0TXN-%ZL6M1AMX3SLk`CRmbNcLT'p6N!$5F@4*XceQ0B!!LdRi0Kr
+ZD[d(5M9+rc!TM4P&fa!VYZ)#EUZlQkNGP(YH$S1m6,%6k13"3!+J+4TkT694m50
+LGF)X4P#aceHZIf)")&b'(T0F(L[i6m6jbKKNSr'%Y6$ZBj3L3,fldA)@@(q`Yj'
+*PaNZ$5LTRG#cPHSpkKXlpTDPTb6@PM*XXf,iIH08'BBLHT!!N!"Y01-5r@*rE&m
+EM'F5VGZpe6mj`#*9GXN0F!3e+Y[D@&-dje3m"@G$-j''4Zj[Y%#MJM$mlLfQ4)Q
+pGD"hZa8)8eDaRdrd0d@e(ZfiV))'TG[@![#UrQ65a*!!9BHCQjTAE%Nl[[K%U1$
+#pb%a3hZ5Y@0e`#[*K"C%i#$0J"!fYprri5l9[NU#0Ska1m"*Sm0*mZSFM"&'%&9
+5'`MZFkPVKMQ"B@d88'I+RU4UpaGFTC&"m)C6ZT(Hb+1%i)d%mR23-Uq2AJNaVDC
+qrIrbD*PA#8k4`+jJ#AEcZ,jbhCC+U2`@HUhUL-e92BLI11#455Y%JB0,J'-5p+2
+QP'I`j6+'6K$6Tb"85D6,kH@9$YfFE@&ZNHHHCb+VUJEa,,N,A@Zr#QqkMN1T`m%
+6N3MJF2aV)aq1KAX1D93R*K+MT)c88(UadS'1Ci"fZ[+U$P"f)##I6``E1PbXmZ2
+SL%)E)!89EVY-&4ahe9+EAcf1ZGA&GCPkbkC[kFQH'Gi0Y+-UJqFY!f&8i8kX[4P
+6hc+AIUE&j*U)[[ZKrMR'9m+I*&Rjl9E#q%P4NEkD,8%XXc39UFiKF$d'Ck(rJeQ
+4j4ETi[h0L8!EhXj0,KdN[mJbNf!T`Bm9b6*TA*[MZ&J&`H3-[`h6Q,MpC1&Qi9H
+lr[PB`0[3XbQ1q29%V$Xh9lbEJL#0U95HZLY1PV+#e)JFiDEG(h*ZXkh`(L%SJG9
+PJ%TfM9`,GIN,b+QScMJSB&dJDj!!Ij+3!)4K2mE`[J&l&#KMf)0FPSMM5T'"bTA
+3Bk+VSrmEqRYHhi&`["&FUr+l3MbH"LELKJC(@`1iBKAdHZRP#E$2bd!G(pi-6P$
+YLe3iBq8l1aZjAm"29)[KF-)GR$UP@i`&V*4a05e+KKpBA#JKceG++Z5KT$6'%0-
+1dRBIdR)B$*6UIP"Zq!hM%IBT(X%dAF9ZM@X''8abee8RRdpPA8hC&bVS)UJ(0XF
+6UIj*FNp*p4YZ*",qYk4'mEN[Qi,DHf!3lV'-CUeQi'9`Z#b(i@P#UaM@c"F'[Si
+E6RDEFGlM[kX'e2*,hKf88Sh,N!#l1@Lpp[)*krI$deM8Q-l+)kj8SD1@j*EL5FX
+aE3*#D@3!"df),L+fX!IV)MlKJk@k!VMIq4RNQ,,$HF#),*eA!D`+c1Y!dAc2XEl
+[AkAerPdi2qM6-G2BBdq-K`)b@9IN0$Tr%9&3bbpk#!+KlaA3k3T@'48b"fAK8'%
+8cKpcjVQD@"6f5K5Q(801kR*CIAp-HC!!@Sp(LLJ&DmqiYKAp[ScMTURThi53!,D
+3!$fHDViSaMGf!F0cGiF%P'4GbKL+JVka@-eZNRf`#JNT91)I4PakCQ'+hH$HpUA
+dNDfA5$$#A3Bme5)%1I1+8S)(qdI51QV10AjIIl1VcEaL6#'8AELdiDiUeR'Dd3P
+qMMmm-ZB@khje9&la[M2&LPA63KT(mVhTm!M$P'r4(bVi#[h-Dr-c0U8Ie146A6i
+@&j+UaM0kRd3ie6dqil`a!dD`iCqcfj2&iq"4Tk+i0f+3!,aj[mqIbj!!Vp#i"lE
+(I&%m"pM,mf6f@1rD50dMHAVKDSS(0,e8,a450JZTHckHGIrH1!8(I1)[-chSpd6
+d,+UZmbUSqSiDMYKkXdf)T(%r#41'QTV4PP)&65-DJ,&p#B(cj+qM'QmGU)FTC84
+%%Qe34QE)MS!"aX1XV@qf29U"8D1[,Qa+KjP[4'R5E5+15E`qDS-B!QDi9459C(!
+AqqlAC'VhXmKhk0V+Lc`39rhLRGb)8eR3iUJ1,KEjM5`K)e@D2Um*hkNVhIY[VS9
+A!4b3!2dS`rp1H[b[cQY#k@YI,Sj`L*T#6)QmIf#[h%SKaR-H#KkAAEZlqj!!`63
+VRe*TAEpY0Mh8+$2H[-cc"RBm)2jRC"1b,2a"&CZ")aEfMjF,KC24f8$XJ+PN1E@
+[6Q*c0qX%HacZ81'qZMBH%*(V--RiSA)M2lQc5m8'18G85AKMUHAa%!Ppa!X4AM3
+R0D%5fIbG-CS$2P!BP"S,YECj2aX9q6Rcb,fF%GQ)P0Li*d&Jc8ZMHC!!eVd`be9
+G3fMJ0b'VjNFbr3e45&HBUNjG)jA0hMe3)cG0bd#pciK[ZDq5h8Bc,b!kLAlidB'
+96[Q"J"2R[dffhP0lSq0NEHqQTAV$!mr3Ydkk5!LK$@AT6`'QJ-0,!'eAYI"K8qp
+%aZbKe$r1fF(``J8rhUmJX)@8EMlL,N5p(NQ3!%maa+Yj049*"C*%0eC3+KUT&IS
+%JmT"e![bpc+)HYV9K@6q"Ld'`1jC,XL5@LmGZcA#0%GepD0Q,0@1rb[lIBY%e%A
+R!IB6%I8d6A5bNaj#'[PSM6Y1Y$-l5a9M6LFF!0IBIf1HaQE4RNSb'X3p0G3DqSe
+@IE22VMUd)'XFE&U12f%S9Q$GURZ9`FqcY[#`!bCrL[B$pbM[XlPh4S'3!$V2c33
+E4I08RR%JQe4j+Zp5iU$Fr$h`5*fFIaf9d,Hk@e*4"-68L9P)GrBr6)ff3dfJ+%D
+KD8X1*0&qc,V9UBbDT!JY914J5)C$qm5$1R&klE-&&%32,d&kpSV-!q$r3QDIdV"
+FR!rVJ*c*VUpIjLh!ZFcb*)1jl$1c(5K$2m5aEhG@4JlcDX@YfUeq$1b$P$S5UfQ
+B-pSD([6fUjj`#d,5K&f2#$3C&!j33RGB*48)6bJ$B(L63Y")0hdN"adU'a"bb$G
+3H#+V56AYR6kVERKX-iq0@Mq+6MqQ@bl8mUc[[!Lc+BC3qEF6Y5EYiUL$F)bLT'-
+)ChkRc5KE3`2hGfpV6qNXkHN-bepe'))[,B(`e[S4pR3H3kXSBRPk"!,!q"plem(
+G(qPcj!18P*rl80-Zd&JFL9XEJ5Ybl41JjAj5l)'b31L#eM-@+qU5NCqeA4I1QD!
+L3b-B%42dHkTCQk63ml&TPQ)S`I4b"VGQ3Ql#`9hQDbURYShP(Mm9&+BmXkfZ90*
+UVrRrNkJY@*&JDVQh4FT9fp[hPcaUbF(50SEc125'5L&pCY#PN!3"!!"#!"#i)p`
+!Z*iA&`!!(DB!!+m+!*!$cJ!5FK8!$Srq!!!ip!#3"!m!9'Y-D@*bBA*TCA-Zci!
+ZH'eX!!(`Le4&@&4$9dP&!3$rN!3!N!U!!*!*!CS!N!0T!*!%$`"#`G5+Fdi)FiI
+[%!&,i2SlF)k&dU!8b[Ak-G[IFMe+Q-f3!-Emf&(([2ab"S-QlI48kGFC2Y*dUkN
+@)4fE!'(FHZ)"L6'Q*GT-@hhRL*qJ*`&B9L'FN9CmIM@+X(ZL$iaHh%[#69+d-Gl
+!3X(8KJ&4pJl+aVH"d5UJiT@Njq414")RUCM02S`KA%"RmPJh-e4KrYIcVGfq2AZ
+%YET[$NdbQb%L05K1VQf(V"#&jSHM#E@5#36JlGTk(ard#)$X-,C`q'NhqAY[h5P
++@K[bH5qUclX,IFc*E'RZ$r,p-X*LEXf3!-3mDi,''eK35+19ib`ll9Flk6m(D@j
+Kq,4(DR(9LPDR@EdD*Q`RiTY)rfpHA1$M2lZeJfp+Xb+lS@48B(#c[pS1N4eF[(G
+!b#Dj$-eJTcmTLGfZ6F6D5%)md`#8c$&0F%4C1hQN9a'16qe'"pH%BbGDXVrMQ8V
+SZQQqh+)a#%(ERNF"ffe$2(da4T4f2R$DJL@6A2d[mMH$!p68I!*48FN56fe$iN1
+LM9dAa+,3Dd&#aH4FEICe%P)DBGK+`3RGp@KS!+j59LNei&P"Ii1$9JDLKLrDI4P
+$r*fX%k&@jY%Y)#&SPVGVk(A1LHmCHd0HjF)mbD22dDhL#FG(K2VC1p%2!)CK%GQ
+qPAqpJ*!!2N`Z##A8,%PNRiNe!A,U'`deF@VF#Uhl6+-V+r*pq8lLfa4k8#YaJUM
+P,CGhrCrQ0h*l!DR2d&hT*5Ar'#IQrclT$F3YVr&MCHkV#4J*`%+"R@$5ZLqR%HS
+6-GABYqRM*mqcPGJ&cdPRcXm1[cXK+MVbX6YKj#VSefed@q'dEJQRi"T`$%,ILJf
+RTUfc"%HGVq$@bM`C%l4'`&C+jke!-Hm"rlb02K*Fc+G9`pU(K)G+Q%qdiQ82Y'2
+5S`UU0Ybp(N-RbpH(kY'r$Kre-Dc[0lUe%S1@FXJGI-AQj"hpr53i%AaU&QMGqk@
+YZ("8HaNc6,6q9m,K6'$ZbX-"9d+HJ*DY1T`0a1-K61jNViT6bbmrTN0MEG9jl&Q
+I)I6Gh8F&J6P4b$!4LqRIa*`@e'9U6CpEfETI)6k"F*9%d"N#QJpkMbN808V(9"8
++E!fmaeBc98i'eJI,"HEl"2haf-AV6K#PP[F-9k+iqfEY4'dalN&%299)hP'#D"C
+E*d6k-!G&UJHHYrr5k`m,mGK#(h$L99Y'l`@md&Kc[H$!bra(rAS5IMF6dVPSIY)
+rpK3,8MdDD0&Sl#Q%rDe6532!Qe+i(%VIX2HN46-d`X%a($&!VA@4r@JBBfSddVM
+0DlQBTH[Feq1Af5VH!U%G4RE286%%+$5KPaB!28NUX!D5@3U-AJNGFC*,5G1TlZA
+C)bkHMG&1aD%0R'"X#RRCqZRGE!4CfmGq!%&1Q(XHUZVHDpeMJ-AcKheQiq%!4YE
+SJ!-08DYlHUJaL"Aqd8bS%N1U'jh2rrCp6rc-arP4T'GC1eT3%l!&F#(U8ZV,hXE
+'5i(iPi4D5dJXbSfYDPrFC2rRD(dH0R-2D1e%lSdA9eqVprE*b0-25KSSJIcB`&4
+c-a`jlR+M+6(ZAH5fJULR*mM(qlLFGV,Z@+3`&QDpF5c2pT03[8e4PR55N['H6a1
+Z6+hCG-$#YkJ@ETKhbPdS@f,CjpZ)Tm,Q*Q&*J[*T6C!!N!"M(8$Tk%p'TNfV02V
+PM@+UkfSj[P8ae%+'aN+cmX3`p4RaMCVQYAdr4@RmLC)2'C!!9U-6%8B)dJj0e8+
+Q2iGfV3EUHESKaiS%)1ZF$JY&IHI25ejA[C%ZqlQ0(Y$jS9Z$NE"bBJTD'RZaP3&
+Q[LA#DL-'JY@QUYiKe4ic@jrXI20&5YmjBd5hR"S"CTR*6UmC)c-G)Y9,4P`-9qA
+%3$keNPI"R55mZ-c0cDmCUlqL`Bf)E#PQ[L`(#9aRRU'V4Kkh&IbJV,GjV$ASa'k
+qcB(S@l5J6D9R*4ka0%&pV#qab4iJ1FV*Bf39NC'LqmCEVCD%lCrBBD3%(S*e(!B
+![cFZ@X(XG@Z83fDLE`GNr95`[i5dUh&pFVIdj!V[QhUaZr(DYR6GRim(mF(#)1"
+h'S6H#DV$"4Na8I"[i)cl$b@T2Qh'*b@2i#l5YqH0q#p+pXSiKCpiGS18cDdMUPi
+'9b"E)8JRAae&F,TBKi[L0M6CdAG[VbZ2jR8-R-!lNFJ+2KIHjTi6&j,'-Jhb&Le
+Q'TkS9PdVZ8EXm[[PlHD@bcZGNI'Y#[!a[mSbrY!55T!!590P"dMX@f&DEl(X%cd
+dDGZ8QYSS2'hr"k$8[1baLSHc%pYBlKKh1dMc`khBhQCT)[GBF#)3GUqR4P+6A3G
+IPXidp(0,["HT%ZikpY!2,-c!hBqUlBTV"!Gr[$U+6peYUG+LL5BH'9hPbGar$1(
+fZURlaP")GlG+DKBqh9N)[lmqq-+#phf(HZBZKY)8CQkYM35h[mG@hGh5p`29e)-
+fb+rprhb#jK)JbD$-$I6HFUfp3UQk8$lUq[5jk%EKK[3!3FmibM`N5AfGSVE4iq-
+eISel1HCik9U,AQ"RXe-1%R$"'PZ1D[e,&imN59F%&p%ZY[(85,eHqf#fYlblVN[
+S4p#L@$qjf+4jZYAj5E@JffdJBC1[@@(Efd8UCZBRZ)Z,"bI"K3N!MF8#)-q#"AT
+MlqJml@dUpIRZC(hR,AiET%q*CNA`m55JE-DJT,b`TIrG1K&aN!!SYH2ZfaDH-+5
+`JDF"ij!!mIGA%XRTrRUBB%ALXcpGcapNF4G@`4fcc$dlmZ2Bi&NZhb[E+1llZ&4
+i#FH#RZqRN!!XmLRe2#XAlmNiDX4B9VYM%SlUQJiPNleEica"85A#4k[R)Jk"Qh3
+N0(d8*h(0U1P%4MXC9rUGKLM'M,dfMQh1F*'A@iY1f$#(ACANHl&S&Mb-B0fZZk6
+)(Z`C('4,V5aLj1f2,)0U6SiK$CV#BRB1$Jdp'[I"rQD2$EP*9ReD5&eKL$)XLTd
+MdDH`ri5B@f546!Tjq8"'fJSFK-j+0h#FeMNbURi2M$J4+h-@T&ZKBDl%+c+iXQ&
+(cIF-2P[-Shr'-YlM($69X'bC0P-lkbUad[([3Ql3Yb'cAaF[XNe2')!qe,SK(5M
+),K,!TNBbKVriSbL2H4VD(Tjb4SSRHa5N9)9m)13jhc$K6L+PATadH#dKQ"B2@[E
+GKAp$6k5)@G3Y#XG6NiUbN!$A0&jJ"Fe!!8JfXrDI[%2qNZ*EfQ-ETKA6&q5P-+j
+d3jKcRfN5GjaC%Ad@6C&TirTr0CNEjQL#FH%&Jq8b&2CH0('4EeDLa([MPBMe95l
+UkR0qFGDb6I1UQX!hAPe)TiGN4b'T66k%(mG9%AiI%165(N-[&`%RV(61&IM,$DV
+aXk14#5hR*Gh*f`@9h#P5+c#A-*SrPfG&UF(f`!(Dp+$`d$IbP'@!L`M6U&P4C4%
+0J`#kkrT,[9JSJKldJd%JbLUD8XbIX[3&%`-)301YqFT#1c0!+(8q44MC@"-AL-%
+DH9aBkpp$lp@,rb1Yaf6mAU+*ReY0#J!,3kZmA6`-C0ib)`rpjId#8$a#r[K$kb+
+%j8i6)8NKX[GS56a9L1mFH0$`,bSNYXa0HP-9qR3j@Rp@R1(qQ!Vc0VY03b`FS9i
+S@((I6d-9eE1(f"DFb#$SRRM&IZhcQ`DEeRhX-VZemV"hA98T*1ND6iT0Tbl5hlS
+5`+N#b15D)'@)C5AC(aT[2hF4D9Ih)h3%2*K'CHX[CAF33f#USeKC05lZP9Ei`Dm
+(*`0"i@2rHLHaY`B,9JUGpCm"2fkF,#V4@NfLCc0PYUK#&rBU(lCN2RITPNRqNrJ
+6D'M&HfEf!HCmaql1&U)dD-Ei$p9majCmLLC52*!!k,[ZamN0(jA9kG0ZrM"d)56
+Jr)MEXB+*4*[TiMije-XH@qkN4NPeALVE6JE1d0X&1R&HZ'4A3cjjX-VM3DF!h4M
+3+$RScc(L4i`D9@8)&3q@h613!*(6fKa+9-(V#5qU$hT8iaSFhPfikkZSX52DT60
+J&RUK'4N(C'&SXD"Q5k5V'6Fbjk*2$jrFGKR4qpcDGSCTL`Ch&aLHb+jfa$4H)f5
+cA!85N!!qRHCDfp%ErEElhRDfLlJrqAS))clJcL2HFC(4Y,q6C)FYMIhH["+h0NF
+MSh`i2A9VBa*M5d*%Lh$F2fE2E-C8IK1rmIIl9[4dM,*GUek&pZYaFE&$qpICaJG
+D+&#C'4hTHL$TBqD*Zc+!lLR,&rBamV#PmJed#V0KQP%lEq2'c2'1-$FREkadHm`
+H$Ek'aNa2Ya#YTH9P*`,p2qf"C(KdBQ"-8VchUF*ALI,qe5S[4-L6c%e!CpE$FGP
+N-1SFS"*cMM4,l1IFZ+AjXq,)9jImMpIR2(5B%*3CmkE@`-`p1Xq`N!!'S(pNPJ3
+R-NRl+'56HUD!R3-[V00MekFKfl,TLRQQ)mimfUcc3XJA6LPj3C@HC'4#SpL$G8k
+H`Zc!1PkLTL4mH"H1Z1(QNI8UE5U'!##RrDP*5qk(,#JNH4+c2dBa5S9(-b$iqdI
+EJl4N`CCIhlCaM@Cee8hmXX[(P)MQHq+*#+Fb(jiGGhqrKK5jdEN&4(jffZ3%aLb
+d1PV85XJSTpf'c"&R`4"B1KbG5A!'rmZ)ZG#jd0(dc%)U@#AD`,,K(ZfE$lVKP(Z
+%$-PP%Hed#N6h&!MS53%VE69-q0U08%pRrlfMYIhRKHL9$$&aTkI,$`4L2XN2l5"
+4L0[-[*j"0FE%RMJ9G#D@MB-pelABSKIqhSSRpZh6L#5PNhS+qKS36Jd)URUY@4Y
+GE)2eL!kJH`0Z'D%RAPFZ,MZfXa`Eb$6H(#iLUrpG'JD`*q-i8$jQU[YYk@-+&c9
+(2KEY#!%GkC553HL2[X![Lb+i#`IYkVY5$Jfi3QeL4)X5[f[6'c1AT49$qhrpR33
+T+Ze409RcFe6`Giqqp#I*V!EUQ"505#2TR2qQ$GHTI#0T6b0l6eD64lcLRFJNL5*
+d0L!ThHEFSq6*[K2R(FYaSTAC+d5KcDjG(Q2!e'S,P3SiJV+9ccQHp41'$%2+h%1
+qTT'3!1PP#JFr(35dA(94&HT+R22)p!LS)akA[3VF2Dai&3Jhd!QR2N$D+cF)#[#
+jUAbRS3h2YSc+"%i[3[+8K'b1m,mM'd[Xd"dbY,85V$ec*Ef+Fq95DKUXYXa5p$P
+mA9X10E(GddF+6(+jfE#jZ)Z)eiR55IG*@10E`jQhrN'mFVkDcdGZ2P6B8k6l8F"
+5JZ"F%l4H6QL%"#04983U5CaNq5GaP6`)d@llp#'b*'pKd69Mcj,HLrNrXkH-M2Q
+#E8)3(L*Q#E2'1@XH@JPc1X3Pj`4YTfc#4BDDDq9"C%X&a+FLrQ'&H9JN3UXM4+R
+j0pal5dUJQ4QV&*9iT'KQqM)PhcQY5aYDd5H$QSPB%pe+-!%d6DrK4D@C&lqdQj[
+J16$)P6!9IVajq0hF%5,(lDRZYZ6[(Gjf['4EVS"N@eD##Qb`rUbDU(A0DN@dLRC
+8LD4)Qk*(G)3E+B*3jER8X'PSpSEhK%*Ul&iK)pLYTRA8iqE$"Z,1aDBcJG4&jCh
+'dEcL,ck*2ESC+P6-Kfam6Vkhbj%#)%Z0#j6dqeb-9fTamcVZp%"QZbRLNEidGr-
+N'8bR%4)+QJA!Hm!0-2j,QhTr(iXdkCC)h'fAPl0VDbmb08bfdR#U69im9l'L!R2
+jF2G6$(GH&Bm6"mB-VBXGl+)qFdP(Bc'8*&RmJc4V8(+B2j5&[021Vq3X*rm'P0&
+JcbcC5!A[90r$jrY!`%@Y6"L,qUMMR0q)T0Ep)(9Tc&X*Ua(M#KL"ar-HmYPb-dp
+Q%SU[kAikHRd3%'VajSL'Q4UfK@iQ@@2AlI4f%STL2$K-,McDVpNUqT&Eeb6TD+9
+@2KjG6LkX&VNKr$I9GajPf2B,9XU68aEV8hUCDG(iq*e9mRh&Nj@qbT4biV2"R&Q
+HF@MPH%@[Jik[`[Mie9[kSCRq33'ZFE2ZKqPVH(I4+44eQ8fGP1L3!jeVMQ0hPS`
+&2fS53!IKUKir$PL0%6hP&iAe(eKBm3@f@lAh4pU58HkD@5,6Ca(V)fmKB(Xc3%-
+5Hk'82feS@FY%F01S-F"b'+c[C6fY!h1$H1feZi2blQ)c#FFhHV*XQ3jh%APXZ+Z
+KM-"jLEl23EfS&ha5fV*1L%dclB@G%F+$+"d6f,8iG1'DN!!'jR+JZk$miINQ*&2
+qi0Z55K)JTEc!325Y'm+%,+d6*h2%bB"3V9lDSIaH8k+3!-*YA8KRl!UMYm'9b`E
+iDd$ZrHT#qY[BSQeBL5be$$N418d)*1TkrbU2#3lJ"1k"S8"@Rk'rXiCXrjaK"GP
+jCjGRPTD[+m9fJ3+Il[&VrSUmp)LC+'S8&H*Qiq*a+IHB"ld58&r"Q%p0rNf+GIZ
+Fa(QeLGel1PN,*1PIU3#-V5d6!Hk%k[(2$&[42,9EG4eTZKa65@BDATXcHc`TFdE
+&K*CGhK#R&%S3QZZc`Q`DqB#UDEm`5-Jjeq*lb,4`[cjXr`#bc-34i-GKG1!,M@G
+"ijCIjEU[PZZDCL3I(C011!a`d*1$5I@Tif"&HV"M%!@$3mNYk9Cb)Cf"K@B2[ZJ
+DfD*&G'#$FbrbZP5ZIhU5&'bbqD"&A$%ZDdKh,C-MA519lLlpBaU+1bmCpjZp%F,
+iF@41LNbA!ZQSc,TSCCdb4#kAi&0El$0bKbS6DL6hHP8MfN&C"F%09BLYE86Xjlr
+1h)()(ElLqfYY-i%$ia,"51ePUjCYA@Dmem`#hCd4f$GZmG`H+`SVZ5U&Q4+Klcl
+mILX3e9dlri9FP@qK,J-+H8Kj`'bZpf"TiT!!j[S3L$T*[)9XPJBVk3%,"+FDrcb
+4'8+X`&QTk@V&JD3eI[6,13(Y!6(%I**5IQma8eG*Q5"Edbr(+NE4"1$GNclSBUq
+2A%m0Y5r2&VfDEir&G99bp)YEJ[EcXkL`E+jAIKq#CAZe%AQ`2+CamcrNCBT3B0$
+FU8e,*@DfM2SM8lP`%*U5#dKbj@B@faQ%F!iepKe39jP!b,j4TQpAL)+hTH*E#6Z
+B#SRijE,3D`YfBSdE@N`TbDR@I9IEl$!CQi12XIYTN!"GNR3a[8%JCSDEHhNj,Na
+i-0(L6fkcI)r+A8Y4kDX6G9MAY),HSDZS0i)d)r[hdQ-cPS+"I41UCkcffp,B0h"
+mc6"9h!VrIZS%jF--DfRrV6@k$!l6V$E#,Upd-3#BaA9%,R1C&8,CDB`TAe!4pCq
+p"$E,18&4NVU`(Xh%0C%K'`LeTm&"r(*&Z!NZa)+&E`Q0Q$B!D*`S9PUbf!+)V0d
+bQfN)%rmFE!$Kc6dTC5LRD8`32q%4$+Tc0E+5@RE#%U','Qe+9e()bKdLGif(B!L
+6MGCVNQNYLK8'MpFQ,JjCqZ44d+iII&QkCjGkaFB)HS)h!mSJiN1&rb3MfaV+[m"
+2!cKra*rJ)%bJSi!6Zjj4Z&2Vp#9daNF#ESM3Pl2VkI)&VV,J)8CZr$Kk9*ZjV8k
+065$%i,Rh*rEZbV$NqjGX0Z3A*3&LLZ%AP+cSSi96hBDjJH66N6Vmp$piVR)T2%9
+3G()Y+-4RTf%MZ*r)dlLZ#+0@!K6C#$PqHVTGC`ZNGZ`Tf&,bB+0Y2M`VDp3"MSa
+"NfaLM2+Y*M"FDIAG28DE#,AQC2SJMq%%Pi*m9EEr"),ZKP&aYK`qha2#6514NLG
+c3dQJf2Rp$V#5JLlPN[9HX(F)jqAM$ir++%c[10BRV9EZerZ5dj5qq6dSjT,jf+@
+MVYdVPAUJ&CdAU6LT6bY4$G'`r0j&ChGRiXcLM9S-0KZJK+qecFJkNa&SrLFZG4)
+SjL*KT)A&&,5[AC5hl4Rc8Lie!82)p)!C,5*S*`%rr&NALLlT'GH5Sp$jbM02%)8
+M[%JiYe98E#JDV"NL1#J9ND89fX@kRdd&0Qfkh#Smq9Bil06PEMeSB&T-L&1H+bF
+dM$VBjFLqbXJ6#eRQ!'-12MG+VIGGGlqfaG0!RrXGl,U(l8lU85m#8&a$0kASiSq
++!p,YX5(&&VK+1P[m'p!FdXd0rXEPL3b5i6l+I0a&@%&eY8dX593bk%UATbUDK3A
+C$+'T)p%j`YpRBJMT3+AXbH@C1Ml@bXI)Q6JTK)KQ6hSe%-Ujb&`chR*3K%BVfrf
+Qp-,2c5F+NHqb98mRl#+VVdi4)*m@8eQV4aP1P`EpT`h'Y%a+TNUMXLYK[JR(TLc
+@%KrE@9r15YIM(*+UlXcG$Bk2(prQe*GHGVfUr1"qAmG"*"QKVp%!Na,'!GYSjS9
+$dTl5[N##h&+ARqqQ*fFSH3'BBrZrhhqf4B4l`B(0KC%CYd(%!Ge-jPbai2H!hZm
+DlY$p%$ZU0@ZUP&M9T0lc0,&NN!!'YbP+XI",#QFGjmT$J&K+Q(E$C93hTf'S2D@
+GKTFlTm3*""Vf29&LrXH%4,E5bKppFY$08*H5h@1#K)D#k)Y*3Ur`(fPDc$Rp*@f
+UIh)cQJ'3!*rM9&hV)8H"!CE'Ue#c%*Xh+iU@c9e`'TL,QEYh`!a4KQ`2@5pl3GB
+DY0AG95ZVJIPSVpSmd&r8kTQCddkNbcD@c@1jHDD@UJLL"Y8Kq6Imfd`%YC,1*+M
+eb*NVYES2&mmpq6-SQ6Mj,DfilM"2ILb5[5XN,9"QcTFPQS3ljC!!lmUCSI(#)N9
+90JX#q0bhY@BbJ1RJD&mp$4A'S(DM1`bfVIeqAh`I0S"JRE*qX)e%6,GMQ#KcdAb
+2AB0Jp9EUeVeEiMeqrplmfA5PP9I"AJkce""2rifmKp2E9j6hY8T2mKfii6"QE00
+L6cPZD`0N,NQ9!fVYdQXb(h0qc%A2Q&46K6!jX9i,ibF`e*kY,F@[2kq9SdYr6S(
+FR-9ecCrP$++4+YCh,jX9IhVKQXr0CHIr11Z6N!![#'IY*j)H2,"Zm[`rk$")X4I
+,*Z,0GfS-p&4F'm4ZUm"+Qp*-GS25F*-&"mjQh%I+B6KFUpa(J"$)Sq9VN!"NlZI
+lQEjNC`e3!5k5#!KSeRdLXcd3E5R'33iiJ1CSD(I[j,*h,5jH[Q-&"(E!,rAVJ*e
+Bh@I2I#[G2!9)AShiFCT9Ea2Cj0MjYVVFlHfU!#(lq!Km*QL@+CV*G2!NI[UEZF$
+F0MFk1c9%!hcffQ!a8fkcE$pZ%FFPl"FjAl%X*f+8[rTQ2m%bi*qb-"[#@hd[%h2
+DMELeR,UGSSQipZ@)8L`Aj+M5XmX"X2-"CpKPI1`#(EMr)e9JT`0dJ$9ET5"CJCG
+H!I[880lN2,qfj0fc,NH9$-&RTmhbKLla(kcAI&iflZ,9JbGNTI#VQi(f`PHE@'1
+HUbAKSR!aalk9TLqcbpB-PYifI*PbHJfA%&eCU-Y$,hj*i6j,)0`4U42AU,Ajmb3
+RaEDL9#S(BX3!f*U+PflTkGL95eAAEAMMD!'"56@a$c[Vp,r"'L*8acq[dV+)*Ne
+lrZ'[a,9fXDS8IIfa&[TfGT)HbAlINIC!*RD@)31a!hdhmpm32YU%LlbNeE59`CI
+VNGPPkG+*i9P8N[jp!m#K%X[kqPbSH6521k(f8PG3R`-)421,X4#8,Zj0)EB3QjB
+SN@K'RE1Bdl`#$&-5FKRCp@C,B+drm5c0YiL3!'am[VMC(dJj2lT(SU!P+%hLQGR
+-d*!!SP`XaF8,h(`QcdRfd(d0,C&IK(,JN50fR-e1Y"eTA)@"#`UqmP1pd81$X,V
+!2EJ,LfA`KpD!h@d95riC#[8YA5rZ5rZYLbA"GF@ZIrE5FNGE'HZFf"`I%Fri"D!
+[rVSFfN@1!d`D5GPm8#RjRQ!X`*Pc(SYehcjX$kqlMhj1F+@#((Uk3"5Z+ZFG,9T
+Kj-'11hTPaIiPKVGSb))j+[LH[0B@KNE&dAqU,+b+JZ)ddrV1PGSCN!!N`"+5m-6
+'V9j%S*fRLD+hak&QiEPC"`2-ipCB8bBM@hKUXN90(S"eT!%QV[Dp(H5$BP6)Dlq
++U+R*%Z0cJNJ([jIG36S9pH(-!E5c9N58P06'4,Z6,XKCM+2pfK(H@,Z2@M@`[(c
+Y@*3f''Q,(LNPJXGq0JCYH-'9N!$lKNE#Sc%QZEiaaH$PC&cY#H(3VIQVdGZI%qQ
+*RR1cE(Dp&q#BN5&I86a#0K0'$EJ&rSIIFqhJMZ2Q6Tipl2S*I!6aDkT5*a4jqB%
++[Ni)h&cre6PJ119Zl4P#9ID-*DS0+`ZBX!p0PP5-LYeSkKj66"a!&6Ad#HMeYa+
+EaAcG9UUTe2h%'021$&D,Nr-E2-cNMR0!EHd204j2$CVrpk-ri`lLS4BB$-"dZiT
+N4+DHq(c0%8#hI9ZCkj9`#4Vj86AGRcPDUIj,F9jhVdQXJ&K*33,UD'(B1'kY&LE
+LH[SDP[([#M'6C%S&Jmi,+Ra#S#!kTb(LaFV"&F#C-S9R+Idq21DD-,-c`8'1`ei
+[kG5NFHq3!-M3D5%%TUH6lLaHGG&ImS[k(,5j2BGM'MG'6T86#8YfK&E!5iS`QmY
+6)Z0UR-i5,9+CNX*@G!VZXCNDM9C*#e2l`Q0LeSSdCk#8KRCL[GP%jA#DUXacQ%-
+@@i[i43"51ij"*LHIV3PRq2%8b-DELp3JV44B26U,YcZXM*-m3Y3Z&Fmk5cf8d4j
+fMbAVVE$Sf36c#6SS`f2X*8Y(cC-XPBM'-B%cThS,0rEPZB@TJmXdK!2UHBLX)*J
+pSMB9GS!Kd42Ydr2fTBD&'eqTQDK#Z9bl&5cbU(H6&FV2(lA#qlhR#!2m9j&Im#m
+6VHCQB15bZ5#%2caj9P-8d*%5[(r9&KcI)6Er&c0ij&iE)X0J+2e,-i9HAcUD+Ja
+Mc41kF$'$Z[d*QC8(ZkVG-UEbPi@D"1Z4iC*VZU(-j4hBD,$@)ACJJUP-JqQThBV
++[kBC%05!!F+Lek8K8RZC9E%1j@D9ZJHUG&9k+YMp4)FRN[,JAIJjd&NKrb`0Lrk
+Td2Ba&e6QHMJi*P&V%m8U`Lpd(9XH[jCar-"i,AQ5Z('3!-AqJpArM"M5D8ml1DT
+-$A4*ba6!%i!TXpAf$HM-S06p%J1R11'L$l*AC@BakUdH523LhD)fEXR5&*p[aRC
+F1P3,C14@'1di3A&J"3M`XN[Ld*CETle9J'l2N!!)Zm3bJNYimeEGRijJQIe1b2k
+L*(C-KXL[MejhBJZe#e@3!(-5SMTd-4ch"Q"1GNQCa@3i&bm94rd2Gke)LP"9e'Q
+U8%N3VD$Li$lMpS9Gr""!daE`%6r0f%k&"KZA38mrLI'Y'kVFE*+DjTVRR++-+C'
+0409cSAmSR5P4flCP,'hPk"maSH1&+mLS*`6B*h%q@5Ea+"GadbAY0T05j`+j9Ca
+J%6P&8P"eQd,rIUZ$@el46[[#HF-P)@(PeaJMBP1Z'!N+dbra()Be*X98F)0c#63
+NX'JPe"0R(hKM-l9GrN9LGUKcpk`fN!$54jR'lhqfRD)P"p(4-6%*#Z+091@M-IX
+2ET+dU6+*j-fKA)J*Jm"`PSlT-!3dDL8UemUY'HGhJlq&#NeTXiP-YFE#Q0$H!YB
+YfcHI69+k(D,e'"Ka`#`$%!KiTM5Gd4RbAZXpqk&a2))jjMLGiAYI6qm8jGjV8+K
+DDS!eCFd3i9*4'Ubif4p3fq[X-mjp%('l`eI*P3R)hMe1N!!`&lVNUq"+XRb`9lT
+V$,@*3HF(RXM(jPm$(mYSPJ-(Ud2ekL"VPhHrqR51Kql$cAZ&S(PdAXNM+hqe%+8
+MQ2-"0)X4%Y#i4`Q!f++5dJD'TChijNf3!-2pQr0TMq!rX8KSIP'3!",9"d&#PRN
+C',fbi+6pV-'9cS(ICNIf'3"`jP*q+"SQ*X#BE9R",CXT86$Ifph2NcYc%d@E'kN
+4plS@ELX2P96528de)YG5C2F@!J#3!"HX-#NVGLP%RrGLe5!C-HI@'3dA-`Q'9J-
+UlX%-#EP0F`dmMT6HEe1P%J4jACLFTjK+&"G59rb9@l*Lfk+90a##SD-fU0VUKLf
+Y![eG5G3p%b8ilZ'e*81"2*'f3GH$+jR9dRYdS"@ab-4Tl9kYGSe"@RlVV-RQd%"
+NG,+rCjcj5m-HJYREEFZrC9'QpNprCS0'R3re8-4rLI6C-R%CDYF*3)"FI`TDchG
+@4kGD8IBj2f9',cbG3P8#8"pad5!D['d&mL3+N@$(ZEZ3!'"1e3N0MN+bMM#IkkI
+3+2#&Qa)HKBZ4Y*Rmbf,L4ZaGUBA4Rd+"1C%+j+YLGTQ,rZ6Fe5acpI6AXa)4&$*
+R#`)hR[TD&Jq#,#lPDhmDdFdM%+EQF"9T&1mfL8H@c00@1ML8HGLrJaUKrXUPKdD
+8QAb!qFMrL`P-DL61$AfQYCbI0i&hc!#6`%*IhbBEIlIJ1i1kJGDiN!#L&@8'@F-
+Rp-VXJC!!i8Xp)LArUCrCJe%@5N-3Dp(5CZ!,Y6aI*4ZK(TLkb!kXl0[3Zp!JiTZ
+m3eAFp8@hS1-fBeK&)!HJHr5*+CV[f*eK))F"-Zr94XQ8Hk2PMfZ`"+hGpfI#'k,
+qZ`FiE36P+D@UErM-J1,IFCNSpk+@9QbS+Vq'D(%mFBVd"#UhC2iKA0Qe&C)M+YC
+F9RM23D4VU%,PJ$cZS)8952qr6dcC+TUXf'k#!IL4$&rl"*`B0K))@3B+N!"PGaF
+fVPYXI"Zb!,UF@f0r&l"8!r`I+RIl1N5AX[T2*CqeJQf@b8)SUiM8"fkJQKHhm-1
+PK&BDL!NNR5m'F#p8i#3-QI)lef&ePJ3(paE2jMfc3R6d9HNE@pK51ZiB(HFjE(S
+c))EIB1#K2,#a4,`L0SZk(lalRE2%HU+9mc9eXX&NS)lSH&`JUF`L,&Vm`$bP'QE
+&Speb1VKZ0hZEkJ)5@lerbrV40ijd*AdIGVC`pN-h`c`r$%T190fb5UlmT'R09a!
+Zcqc+BHel-YYU-#3F`DR*T[4k6LMe!%&Q8Ek0CLRfNB,I-"b0j%r,`+EhKA0Q3"k
+#800j[Xk0Rid%&4h5UK!KZ+Gf6QUSjKL9'*YAmHaCbq&X-T6-0Z#i%(SGr[,R"Cf
+@,p1p"DeV!UCqj21CmXim%[)14Zmc)L43q(!hAA!KJ-!E$X"3LeYF1NR(8(3H3DE
+KdMG[!4qcMCUl+6d0Jf0rD!8N+,)j#,Gi+r@E5Fi3l4eMX%r")(*5#"5&KHD(p)&
+8UjXY39'UTX3PL6m'&&@P+q`jJ)K1A9R,fMAr(qYMJS86pT!!1,6EddC#Kef1mA@
+iLXcUP$3Hi)%R20eYQVYlB30Z@(r0XpbJ3bR2LXIYT'2mb%K"akB$a"jL)Y*hrYI
+$lc(-q+p&H-1qGKXiYCAK(T9(iAG21r")BrrYNei-rf(jK-lmDY8(U$rkl,RiRQc
+9%'5p%5D(3N-5diIX)rM*Hbql6%V5`r3melfP$-R$qSNJ!j)[5C3-+BlSN@D"kHM
+[8[K*'52%&,2STLQdacLapAVYMrRb5q3JQQRE+NPL"C0p")j[P$kMQV69#r+L"hB
+mQQ[B@YAPhpKdrJ"l403cpq*qbX6`@+lNY$HVe&VDAVXVbAl'*dl2!A0`eDTk"()
+*$2BT0eAlNeR2aJcHVNP@Q+rNEK(EiM)eHC+2Cpl&STr+h2CmB&`jSiRE%9$%)G'
+"fQ)K@mE5p0LlZ%Y(X25P!f2'KeEVbAjHe#BqR-+4FqM3T'-3Ha5X&"r&I[C@j92
+ZjGp66cUkhi8qEJM5Z)5F!0ih32+@AqBLNiVcUb0`+YD-0#eZ+)'mG5"i-9Z!VKa
+[I-Jr%iPkMSpePde(0Dd5F11[a!cS2R'MmUeQpFFDU@JHpj5DBIRC0D[!1F*LjS)
+8!Kh,Lk3%8`M-%djMbLjl[()dFT2dYAAp#ih,dBIe0ekYJr0"R!S93"YlR21II-q
+LfSCh-V!TEIDpB21ih[GidrA-H@L)HS4Hp[ISrQY2Vqfl8$J)Q('F-J9N2Zal[@a
+fpqiI$KkCrAK2ZA+)*a4Y*3FL4SA``qj03*CLa!X8mXVdl@G4*N1`)-TSTri9'R8
+"i6JTA5G3MLqK!rM$d,P`laUF1fd@l)&"L3,IE&)DF'CKrR'U*hRQ2#*jff3GF2S
+b9N!`i3hl0qkaYE+q2S[%kZ1'+FTdMVArCRXb6YH+X0-pmU&fNUNE$3TT63QpVL*
+L%9'9,T@GaP[ALAEZ3IMMe%ck94qNY5L"TkF8dLHf)MAHm)N3bF2c828MSf#cQ%F
+qF4SV0VrCm@cTbH#9hFdRN!"bDThXQ@CIL(11IqL,+Cjjh-EjHAB5VHdIbGTc%GT
+jiTr-bN$mCc(HpR$B1i3UT1Pi9iQ6kH2RMF0rT9@&jqd@UHIP6$d4&l'-d(XKE!N
+P*5TfALpbJ5`jJi#8cjeF+,2"!&pL!l#Kf@)*JE2*QUmQT)IE1l&fibSi"-*p"b4
+XJN9p"0"LRR-J#Xl`Qihc!LAAiP@9M+h9CTc#1e"-8i)&EFJZ'lAY+(!h3Z1(#H)
+Xf5)4&!Z%,Jri3$fjKf0C6@'S'j`)ZJMP0Jf23-hq432G*Zc+**5dSA0KZZC3-M!
+CBB+e0KJ)Ph"8Ajh0M24hqjNBNpBXhkSjRb-N"*!!ic#FpAK5-D(Ge36-ZHrVB3$
+@0''Q2dUD+)f6NdIfm"CTAS*JSDYVV`K+"ZSYle8daplbH6I+iYQlfE!dr+0abmL
+2KfM'-#KTZ#E)8i$'+$RS*MG-`80V2&811$"YILfTmR&9Dd'Z5h2'22V0ddk3!*+
+@c8@jp`lE4c$[9Z2GPm,kGe@R3"qI6bdNiBLGV@$,'4D6MT642'-%K!5PdkS*hV3
+PlNbm![qP8B9kVP[8Zl19B9k*6XCM25i5jZH+0mc2-XfZbqP'#FRjcT)[*X[4SUU
+a1(c+5$E`cXGe9Ba&'ik+LBi!8ake1MrCp"JFG$B"ceN!"PM6c-FA*(crGNb5jTD
+PjYDR(eU)V8YHa4E"Iq"6KJ(,r'5#DXNkN!!Nlm`Hq[AY3Qh,d$5-kMd)AeEjd49
+(HfIK&5jC41G$CH16)S+,KHq$BbC85mXp4C)&!1()MP8&ZJUPpRSRH1m6B&aGC3@
+"((EZBUG35fEXhi(1bh1Ad-hldrAR2k$Ne+$EEVC%3TVkfCdI$2R"BV($@QdY98X
+[5)"dNM@PQl#GY+S0rRR`UmBUA9RX-9[Eq5cLDZfe,69!)+C`3l[BX2&K+iI,(mj
+ie[(cHVra`4cD$FL8KSr55UFN3TBZUq@UFdVMd9B@QHLd$XJ1'[!XIcAm"NFd0fD
+YBLMb&'1p(Ef@)cH"6q@-H0mDTr%rR5UV%&M@0pM`J$M1!D9kR)MJ-C@E63GM["j
+A6*-,RP8Ak`eHei`,iBD1bcA4AEi(Nka&8aB'L@k@U3[G4he384!Ji%%bRNfj,hB
+AMNjC'GV&&dDFra@Xk8-("1l,)c5N4rV[44(ZIP#R%Xe!E8#01Uk6Y"fKKE82B$4
+T5`DN%+NMHDH`X(#Hk5SL6DqH+HF2#4Hhm@(Cl(kV(HY'PZ+8#iahF*+#DjFd(b5
+92@Mer15STaEkHpL)%65b#jRX(Sqb&bcJmA2jRZEPQHM3&NB,KY1P2pK6Zrr1KMG
+05-#ZS'rmd)4d3Q-FVl!BecGKlSq12P%r"BXeTFS3RGl-ZPAMQ88h`0TC[FYX@'B
+%R69q&@VijqpIh&aZa+l0SYpXZjbZET03`Sfdrq5bih8L6HZlpSmi[dLkieZD+c#
+5dFd5P+%@D+[HU"Jqh8mSr0[d3hP'&[8`45S)`2kE!GI!ifSr'(&I6'9CN!!$-4V
+pXU8X&Qc8c&eQDk"hh$eSrDA*%L69jBdcdk2rVKUP,3U)S0FNih1Xe&"#%3e8D,p
+i&!VU@V&3aHp,Q4(DqN'b%j,PI2keV`Ri*9HZLSaU(25KA%MKb$'2KT29T@"5XS1
+8@FG239kPS*2VQi"@E#163AHAiQD)aJ$&efU[DEYVQ63+DqUeb(k'M$0I#Ek9E&`
+5p%5S'QiXh*GTVX,*bpTk$XThm3b5!89lfmmQmm26N!"#H$PX`$VB4V4Q)&JZmKF
+h83K4j82jF@dEq+*fb'kDqE,#VTF1K0#DGk(L5fMc%F)Y%4d&i2,K(4rP`CT2a5r
+03lh"DHcV&fliiFrf6ULQ`5EE,SM8C2CCdf6C['am4+i+mabGmE(*p*bTk3`"6P$
+26b+5eCKa3MFkqrr-'NN!hVrl[8he#BiA'LDfe@JA2Q*fQCAdM4NZTS!2jh0dDP2
+Al#*lj-l,eHK1I&2d,8d6hmqDEGRXc)C9BIc16F*&@TAlpN+ESaKlr,L-CpD926c
+R(I&hI&+$B*Iapq$FpCMa-6*bmA0mfeR4aHFA$0N"h3T'J&HPChUX*(iR90(`,kY
+f&m*MYII"`Jq)"%%fZ!-i2p99HFTNhGVP4#2&(-B[-J)A[AP"Ef'Ne$A`d3`,3Q@
+&qhTeFk3pGVII#kZqmk4bm"HB#fB4addjibT@AIU-JdpDYP"Y'NA[CCF3kJLbC3q
++)i-XH*02&Sd'C$U"ac%eX8kC2ReFMc(fEpS22YhbNk$VN!"I9a*Up!E,HCNI@35
+kAjSh,kEIcCihD*3Uf,-6QQC6CJADCMm'q'*$C&2%"-X`Jm`eh"1YLE,f5I@Me(1
+Yh@kLBrFbQ"2P-+NqVbPVFhATP2!mm`U"2[l'AZfHNNG-IKQqTd`Iq5S3JICEZA%
+,*4UkNHV)q1CF"r[rFcQGlCVFPKEHqUGap(05`VJq[5!rX43pH,"&iTkGKNm+pFG
+,a*hKJMUj)EirN!!i[5bV"jr52mTbC%)5-klIaRP"LUrj1hZTlrNSIpF!m,(qk'p
+BMjMMNUp5F"km9!dCE6G)%V%p`4[&YcUechFZXkQVk`bQ'KB@hic%S'qr)D%2!KD
++,[NHR8Vr1Z-AdSH95VGSC&NQ(*SH!,`8,rXDSr8LVF*#DpcYAb#iFR[&Xp"#5&L
+)@,HYQbH(Gl6hmYLik(T*5L#!Fem%&8--eK`e8YbK-06rKfTl`iN@38&VFB308bM
+$j@mC[UTe0XGU`%RK1PC52#Q#ImPk)CN2P-@&eUL%V(Qr,M%8#S'QQ1)NRrhb@4A
+K&j3X*(`,F-"'6&U,3K0*GrUADpABk8aZRP$FCIjL,VPQp*cr&i5mjp6i-dhqL[$
+r!*6mp4AkXmQqPDD**Lm6i,5a)jlhU68c`X+8@YJLUZE2hP`1TL*UIr@3!-RT%hD
+GYT&PCPQH6+4XM,CHd!X#G'@4BEThNJddcN!qcGed&4VfqBC&I8DE9!8NIH(Ckb8
+0J%LHc@6GAkQ'k5B%5JSkie*6$M9U4c-j63fM%ZVBl$MjFd35-Z3FGrcbm6hld[*
+#,BhpZ+i"T(N,&l'DjZ3A,Z5FY&1#hcT&#"&JBIkcp[@1m(%+KM0,Hj%4kek[HXj
+P`%"k%lrZ3+%15#BhBHHlNmILTYFmj6Vp3h!-jDB$CZbJLm,5jah$dG'kEbl1,I3
+SaF0#CIPMkAi+KhHqGllP"[C"92iAD0()i%Udl2flV'[(M&JJe2,hYNj%92dfhkQ
+Tl-DBZ0[QdEZ%k@B(KmK)%ZCVQPAV2Se4qK!DR#UAZRDGelT&eTdqQh$TVHDQTqN
+hXZIi3&9YI@SaVU0'd9Hhbr`$VkiKcJPP&C'#UXTU`1*pHJENr!PVV4$ppY)K3LQ
+,La8DHdAZ4jP5SZb*Kq48!Ef@$jI1ME)01!EBrbDl$e2ja(CSkU8SaejCNLQ8kS#
+BdYHKZjV"'j26Y9fRP&Uh4#54a@c"c5e$VH9JJfDG(+43jU1r!VmA'1[DL%#6I6f
+jH6DRHmN896"Vh(NGBLYIf5a%`eC1QGdD82Jb'*Qj+"Pk[T!!,09#e2IXR`m!'GJ
+'p-!T9$rjU8)Vr&NAq14k'NGQZ+r51A3KHcY'Ic3krj%k4BM0L&T$[K6SLciGjk%
+4PeI5kV3#90b9YXCfJ3kXiMYCk1lLHdY@KG9"B&hU#dha#5@4pX[H6-#0`5aS9P@
+i0$q10"JERMLGRTi(h)d$+4kL6D+MQ,l(*M2M@SREF(m%lFle)+Q)4"-49[,fQ!T
+4dAFh,GcUh-NKHfeX('liZTZV#L02qYlVfFRBPHM@)0,j,-DjLXp)GG4q8BJ9HkZ
+q5eDh&2DkeC-0'I0!JM'ic6&9VQV(M[Gf@@I#Z(ijbmC2YlPE5iq!)rHT$l@r(TG
+hN!$K0&q14Caha8i2MM$9*YN0mhe4jM,A[,F'Qd(krlG&NIXBdKEQbh2D`[QBHmC
+mh%eF`ZjhDpR0IS"M8RM8ZUi)8A!a5Fb8'YT@9[E['TR84p[*q-"q*RXF91TI`0X
+[*BED9R!M%TDZ9T2+@6m0D$`0kQ3$59DpI5`d&%m6KYXBUKJKS5NALkmRq#Z4QKX
+H8C'kJIbeTh8rS%TY@AZ`#'B#Z6-J'Hp*m91I6+P1[(V&0Um63-c3dVTJ)RpGXDq
+R9`hiL42(026EKk)dBCk-+p(5SC-SX,Jda5VIl`QJ*JL$G6l[%'5F0Era%!Li&TN
+@[#X)cl1XXQDeG+4DeJIM5hF-da-ejc1UEk1&4*!!!91jUY,p63kQTUl[P6)"em!
+UEaX%h+Xm43!&alEddASp,I"IGR3@Z&,BM30Vlm8N)LU4VGP&$!+Xr(eeVcDiJq1
+MFEjS5mRc"C`3NHd8PeTY"G8hlBb5INFN)GG(1Y@+'IDPa0"pcAZM8bkh-&e9(f4
+!$h*6aPD!RYr%PIjGScI8BY[Bk1XV-F3"Y-[43'cGrpN6bbMk*`H2@0%j&%hCL#0
+EENpQ1@KH-NG"!D$ZlP4eL)X0D)#h`2d3""9+V%Xp")5)GcCTJSLkCXaZe-cBme%
+$%F@TL@hdGllq5aKVmA'A-T-emS(@-#kraQd2Gh&08L3cEIk'#T8ZG2@YC%hI5"Q
+bL5Ck4VV2!5+S$@(VHDZ#FZ-S[jSl5L-e,df-#*!!mLfKh#,hAp1V)8`3Q4,V!)N
+QLPf4A(l%4lZ!#fSJ8[J0"@drAHS+9PUJeTMS0jUrR,lB!"4KPJlXIKPS2"D%5HQ
+5k@VHp)(I(@i$bEPG@Im*35)V-JrTR(6*&le"6'$,`reQBD!UP)lHHAmLa*@p*%H
+-bS3H@hrSr#c@,5-h'-9BM!"-JUq$Mqp!QK&YNV-rea$M!c86C+Ah*fXZ1Eh,2jc
+A(qZ-A)$#ZRl$DBF6D1L9c[Z&mZ$`dc'$&qJd9Y#Cbp#EX)ZEa0-qra6*e)1HH`0
+[b!bkJHYpaPBfRdjKTJYGMcA'$!9XYk15RbS[5p5IJ&)Acmh*1H*(,ZJDIX5UIj0
+Ce!Z%NeGAXAN*kM#+MeJ(ZQ3J&0Qe2*%UZ6TbYBq6ri!(Pdbq$J#!)!r0ZfHp)Q6
+MU%[SMhiUP0)biBM%%LGQNA00$)CFZ)h&3#Ja,BGXFTDi*Ti`h4raT&96QS0PI(S
+"3#&ZQ%8SeXaLjC(JINe*U28RFpbQC["03rr+rr!ZK8p#2l8EIT&CB&iG+j@Z"K9
+C#XZHaAihMEPam8acX((*LIQd%mb-r4DKG!I'0AB,%Gci#ad*k6dTaAi`r5ZSXTf
+U-@"mpZ1BT'@*Y8j2Y$[#`NKT2ScIpJE,kTfRZSk,@YD@6p5a9Rla$#*Vm`)Zbla
+%5Fq(!jq!F#45,D,[Z'QKMMS%CC&mQCET,G1fckf0e5k#l[i*kp5kh`l'U+TF*$q
+3!1!pN3)lFUcYj#$Ra4hUSS*`4XmF%HFVJ54YL)Mj5G`F#l6NSJV-X"8Pl+'c(bk
+SPY@X&&b(JViFS,2YSqA8`JHlm`#'6!F#LcaE2pa-%"A*1)'@652m'Ma%IV5Bl+f
+*-bAXQB'%`FIB`9H+d0AF#GS53DrkKcej5XG[fMN,VI(iS*VrAm!mpbp[pN2ch$6
+59&XFj2PE%F8f4UfK#f+AP)Q(cFXVpY,$J32NKaGTA*ULTL%p2300ZG93XX#PN!3
+"!!!l!)#dSNd[Yl'dI`!!G6N!!3$F!*!$cJ!,5r8!"mFk!!"4F`#3"!m!9'Y6D'9
+XE(-Zci!!!%#b68e3FN0A588"!2q3"!#3#S"`!*!'3X(8L#ff)S$m6EUH,rkT-ZK
+Z*0G%`0YV,P+pT-#I)P*H3NY--N(I,I(SC*Zi$a[liHG4iD!a'X*,R&ecKS8SK,i
+9(qJQbK&CPI$M!C9B,f$l0M8(RKbAI(M1BMhIBUS6B9PJF8r`10BMC6XErj[-YTE
+Hm$fMLP++4m6Z6GN4ZQGl8+hflZl1,6D@ac@le1K3'X0XXSq(@1,cQ-)0,YiMP2J
+fB5A,%MaH9T!!c-D+H-8IpcmKLN++UDLQGH#*eSJc)VpEFXG-AHcZ)!h(6Zm2QQ%
+X+M0i&CR"NAdm&Z-rIeQ'Ih$ZQkr+6j+Qq[UH6RU4A@cQbp1426MJJS`($E"&BfJ
+a9Z'a,!k2dJ6VL,T*1"qeH#NE'X-hE,*02JRl80ff%l",VcEbKAKGUf&K0-L89YC
+!8i0'SNkZ34)J(l2'JSb#9GJK4a1bUfCB8P3#"[Mj[2YdjdFlVA$@'Ccl4+(9j@R
+43QhBTAm*V2($Uq,T!DSXVclq'@E))EG&&SHQ61H)cGEC*ENl&SYqiAU!0&INZh#
+E-E6QJ5m*@6fLAH,AK"F#CrX*f#PPECm)b4HAIPfFG-1P1q,J98I*-BJQFC&DDei
+NF)&G!+p0lXhr#MSH%BBr65),"@Ik[fdL,,)jIK0VfMZY8m3I"l0aXV+CYM30Hl%
+hVCQA'a'JX6+G9V6eUcmj%$68FBj(k"B,R,YHXGIXKebE"LeCI%bX$UYH",'5cd#
+$-CH&a+i"4DU1(lf@@kMCIHHI541f3cZTC[#,lQBFT"C9GZiA!4J@F+i[I-6rm+$
+m"E'6aLqF5+6F['2eeB"#(A8MY3-YKbI3hM`aLPrIJ58"'+hl"5!1TfPl@SY&&N&
+6U!)@1jrELT!!lLqD+`9ACfGl8%VddBIPeESq8TQ1rJ8KI*m9#m(5mM3l)32+N!#
+,IRGa,2m&L*[LcJ$EkPqqFp9e1&2jZhV3THISZ,B(1,f`8Bqd@1JIVcN$XYeRi$d
+hBBpK'E)hVJ$@&"1f5Rjh+bT%"")ILCT0bG*q9F3!%X-(Sli-#9m23SQYPF%YJR!
+8*6PAA)9q9REY6)Ue"TT9Y8CZefNbZ0E*C@pcTrUY[l'%r#mjrp[F%)0P!f-pPp-
+"HMDd8fPb#4+6dZVXL!KRT%8`#kfGh5l&q8*mUQk($03TVc'CGR3PGjL@!k""F3m
+i!4J0Z"*rc!HLYi,X&`cRS5c[mUJaIdBQaA4,pb&c`5fFX@HQI#-CK#'T`D%9M*m
+bGqNrrCe`"QVrMVL4((((+iUG*8"TH,Ybjc`lBC9Icf"UT+2K4SF!ZI@4Lpl02"8
+j*CS`2d!R'XN-@2U"ReEYN!!,ipjdR[)Z5YQB,c6P0Mj'N!$D&+6`a#k*pr,Z$rk
+U$3THpS*+2KK%LHbJe+-Er[Tb@b-V'(#r+Q$$9k[rT4a"piq@hAiZHeSP1,X8[#%
+ImH(iG6,Nh6KK3RYG,E(j@+Lh)*i@K0q[!ileX$5D%JiKME4AIQKDLjL#[6DX95L
+cUhN0heKdib4e$F(BaeaA#5%I6LDV`2rC,l(V-UC3ehQP*Sm-9DYC!SN"@l%6iai
+@J$kDchSK*kid$mAeD)SNjL*+b2hN[kr8%N-(2b#3!)&H%"M2iD)1Z$(6!aII[`!
+,U2!(p1BLiUj6e!E0ChN2P,P51Ik5@+iRHEYL),-@Z[qK8Mqkk[f9J'R`(+$C-XY
+,Xf1JEqQc(jBjdJ8bKXNTm$2G#pRAGYGSqmm(-TI-KXS&$T%ha&alm2Gi4M6MceJ
+9UH[a!GrVBKk25CfGfh36aALIYb5r*djAZ)hFEfcQlrjh%Xl3YST@Y-!938'm'A)
+a%#mTVJllK$dc`5UIeRNb9HNF['`lBp&K*RH8$&H(&,L))r%e3*r+NHdfb%SDFqJ
+XIEbk%+eH5dH,IlB#D&9Q)b$Yp60Ql+825AMfU(iIPDE+'bF`"VNrBjAD!SAAMd5
+N6T'dS'Hr-8'Q4cGI#`6V+aNa+(['k,L'fN2P,(fY)j'CVhAGUPlLKH3LJ3Fr+hV
+ILLmm'IY$'D6bKB5e4dLTrfIr6#$kf-[dB6UR&+&#Id!h"S14)i4%"&Ffh@K`IDq
+l'R`Dj0X@UQ38[IlM3H"-`LKHG$KlJY1fDm1F+#Uj+8`aL!#TH1P(a6m8eC6cj!J
+rVV)TiC6ClE1mIpf#LJY$!HL'15JbM3!1Ujkr[*YhC$V2lQ8&9*A[a"Uk&1!SpfM
+RH8p0ZL5Xk%8(Q3Rca(I1Ep[PjZ1`RmCN#ZYkEVJ2QMITj%!iIdda[1qYX44NR,r
+,GDKSGB`jL$C[)C[@VbLU5kH2B)%b*Rli)kYplCT`"2fR5URJ0(Lj50qqJ#A`[!$
+VpS(8$R*8(P)&Aa6'm1ND%1lb+NS6MAI`Bp!)beCc#b@$3h)ai`2!NQrr0JJ684$
+,)E%-X1YhRHj+U"feJ3(R!IV9,fRf1,rFA0BkKFmGSI,ABfVX'a3G0aa#`k@iVV%
+FpVeX5EE"X%R%5m[j61GBD!6r8b9BQM%qrP#eBNiH-SErJbT"hXqHF*E["@G2qb)
+qNpUij-,Z`GRdc*aShr*q6q)$iN6GTHR0hdmp0BJdp6e&[N"6!XFMk!2RHf(lXBL
+3!,IS4PHIJ"RR,,M9KTrCl+h3)+-N'N+K2Jc$'5F9"*S*3#PKC)pPCMRF9D2q#2c
+j*EMYpKdD*mXheBh"+%D2kNq5@@JRJ"E+UT!!jq@H3b@IUZ6A'8Pqe)TB`G$r#1Y
+[+(VI"'#Hc[#de&[@8jf#Jiim[kUJ@[06MG'$Y*kqpm`l+GqkKV!9-6C9bjmTK-D
+l8G9Xf"'cJhBUIY4QhSS+c2-bP[Nd'KQF*'4DpBbVP+'4DL%arZ`lVr&+V"&b+62
+-eXGF-Z5"RdD5(+cEc"1*!63,-0#P"(@XjYS3[!PU(a4%BF,qYqq0e-jqVjYlBG$
+1$S*9IeE,i(3qf#$CRiH@+B66aFpXG0QT81,'JpNdrl5KBi)lM3#BLR`!k0I*KK*
+jF*B&dZFZFpcCJUVS)jJ8KkRQKH8Qc"YIqk`I0J2dU%dkYNk'VZ!%"V[D5YRjI,B
+M)MTce@mE$*)D,TS6bJFGLpafbI(dQT'&jPq!B1"eS5#3!+CDS*'J*E04P-f'VGr
+2-$V$`("b4QJaE@JLhk`kHJDq*iGX0GN*rK!&YB'@"Q(4ASH$C"'p$bGLRl2'fEf
+*2Kfe*ZNPE3YLdQ'Q-J(bN4@rYV,hFPEajp#qXZ*YM)*hAmZLN602VZ,cT%&9B9+
+fc$pVpL8XA@5JrSDrJAZ#fQi4hGq`+-iUlMcr%4M&EiU,j-AE)F%CQ2EL@rcr%"H
+$jYe"'+QCq["'hfk2+31*fqNRhr,!TXjcphc)fI`qb"LaZmm(Y$f(r"4,5F2AI8L
+QAZmd3[p,p!$qLXH'dqK9BYNmA#`K26)`Ge,6!A+l(!K,jSk`6rp"qadJ6J`+1-b
+p)jkDf%MF'l"`[Tm-em+"J3%6XS2`+Z(U5TADb'Ef-9L'ZfJ(40'5Kp'a%P*89P2
+$J&4eY[JL'F!l1fKkK2S2r+f,G8cPc'Rer&K[$-T6Y#PYjp2H@M)'mSCLR9LdhYZ
+mUXMbS8qJDYALE@m%G`IFeHcY@mD3!"CR'!!!KQ&1#NTR5-Lm+eaH5)@PT3RGrq8
+S$HVkUJKpeM$Pm`%B(+%Ec*+'hC69KadJRF)I@CJY3FALBpP%KQRBeSCmPTpV#bL
+f6VK!M&X8"d5e1"9+Y5q3!2VZ$Acj9j4Y*)QA4Y)A4!1ijbZSaB)ZeX(d25r"JVq
+m6kB"5dLr&IefYQhJlXUa3f61b-S9F@6R6d(&mX@HkRiI6RbYbPj4HPUqB0&-6bL
+&dAbhXf-+dS(e&U9*bk-8r2C*Rc4mckKqK+#0P*+9`81hUI4`pG[-GHkVhd#9#2"
++-eTS#cH[U&[FHIFFGbrYScDG9'FF)`rldV3D4bBRP,AibUXBVXcmTS,V,a*kD#-
+D04PI8!l(rMRaNb303&0LH-CqX5+%JNjd`piA+c3[b--AA9"BGFBpHpGK3qdGrHQ
+@l*!$D+U2L$m0)&CV"N1Y5qP8fHXbi#IE5I(+-G*FkNF&1149m*cd#cTlP20Hb,G
+))I(j%hiT%SV`JbHFTFqd*8Br[M8A)l-rHI6RY-Ahiadc09q3!,EZp5+`HVKQd2r
+3(Njmr*f+RkK%4dRh)QXYfZriXkN,)B&0mJM82Eb-jIjV4[QEPM1")Gc&3@D0i5#
+&SEir#)-HLpmbLBqI[Jk'$$&md4(SqiEb+9BJHpFD0@0jr@CkX@5LMD2-NF("`jK
+CS0mF45DSrjD-BLYq38QMiX+ZL(Y9RT!!id&%)'AlS),CX0Mrr!kPSRLA!&Er*R(
+""S39XM0V*1Tr-&h%*6G&51@TG-9kP592,c[MPE8UpXjJJ*h-B$K#Mm$S2d,q+IJ
+#T2V2&%J9TEH8Bc3qK9&ZHH#'1lCB2Lkf6SG*&eUbXqF$SIaPa@#Ib#HPMY)6QXF
+`[0F[El5k&'$FdNQ($+D$CT+rFqH`[,)!R1Y$@#*Q0I6dMUlJ5-%NC!*(M#UE'MF
+5G6+$4l29aG-dr,EZfNUCK8HdB"*!bYpP+*eQ3qjeUrmfD+,#c!JEYph)U`,V)$H
++$I6$TbZSp!i9V''&ZL%HKT8L"a['lfUSN!18V0(1&l965!kk"mHm+9KE%!TfAV#
+#$,9G9[Cl4i#DU$Q0l*P+hl@L)jAheQ"Bem,B3XGZQAGA6'"U!@1%hEeZVLc)C4L
+"cDa11@e$(B#5bjS[lrd`-fc,I24ch3*U9re(SD'q'lCSG$Aej'Ge3b''aADjr#N
+0lf+E2XD#Z@c$9rm)0Vi)P&-#rPKq3S(12P0Tq$8`$IhL6fAI[LXKi55ijb12Llq
+f0BXFj`Kj#c8dUE5f0R$hSjfbSPUi@6*L6NXh!-0Emj6-ZfD"UAd([!f(`TZeHM`
+P)JIe*%X"N!"9U*,6*j3GHA'h'"i-f9i(UCdrV(!SE0#5""Gmma2@ILhNb'bDrBq
+&6L8[EK-Hd'K4mTDlYeh#C2h()XXf60R-)FahVVe--XfBKB`h)dbVGfd9kQqBHqP
+MjSQ6KS1@XhFiA*E)-kLPEI+)-FeAq)P$,"L`BP'XhAf3!2bKe-QC$4"8)1C24R$
+5KDj0"Jl"bPGH!6$[4[AYRdbA@d0-q+A55d#J+l!@qT!!,"'Um'I%m92h6Jb%Gfk
+2d()b(1c9eY#($K'@Y*(4p-C3&H#Z"*,*lLi8*J)Cf(DmP*iBS@@"#SAT*S[qY4F
+3rqU$!miA2Xa*A%hYbE(U!0MZ`00`h8%GM%V5bFcSPEX"4X"bf,i1[YPkN!$`Cq"
+fSfH"MV"(Eqq0jYm$ApV!A(kQ6S#U5GV,NL%ff4dG-Y)*F-"Z!@iHKbXJ1d8R8k&
+0ZBA6jB*5`CqFS(DCSIRVZ"MbM$RSeZ*Xf9NdKbAMHGD'leqe2iCKSl`)cf&dTj1
+XAU1C`[KB,Fqfk,J"jf!G&[IM-K'*G!**9UCSm@PcpMI,Z"$"C)*hd3+lQVYE3X`
+ZE+MD9m8TH)'MpkJEbDX[CaK3$-EJlDQ*BU1862l0eQV"h#a2QfT#,lHC%4230MV
+'[!'4Z%'NHUc4eBr&F,`+$+Kq[MhESCJ+ilm$2Ui8aI!"Fk6c`)JTDb2V84*8b!l
+NJ%h9@(KRcp5cFU2kapcB&K2jXqik)P![I4`TiUm@UVCFm`(XP8C5l+Y&d"R4Hd%
+5j6mp`p+8)J&a%lpJ2q9,fk(LfeGMSqKk[A5`0UJ6eDNm%%"UV@0Th8,Xc0qB1N2
+TANE)'R`P%ar0V'SZelAe'YlKf4YpYUkHS!rei0eaPSAI*$kb#(c4iLA`U,Y%lH-
+@SF9@-2Q-BhLl%A"PijRjrhNZDP%``CNCjA"1rIB(rfDk3[QCDlEAa`#m'K!3Caf
+&iL$"*DCX%3@-kPr,ZH34,qUK6(FY#f''FaKA+2`+6d(E"F@TH(6HUAfq*@Rai)U
+5[0L@C1r5ZAbLIT%8EJf+hVm@(!6%`@hJ90'e,X56S%RCbD3#dbcicV2bD-l!0ij
+5BAp8hGee"Iq[V--'#!D91CVIR#&`@eNLFFTKA(`KZ4kQh&pCVkbpRP@#$j0CTa9
+34E$Y3r+l`9&)GlS*,U!N&L'!9QQ05Qc(,DjHA%(LhkVrM1NR#XKH0#fGIF4akq%
+ipSGV(r-qM%qii#4PFI`G4m#YmRAkP05j(S2N`NApm[A5JVMGI8SX*DBKZYDk$qk
+(&9-rBeC-j0fXiPm'-"B%'$q"P8dGiLMRVDJjEPXS*qT4qA@+c#Q4e0UABR##AqB
+DAS-)%acQia!mMd2EZ*8dI`DdJ'Nd-61FAdH*!A4Hc"5-@8KV2,Z&q+3bmm8*lXi
+`K,1&X+kTqrK#&XJAY(X1ETQJj@33R8,'mK$U)S4e(R#Z8QV81r1LLmD`I3KQ)SG
+rC@ddR#+D"eR9GJL,a%6Cq4d&D1#rkRZGZ"ZRi2`clFX6F[#!%SP5C`Kb'j'Lh#%
+`59,Hr9lRJ13*IRZ)H%lYje6Ab&XJC)[1$A-ENraX$mV&*CBMLMbTmL"P4Vc@3cH
+K26TiCYebJQN(0398e*&Y"VT'#q+XAMPE3`K#abC``*+[0(9A1HFhQr,b)[1Xj-T
+bZh5J$,mbP[VcAljmGB3'&Z-pJ)m'RKPY$"Afj4&Z2(NHU2P[Z&NM(dA$!kC622H
+3!)Zrmi6'Z64E-LTVmaS`Rk,YQmP#0d1YMBYLXmCp`B19@rG3$NhGf41#E!+e@[6
++mi[PI2b#S111VDdJB$T9ZQ*TDI&h`I`XN!$"3Ia53LmqNfId3`5eSFm0%F-`%B&
+BQd'Tc@IN%MkKIGb4+Kl#NT1qi-ZkCE0-c6C,MX+$fC&VVN(-%I[*9N&+*EGRX[&
+iBcl`*6VVp0DiZGA++rRhikUBpL#YY,rc9eREk8YR#cf,QT3KG4G+C4$aLKPRVUI
+i--J&98pfrhDRp5hPB@jNkj2YE8IGU,3JXdJA[aNE@D@ik+%cj&lL%qPN#&X)2UF
+YThGFci*Rl!MAAa$'$EPM'%*qAdGM@q&AN!#`F&pbXiT!di9SZ2UhjBJP5GNM#EP
+L@ATP&h%"&d31iZ(HmC+VP&&VEm1l5q[c+Aj3l(6PJ8jM16U$G"'6Q9TPcRP6c6j
+Ha,(r+V')cLh(AZcNAJD1P&2h&%-85Yh,@2MCSLA3J5mY*J[T1-jIc#U988KG8eA
+ch5G0Id#2Y0`i*S@a6Y!SJSUUT,"'VfSE,A5(i@[!JGP6%9K25!N'l$a58kr%$Nl
+AFFE9EGi!m6X9hT)lL(!,,3LTZR2+FImam3kd"h5&4h@2R,lcfJZ,GGaXQb$8L`Q
+bQEMeRFM1M[h-&L'T0X98EZ2-p6DCS$p2kd)mjQi@m$)N)m0[XRiK,&1%"L#mqlN
+STp#UQT6#(GXaR'FYib[S-X&NY*f(lFA*2DI3r@f6fS@iSNaaL)hpp-M$h3h+804
+QMaI6@UK%%BF#*&QQMl#V`H1j[fA6aL%T(,SCkR%RQLD(kUVQ"U$L*4Lm1ERRr#V
+pUh[8VBAh)+T8VeKqemIL@rD+VKbIDQaGijCr'rPicCYTR[P#C0VXb-LPKUe%-DB
+3[A9MC[S1-CUX+"Q[L2m[IqZ0e2i&ZEYdCBl1h@C[f*qe4I%fRG#S%8`[DIh6CF!
+aG`RZ8D)d%)QpE,@G*"834aTHhFH&0[N@@%FeCNlaNUA+,ERfh'@(a9[SeNB*%%'
+bI&0,"IZMb0""BF5%5KVre,C#G4dLdH&2mTQfm(((d)KUBEK,r'0p+8YE@&DMl-1
+j6#,HH(,iP`*hEe&DVV@#jpKqpJS[6i`Y#)'6[0C+0UXT9%%5TS[4Y#h+,K1GF@m
+4qhk+!EYqa3#[ZQFKqakF!ml*6m0@Ge[XMR%i0&6U85T&dlVlG5V(3r@0T@ZU1"p
+d$#f`ak'ERE86(@IQV&DQb6Y%FV6mD@`kZ4Y!a2"cD&PHY)!`"pD@d5"AA`'DmFZ
+9%D(V19C[p4R6JjRGEQJA,j!!VRkhKQ4-ADHiAFSEqAK2V4r)I,'A"9cDRcqVMl3
+T$AkLTA"5SdZX+ITL5['9#JjQi$($6K(Cpm@)EQh'j9I#h(#f*HKNAXIA0Dfq"Gi
+`I&13!('U`TmVq+raUpc,+,,1"SDICkKfCL0R&6Sii6EV("MLbe@#Sq5fMkRFB*Q
+$PBmK0&p`3D9E`3A3f$Ckl"j1386Zqe03AIMST$D'5%Q5@ZMcUYb19pTi'6IQKf,
+hb1a3RQ9rk(de3ZSL84C5+6@kU3mfJfTdk,NJP-cef64QLqIGNCd'BYl54h%T'c5
+F-3LPEHGe4dHl8'NV#8P%Nf`AN!!T',3YAKEq9h*bRHYTl%aYC(E)-DK2)V'-J-`
+a9[(`bi4Mk'RDL+B1"'b0iUQ#KSpae[ARIDI@e9pQSJ5$aVcjCS#S%@bS'@EJd9d
+USG8+hMEQ+Gm$#5VUYIm4X0b9f-3XNJNmq%(#0B9-,0UT$L,eVpbIVFhGcZYHmb%
+8@l4Y))BfR"p-HG&f&*!!IH)8FmU`bD*56C5I4mEEX$h'dZ@LLPbZR!abjrIeSJ0
+-2d%N@8-jd-E3#($"HLRPScfcMX-FT%#hVK5kD813!(14eB4lpY@b5Vc%rJNX'2"
+6$,V*IS`)@cBmAD$90$[#4NqVh9`IR'$1,YqlfJ'5PD1#*C3EQ[,*CcbYb0-c-35
+rdbfEflj5ZR%H3bGL0m+pPpMZ(Zmi4+5YXZcUKDMGqTA*b"-64A890rGeq[ARNdU
+0KiR2TZhJ9G)!CR5a`jM8CiSaKf'Ldm"Qb1*k4AFC+,8kIDAJDXC1$d@&F2P*+km
+G5`HfM"'jhf+$eB@G1T9+QdEFK82MEl)JL@rLNj3c"AEj(Tf)EQqqA#mhZjSpGJ8
+4lUM-+cQm1+QYi-f3!$56+RaEHYiUcjKj50JNr$E$8k&q)R-H*PSN,4kB@)&2e06
+3(D0`DXcc8#BP&T!!PUi!@,%DT!R`(j@%0m8cj5Zi3c*llFr[!EP'5[cD`QRPdKa
+-'H)`'6C1pe,haqMjZ0IMV-f4NeaKkp68e668H+h2+QCRFm6"BUY643#j(CHkmUB
+e,H6pV21J3Bhd&0FQEkE-1imqEY`,34"R*ChBp'LKhhJp+6Em9PZ&R3K*FLQieIB
+3FjL@GA)ALEhB8U2bRXbbM,bNIU4@Q-(aR&X!(1+,kCREfClCP!HFDSAapG4i@11
+a'm*#BeS@PDK#2P#3!"pHHAZPj[*Xp3K%MaV*J+&Mhr#RSP`8UF6kEYM%K#IqfPi
+4('p-h)-qd,3ch'RTe[U4SZE%Qp[Zj#&Uhe(Jb0q[+`,,3U9J%H"[iai3C,`b#4b
+KZ(TJe*9#ApH"eXfr!+Qf568U2(%2&EJiAc*-lkE*Kk9LLK`-02Za0eSTk)a0iJI
+SVRC5hUaH6DafGC9fBbN!r*31b1@@9e'ARiVr8K3)pIVVI4(IURc$6+TAaGL1"U9
+5Hji[q'e@[VL0FPQAMfaV2kXFUrB8Xeq1lkj+NM5L)ck1q5BfCbfpl"JV1kVK%pP
+FLIr8@@aLi-SXNDNITRF+eHj4#mm@1Fp#+2#%Lcp(MRM4AJ`i$lakKmcPelb[h69
+6%jk%pp@R*J4pbl`'ILdb24f(E980,$-AKhfGf@ikqS1l-e&9`bE0L0HYDV0,fHD
+F1+M6Njh5piKk['MD0JQ2RML2"pqI[NMclqfhM6XaV-S[TR`'ijF9Vi,dZK&iR(@
+ZRA*(cf&,i,!*Z*!!SKj)V"Qimhh8)kBNmCP[VQZBKk!i(!2(i[cGdRir,b[J3pV
+HfAFl9afj0$ar(3-Eq+8*KS)&kMX$4X-d@EPldD6"'41kQXY&'pNT&d'(eGRlZ*Q
+"h-!'9EXc4qi((PZ`(lpFE)L+5j2B2a&1`YqGAF4iNBK&@m&3"1)838)cPeSQF,V
+QH1EJY0r99QPafaF3-,#TdkAY&mHN`YHK'#P)%S@aMUqeerf#%D!Yck,h33Qea4f
+8@FAbDM6M#+#1hB&kGUMk59c,33F(@(-QN8S2R2EeL*J`#49"MQiY0jdkq0CmjkV
+UD4DVU9,Q3)0Ee')0PUK1,rFmJB(P4*BVCFYPQiL#UP@Y$5V9d*jfS"cCA6SL)T%
+d43)#Z5GB([BQeFYfrQb&eGSU0kZ#GP(C*jUf+5NV2h3EQ6+M3N@+Cb0&3RhD#hF
+,4e+1h-ERJA"U6A22(qR[hAZD@f&j@PRhcJemDpMHjdH"4RZ"ArY6FI9%3eQ0,c,
+Dq"9V!T[ar6)J8TLYc3(S3N+i1S(hb4J"di"K[idYYY-lbB13!(A9192,cVp5dhB
+KbFV)rP"%5R)"QmB$jVNH*,d0"+4MMQBbk)9MGr65H"V"2PfLm98FD'(#8SB8fRY
+VfPp&TqHN!9+QCLfVpV(8QT@5Xbk@%%&@cZ2b@,815#Q-`!lT6c13!,YQ0pMpf%Y
+&Ti!H2R()%AGFfp#QkF-m+6`8m1![NjBXaN10VTIdIc,&jGL$0mVFrjPRf+jT5af
+@cJX-Hp+@[TTc#-aRVBjVM3IkB!4)3Y6&a@4dKqb!U09k4jdM#KeXZl98")G*BAa
+#)FDd$EJIlI3(YZadY6$mZ(mM#!k+A2f%$Vaa$F'3!%PJ)Q0@Y"!mA![a0F)'imA
+U&Bp"UmliLR(AS"S#Jf#J+-rID-VUJM!AN9@DlYM&SSIT"X+ZhYjSl$b*LjSAi*P
+qPaVm1)$RPN6h23h[953-@YBB&fINpX"%L[%D6M)29ZV8Ab5P2XGZCTN!'$Aq1-%
+HfP3R*qafH')p2+r!$C6r0"(0'"5L5`XH&BJ3`pY(m*SBJAV$XfI4[)eM$$6[C#X
+e2T3rZU#e9A%&RmS2i*,56rG%")G6,mBC[NdUbaJccN*bLa*ZTFQjDffLF)d5eI[
+"b-&e4dc)l@SQlI@aaDa"m[EeT'IXpBH@)GZmmJr*-%BVc$X8pXiIXBJL(Gp$LmN
+m`VZ)TGr#hPAe5[&8lh#kj5CMGXrq61"JLdM9cpAk8Af9`Ed&*f5UcT4[p(fXT%r
+rmZhKYF$*iZ+d)ENJ,M&lX9L,(cSf26SJ6ddqH)(N@Dpf#BSqAUpV%E&6TDMf"RV
+`43YS(45B41X9*6)TP"KE)M1')C5(aVAMTJkhLl'e+f2(Dcb!ic5"Yl8DHE3*XPl
+"m@)4cB$Hh[%4YcFH3c,aeh5Q@,F&iIp3bL,"fq&IN6)HAf1[hGC9B+48AH#FBB3
+!%j6(MPcF[DXHfE-Rjir86e$l*f@&TfN%HP`J&ei(Jpp6aA*p2NVRZBD8Y5LZBa4
+QNH[SD@&U*5p,Y[r&RCi8TKI(-T9FSk#L%@T6'%8Ji,&3PjFmLqe%$$$DMj+"YA%
+pm@9,qB9k#S[j#"UiBPD$([m+YZJT4r#4!E120eSf%USKV`er8NX8Vb#%KSjR6'b
+8&RSl)*'`4L5S#IBMD-F!Sja`lIE1-0"Y9E&AHC+Q&9Q%6B3$1cG%i(Ti5Ue`d@8
+)J5bUf9CE1dRIbr,@"-%[%0[JDYGrQ9dVIHRa+kBjG1Z2!i@-McS-ThJD+5-KblL
+#F8d-iFI#cQBp'VHb1S0NTqjpbCkF)E)q$2bM"e3-"aNqEa%9PT3844q'iRHb-R#
+K5,MMM[GlP`C2$TNbJY&Z*IdMk)ke'3LD(QJcF-pY0-P8-,6Ip`$*6fZ2e61%qPa
+cC9BUrMZ6(Z2hHpX(Aa'I0X5EQ4rea-`EarES0#SaM%,8F[jdHAKVM,$&p5YPDK5
+I0)!i"B34KD`fK-b-+A8iU,UVqM&`kqL`Jl-`#&QkV41GU8#(9*!!ZTBISfm[6`E
+8C-Ni)$N*D)3dN!$b-EdI'Nad`RCH&1P*M4pk'XadR9S90r+)pITh+6K'4Y6'[Fd
+pPlq+-5FPRIQ4Gj5-U-aXPXS-QVr-1D)pE+CAA"ZkES8H`RU$QMGVR-*4@14GjXC
+I"$L-"hNkeFd*q9rR3XPDch5PEp4iqX'!Xb9C$ABST8ZErihbi2"@"IAiK)f-l-m
+TS-UA-1'!idD!kplJ84[81rSB)j%&hJar+V1'KT[0bVlq*9MEjKlIAJ1lPlPCcDS
+#C'iP2CD8#G*AT*j+5",ZU`U,h%J`NN-,L9RrTe9@[B@X6(h0'TTq&Q2b4V&-fEL
+3!#0PH))`S2S2B3!#AaN2cba4XkNEmf"-p%A#kjKpl*A&%Db"3a@jbNBdZUSK+dK
+iJA8I$*6-CEq,0d`Qm43fQAYV&6P6[YD(!*-(XmV'i%bG8riL'180M!FRPdEVQLq
+kMfR)5+[Y4iQ004b-2*cK$$!"%0)mV`DcC9qifqiTNB31`%&KQ`r9dpaKIFCaecH
+8"1[46$2RjCA05r9"j(if(-PXj'c#4KkL)&ZeNlHRT'18bDK9$"N6-j9Ljr+U%2I
+3BAfE'902T`L$`FTAI["J6G+lU)D6SE3`UIK0(jfYPamr4"R9Djj'f@hfR*!!+`M
+DB)!!Bcc')QEA4PeCi$9RbA#aG9VQ1qjYQ4jeN@K08r#ee%U8"'J)i))eR@3+hkB
+DaTFUh5!d,)$XFQ@9Nr`$-ie%Q!hE)dM@riSKNl3'QjqYY+I,l"#ZMJY9XSQfSaJ
+)Q9PT'(#QUP62)ejj@9efGAa%Z,U[#U@DI*iJ9GSpV)(XNEhTfbh%K4h$b348lL!
+c-YMe9X(BbTPGp3*V3Mk$0G)j2P&4aIU"$VSR`d%rJD[bd$e'$5$6+PJD'*F1d3T
+R`k$I',A8P1DCM8VrPCL#+I"@@L@4Rc6S+IIkK#8&MUr0i4%@U["ZFGc6T5N+eqY
+R!*RNG4BA-PYjG[F9QUr0'a`8["+Aq(`(8,`@Hlb8YI%jYC3AqBL2'(-SZ3"&3P#
+QjkY9afe2iVE%XpiaQYqIrjePGUNYG$&c0AS3P*!!-h9JAYmMPj[@`[$4S5'Vm1X
+&-[JXJ(GP0hB3lUMjX)Rc"[bQd*2'dZM#H#Y,1[3!&%F3f*R6NQ&&6YR63hmk[S9
+QdGrfdbMB12'rrH1(iHCr08e@Sbi-%9[e*G[ArF1M6+5iVMm8QK"%C),DbmZDIeN
+%BR9,rmMb@,leJ[&&1Zk9,kld'jQPaeBej)AVR'[ArATJP2')ST8KaMX6-*pR2Ej
+3P'&2C!&KkCm$R*%4!m%MpJSAiUh)2a[YmJUPIqkQPPHRBN+beZ&5QKa%FXUV&Z1
+0[mjZE3-A@`$rEJ'-6dHX8+)mIlkL@Ab)F0K[6fKZMj)UXj3#JU5V@#Ph[c9V@bD
+EIVN*kGXT*6pLH)(12GbJ9-SJ+r2*#MG[!*D-RTC-G8LBCMpm9Y[T1!-(6d1CfVa
+`p4H1!YH`BYD`e4`1YhCc0jTHJVZ[plLPXp1P)*fKqYEfcZ1MM*)([V*`#eEPMSd
+Q9-"Aq4h!QICJdm#Y)p&p6A-MakA8(V85ERl6bSTE8@Yc'2T@rcIqij5l$'f!I0F
+erab"PJ0"`S,)j&TlGEPeZ+X-!(%a@0bMJ9!C,(1NQE2d[iC)JBmTQ0CbVBd+KmD
+X1l1(XMF'HH!4@HH82@Q8DCIEYdUNZ3JAN!"1KMlQ-kPUi@RY[pAqm9k5Tdf1[[d
+)A1I$R0d5MZ&cPi"Y26@prAaC%ZfQch)UVQr#@8KH$R*lCA!R@GGQG@R%k"PS3$m
+,NXH92d*'bNb'b)BNkHZpTbFVh`D)@h*T(cC,DhVRqPl11E821%QRlU-ABfiVC,F
+-i9@3!'a#P5F#R--m4T[!SRVX-a*LfbpMePm+1IrLX+X,52rp&k!3!hD$r+ejFm2
+6ELi1i2aPYfjBZ'U[V3k[2PAhZDqCh$8)de*XqS3AM51ZiVhLJQh8&i'QG5al*Y)
+'`G@22$08jUqVM9'pebR"j129#Q@r4MH[IV8aUkKSF8ecN5Bfl3Xa+'PNa1B3BUR
+lCCG""T%l+l&l"3$m`Y)H0qeFC@"JK')13`6MQVpCH04-qmJP6m5UiLfFBFCR)Gf
+r54@`kb#J1MmVMJ6PE!'9eQ*8+hN*,9#)&pGlAaRkN!#'0iYq$lc$Tl1Sh"Xf`M5
+a0BXma$9,9ZfDBGfFqk!@)FlE"a@UBJ$(Nij'EKmMGHjP)If,0hX0-AG!3UCjMlI
+%3r+)Mj-lji5$LP,reRH3!-N(-CXVje1XD6B2Yj38*MdrG`C!pYTh+r*HBJB8pSM
+M$TH&*CUSSrXV(kfqZ"jPQ9ZN9U(9&T&b4f6N)PLh`lCEZpK*[a(FDHS9J(eElGR
+hLUSUHmHVf5*hrj'6j-@,@2c#jqm1TjUF0(B25BS6fkmFCF(@F!AEIcpll)Q)N!$
+@CR$SF+fFZG1C"hSNi[,$,8c1c@Q'Z(iQfIp*lS&+,`I&`506$5a+[SHDP#kK4N*
+E2)61Z!1HBpf$kLXGeSP@1Y[#p1R8H@*q$Q5)`f%%GqrarqA$S!p52`e-`1bNl!U
+HkpalSUF%rq[HpeJ!Yd+cLKSkVR-Tajea%S5(I%FpYe#jQKQKRIe$)E9H1kqFMSU
+Z9!b!cBC2UmKa,`*[bj!!VdPNUNNmj#)&eIJXc4-K#d'6mFQfML,k%"b'$EZRH`M
+HrA,S94'R40m(mkkj0H&Vb6UP9h&eb'GM3!*DJeB1fambb4eHrUbMper+UqV4!Um
+c%30kjV#YTAUIl+rfC'096--N&U(G8SbYXhJll5jMYJ,Zl@VSPhDBIM94+GcGKGZ
+pKpCb+(N6-l6p$dSQm*L`BPrBaD"XHaE%QUL[1B"1SXXf4Z4iIc$34A*N'Td0A,h
+9D3f6*5jM$,*Ba*Q)Nm3,(abY-pk6+"a6-1"0a&5IQrPll`XrR&iql(#P[f*P'AE
+Ylb'0H3cfD@Y`4TYbBlNr4CSRf&M2L'K9*XEa(8"HdPLD5l$`kFT[QS[4BGKlh"D
+%fZLHHQ(MZRfVBVY-R*r!k(Mk`q%4eIi,hlGRh*QmUM6hQ%qQ2Kj"*f1-K'Y!qL@
+6mBA0@[hT'$m!NK5*GdEaEFLQm[%ZJT8IDqY#qd43L)-U%JXMN!#-0"JVrq'l%p5
+JeE+pN!#JTa5'eN-"GQf'!fj'+GkG#9r@Zb*&2F`bF!UUP`BTJXm,kl,H!eeY!%X
+!fGk#4KF$TR@S%C*E@#rBZY'+XICKV8M[3ES8eY`3@bhi2D#1pleLlIl2HCjM)04
+#cKKbIQ(S`%i#TJ%86Ga$ej1T`&bkkk1j+!Gd3(LqbZXcV#QLY&Kd5dRQP8[T34#
+XGQR#Kl8(Pj-S4-I`&`fY!%I@rmhFBlcRp-)59V'pRY[5VEQ6U-h%IV[IK$N9(Z#
+dUMjEMJl'm55)'1YJFVHI5'T`Bb2CG"F9@N%dD`[B@",,[DD#b%qhmr3Hq#kL+d3
+rUJ2LI!#1al'fTQi[+"Mi-jC&00I`K*R$CmNVZ,CHX8A#-fT0qL&2h2)+E#@SlQY
+)b%qXlKPYdMGbbV--XX8CZm$E4lj#)32ic3Ej@)mPN[)&d`Se)9VrM5&XSk[BqM8
+8[,jXbVY+!jlJ+GK9'fZEBh%VKaMbfZQdUE3[JF,YpJmbF2eI-Y5FKEl"9L64YAR
+NLaLqHMfFGJfFpR$VUP3KajJE8SP[$5-#qNm#T8a-GXDkbN)8hFFd(dk@C"`q)J6
+URS*2bQ"!N!!0@@i0,hMVDk1qX0!"IRGJ#@Z!qh&)f$lkJarIKDi3r$`ISc[Q9fQ
+FD"V'e816lF$2$5RX*ULe18m9CV1fHLYFL8qI+a62'V`9I@`@!p+*qkHD+MH@`p)
+f8p[dE%KC`!G1`hSU`klE21$VSK5Jdch4%IL1dX*#VTiq@b9HiHV`0D6UVjdNYB9
+a(U%HjXY$QZf`KkG!9(`DhXrJ0XriP[hB'U"imGMHdlN%aAG%&$rq((*plP-qhc1
+rMM$a*'JJdAJ+NE8#-lU&*P[d&,e%2@kNmPDh1JaqS0mI+1bN68i,CT1"8FlGLjI
+14cV3F&#c),4c9lrRU68LY(0K9XlB"q0Db$4KcSF3-HmaZ(AUU@U+ar3)8a%jfB4
+fB'fai("jNpB80LH[UPF6laE[MmBrqIrcV[m"cQ%DJYr5S2&aQQ1NS-IP`DXUU50
+hUbTGq"@)&D&UkTQKhpR1bX`SifQLhb)&K+le1(S#!Nl"e%pK0[[[eV63BEAbU8$
+X5iMH+rS4#!l0@$"PrZ*,4BEB3h$Y5j8I+,cGjY6h(d%m'IYZ,#hGMdHGhqrPejF
+2[%6'q!BXrpV#@Re'KKQ%[kKN"KCI6mRS5J[TraB[f@&ca-cZ@e8IPhCMN6A1!P)
+[PL2aIr"dqS",P#LMkH"d0@d@MRm[YL'a%fJX+`kYk4cmXTM@QrEHlV!Qf-FHlC&
+bZPX+a&h1-$pSf!H0&D3AI`fE`KplUY`Th+A%ec'r),"fc[KrTe,4A%jQY&*I8'4
+ppCq"l9)$qaNCG,(FHbGPEE0*i%0rSZM5Xh+S([bYAQ!IRGqk#@&Jm0N6@*1hd,-
+fb#CJ&NDDS30pcpN4S9lH!YH&CA'$3SEV+J9KD$6'q&[-!$d`J+VZaNA`G*0Gh6r
+p-Vl1da+RQi8NL&9-Tb!U#pmDH3Q$'b!ZAT0U%6A0!8r2@&d8Xa4FP0lEUED8Cd(
+-8[I9EFFp5)PGD6qb&+H@q#'lUTel+1!LZ8r4XKNLV"IkHG!,Aiia'2Cb'QS81kG
+@YT5c!TE4UARiA513!%54Y!Zp2FJU"Y5U($ZAT*Y3%36,f$Q&i#V&-XRf8p0d6Tl
+'d5hE-UY)fk1A3&1DblABiVS3)I!XjV*c0mH,(PC2C43F&kAT[4LhNXYp64'JS(Z
+4d!RH"h@4MihmIeU@6mUDre,AZ*5r6&qX4Z6B!cZjB"RE&lU5$&JES@[Z%,A*l6q
+jUXj0m$rLj$MdlJ@Q'YM)B*!!TU"ffi-aKAYP4+pa5Ai8YLVL8D)4)%lDQ%pPU9q
+iPdj"V1SC'*)%P-q`-c!5$b0q2FVVqGV)B"$*+'5YRM@RJ*Eaj1"qmSMZVGLJHeA
+L&`p(XAl&d+GqbUr'rZkR(j!!(AZ6F-C$9'Gcc&0c,ZUmAGbR5BB-*5@)CU9'8,N
+f#10BVjeY%(a1"-h-)Aehq2BbSPDXhq*lhjUMMf4*"PQM$h(aPT!!rb5LdrY+3q(
+`ppa@c(XZ&&Hak(Y&f[P@@MA"*C'2@QK%h$JDq#+M5)H[VPH0j&5UJd#3!+U9IQA
+%'NQA,+)Q4#`&q%L!R'C@Zq4efb[c%d6[#VIf*j!!Aa6iJfPd&1-G5YmkIVqP%`[
+fhY9Z*bP+AQ"j-(6@&!Y#eIb16G$PieEacKKlNa&R8KbEbrKBprA1LFLqVl+ACZ-
+hm(-GBc9Rdb!5)qhZ!N'G5$ADbk0[L[r#-%VXIqLJ(0R,jAf2ep0ZFcZF+hGAl0r
+!2N%@NEEef-Yr@-Y%#PllBGAUjC'i[drp[aBVbPJ+TNj#-%!hT@je4@YRB2m8&2!
+$U+la%dKLhSk)(@bIU5l5k"C$Z(feY"#-X[K3YB#U+p"'hDkP"iBkK'38"8RGl,(
+r(kN"cbT"KjJN4D`a!k&PCR3)X0m4*@X3f#eB!Y-[Xpq3!+Hb3'Q2XV,bjfRdaX$
+0G*L$4P9E*iZAr@jC(8)$[4XekF'T+Kc'a8%``TE3dj!!lK-ND2V&-jF'S##PK-i
+lqdcM)"eXaBklQ#E*RFJKm#@NKk%6j`QlYC!!i-dbDG$-H6ENVkG0SMFH"CmGQ[a
+*Mjl"JqX`,5pGSDl1YFH!["CXMi)0dEc9fG3!NK0hN!#*(0m+f!)5cIP)k'BDF93
+Cq'LhMFb)$B9NSjB[TUGIa)a4#icTTmN*9[K%[d+16R#iEA5@c,9KkX%YM,$2[mG
+$EcafZlpQ0(0C%NRNYa#F4+E1Z*XCXXaBVNBKBX'blMjrGGQhe5c)Y!A[5MH)%G-
+T4Q0F6RZaGe(TVN@mmcJ#fJarYAG+TpV$dq$%kR"he65&P%$ZNV,*K64jr3Q1&5p
+25f"QebFrVA0eRG8r@"mm'ZEi8,85,96X(B,91Bm4J33Ae[Q%I0+pXXr8Pcqa8qV
+aPYMU(U"pbTJm(@BdT5ESGH5Le"rceJ'03%'acRU4VbY9Jph'3bXP4Hj,,6"flZ&
+Y2IFPYmqZhB5$k&ET1@0F`bN5,Hf1)LRIH(S'`(-L42G+XYlDkZAQUX)f@H05'PL
+h+-K*,A%$YlGac5rjXa5pje1HJiF)#KKB&m2H$(*[rqpNG0iSaV9PSS90!RjN+)J
+Yh&`VpTTm5-iRNp-+%UPJPk#0*IK4j3jYhjTJ*+),Qed$m9,L9pc[9X6E!)de1GI
+S05QVD*&*k8GjLS"+G854PmKmMhI"Mh%cPr8VqRZ1&-G8Ii*TV3XFh4DAf1UV[k8
+pCf%,RcXH*6Ui`'!qX[jEpk#Pe&Aj&(!I9L%[c#5I!,$0am)Qr30eS$5Y++T@"-B
+%BX[0NiNHES&eB+$dK2MiS%-XPKU+K-lRPf)4p)%9c,X`(0+&cAT01+e81EB!j61
+-UeT0haX6CG"`6$c5jMJbcrh#pRL0dSkL$imrF56!Mf1r%IfLZHrd[+&"r##bNT6
+mCV`T"cGj3ZcFMQXVX1U%kVARHpfH"!TfN!"09c'2eD3Y5VY+)G@6##HSGKc&M9b
+-+MS#a3#TL9$k$QU@DBeT(+mbLV9IHBmI1F$rcH"ak#2fa0FU%ef9!mqCTRGlY0,
+MENfEPq)&I%(8(,2qXrrMF@Mfd[@('4f@6pCJ,j!!ATPX(dmXZ@UcCbCR8RS1c!K
+T)aaLR8mGb%TT5&*(V8*lNff'YUQpG$##[DlTL'eUGC8L5E(35jq[,0@KEacma%-
+LXRCN!M$#i+Z@*0i#D")RP"58a8q8f(*acXVUYV[+H&k1$F2X+60M"9*MrS+E,f8
+E6B8lXYM4F2SJq"T6pS@$c&Y*Q4Zd(5PINN'*UiY#6A[$,6BMkhefLZpfP(e2T@6
+6GXYb`3D%GhqT)i&ZTkf5PZkk'+d9@Qh3A3`CQbjITGX(T`r',4XLTAV!Q%rRL@8
+*fp`%F+-!I5pQrT+$(hHT")IAE2rFS`Rk&KTIU')E9*Yj4`j0,RXKDh2iIq**RD6
++2A*j8c',ae!IIZ+$X9X36S1CSCa0&'-8&MK0kRrRN!#`hAPT4G19Y"XJ6Vf!p!T
+ea1dlP@h'ce2$R!rKhJirU8-l$*jm0FL,jLa24UCPbJQ"SkE$qaE2B"kaX-SF)6p
+(1TIL$2GXBF[V@+$8#lfB(HTHC[R(P5KqTl+dT`5Eaj&K*PCQ2ac(m#PS4G(F6#)
+T5GEd,dN6b-ICDGV%"[V@a'UTCi6#bc39S"`&TLq4Ecr@VYE-CZ2jDfLL5+L%83Q
+qR@T-r,hHF"$68he1L8'4ESEHpX3p9I0ZpV+*FqGmEML03q$I1@kY!G98A)RdM+4
+SJmM%U&[C`0)Mp"qFi@*%`rhic#5)"N$#i*Z"[-SY$623MiH$"PkDm+%@4BNml1$
+3FqBHVrlBca,HrJ!6a2QbS522e&#MP*mFhM`e%5K`&N5JZ`fh"Xjj&PQqQ&NdKEI
+i!+%(#TBT%ZpY6p3qp699M6@+ZY*9)kJ!rCiXr0)+P"lCAG[ia5'K@kKVA&mc#iX
+Jk&HHR201f5c'jC(4%$33'BH'9b56%p2QFr$HkM6h%8`+3'a`[9GD2M3#Y`GQ%Mb
+U",$a"5G'X*@eGZPrX`J#e[Pi#aZ@e3qNkYd8BNiq$4Ace[d8ea#aL5qllXI0&XB
+'kkbSa-R"f#)PNr6QI6*8l"jZUZ&kqeZ%I8CFm5Q+5f[Rr2d([++NZ@iNU#C1-ik
+q*-@0d-U(2ce9+8ZXmK#fafED(&b`VT54-eX%1ajjZZ2[[aa5'3C(Y$LJ3YZ&e&[
+9JS#PhPX(JSE9iJ1ICF5pI#X4`3+"fM1BD-Q4i"`MJY#@l[b0#RXZ3kpRbrIrYN(
+PrM8MLpmhke20T,$$3BVZrZad!e-AIFh[*![KUYU6EmdRqm&JJ(N2ZB4-"aSb[L)
+KE1!b!h$FDhU0R`2lf35rkb3LAaeaYFT*ba[*IfT4QBN8mJ`*-M3d"[1'!%AJh&e
+QVA4%%NSrrd8I#*!!CIi&k2M*A4U1A$cYZ622"rIDHYY1T&6jYchA1&b0+G@1G0%
+`5S#*ZD'UJ14G-$`Z[ekNC,a9dJKfNAeai)aklk49TJXH-&TDe!Z03rbCmql0D1r
+d1GMdSm&SF+rd3hMFUlVbji!'VKX4p%)FeEe&X4PblQ,9f,fhMa,+KYf*HK%3#4*
+,@q1)MVI5,`k!Ff!#Q)mCG0Gh,TI)HhaHX-LETZ,3%[Y$"lb2$E046))j-P&f#Xe
+Hd[*hA3S&5@LI6ACp'kSa3c`iTqJ,4h*2,`$J0@$3%)'6[mDQT(EkEYaN0[fZBU)
+C&20i#-d)Aj9IrPa&"JT&M46Dha&5TM69R*hcA-Q&D2MSbMq(X!TJ93lBN!!KNDN
+EBb-)&DR,A'-06I`ZriNb+2E+9[b9KFc6A,iYq)Jf9r4VZ%E"#-l"lqRjU%Kl%aA
+4f6Jm6)hLeBV,US)12q'Y5VXm%08NEfSmfk@JlETd35-!rR*Q&GHEJRE,[X4Z%B'
+jf08IrBEG&qPlLXaX[(3VY+0@dqFSZ!!m'Y-JCS9R()!b[NSc`pZ4Jp1,B#e%jXf
+A!EaYV'T!2eKHc0L8-j%+m!M0"%ea&Ajf0C0U*S4C[TL%L[P+TchlLm()mK(kZja
+4YG11p#TC4BLX023ceKU!"KKjb,8EUA0k@4!6A1PA)VVlAbC!S4XXP0!CFaMDFbd
+AJi$3,#)1CZHjU0#F(4365@*VG3`4MT8*XUr0A@2Y3+VJZiD2'PVIRmcDadq-"ch
+c#VMN6*'4&U9h2AT8A6"#%-"(9Z@raDk%UIDE+%'FC5PGrDRH5XQHY5i`#!ZMq+Z
+#@pKZ(dpV@#G!*4e'62UimDhKh4Y091Y`$6KY[V(m(YmT1`aLrbYbZ9Frd`B-a)k
+ED*GL)r-K[5!XYk4'LT!!Ma,V%!Tm,iQPHTXS*6R&YNY5PZclbMMf+$&VN3'*N!!
+&QbGqS"Mi6rIDK*!!(+"e-6&mqjbRI3A(2i2SR&@EU!QZ$`)PQ4jKMGAe#,hTIAm
++Y"NqX8XTHaP,S&b$cBdkY81(pqC+P8+YP43$'Xp%kfm(mpfNAa[-VX8!S#NaU`f
+NM3GD)$9*1K&p4F$P[UH'CmYp2&L$QaD&)p5))P9$43I[h$FR5fRVZeAe5jUVCRF
+lbc1UZ)$Ur*qQKdipZ9DDcUB%cPfIJbPP`b)lXP8HGC5%d4dMG*dUpN@@bMPAjIE
+p$dfXLVNDTD1+a&QC)fpYE)ba8'6IFGL,@2,&T5+5ppi)6!UV-##ZUbkJ&L,#rRS
+55E!8a`*kCD5E,`M,`6A!PkYXKi[RRf@i[[a-34%i2I!`B5jcqUC!V!fiZMM0Y#k
+0mCbM9R[f8&#EYHPS(f$iehFl-6`dipHR3EYjjlL+GkHll%(bi+80&#c8V`cbP)5
+#i32rU-6p"0SY(1j6MP`D@@JbXM,0%2f`li1Qi5iDjKrr5%MpQLF!'ZZ`P-MUmU&
+k+H2MheZI[3&$9m%9kf3A"If9rbpklFNbG$ak4-RT+E&`G"8PS(RXRNVEp*!!MQM
+[`+S*P8V4kcSUel6edp"%l@3iKLi2M5B0C+JfLLj$ZPDl5"EQ+4@er-iIc2$l6(T
+h2hHl-qr3f5G@TXjHRfiVrZ3f)p&5TqDPKq5[V4@`&99m(0CDPQ#)4M%fD$,A(('
+b-R&hB$8-'YU4M[9BrcfH43G)CVCB@F$ECP2d6SKU#K&mPF`83'P$S[r(1-UX03H
+$@'A)c'$kCTJjFYiBYfIq&r0LhA0H)B8bpRfHZGJ5)hla(Bh6Y4!h0e-&-!qVA3E
+UVE"iaES!GjK)pr%Q4,@)X,IlJ+U1%dc`,bcqJDS+SJ'F4M&@'X%ZXRS,5RB"d&E
+U[r'3!!G'3!LhZY03d)2QN8293'e40[G('&2M$5C(MZ8RXkE[i5cP)f11VGCL"Ri
+)GX&69+j24A!k(AKNlHMK4i85N!$aafm[2HpYr+Q-8rMcR5T'U$#Q2e#!YFeN1kU
+b@*mHj6rHU4#XAF*6ZA&%rQACa(@G$T9rUm9+)0[SEZ@em$T,LE3)CTN3(-[p*E"
+(C(B1L"PK)*rDR[P-eI&%P96UD!,akle#fIeZ3*pL4"S(T*EM9)ZKk!3hIi@q!KB
+!XdM&34SfQjm'IbkSiGF21qC`b"*J@cbKXj2Q56362cj$b)SfXEc2Sd'c66mCJ*i
+%J`FT(i"[a+K1UeEQLJLcD2K&Q2Zr*#9G9Zma2eAdGQ8q6MXDf6mZfm6)aF*cqHp
+L68CV&HQh8GPeH%XID%P2YC9cRbjT*86L8bR8fFX@!rKLFQX)ljm0f"BA'bZM1!U
+2V9jSZLK&Q"#NiR,mH9+-lcA!c'D-M(a)fSH(i"(f[GdA%42XN!"K"NK4e!!CJGh
+#NBKKV%5ccFK"6bJb%NT0LI`"(DKN'RFUEK*K0L8q50lV)YKrDKl0!bY$B9Gq1R"
+1RCqaE+`0(4M2"b$Rb+56K%$JIA-c16p9q%EU$[2b-AFSLeFIRHEhYFaaYT`HjFT
+R"rU-k%"p1Z$%&h3F[dhN"V-c,ZNaKYY&pPhherE"MaHq50[dSc2Q,I&F9q`8'Mq
+!5iN[c06RAqa21KFLFQ3QcNpV+K**R$a4'NDdL)L6D!r3rpFlk)B`@V[NS2$q4$B
+B(ZRVSkm&a'X-T5Krk6ZaaT4r4DhILdHQ9"B2M%lp3E8cUL&X!fC`0!0kKYajL9b
+qCrNRMAF,6EeZQUhH&$eCCSB-qKPA%#c+%rcV#3VPUr9@Zpcrd#iNb`V-P6GR-*[
+FamEhmMjNQm&`[T%q0NaAjc&bi30XRfe&*M(dm6*rU-H'hl,kFN39Bf+Vd*(3'G,
+!Dfq+rC!!6143X3SFEj!!M#CE!6kq)#dY!j!!eMpYC0le4j4`$cb[*Kq+JIl22(B
+(cDBJT9NT#c#(9bVbld6#EaM!03Jk3j@#HSK8Z'mQm`H`Y,,)`q5E1@LKVhIf@Ip
+2Rq`2Yj2B)+!3Z1Ql-dA+!HFb!H(0i8RkG8@qS'R6b+"iVlh1Gb6QLZ0i"`&E`pl
+kk3JRF5Bcd#cY$5rq("#kM0PX1G'l-QFZQ2[Q-K`9cqeRqBNe95F3Iq"(L2e80QY
+11Jmc91S00[)NqN6TdU'aUqMPaK(jqD-[U3@J"[$E3XSl"pm(+)a5R-'#S'PD95C
+'C1#f'4c0HFU`4NA0Y&[R$@KF5$*@'(Bh2NkN14pJ&h!)ii&GR*E)!eKa%c0S2+T
+XfV["*qpJJ,i+qL4"aA04VPbHJ0cRNS%AAN8qJ-0@QcBY9B3[@Sr#b0*bRR8Bcjc
+pl+i%p,2YadeC!T3Nqk)@d4bU3E'8mR9HqCS!@Ke[6Y4H"`a$cJRPP8-DPi0Ib+k
+C*LX,N6JcPSk"QU,fA"$*,C'91qfZ@hXmBM[!Tj&kI9K2bC,DbPF3c5[RHQc'lCK
+'"CT3(D0pSG*Qfc8!8jB0(@$VSkQGYVd'9mB-B`IZX-AaAT28920)CpqJX&m4063
+c"4%0SG3!9TeiNlS1XdTT(jY8ASLC-3f&cJJC)@Kj[,V1iJSL@m!VV[e1c+N!C2Y
+dT2)%+@e1'f0D,+E!AZi!MZ)MJRI4R25$'0Xh0'Ya"3)a"ce1*fTT[@HR",+Bl43
+-VbeerUlN$&PRdeTSDVj,0K"PmUAa4C[NC-TNhdTeR9Kmdd1dha,HlPkSbZCC[mP
+el&1E0edhh)%Yd,PA!TQDkE@&TAaA&hP+mqdS5)-bdK8lHc[+h4IAS+U5q#I%A!L
++0aMZK9MiKBHl)$!0)%J2Z&+GrCT3ejKKp4+bD,15QLMY6L@caf&NN!#1Ke)-HA6
+-Y!B%JAc5a+4#l-!YIR*kpekT($5Y%1NS+Ipk6CK(pUa1UJpYEK0%T#$VrMb',RQ
+'lXHdVV&AfaNVYLb!cCI2-59ZQdJmX,2Sfp3bU6D#a8ADU1UhX"RlI+!I-344i#l
+6i$p*NK#)#XGdCM'`56VfSJj(pHQQP45p-&dU[cJS,`QH#YjBPD-A![rZRpJ3kGA
+VfRCGl,a%iAR!`Rj'GaNV-(Tr8DD`cfF&3q@jXI2(pU1bIij"3,AB6@LSqf2Q!Mh
+Bb`j!+X5jBU!8A+X312VVhHFJ1m&9@"Np-ELYBEJ)FqYAF+NGJqj@(f$G&pEdZ9'
+e4JTF%DRVI(X#d&8*0k[U)bVlk-FrP3-rYAfTRb0VUlRKBk*jVG#&T`FS*@2F8Z1
+@F&D*HR*`H33[8+1p24@[l&(X+*T$Mhd9+[Hr1TZQ'#MN[&V6`[U"J0iE3jmUb&F
+kKT3JQ$1bmL9*RJ1lh2"df9b4%Gkf&3pSN9q2r0-&S&4&+3@pKKce(Yq48H#fM2R
+Pk0EeT4PBF)iJ8R)$beCQSK,bN!$e9-p2U9XaDRmX)q)6'ZTAXB&),KK"Gh6P1Dd
+HYlah0X8S(!`@jhK-MH)HRFZA#-MJQ`qKJZ+p"@[,hX1'X$(e#pd52dh#[HBTflV
+`jRaakZNrG'a(Z`8S3ZVJiUib!K$9"hZamb'@"fj8CX!qM#E"i0,$aM*#-IqQ-l%
+[#CrC'LZ41M$HHVI"YCU1ZXj`ji%mT(*8J)3fD1bJ#RP1I`HTV0Ad0D#0)$d1Pd-
+)'Cd5#hS1lCe0FhmY$2GD0-bK(d$Xr4f1!kBB6"2MFFIH@((5GcK5&k(6$j5CS)$
+j9dlhf1R(1HK5MEBTqJ$@Z1&b1RAZJMDMP)DJ[8)Zqc0ri*384P0!3biPH,E16*D
+c4`U@Z&R+#p@IUC*qMAJMP*BHMLI1q'd-k94UUPFhFq4H!VR"L%e(Y8Rp#m(mPa1
+00BSSL%$El)ihVZSUMVpDFIeXY,S-pd!*&UC@m(jY2%Pjir8CT*pEL)jr(ECc0ZR
+@(5TaSbIP9!ffdRL[!$SRI[)U&LIhL25dF-U[a#0c9@'SEY%U9FAP4&K3831Qb(T
+M"c0SCH+SV2'J8,EAAP011DR(ilTc%GQeHL,BcAPXmk`AdVb%Hi%ji!P[#Z-4k0N
+P3QlJVlk,@bm181bTJD1#&pPjK8A13cJ+qFpp&FhQJmNj42b"'pfM([9mN[VJi"B
+8hY"%`8'fMT@5TUQhU-"ASjQB68@8&mQrqEJ!FG#bfF'Z*5bXP["dH!4Z+EjcN8d
+Mr3M6IEl"b1iHrD"'NZ&`Md,Kq*2V$MV4VfV0Z"Y%G(9cE,"ETfD9X[VQd-r&A39
+3a$"1k4hr`QE,q,94qD!6340-m-"FF`D,Qj)#e1YpV4QkMNBSJ`K*ESl`mla@cTI
+eU04PiTPZp!(C(pr4MZVGf$l)dhmTF0GG#e&Xk6ibmIl013M-beBE[3rCC-#U3c4
+m61VPaAf!VMYkA@B4T'*'#IVGcI#G(fYF4-!*IQP2PZ"QI*(V&KU2-q4)#Z6VMB*
+pmG`0rP,jla$mV3Dmk"+),9l*48p'FQG,RR,4SU2j0qQ3!)3+-K*-2&ZfjNHcC!J
+*BPCDfiY1Jj%mUPS99iNerZ*`V`FbCVpcZ!RrMVVi`hq$Z8ka`KAle%THdKp6IDK
+A9#Vd$efU'A86"JE[cZNj0E0M&h[KfAU"IL9H4KT6je&(bCJqIl0FEV!bJr,dM,H
+%RfGX#Zr)113#JrKXL$SpeCSLV,3"#T&,[k)YST'0AGJ5M"aT2l6lY"m4ece(8k%
+d`kiQHc#kdZ)4Y0D2#NL,kaeNj6!irPB4JS$,HaK*F3+EY2*RlDe,[A8"ek!TS`@
+N1`$QPFUPXeMR#c-YX5I'H54,cciF826#mq,ErTF#!i(BN8%(H5IGdp,#R$!B`I9
+[qQGkma@93+"F,CQ+d'M8q8Al11!jBRA)-9*mKkI)jiaf[kk9+9BA`J(+#(6[Ue"
+G'&VF`JGXc$[QX4#V"L#qaUNdr@'Zq9U+Rd-QYG'Bph`pDbG3N!!Q"[q)qiB(YkK
+SrHb(GeZ3!)A**`XhJD9EI["aG6Sjjb)MYIkh5kiY$$c*V!jNI6TTjbpU,iVKi"'
+jLM,2&ZC)!h288,bm8+T9@U2QF4'Y%ZVFDK9SGQ4T*QYUr!))18+ma-A*9d&La!2
+YCl$Yc`1lZHIrCCe*@S&N-VI+kVH8V)[P4I%LM*!!`[UMCj+ZFmF"ETlX&'8LFTf
+5%CH1FIV",6dKLGAdkE&X'RSPUa1h'`RP4QGNL1q!FkQqESQJk3#8d+-c1r,Rqk$
+"*8BELTV4r&'C8$pA8Ac&eKeXMMIDcSK4NGQSD$kV2DQNCU%dJT9*6[K(45'ICeh
+2qNcM`5&#9MX%S@VRTDL*e$Jim"j'GdLlJ,jb-q`$$)hh!'1[IJi"`QjR!+[N[r"
+e$al`Uj9CaGiDfC6$Q8)RTNjlHrbYNF%Z69$9[J*4SCI)1R,IrYB'IAp6$GBVh`J
+h"R*#f-+,'&LkE1P&*2-6B#Cpq+lN,FLD'hriK+rh0`9b0+jHq%!hFmlri(c"8Zf
+Zj)0c`TcNd&K(jb%LD6dN4`"cP8R19-[),b3Z'Z"KqGMje3*(-D+m),qLT*5mQkH
+B9Q+i6qDb'ZrT5IRXNZ+bRLr`6)*bh*%e(!h12M9dhI+C59%rM%cb8EbE"mENYr@
+j5P'Z5MaDmFbTH!)RFKa%5FG!&B("Dk6U&DYGIcKQdFjrE#f[9`P`f0H4L4fH!qc
+SJ[cYp(Jd0[Rr3Z+p'DY2IPk[3bcNE,62E0E#KhlGeD+U(%"c3LJ-4)f$h)8fF+3
+'@a)NLSd2@-QGQ8S0Rjp&dd4BX5mPVDdU04#,,CGfk3Um9,jb4L9)e@5dJGE5%hL
+#HYrM`Ic6,TTqR)q#qRdmr#b[dp2qIl[L)UB-+VS)BAX-j#AHFMG,RF`$A0aB1GI
+8F5RGTUe*$8,CM3ANCqScal$-SG(),C%J!eD(d-G%8!D)FSaU(H9P(L@''TkiT2f
+Mc@F-SYc0"L0N)A'&-c`D5G0-Uhflp0fP&+2,Fr[2`#$9LVU6MX%+MLEr`B)Vr3`
+4Q'qU"#aaC%Tk`3,VU`Xp+`Z0S2H4eI9'ch,mGm'VjUeZ$)#X@A91l[8X&jfTM-,
+9,I+C2F&'B-UFK)SlYmf3!1qqS*E+[Xb"Y6&1&`I*b%4-cbl1(FTbS4)bG$-icT3
+f"13N9H*GV6qKhBqL[hX'S2TQXcRL32e6TU!1*-1Jd-Rq*d2$lj!!c81p2h!p,rT
+4d(YI-bKcTS+(r%0LJlQL!!iM`LL[S$DLca@ZI[#U6ChrN!#S,PJ&[pE2D0!fj%R
+'aXc8aTREr6C['4J)bD6I3`$[#V9KM"U@fYfdhk!m+j)UH(0%rV1lRLAZBaEi9T6
+BJ&0Nb!HdVe-CKpiD'q"LE,6E@A8!`1ZYMGEr5@kJd$#5EmJR'D-HQ`pdAYjQ&Da
+R,59YTZ(U5jc0VK`LSTdM`-43H3&k%&V['IV3"$R`VbC*-&-h&i%bC*S-j'kpSka
+QeB#HmS1FrAE!ME,2#,0J)ZVAMYQ0cHRh'pC&D0[jYk[Y+"#3!+0(YAK(jbXj#d,
+)ELQ03r'Lq[,*0%i`2CNqUb!%4$)I8X#qS2AAq+8liEMD-Q58I3L#XA,)90X$3Dk
+N5fUCk@0C`p5"-S(S+@"9Lj)H@!4YpqH8S+&[4#qh[D2aFqm8P-Il!TlhbhSFHAc
+Xb'%"%Ie6d1cKMe%994HjBZ`3TVh$hPCZT40T)CG0LZ%,S"AN*BPQ1M0i,Dm4imq
+Y95k)$1h2h3T(ff3YQ""Z"prJFbB&h5'VLADH29#@A1lbD)8R1#hS2McaAS19E$$
+f65hR#f5kbijQj[9BF#-GS6)-AJ9&dqa#fTmD0S$PIQSG$1r6jFj(MfL'N4&RQ+A
+SM4dTJrLfrZkk0A#8f2hP6@cd##2pb@hM+Vl84+-NE2%lRmrLkU$FdQH*9C@BZfp
+*IQb*F1*)j,!I&$CXEf@iV4%%M6+*'cQBm6TC@SpbSLXDX9DbM(jfcq0J[lZDX34
+35(G-96QDV,pm'8@9IU#NEEVB0F8GRhN59G@EhKEUY3T#"c6NE,*VqK&@N50`p%&
+H'[4A,b'2kFCfMLJHaYkFmfCV,G!r[f(4b*aH#m$YbbS@f@hrcLbi*6V+AR3(Pe[
+X1@8k)A5a'1qkjUGHUUVq%U5hPLqBCr2LMfDaj2GaGJfjdmKJ1LH0C!9A1d''fHe
+B&l#T*+pdKQLIL'He0H,a+84)1mQG#ZIe'9rZU"%j'pph`A&`DrBeAD#8)LY`JG-
+$TTZN"%0pfJ"$XfDVk'*aA%3lZGU[Q&(X0%[E8LSPc36)@kplX[#X@LHlK@HIc4G
+`XL@),e%miQ6Q1RHj)kRH0l8h'$BFMV5#Bfa[Y*jajlJG`+@3"!%!!$m!%,JMfqk
+i)p[Z!!#[#J!")fN!N!21!!rZ[!!+VV)!!#)U!*!%$`"8De0SC@aXFbl2J#jiE@`
+!!(2"9%9B9%0A588"!2q3"!#3#S!!N!G#`G8Kde44CHa@Aa`3[hE5CGaS#)!896!
+%PqlCVCrYURDGQVlm$Ape4ScZU)EUBDP48I%b"k%HcMm09(R@U,dNJRN`a!*6VHB
+FVAimZmJi4B[%NaSkQ-b6Decf0dR@i",+Vi(Jd9$"f2b)6PkZ,,Za3%VYSTpE-5r
+K%+SDJ*EQEhflGQ4e1U2E$!CdMQaV*ml()X+3!%5,S+ISH5%Kj[L-h3P$KqV0DH3
+hENeZhQqR),'HUjf*+1YkV@N)64X$50L!PJDYYUR1Sb'6Ta8@H('UUF8'11-A-,A
+ZNlj[A&8k`&pTiNS@YTk&SD"'11PY969@L3j)Sb!$kM8*dKTKdhaL%Hm,[Q4V-r8
+h9L%rJS0m85eXHJNN'V["'I1+V,3pc!eUS!,*VbCS!j`[UXCB$%SrdRbq#,cAR2I
+"8-fF6S@r'k5kmBRFb!h0)G6YP&h+(4a(rFi290)Pmdjjj*PR48#E42V[-KM5k*Q
+664!m-%K`d(fU''RKQ+L3!+B[i45+&Pm`b2$HjQbEZ`lCDLLr45RBdRF"bB$C1%P
+i@G0`00&D$ER(Xj!!$"95M5Q)[!b#FecpDpJckUqda4Y5SZ"6T*@'CkV`RYI#XdV
+dIlji90+SB2*EXJVYCpQ!X0UPr%!Q*-pVPl2b26%kNi%LirNF,#Pr)eA&M3UFAp%
+pHE93QlI9qU-#dmS)dl+3!16Y[H8Ara#,K*eM*R9@j93HLX`L&X23#SJQm*4T$H"
+$)AJaIMXc8C%ER[6dFa%kQ[CEL-(fRG*YH2-,pZFh#ZMHrHl6FXjKQJE*d%k0r&+
+RZANm&65L`K2Hh4'92QP*@qTa@c"TKD'*cpqED*!!lJBHAr,ZN`IZBEZc0NP*DQN
+52&c2VN%jG8Q9&+dI&m#mp4Ji,4Qj4f"Q#9MF2E0p5m-9Y"D#**%bGD,,,,()G0T
+!S$re#hi6T6Ih&G(ET"-[(")K4(J8fk'kMb[FDR@,1p'3!1rE`GV4Z"F0*cmJ2E`
+m5SiH%4A1JDj$Ph2h'cFq(bp)FT`EqhG8#D4q#*+%(K0#aNAIIp+CERR6M)f-mLj
+HYZGNreMiDK`*b&)FSk5ad)rr`2"h,X&DIT1A4J'THM+eDDGR'[SAiNZJaje'e"U
+NdRQHJ!0-(e0aD!5FKHZDkE($XkY@SZhVp)B'#fG"-l08VM(e)(J,4l5+8STSG-F
+jQ5Z#Y[YJjCCP2`KaM@!F4BU$BT%qUJYjc%4`6c6F'5**#ZA!ZQ#@3N(3[@`#h-h
+2b,aPJ'Z+@%SU#r1YM4TM"U&'HIad@M-[(G'1@GAeK61[@61[lMJlLHIUZGR1hXb
+@`T`1$BZ5&fXbm!lD9,#1(Jedk,YZ)KPcb+(V+SqR#hpjrKq@Dh9-G-D0A$V`49*
+cpM"U(kMLLfB+0Va+[J(ZL5ZPm"Jrb9bfb)#+hU'mIU'lqr2N`)jYCDULMqEPTpN
+hdArY2"A0-lPqS"$)9"5JZQ9XL)krL,mCie@![C,V3#a%3&XQKf[%0`,AR@i!M&I
+K$`H4e8(&ra%mU51$j0-PS05Z)"@5@Dl3Tk-B0cJ8j`X!pD0G",8[FKXrQEp,RJ-
+%mX,j#ap`dXe-l2aHU-,)6a*X$Zc9KqTld,0+JX93MMC"$N10h+3JciU,eYJd%Xl
+1mVhENZhr#14MN!!YIcEBKlZ*B,h$bBCR*c5*#hmlA02*0CfV)kSh3e6RbZDq-T`
+piQJI$rjGjU(ZII1J0%fiT582lYqUpcbqRl!HDY[%!-Xq60&89$FSAH!iK+SBdZa
+a*@l$@AmDY2`Ah&2)M3AGZ@5R"KA'p*YF*lYXL[S,VFH0iX9HH'#,$DLbTUr)[ie
+DCmFG)1-H2r1kkbi&Kim*HIU,R&-c9Lila!4h9R&15KjYqS+Pq3"rP2%1BeE(b%&
+UBPS&j+Q+0)&X*'3CcQ[0(QVmZXp-`mN%F#VAT1&jCM+U&@&qN!"E2c*q[Tmf`KL
+%IUp!cBU`-caFXUa'l$[ljSKfZ(*dqU)c(kI2hAl615BTE+k2k*60ibU)'+M+69f
+&-V&[L20XjQEU8B#CD"rbb!,qZm(3!LP"Yj`F@(p[B@D83R$),(e1qAMc)qHNYNH
+rNC@L*$Yil&6jkj`TbKkHT!&@)5Bj%L"YKU6YH1IDPTmc*E9Tk(MTkXN)*bB`h&'
+Be2FNXEBAkISYE`jS()RYVITkEIqL-PlJ8,EfC1DDj1D!MC8FBIX0V0EIaAq*3Z!
+cd"9ARf6(Mf@(2RCmSL1EMQ@UJ2Mp@B5*Rfc4&c5!1m*B5&+ZlaFR,E$#cAhc(cL
+G!EPa#Tam!PHL1i6(jj5KDE(V81LGNAG,-f!La"+(b%d"!B9!TmDM'mlZNZ9T"ET
+!!V+3!,``IMQT$'2qB+!N!Ie8-bUS@cd3YK@5Nj0c4aUe`ZrVDhkN3G89Q82lH%p
+M4+DE*pANYl$"MaJkV`1ZF#L,aXAlT,XDYRDeQ4fa9(,h!rHCCY(!d*NAdY*ad(*
+DF*`1Qd4KVk'ZLBh0A@3KIJC(+RfacV$V(VMebPZd-Tl*8!8aD6R'YQa5Te+kXG!
+5'icCXarBV[Hiei"FdTjaj-HHIf(PE6U"r5V*-$,G1*`mScih$+p6dKbJmi1"l"r
++9ai-58-rXJmfXHSq4Xp9b5er$5-pG0++X5T"Im0ZAcY2e"RVFL,a))4AKpcb4G2
+GH2a1-q5MFh2Y!J,6C6%m0m4iZK5VUQ-(`aD42UC9U'"L+ka-aH4G-T!!2'A2KAY
+mQ[N`VFTif3r%bc!4#bBlMYbM"DBirraQQYm[2j%r1J#Q&m98S5BV#2kqZdZm!"a
+"&0%KSXHM@1DS+JilHX#Y9dj&bA'fcQL&8#U(JN$8'X")+$HI3Prb&Y692%a#bi+
+*kU13!)BebTcEBZLYJQL&)TP2LHKJPM2"mCXP(#VPXMZHK)CSk9EQ0ccKDZF!Aal
+f[9-9%5&DM$(S99m3Gq1!5[*Bb+alQKSdqjQEdGcHjF8CBN)-!Je#fm1a%d6K,M"
+bqb36M#a0X&LfE-(eRmAq@CHK[FQIR4iSeSGacdMJ(k%Fqr3lQH*53ePH@q8#EAh
+93B`@RqH&ipI+"%KSCEBj,Y-hSXT,Uh)#$*1QYhdD,N8Ka`23fL!HPJEYm+RRq`4
+I$3&AI,PSAA-Z$pcb#m)8HN[*!3FGR%fE''HP9b%c8bC[FNa,059clANaC88[QTT
+9P02F+A*pipeL,h*V3"CPr1UUkmfPMa!6TaYjEC`mHClhY*CK@Q1Eq#QE"CUp#G&
+XIYe2a&VM*Mjed#bMFFEd590[qj`,3UIb+d+ik(%U6'"c!E1,jKV@lACXqSQXU"U
+['%,%8KqM&HkLk,Sca,1C-6cpI*m4GpU$qNa3*NQ@9raqPQK1IEAb*hlFfBZYi5)
+iEJUkh'p3U0CE"Ad68!X!PLkM,a!KpZ+(6JK[,Lbc6SaT1'%ZQXmH5BCDjEk0C0C
+&G`F69F'd8L6Bmq-e9RrfG89iXl35r@G,QiHZ&9#1*DcFBC!!%KR(Zb"r"F)N4bZ
+#iVV)R43'CbiK92M9lrhe'P(q+U"++iUH#H)b*SG0`0ZJ@K)FDR1,MpNb[bA$bPa
+)`jRX*hm46ppU(k28YB[K,J$2Ue3(5N(!dZFe6reZ,eRYcE1j*`Qrr#2%d(MRH3d
+p5lh!T"j5$CMZSYF3AhLBjBHY'LepUJE3iPfjFa@@%%Ia+Hl-X+5`CEifNr(DQ+G
+RYCl!4J*q*!*Qq(5lGPhA)(p,A"@IBPph,+9reP-%kFQVrSaEbEd-6drj(e1PK0"
+Hb"fMQFXNqmBpiF%*JY[2lAr+lpUqC3XVrl!$CdQV)F5#B6)peQ4mcM#jF`3)a"5
+$G5KLDkC)mGL*+f$0"FTcV1hKh5dP'BL4hV6111[3!Rek%D[-[N'1@QeH[-,`lT%
+JkF!q68L2lTMENaY`L,UUerdmYUNKrBqXHUcIEB%EY#MJ-KGdi)aTLKQdZ8RJTHp
+Y"IPF"p,Ji6N4RKeME"j%YPCp"GD%N4$"kdRdk%iKJEQEJJa),AeN92*-GjJS%&'
+XP2%F%@hEBi00DBfD6(I6+hqY0JqZF-rjP(rN8BIQ'k-chD-M@Xc%8Fk%"32&Ul&
+9%CDTmSS&1Jjl@0*P48Tq(k5j,*3*r)&e23jU&L,PXEkZ#IMYjHB5aVc$"cF)V+F
+QXmQifc+XEUiDMD0beL$DL!kh-5lM&b*CCXbFDC8!RYM"Y`"#*d*Qjd@['mKfNSj
+'2N0N9!TNF`e8VAJZQQ,,Z(rN!l`$hA!0*)GhZpS1G&dBak5#j-"8CA&@j'GHq5j
+Z-f$jcZKmVq`jPK$r4kiZe%-6[Me5*S,bJVieUUHID*jr60A+ia,!2")FM2E'1mI
+$mK*C1*rCZ,AK-"lpAQ+UFaU$rQ8mk"(,aCB$3*&#*Q3&F1*)cLL[AFj'4[#lRpa
+@hba3GCl1ic+0RUSKb+9Ge2P13QTEeE)f![3[lR6e%RqlIL$YY58*FIH!TX3MZ%+
+ZT8E*YPB'ISj5Z6,I",eFi"!mZ)dkL,(@a2'8-qXNh!R'Rbd&@6U1VAZNZP8#L0%
+IDkBXf2Q09dScFadjZ4&ic!4S"h'Q6$Yqr4Y'iT!!V[`VaT%1P3bCc#8B&AhCAH`
+#ZIMZZ)C8N6*GL8B-ISYI9eM*eq,S)26SIA@9N!$rQiZ5%kfi2'dqcP,NKH!)$P2
+ifcl%FEh4+RbaB!"Fr8hVr,edRKEhN4#ipAaRD9Eqk099#!iYY*!!'d!'IfBhG`X
+QrVr5)1lkHEq#)NbfC432Hf*3U,"@8&YrrpK(jUdZ!hh'5`q"`p@T`[5qF9!6&Hp
+p*D-I((jF,A8I8C,fi%ZR*%k5CQB&DQe[blZ'RI1[IlNpUlmcGl8j(q0m&4PVK"e
+NVdpaC00I%AN0q'Z"cY5`jPTY("#R+k42#khi5(maU"U,19r"1`hcf"9YCT*L,Y*
+kkpdN6EHTKC9,fZ$FU"BhC$DYIQ#3!,qPIYh1)c3JJmrPHUEL'1)#U9HdMKP(e)T
+Pfa!rlr*C1HfQZJia"pBdDL*Z%@00Xc2E6@5f55Yl0lfaR1'fU$hpZ2Vkh&Kk(Fh
+mqP1)2Bf'Qh"8a0QE0pQlqDlme%3FHA2F`UTkjmd52&10JC!!(hhV)aSUIE`kS'`
+DjA'Ca0`(UDqJ4%lm9E&4j@*4#*rLM"E24A+3!1X'qNpebXVj9K'EqQDXcY%rm0B
+4KKmHrb@G1))-6Vm#jle"EK#EHHmX2LHc2mKNF21mXYHfDBL3!-Bc$,SHf[A1pNr
+FRF0')`U94#*(rV8'T*m8CNSj3+a$JZ"%b)#($2T!MhKIDSAY#aJ3`3idqkN*Y&*
+FXT!!qH(Xj8SKarTpe*iHcApZ#6ILPE@NMmfhFB&liCcjEdI0iNL&0YBC2`MH,Rj
+bAkAKbpL,MR+i+chEhDBiT86Ue-D,Ce8iX$bNBB4%4dbY8l[FqdVacTjT13iNADj
+Z"(1X+L"FLR-%FdSi2r)YFmGb'PbcSLd82f`!K38A4MXH@P9XrZ6CqQ,FUJJr&#Y
+[1I,jeb"IKf33Q$[R99ChQ5%YS`)NN!!dcKfPe,`bP*A35AhZj&h5QVPP2p0F'0r
+AQEXCPHhqaI9FP9*GC)k)$qk-+Pi!HT6[hh(0hqFp2IIjpePJ!llX,@UV)&Qk`9)
+cj8M0rpJN!XElGm8#5PBmr&`MSaRj*0BHZ9F$4lVJhaKr$,9bH6)fNSTQl0cqh&V
+-U,c"FE2f"%Gj)kli+fcDP2*aX*!!@5X5NkeGi@)'P`,S32Add9PMk&fc'Ihm5Ua
+a(+[f[ZF)A&Tp1XSq#B58h"KYk$frZDc,BK@CG[eQ@Z5P`fYJ*aak+Pd&Z8jl8)6
+cJQh3blK(9lkD[f(CaXZk&M$CF@8!-T3)AT)-59#5D6kVIL2Ta92+'d3-EE'FQDp
+Z8[GjY"XZeT-"i!*(DEHe[MC8-6&[VPb(Ifr2ZVd(6L#86p$HV1[21fLfRUjd9bC
+'YPpY!0CmpD[8IqVMJp(hdQMbH[i)lBV[pGdMcL6(0"`6Deee(eQN2CYha)IIe4m
+B*4p6`K'(CDp3*N05&LMDA+llPdD$RSeP)c[QGPQbPXP9"0Jbb8p*Zh8PI%jFI!(
+P'0[k'X`VBXjB9@FMSRZcH8DjqUAR@R504f+h#l&BbP+qU'kNUJXA6#mN8j3j-5U
++ILIBRfI'6lQ@XA2qrl%0,&9q3`lVNY+6[k3eEJ)5k5pP60mqjXXM`a3"R`@B5,(
+h22FUV'%*-6%jdGGdM"em&hp6XU9d3Qj2jUZr8)[fP*+Hc%G[PCUPdVhaY"Vq*Z6
+)D!-V2TpQQbfa*E%Fr'6E"%NNYf$dM*5RXXSVUiI5AM2Hk3JQG'j1ea1LGf+l(L2
+FhK!Q5XbTmmq"[JT#'3#q92*VdmCAr$#RP*!!ZQA4F9AD4cl@P4BNNMcarCJ@1G`
+2a6N4L2"Hd(#$+L@*2&0Q1BDTlEVF9@mFQ@)V*0V8R@4TJp+,RYh[I)YZd3'N938
+i&ibBD-J&6!%T'',Qh`#YE8LMrHIE8&2-HrqIlQFBTNK9im30#r0NEbYTl&S!DBk
+fbZR1,epCDGTPX9lG,!%mdGrIR)`cRR$11m&M0KrF2X%6G-j*cC%0'Y4(hA"Q+%l
+q`@2YF`S-8k"aX,He-Vjj(mSmAY3D*3PE,F4J`hA8LQ%CF"l$Ldf5K'(8E-Xh[@i
+qBVZ@a[R%q5&!"lNK"GCXRhifED+5486@E%XHAiiQLScLh*UF$6SJHTM!)V&+BPG
+aNM#@S6DD&hii10c9CZSY'+eTp`0IP5NGlQU#Q&2jp*1V`aQ1j14F3Yarc%4q"9Z
+hkRI(U1DVFfqf6MRm'cmk!`KZj@-0aPTr48)%KBel8fac-h5[kmU5QYE[le$C-`j
+8&4JAaG33j`-,(29TPVjGY&$aa-(cT8@qQMrAfQ1'Ni`SrQFU4l0F8LR$HD4BQXA
+VCSPFr0'J*9P')e!'!d,CB18RULLc'kclZb)aGM$GkCDp2iF9-0*Cp3LDDLUXGkX
+'"MkaXr(jrFMb2rq&*$UM+mbX*"3!U3NS(YaT%,V(SdL8CT[5aDHh1N`YFp4,`N5
+c,J$V1iTLj-Y%N!"26qGI@4!c[,Tk9(fkK@bI6r6I50j2eYQHLH43TjTe0h3)IB-
+QkRPG9@RrXH#lhMEcGpKk(D&%#[bTQHEUAi(E3V1e*L8bR94KNF%EGa%Z@KU0!%K
++9M[Q@0UrZc0EdVfLG4XEjc6jbBYeU8!8Bb$JDpCCjHNAIh1Bhm%UKm!D*fG+IX[
+*Xfr)2YC,ji5IVb6h2VdBj,rX8qQYPIRTCmbfd[822j%5++P*'6+dj9a*2QSrP-6
+im#IkcDAa$4F89`PkJbhTYpcH[pYNLR'0KYCC*HmMZGXS3'aI#(+*(@QFe&0Z&,k
+i2PrfJmFDJjf3!,mS03($9d5f6ciFiSfZ(%FT61*Sj'e3YVUeT`,&(b&S$2'-eXU
+)[ra5LVk"ZX!kS9jh'd*GhNTcS+C4*U"H+h5&p[5fe4FaMiq*Crf)IIim&FddV2Y
+KG''l#2EY-kH@@PMD0`CXY5N8DqE$Y(`U5a[@i*IBlbK%HCC"(k&&eF*A3j8Zr6E
+`5J$9b,Q8EaAi-NHFNBDCJN)PLak-e5q2Y&b2hXK(33cSaLDh*d-UX3UN*a`GhBf
+P4@S'6(LM[Da1d#DlPA4[XeeeAXC[F2U0%ZK-k@RSQ99AI*a15!BdU2"'Vp-HhLX
+Qi6q8dG`#1DP,q22L[69)EiU%qG3XYaR2!R'XZNEi+@XC80b!`fGU6@%R+*q40N"
+hFUqG`-)*Hjr!6AFTK81*pcTZV3HQM3e@jB2dmT)kM%Upk#UhH2beN!$UA+E[j#P
+E$28aaJ+hKM32'q1LF4AaGa@"(elE%2#VP!!0i[!(U`f&TLcLhAZ#D6bYUHiL%Qq
+B9)NiHN"5)QDB*$!F$L"TGaTpAlUS!%-VdYKT5j[Vp'd[r320IdmbK*GHG,@BKqf
+L4@iqQh68!JHMkQ33DaT&Q&T9[N*-F8ICh*NbKp#CH%3N!G`C$*aKlUQ&QUm8I!V
+#F5BKilfiR$LD,C!!pBhI6R&#B9$KIb6D"dk2hDi4E",EqGBKdFfYJ@PF,r'XALT
+@A@V*G$kpLL1B-$0Lfd-QXV0dlF#AcdC1`lPfC4lDTjiS%h$dp0ejYf6iX[3mdCc
+dPEIpV[(@UYJUM'jGr#Z*"PE-4bXS&a2m+M*#10B2'CH0[0`30l5,cGqR"29Ec6V
+lj8$JMGd(ED!DmSAAFK&,K`@FVH9e"-f)&ATrD5FX1ZYLd#BU9,iImU-Kdm+Rl+`
+[46Tp,+P%TPIUeTF-rhH$U%VXqTEB2fSbAAmiA%#&THG$MF$Q9U`cFmAi9Nb3!,K
+5la"#K@T'NC'&lXRHkL,i)CEI1qT4-G6KUa,HG#8q$KR&Mj&,k$`j'SUbXeAYL"a
+PhMKlNmkMHmT+qhpG$kV`HD2`%HA(1@#P4Vm@5HZ(#ccdXpNRm(a69-h09RZfNA2
+Y4"Caad$*qYah8Kr%U'iA&fcE+T0YUSr$LS4DQdD!DUEDml6Ta)FGlG6ep[lX2ql
+i4b9h5j@f)1GYShX"Vm+RKAjG,ck)rMVc"r&*'d@a44K&fY@$XLCG+YpX)E5p"!Q
+(`AH+GkR5*+9'rTMFqqh!hQ8DZrZK,Yh*!CqekSSp&+TPkU)J)ZCAkDa"C-$H8rP
+,QC6I%FrQ8kIpJ+*JE1#mC6cp)CG)`#bD2J9,+[[$T"F$A**IHaZX)RS[(BqSq$p
+TXbrJbQ)bRlT*Fi'AC%4q()Q&VC[Kp28Yr4,&$2I5$K!R"3H)(*6HNFaH@jLGMG[
+$U0YI'r@G$2Er('1eYh3rqm1edpUQ0PBEIIMa"bkrQ%F9,G3&djFU-q4hAq2CMKP
+jqbFJJ*CD4*Lci)`c4+NaJrcQPmih1*jpT!A2"(pljHP0BdYImr+Z'(m,-&IcDIN
+$G"(6BI#YRM3mR(i#LRT)BrMEpHD#rFD8621QQ6ZRI8e*qfH"NQmGXZ"m,@h`9G8
+k3LN@LSED*%$,HP-`5@-e!lk%$be"C4c+@U&SLrRM!-$19U'k1#LG!JIhq-Km(6J
+0md(B8DD[B!-l&E09b208H,ldK4@A"qZPapHjIHjHDLkErV6qL8#DjfDJ(#[#Ed(
+34N)%"qT6GcE1HMYIl5Cf1K*m3"lp'BK&2eYI%"4eHelV!Nc2MUKLk9'80%@l3'e
+k"ihFR4Q+AGfd`cDG[4cr)"$6NdAQl*!!T#Rm@EMdiF0FRlecpjE2S[@DdQ)Uf0L
+aS"l&"N@halU`FIZ91HH'1hS#PEf,!62@I%GCB[&d`NqJm-9+GbZX($'M(,dVDXP
+A(Y*h`S)E,lXC"Q(Xl5#''0FQ3l9(-k5jRmbp0Kc2#44p'N3Yfp#GZ(K2Q-B90Id
+N+$Y'-0"[GK-(F6k!q5XjjRN%kGQ-@0MkMD,F`6-#8DMH1Ji9jJH0-(3QIQ*QZqc
+P",2BfT3)#ifq+k#Y1T2qTlI0il)eSh@rjHHp%&DX,3eU[+&)3AFDCSN+6G5YHX(
+CR6%PM*%rH4Qa52(cR5*MSN'8c[,(P!YM"2-6IE%d!HA,PA)IqMQL@'%Vl8)r0(-
+aV1iaJb0YK[&Cdj!!--U&I&F!fN(hr5eB8TC-8U`BAq9X1IPb'pQHHNql6`PGPJp
+ieR'$)GKZA#Te,M%l6mHek%cr,JL)iU5rHMb-[qiPG*1AHk6Qb&)Zl%6AJ,TpPKH
+Bb$cbc'-BN!"@YR%&m1'`c0BiFp$UlB[rZH(mT12YjN&X&KeCh*1(-6il8I*CCMh
+@U1MaSdJ!fF`XT)"hZ-+M"M0EGA[$3apMDkr#TQRVCraS$bcP9AI'V8$*"bC%0Q3
+VJ6+@#2IT0NlY""hd1$HK0Qa)$Y5Q4,2MSM(5C-TH!@Sk$lc(Saf5$U4`5C@-fdd
+"+aI3(f,d9P$jdD[5`cSU@5ZMXmIeYL!G-Lp&Vj,Bq-SBRI0STZ4q+-%QeLrVe4*
+A+hSajjaRHp3i''RLf035d(qQB9A2G*M5%m'IM%f+qGEZX5IPlALdY2@Lf&,EhrE
+FVZLLS+Rf-"4#e+-kZa"l8!D0h'lcc5B$h)LTFVJ2[#0@&20JN5k*aiXINc0k$GM
+&YR2amQ,)r,318km!P!F+B6Fm&UkqL$)q[pBXm#0PG-qC51$ZfqVE+fECrELQ8V!
+Ca&`(UD[8b'cAA6!PlP19e(8%Ep1BkEdhi$033JQTMXKHlL9k`l3B0p+KPrpiNC-
+)PjL-N@bh0')5GG+$Z4#[SDZ[#EZ$hfR#)KZ!f$JJ%D"HrUPSXZdfh+65a3CCH`r
+)4Zj(p3F66bf-8CA+dX52qQ5#MFYRY[%[HZVBQ6a[51eGPia,1eRVqElB2$S0CXD
+6VHNZHcie#@UV5V4jSq3q"kS@4$5`S"mP(M1Rbq&+HE8k"8L"AIYB`8K2LU`Cl1'
+8j-YhGa1*19h0H3a+p"BIml[Cq#"F"UPfSGQIN6JTiYVYRZ`@VkN"S$4CcdhA(RP
+i#3bk2*J4QG6iM5@VZSBY5Me9aC-)pQCLeZ2&Q9,0Rb1GrLj3&'DV%!5*6hC!+Y&
+%rGS[e2+"6-SSk-Z92#APC18A[E"bqr)phe!R@VPU[XppDmLC!S9f&bR[dFpapEC
+kPTTViEG+p-96FGmD&T8Lib3a0b2i'Dm3K!66Q#`@rPXBj+H9)qCX`"SPYH41j4J
+FPeI!I%&bJrkL$ZH!L)aCSbHX%$4LiQl-33`JfNNKDfk%pS66FX`,$,S4!kh51CU
+r,"9p#Vam)J,)dGBTI%cAi+@Ae[b`Y$(5dP'TBCMLB$&IeN@[mlj5T!Z(QpL'I4j
+cGUcaIQklG*,Ldbl#``#f+e3[cq-5CASklPXY9B'5a#dp`'#KhR5`DBaKqU6f!@,
+'0dC6[95$Ubqc[[8*NNTj&&149d+TkEil'Z9%@GFqVr+cM&Y8IDm[UN3aQ[d@d+m
+4)@,H+ZMR!9D1)'1qBUY`Zpeq1CX"JLN&K*R#PjqClAeZe1$k94["&RXqJ@E5$9A
+J&Zh6e8I[Q(eDYk1pj@GYLRbReTKk!@(H$lR'B68`ajajPVkAl&Y"@'r+$'b)3`f
+"D+$`Q!-@Q,dkN@&YEfmmHCPq-mBFVKGN)5Ic4)LJi)C%L4cB)XM,hSr@1NFL@mI
+NT#RY[NjdL'1,ke!&"!P(eH1Ua9!#T+@a!)UA$kl8UTH3!#8rB,fUqN-"aT,B#mU
++)MYcmZri-2PTkBKc!f(M!F6BL-pbGMF482DVNQjM5%1SapjDJZ-5&@&h'D9H8be
+)`)a-Vb+(a&e&1iFBZpEf8KJ`Rr''"V%61if)AN3mfVX*Xp(i*m8i)&j0SDh3-qR
+pGa*-*cUr!6DI(293&B8q!SbG)TpedIeqPDm*E(hFpR6%IT!!8qi[%X%ZMda)))c
+$GNlAKmXE`&('6)A0j3k"Q8+h6FDBA0k3!!ZJZF-mVV'V8$%C[XBV`FNb5!a4F*!
+!GVHceQ#+r'9"3Y&8dU2[)Z)QXGKb-Z5"Zj'BYB5B`%ZbIN0DC%2ir#d*&95EMI9
+)r!eiVLmkC-MBebd6%%I0fe2Z"6R,dHXK+IaQa!c+m+Y%MpKr!ck@L#HQmQa9Nfr
+8f4LfQ,Dl(-A)q`#RQ6XH!BIImRDIUmGcGE)#mc`@3k0K&1)f39NH0h'JITFHj`%
+kUTa6ZYe`i49Si4$Fh5ec`*!!kkkCl4SDM)X*""P21l0qXP@Spk0J-`T%9T(*e36
+EUi%1*UlDU`SHDfBYZ%Em@*elXabrXiYRl4Y3U3i@3f-*Z3q#[h`aVm4b[,P,+1$
+lR)UVYpL#%fN*a(X0+li9B4Pm*hG!TC!%!3!!-!"!!*!*!3$F!*!(cJ!!!e[rN!3
+!N!UPN!3"!!!e!!#fm8lcY[&1m`#3!mi!!55!!*!$FJ!&J(J!N!j*BfpZ$3!"%Le
+TBfpZ68&$8d!!N!q!!*!*!HB!N!1!!*!%$`"#`G6Klm3JH"k5kcXLNd1@28i@a86
+FZS%c$NZGQJUSH4bHKqI!B10G(MDil@6dI,-(Up5RBpA#Y*[,Jc6ZVdl(MB8G2P2
+0'@HQ+8l@&,%cFpZ@ZdA2CRZ(blTpfJr'bBN59qAPP+-4lhGC8A%HlCU(TqTMVF-
+L#$JH*!8Lje0B!+@3"!%!!$!!3!#3#3%MQ3#3"h)!!$k*rj!%!*!+C@8!!!%!!!'
+AJ!!"PS!!!!9,!*$c$!!J!!J!SJ%F!)"993#3!``!+!!S!+i"6J#e998!N!--!#!
+!#!#L!4`!JP99!*!$$!"L!*)!m!'B!)9993#3!``!4J#Q!,S"eJ#'998!N!--!#J
+!+!"e!6`!Ke99!*!$$J!S!#J!`J'N!)K995J+!*!$$!!S!#J!P!%5!J"993#3!``
+!+!!S!)d"&`)"998!N!--!#J!+!#f!4`%!999!*!$@J!"!*!&A3"`!(%!V!3#6dX
+!N!G+!&8"%iJk8fpbFRNZ)#"*ER0dB@aXBA4TEfiJBf&Z)'pZE(NJBQ8JF'9bCQp
+bE@9N)'pZ)%K'8b"fEfaeE@9c,J#3!eS!!3#3"9d!F!"a!+`%!Np,!*!(5J"9!41
+)1P4SC5"QD@aP)0*H-0-JE@&j)'*P)'4KE@&RC@3Z)#"3E'9KFf8JGA0P)'Pd)(G
+TG'JJBf&eG'P[ELi!N!05!!%!N!9Y!'B!J3#L"!*25`#3"33!5!"R!31)-P0[FR*
+j,#"LGA3JB5"NDA0V)(*PE'&dC@3JCA*bEh)J+&i`+5"SBA-JEf0MGA*bC@3Z!*!
+$I8&%3e)$!!"q$9-+Ni3"Sfd!l!Yb!l5b-LXVieY0hP[[D[HQELEAJ$%!3!-!N!1
+kY3b!!!PT+[lJ!985,2Y+b&X1iq9cZS94MV)rcirrVL!j0k`Dq"(+KM9jKQ+MCf[
+`V&ir"HlX#m#`U3BL1%aA2VhVbkfM'32&(&P,'cJ,!*!$6!!#!*!&-3"R!%8!V33
+%8A9TG!#3"3S!8!!F!4#)'P9Z8h4eCQCTEQFJGf&c)(0eBf0PFh0QG@`K!*!&#!!
+1!#J!,U!#!!%!N!28384$8J-!!4)08`UE*!!lLSL+&Fm@d(1X4'`3p5`rIcrXejf
+rjql1$+GBf'%P+PL&999LjEra",'U"3ZbC6Y1)2Q3!"m"9#5BqM@mKDIGaGRG6G,
+)HT+pI4mZ3pc&PmHP#aEjM6KA6jAe#b3m5Sk53ElSG,A`G'S9QL)q"HC1abaeLk9
+cJ@A[I"3FZ$A+c+Ce3%m()3a-9j4CR+h"Zf9c)KIFIJai(r!m3+*2iaUXL26-$cG
+j+&$EM-KaUkHFa@0E8ER-cGETJDZ80pr*q`cTre6rb@d!N!4Z!!%!N!9S!(S!I!#
+f"!*25`#3"dJ!AJ%PL%j6EfeP)'PdC@ec)(GPFQ8JFfYTF("PC#"LC@0KGA0P)(4
+SCANJBA*P)'j[G#"cGA"`Eh*dC@3JBRNJG'KTFb"cC@aQ,@9iG(*KBh4[FLi!N!1
+T384$8J-!!,B08`UM!J,[j!5Gr91a$mmfHp2E9(6Bajb+k03*LRTfFql'k6J3$a8
+lE'G9#9C9N!-KhQd6UrS"#j)2B)QrqC!!!Al+C$IA*4T0h,,0C$41)9c$S80X0Nh
+%l40&LQIS0$'"1Rme"P-qaQ1QT*,p22dS82pVc)-l2TG!Iei&[QEeiPFKRRa,frh
+ZGP$pLG-c6DU+j6&M59JZp!+6*N%5EamGV!)!N!-k!!%!N!93!&N!C!#6"!*25`#
+3"3-!4!")!1L)'94SDA-JBA*MD'PfC5"TFb"NB@eKCf9N,L!!N!4)!!%!N!9(!&S
+!@`#8"!*25`#3"3)!43!a!1L)*eP[G5"SBACP)'9ZG'9bC@3JB@iJD@jMEh*bC@0
+d)("KFh0hEh*N,J#3"")!N!ZH!9j!!J2S!*!$I!!"!*!&D3"M!(d!R`3#6dX!N!F
+p!'!!miKF9'KPFQ8JDA-JEQpd)'9ZEh9RD#"bEfpY)'pZ)0*H-0-JG'mJBfpZG'P
+ZG@8J9@j6G(9QCQPZCbiJ)%&Z)'&NC'PdD@pZB@`JAM%JBRPdCA-JBA*P)'jPC@4
+PC#i!N!-H!'i!KJ$H!H3!"3#3#!%&"P0dBA4eF`#3"KJ!0!!8!0)"FJ!"!3!"!*!
+&!qJ!N!18!!!"(d&%3e)$!!6Q$9-+j#)!hhB$MR'R6XAbV0j%XHBmX)IiV0j8,+H
+JL(G6Cr8c`3!G"L,18R4@$cZXm[rIpjiFhYRYG&J##k#MF"NjQKYpM08c$@fcB&c
+B,DfDBBi[Q8@'KZhRa2eh1KGblU3+QbXZmrjdJl+K'E8"E#iG,'U!L9ATB$8iH")
+""%H4JmH*JiXFe$A2[B2Y#,$K`U`5"0`DJf#cY2MX*ChTT*3S[2"4)pjUZHHr$Vc
+5*(XM!dUL`bYl#@3++G+qArAV)0Jeii&kIZM)c)ei1q,`DdZCb"5#5`TS9m8NY6&
+2mINh23-MRM'-lh6%63iY205!1aPr01FI1[ikDb1j$**hNU$CKaEqDXNA6ICm`&p
+cThAf4L+8'Sm@!!!(#N&%3e)$!!`S$Pd,V))N2ZS-hqrZ1!QK5SG3'UP4i34(3(P
+I"fEcS0Q#K"92C$K@P-9HE6bcNT,DRQeBDc[aqqT$D#eNV8)&DdiZN!#%#AZ,hfp
+er$l&pI[)`U"CYD61l#ke%eX8NM![bE+N5i83d[Fl[Hr%iYTckrF($HIR0$%"*$3
+M04p'j!kP$U6rDXM2CJM"X&PTH0km2Rc"[HG&*i[#(f(pFTmm#RB-&ck*PBNHVS0
+Ka)H%LDfKbLLS1)"iAb3)Jc1%ji')q4!C1e$+EV!VUAf-f1i`r41*8jqrIEb"rEc
+klR#mrrCRJq1ZiMrE`$GKa94jU6lIZC+pD562CdmRci59Rbk'XX9!h3"XQ6cJqBA
+i*cH0kBALkBGRaJ2-hYTYaHF0X#p)F@%Qc[1G#a"XIL%ELH@5#bPrb&FN!i1YP[[
+jlmh%-jAekAJS-Tbl-E)iZ1NUIe-VBQ88rJ9pHaHLJ@Eh`JAEM3p+f0FSl%E'6qC
+a%KQ%2iP,fai+q-jH!bq+%HV0m$2&U`*Z8DmCK6Fa4b)0ia2aZ@G9,ZE96jqF'A+
+Ij$iHhQhJ'jH5ilPL0P@@RLYfq+@YAja2bVlDmpZP*2I,Z@h,"(a8`Dpi+2Y+*E`
+HZ4D#c&!IJeYh1f)'[V4[2$Rj`rR3DRRZZ4P-krfTLRlUKe(i$rbX&E"H4f%A%L*
+8[*bH")%13M,hk!)G4+,3$D[JBV+Bjf8aYbL,qSpN%HGN)5K8P&!iK!STh+EU4DT
+8TGX$6l2Np#Xa@8ElR,`XQErQ'&P+VqH5XPaq[HHa,'[HLHib-$qZ-$#P2h3B[-M
+XF"J%MIj%-2JJ0p8U(mB,prl%JeVVm1,)AeEZm%SE*X-`5BE*-dbU,YN'[m&EE"B
+'2LhLq,L`#pHl0G5RHl&m3iqUh@40JD9(e*HQ86pSY4)kbiIU#Uj-Ef"*EcRJ+"8
+ZAeLlS$BFA6-Mk@jidB4mU*AB2SM"$YV@c)e6ZP[!58"@0Z$l&VH@lU8)$TUqSJ,
+ad0G!-NIYF!j!F*SLDT[G(%-YY1+4d3cZ'8#`BSaZ+d%dCmC1$q(@5Y0rN`q4-!-
+1ha'[$Y%FkIYAp)0PY8QXb)b)T$fUCG50fMlBQN0K$6RbLSHeq,iNERPcAVd2Qe9
+[[+(EK2lK4,8$e9plc0*lJPa-QD5UA,mZQbUjH0&"TCi'BkrrbN%mb,j!0r3@J3l
+Q8k*c-HC8KkQMJU2r2aJGiYI$JP0PlehjamNGSp#DZrFrd!Vk!ik0+iAq'Y,8GQJ
+8b+FSE'$8UEldrFcdS3m&(mk+)&3YAHAqXNrYkrZ8F[9L`#PmMI6H+Hh-((8Lkjh
+DFB"S&TqEeBi0Ud!1!(&rJpk4f@N&#pS'J'H20CY"b341$fQhhDmiND1JaHNQ)bk
+IkK@TGT&k$DIBHaEYcql,N!#4DFY,JhDhiZVlbQI`3@$8hN,c!hH0%aR+R08FMJh
+h@ECjV+P0"-Zd6F35M*55`k6eCJhMU!Pad[(@4`i-qC2)FY#qJMUR`YdCfbMk1+r
+3R&+J)(jr5rhl5'YA@SKK9%!H!r4H%bbXF$[d"pU$B5U'iClN)J&HiL#@#!(!L2q
+jUqG!m2IZ$Cj[E,49[EIkj1P%RrrplilrR[f1Drp0IhAHNmemXqPLE,dL6N2c[MT
+mebIael4Xb*KF8MHPb-KfkFhFFMMC`MmUKV)T*T'3!)2Ae6fjaI9)fU+)ij)8%Ai
+RFG(NYp%@hXk%(Q8Bbcj6m(CIRC5SP#5r$ZF!$h4)A#jj'S*I+SED&@CfhK6FpVL
+ZPQrXXH96Uf02NrfU[bF5ljA5R4hMrU$R8LQ8U)lQ'fK+'"6Di#a18cl$iNlVlJp
++rKN84R%G82lDSS,c203D9B&$eBHXGIk'SJb-+l(rfG(,Xj!!DEJPcY04,9,L6'k
+QcY'!L6Zfbj2jCblQ4rRY%feAMe6hl#aI[L&2l*K[(6A"U@*M-"M+KMFVMAcGZp+
+Y@52A'"`acI,B`SqD$mS[&rh"B1df%Ajb5p*qEZ6m`5(6P)mYmKN@+"XUcXl6Z!R
+*AdRCJ'RkYmE9`DZf)5QrkCU0"KZBYS6dV(%l0b3&6'8"2YK)i5r%+M)`#)5pZK+
+HQ)46m[i,Y&`!4QcYX%5[kfc2IK"GY2f`6%#!Z-*dZ5E6YM'#C"Jbl+%p0VTKKR$
+,KbILh%H2ldDLRIm$L1&i+'1D)BP#Aip8rh[I9rq05RFMf,P*YLZeYS1hZDV-RSR
+eYqdQ+T!!rFbi0"[YfR'cUAf6'*A&PNUqjeSS*)5cKP5GFBQ$Lem4K9,T2`'9dfT
+#+q'86&fLP-,`J3K(+Hi(,C@*R(maa1K#99,Uf&MeUrA*%8pADE*328BDZ%I9arQ
+fr(+S+E`FXbE0J9i'#D503$%DUN3FZMEEJ3Uc`S,"3PUK'qV+ecpqDb)@pld!!!'
+e384$8J-!!XJ093Z8SX6XB342CpAGe5'%+QYY#3bBY"a*C-$N"+Jb1CP)"J%Lhk'
+N*4q6$L8h((P&ILE*QIaYB-%fhNkIDAH&K%Nb%pNN$FJRfl0MlLe$r14lMUkjBj1
+#Qf1pV+J3!qd-q")[6T!!2&(NN!$XH$VqIIf-lF$JY8&`Z,`m2Kl(N!"fG26m(+L
+c@!dY,VZ@Jq32[ecHi',DFQR`2$R2R"FmEhPV5TS[8GIj4FMFPUJN(S$krrcHmXj
+TT(LK4Sf51[S8m0FeEMVMk6SYm6VJhLGTV1lRVZZ"EaEFUUI2-L@THq[lVS32kTf
+Q[&34P4,qR6LH8leTcUSC90r2)#jHlq(PSQ5$"LU+0r@-Q$28$kPkq[BSR&*1dKE
+`$GP@`m[M1pi1h+5UIP(#Y$f["YEirkXd45,c*elIF+LUHqKZJ#aQ&Jj&V0F0QfV
+hJ%U,iK)b8Rj5bF3(R&Ge&@C#A#EdNS1e+6!l+jT"0GNjAjJ,"X-fS4558*PXpZT
+"@GPQ4BRK,$U&MK11kK6e3me$R&PmRZBeK3+'[KCeKV"#+i`Erm##D%'$C3Y&%VF
+INEJ[pV`2cNF!!!'e384$8J-!![3093[FXX#Y$`3R*l4pR,E+,9cS9G6V%TrE2UV
+LrRe&k`k+#h8laU81%*IMeD[KZ&rGYQdIS"8K,pp,FV&4FGX(#qXa#P`NCE4GVrb
+Ad[T#VfM,r3Re*3ecY$mEP0C#pVha3DjUN!"UKaJA-eeFRekm(d!DYF'LjIVki@'
+lV9ff%4XfTid[`MqGTkrIr-H08Z2RQYdRFfCm%reVr)q5ZeS&TQ!EF&3"+6i#@"P
+d!%iQbLiQ6TQbP$"D+p3#T3k[%+J&a`QB&HN9`e%"!i@TRSpq41E'-KF*+efY3YX
+Idm(#Tb4#d[D[L[pkkf4+c-ND!HN5@EpmG)mZV-J)Iq[a,UXa*kPPGerLQap2iR2
+K)Nh92bG[iR,lp(Y)jfcaeb8Hha*bcRH98B[[d(Y'VT5,%hmEqZYhrMc'4hLLD&Y
+QKeplle"Flhfm[)H#CTR`3'M"adK5D0hlB4H60&a8F401Y5HehLpe#)T8"HB1aEI
+S)*JDH%-bDfGNB0V9N!!SjLN38TkRF"(GN!!D('BaRVX@iB#Rb*UTJhNT&Z612U1
+%V%JKlaXIpiKYGiKCQC!!pPcYm43#!!!"LN&%3e)$!!+d$98,R"6&p9%!hb4j54V
+AQQc[Y9QY`(p1RFT8hqPl9Ri9f!Um#Q`&!,j@MEDeZEP[lT*ee`S-%pN4!cN3c9F
+'jrI-mC-IZ6ph6qa+GR0XIaXS4q,T@IMkII8#j)ZL-j,2I"hr[[dG9f5[$5+hcl&
+C-MEhRLRXdbr01c3U2@pDXFKTGZ(Fmkd+U6kTDI&,cPa2DK3HSITrrZMjP+3b2#K
+9DT5&AV+qfqSU!kjPN8RAV,ZAk&6EX#`0HPbi&UGEc#@dD@[,*"r&Na5l5B6%*2m
+Zh-m89c%6-8#Y$3"@1i0ALf%+#b3%GfQXKA05lq9S`EPBLAj8Eq4&D"r!(S2N50#
+kmM&4LfJ6UL#,pS82Ei#*`@k&G+U'aeJmj2p$adlZ)&Le4LV)+(D3!!#09FG(9'3
+)pJFp,$-Y'EP2#-b+Hr+4+K!XLeb+8j!!Q(9`F8!kMGP!SAJ2#fMEM0Id#YU*1Sl
+5`QdHYK!+Q1GUP3%(P8GKhIi2'&60&Kak'&+irSc%krLeDhBd!J!!"$0"4%05!`!
+'G`e9$8-L%K(QAQi3C#dC4'Vb4#3,%&QVTLBRYcf,M1"fjmK*Yc06mTPrGlr[fiS
+m'pr-Yl9!NYA1l-RN5GLq1j-4NZ9@j)QXb1mIN6q6RmQmfGCf%8N@%l)h,FNL+%$
+L"rp1@BD49%3iU!XlH1)RGL%XdS$Y8-@K&RB5AKr2MQN-Tdqr@5Tb%b2*lEeNEa2
+deYr0KTa,b#P((lQrdKDbpHCeqFBN#8XTDGMHT"F9Nj*A@5m3r1$*iF)A(Ra+`bC
+Sd@*%bYh0[UE$mLb8Z8NZL1FKb4cpaH#,'S2Z2"A0G593mh5B(ilNbH!U(HDq*03
+V2L&LN!#Glm-GLj)350pE&JffVadV0j9c-)PcYTmmT-U'cCf2[lLr"Zb,Dr,j*UQ
+J&eL!@HMeXIT'U5KXK+Zi)G(%4'NH4P'P*SBS*l2%Ke)*Td69NE&*%bSLi2'$"P$
+iBJ#e%QfCd)!P0"&UFSY0QF0BUD3IT`bXGDL,fZ$B!U8fSh08@--BYZrp*)$#,J2
+%1@+BZ'k&r-qa*h(XSZeGPi*0bi'TkX2@JbVR0)ahG0E&J(3EJ`[@YV@,-D*-cb(
+Q-Y`6mPcZfjMcBMp"cGLljK3Rb&aVTMai@-PP[RfUT+62k1U0klXYd-Kcq8@f`RZ
+!4-@X%K,E)89)*H!)2HGQk+!L4L(61rDKE[-93T%lT4&h#Yj6*Gq@)$NpfZfT-bI
+Q[*a$ZHi9U@$-fpTGbR)EqIHh6JN-ELhIr*F2iT-R9S%)rHb*!9X*2'JQcVG5aT+
+bk)"66"T!8Hh@RKiMNZDb1RCPrpLBBZE'f'*+5Z1k(+rRjMiNk%bc`$2Y2dPbk)d
+[lP"05[[rh(fm5+9i5KpCGN!BDPI(P8iGH))aB&$'@AMak[HhZkICP"IAk`20U"3
+0ED$cl3ANPB5bhE"dKJq'UT!!'MJ$K%Ef[#TaY#Qi5[JiZdp@*Ek(V6S2"5LGMGP
+9XcSTH`kX!)Q$@e`Lj!Hc!YeF"G@qBdCpV(kpX(EYJl32qi0AAhd*'kUV,i&`%M,
+25lL3!)9HJTA-Hq-JNiRVb1C`%N0V@&,9LJXedG30VZTedYBKmQ8[pD@$C2LX$T!
+!US[$LD0[BBPS9ake"Bi4i"NpQ[B5,S$!l!aZkDY"[CV-MSM(ZdcHrYqi$lHRmXQ
+0Uj1Q&hdZmV+6dc$Q@CReZ"0&fVV&S"Ua`C3d8JpM+h9[1peJ#QP[H2ESABrbfDQ
+9EXl,)rR"Y(aV,(DK,&e(qXHCLJYTG`ceq9R+jqIUrhj)D3VcIeGqcX4Q-IlfpqA
+BR&9R,NpTEKEkTP6FE&CkmZ##0U6Epj,8cI&CH25LN[RmcjI[Q)F-e2@eAFBV*qp
+h(["`34I,9E@$fDIYZ+ZVJh8&%Tl"cXY,fjl%2ZKNB,XDjI@RH3*a"UE`8,`*ALR
+F`jGi-!Gh[Rked&R$@pIN$J#3!``,9@j6G(9QCL"KFcS!N!-)"b"QEfaNCA)!N!-
+m!!8%)'pQ)!FJDA4PEA-Z"&0dEh!E5A4PEA-JFQ9YB@PZD@jR)(4[)&9Z8h4eCQB
+k#e9Z8h4eCQCTEQFk!*!$,8&%3e)$!!!`$8X$@f`,YfS!N!@S!9[Y[`B'!r!4fr*
+r#&K#bBm'eKXaPa-!N!-'!*!&$3#3!cm'!B!!N!-&0Li`,M%b0Li`,M%X)%0[F(P
+bD@GSG##T)$%j16!Y-M!`-5""E'&NC'PZ)&0jFh4PEA-X)%PZBbi!N!-L"J'!!*!
+$"6BZ-#ia&90dG@CQ5A3J4'9XGAKPUL!f,M!Z-3#3!``!+!!S!(m"F!5[998!N!-
+J(kNJ-6Nj-#dj1#""E'&NC'PZ)&0jFh4PEA-X)%PZBbi!N!-d399c-J#3!`&*3di
+M!!-!N!1!!!%!J3!#!))!!`#$4P*&4J!$!*!$J!!"!)%!!J##!!-!J`#3!aaKGA0
+d!*!$!8P$6L-!N!@%4P*&4J#3"B3!N!-A!*!&%!&+!!!"!!"N!!!"%J#3#*e"4%0
+5!`!!U!eE#PT!!RIi(&CeCqR%2P6X%(Y60h9ff+'2YaYlZYfEEiHc(faB9@*9*9K
+9BMf'(9B&#DJTT[J,i1(,8`"QDIbQDRi#lM$$cBqlU)D,4ASBB5rYZ5acTL`96)r
+2pNKjl1M&V$6BJ'b3!'ZD%ZB8DBKG0`9Epd3(4ED8d&f,-,R*JQ8b36(T0HQlAa)
+VPkLN[F!r*`mLD`#3!jp"4%05!`!!UJe6#T`#!Zr@j3bJ[U#@m9XCReQCTDd@cmS
+kYcGhYGkYfl2&Ej`"J!%!D!"JC(0C'3!$#DJTT[J,&1R$QbkNIKkRaq`VEU4dMCZ
+YeC+69%EUD1rE8eAPM-)NM2YcI8"Z'lbB&D-,`U9`KYT)$S[40NdGA$B!#a9f-0*
+INe$h8`6(+)1+dE24hj!!*RCpBZREE[)VqZ-BbIX1!*!$6!!#!*!&#!!d!"S"'iJ
+E8'aPBA0P)'PZFf9bG#"NDA0V)&i`)(GTG'Jk!*!'#`!,!#X!+k!#"%X!N!8G!$3
+!,3%BL!*H-3#3!cS!!3#3"6B!K`"+!-%%!Np,!*!&!J"&!#m"2iJCAM!JBA"`C@&
+bFb"dEb"LC5"NB@eKCf9N,NX!N!-B!$`!3!#d!CJ!!3%!N!F""`!!+!S!N!-B!$`
+!3!#d!CJ!!3%!N!F"#!!!+!S!N!-9!&3!C!#,!BB!!3%!N!F%5`#3"!G"8&"-!*!
+'"e0PCc)!!3#3"!G6C@Fc!!*r!*!$"e0PCdi!!rm!N!-(39"36!#3"3%!N!1!!"r
+r3!!J!L!!)J53!!!Q#FJ!)K2N!#)J!J!L3!%!))IJJ#%2m%!L($!J*"Rr%#JDLJJ
+b-SSN*M,b-Nid"MNQCI3b%Q88*!KRr!J%F-!3!MrJ)!%"J%!!KX#!!%!"!!!J!J!
+!%q3!!!R)!!!%N!!!!!)J!!!"3!#3!i!!N!H!!"rr`!!rrq!!2rr`!$rrq!!rrr`
+!2rrq!$rrr`!rrrq!2rrr`$rrrq!rrrr`2rrrq$rrrr`rrrrqIrq3!crrrriIrrr
+m$rrrq!Irrr!$rrrJ!Irr`!$rri!!Irm!!$rq!!!Ir!!!$rJ!!!I`!!!$i!!!!F!
+!N!1!!*!(!3!(rri!#!#$!!Q"!S!+3J*!#)3#)!N)!K!,d!2i##!!#!K!!!J)J!!
+)#3!!#!S!!!J-!!!)#!!!#!J"q!J)!r`)#!F-#!J'ImJ)"U#)#!bJL!J-!BJ)$3'
+)#"Pp#!JC4`J)'Im)#"``#!J2q!J)!'!)#!'`#!J!!!J)!!!)$rrrq!IrrJ!2rrm
+!$rrrJ!rrrm!2rrrJ$rrrm!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrr
+i$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrr
+i$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri!!!"!!IrrJ!)!)-!#i%#J!K#!N!*K!)
+J#%J#%!Z3!!2i##!!#!K!!!J)J!!)#3!!#!S!!!J-!!!)#!!!#!J"q!J)!r`)#!F
+-#!J'ImJ)"U#)#!bJL!J-!BJ)$3')#"Pp#!JC4`J)'Im)#"``#!J2q!J)!'!)#!'
+`#!J!!!J)!!!)$rrrq!IrrJ!2rrm!$rrrJ!rrrm!2rrrJ$rrrm!rrrrJ2rrri$rr
+rq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rr
+rq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri!!!
+"!!IrrJ!)!)-!#i%#J!T#!N!+4!)J#NJ#%!T3!rJ))!!)#%!!#!L!!!J*!!!)#J!
+!#!`!!!J)!!!)#!(i#!J$r!J)"``)#!Crb!J'S)J)$+#)#!`"L!J0!BJ)'Ad)#"P
+(#!JCr`J)($!)#!ri#!J!B!J)!E!)#!!!#!J!!!J2rrri"rrq!!rrr`!2rrq!$rr
+r`!rrrq!2rrr`$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rr
+rq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rr
+rq!rrrrJ2rrri$rrrq!rrrrJ!!!%!N!1!!!!"3!!!!L!!!!53!!!!#FJ!!"2N!!!
+J!J!!3!%!!)IJJ!%2m%!#($!J""Rr%!JDLJJ5-SSN*M,b-Nid"MNQCI3b%Q88*!K
+Rr!J%F-!3!MrJ)!%"J%!!KX#!!%!"!!!J!J!!%q3!!!R)!!!%N!!!!!)J!!!"3!#
+3!i!!N!H!!!!"`!!!!q!!!!I`!!!2q!!!(r`!!$rq!!"rr`!!rrq!!Irr`!2rrq!
+(rrr`$rrrq"rrrr`rrrrqIrq3!crrrriIrrrm$rrrq!Irrr!$rrrJ!Irr`!$rri!
+!Irm!!$rq!!!Ir!!!$rJ!!!I`!!!$i!!!!F!!N!1!!*!)Gd&%3e)$!!#!$9-,@b!
+$!kCJ`kTUXc#`!5*LB$G,XGYCPD!JBX-HkYR!Q&8a#f-UZ[HR8k`+#iPMb,ELGpB
+!8LMpiEh!JNUia8#RBdJbMUrCpbBL$VrTa[llf*mk9dmSTT%&(C'kJKQiSm8DVUK
+U*k42-JV[4Fi&!*!$9d&%3e)$!!%"$9-#h0B'NrI54Xe&%fd!Y2Nh,VcE64YQ`Qb
+qU`[IK0f`fq6GGYA9G@%!#6LPL2pd"ISD0+Bf([[%R@[C6S+*X0-3qX#ck!"SN!$
+&[[i%[JB!N!B")N&%3e)$!!1+$9-+Qb3!IiC&X0dj141`a3jG5dj2(GX"&32EXIV
+B$&EecMiSU&KpE-&ZV1V'`$pMIe6d[rp[Mr0f9KR'kJ!,Q680A&D0p-'14[HZ8aV
+X",2c+"6FaH)b3VE8Z5$*F`Z3!0p[JRD#kG&%G-mTHE-6hEc*lLZ&K$2-5eVUQP+
++(3Xq(j[6I`6`H[ijkXV6kQVrRepZakZIr82rqj'@*3+i-fUMJQe@`8JQ[%@VE)a
+9Y9jE2Q+EYiAYB49ph"I'dPT-T*5d!R%I6(k-`pHZ'qD(TKRU8p[f6Gd2ZK"S@S!
+R"-J!R!"-[ISY!2lU#3-4I`$`SR,K!K!FJS!"JQ*J,6L,N8'-h`a#j")kiZTMNXb
+p+(%I60pdq8A%+fc,'!#3!c!!N!F%!!$rN!B!!3#3"`)!N!F$!*!("2q3"J#3!`B
+!N!82!!!%!*!4J3#3(S%!r`#3()%!9#[r!*!DJ3"8re3Vr`#3')%!92q3!e3Vr`#
+3&S%!92q3"93Vr`#3&)%!pID3!e6fN!3Vr`#3%S%!pID3"2MfN!8Vr`#3%)%!pIE
+fJC!'9[IfpL[r!*!1J3$ep[Eprj!'r&EfN!-Vr`#3$)%!pIEf9[prpj!%JIrhpT!
+%+rm!N!U"!2AfN!2mrIG@Ij!&Uj!$IrEf+rm!N!L"!&6fN!6rIrCr+Rm!N!089(p
+@+rC8+rm!N!D"!&6rpT!$9[riphmUI`#3!e48UrFVp[p8+rm!N!5"!&6rrrD3!rc
+ppeC8+P53"AqVprEfrrp8+rm!!)%!92q3!e6ip[prpRmUN!989(prprK8rj!$92M
+r!!$r+e6rrrEf9[rhphmUJC!%V&5V9[D3!rrr92Mr!*!%rbY8rrEfr2hf9UXUJID
+3!i&rrrIfN!2r92Mr!*!'rbY8p[EprIG@Uk[rN!CrprD3!e6ir`#3#2mVp[C@rRr
+hN!6rJIH3"2D3!rIir`#3#[mVp[C@rIq3"S(fN!Ahq2m!N!cr+rD3"[q"pj!$pT!
+$prMr!*!1rb[fN!2rrrMrrrMfN!2hq2m!N"$r+rD3!rIhq2H3!rEhq2m!N",r+rD
+3"&6fN!2hq2m!N"6r+e6rN!98q2m!N"Er+e6rN!08q2m!N"Mr+e6r92Mr!*!DrbY
+8q2m!N"crq2m!N"lr!*!a6SK"4%05!`#N!""9$99(!J!LC1jArpklmlMNXX[-ZFF
+-Am6X%Y5$c(A*3%qJih,d1S84PXd$p3l+crG@KBb([qEiI#1RQJ*LfjCT'E1fe0#
+-D9Q@lDqaPQRCfCl@f+CKQVCaf+CK@(*CPL%6mEkrhrZqGkmLRemlqrrc!"YPT56
++J5!2!L$)$!"GY6rlj-T,-Y)C#,jI`N(IJQ1LlClGKSSAJ%Vmr[P[BJ&$r5[r*l0
+Jm'CKk[jZSZ#,ImNXS+k%(15Z2b1NYPJkmS!8Y4i4L"bL+IT5Gi(a[4f(jVDhI4r
+)6NpEjYaf&$!`AKrDHZDqk355kS2p)hiRd,d[l(rP"klLTi'bR2ZQ4A[hFfG,aEB
+2pZq`cKe!mEqjf)rLCLkfdH2"JX#4cqkMai-&`6iZEJC5Z2fcqcVq!b"i1Ef+MJ+
+"f1ESf6,6&E#j%"ASmXM&Pf`IG2`(m%Me3$)IUpJX#,q$k[Z9UIi%-BSY#R(GQTq
+frTA3m!RJ%qa,%0)IIMAqY2@F-`KNPGY9&ZJ@2aRlaA#hScXV2hB$ArHkbVK`)0*
+VVIp$IDb1Pj+V'*0E)pe$6mI8#3BA%(ELX62'X4mT!hcQ$)DKJ$UD8YIVI&ri1RB
+")4N6a@*8l"DfY&I(FSe'r[aLl"G8-91ZIU&F2)PP"6lEXPqPUmLVI*dYAdGH9DF
+U$eS1Y)M(+[iPXLqm6`3cKG%MhCifa5L$Jb0&9kED%N4ic9qdAX(QVf$c9d4`i*I
+*)YECr2m-'Qmp2%XcD&DhYIi1GmbdjMK0j8HpVV$cPlqccZMP4f9bpljIrZl9'5H
+P"$JZ)f,XcLD6'(l0m9T'Nh3SE@UJPC!!TRf(4KiB+5C9L0%pdM1hA9NNSk!@5Ch
+54iK5GI+q2e%H4'LkHEP[T0LmQ*5lr'q"-0N$T!i8a`E1S,+41AI!J5hD[5Mf3mP
+Bh2Q$Y5*l#LKJr)0DVN$k6XI"lQH%-(aFRbX-fm[pfcS1JQ3DKRdaHmVkqpVD29m
+*$b+%4qUCfq8UPRS2!!RHF5RlT@Kqm@fbGk*,mP$fF8cVKI)$*!p0MGhPQ&`rhq@
+9HUY6T*p92bUP5P(*Ald(D(qrNbBY-Gl5CVecYX"QFQUPe,E[rq0Xi3AD1G$QMiA
+I20%""[qa3J5LhljlNA',!ek*P#6[ISl$*[8XGIjJh6V(T0EM#P3BH4[N("G#P91
+-$IM$6p*!pM0K)2#&,c2Zr#,Pm-"Ufr#Q[45,N!$$B'EV&,amY#4M&GZ%H0l-',B
+f!)IT8"i'@r3-pU@fraB"`F'"a1Hmj(f4+'hXNEG43UQHQa)+AKU*(a[E%CQlld#
+,d6J#"B3%"86(TBY6ICPcpdR&pZXSZDfrGiVN3-HZ0K%VlY3%SEI$(3IlK0@fq1e
+qcGVp6IdGh9DEc9ErGYe*p@'H,S2Q,TV0CVAC4bG3eE2fZRcZYlX`L$0)"5QJ6ZV
+LKeCE[aEhf"dRlh3hR8[hAMSA#Gcp,pLk-SN)h,bFd(!M39)VDNiNGBXaabd'YrP
+&G8per1$0Fkf$Xm@2SEV)U-`C34)CMD5QU'LZF&Cm#PA(rkf-RK,9%j&c3!fl-lG
++,CDiK(LSCh,IE@JVRa"f!`9(31qkA6j,B+RElUI)@V%S&ZjB!X6l%N'&1m`UK0N
+M`4fCFaFfQ[#UDGcGdC!!I`NS[E$Y!h3VKf0BGh(+SJd#r+kqp(5'mEZ0$ld2%,b
+aAfUa*dQ5I+bMeqkh"1U"eT19HNrh0[D&-pH*a[k,pIX%PQY2#G9a*h8RR2F'11q
+&aYP!qVGFXeML3N2*+J1`!A8U$HS+R0+HlQl`i0#-P,J9(VTGDNP+6V(RQD59Q#4
+e0$`6Hrr%Fk,4`+qbpdmBMBh0YXa'crXR4,Ka[+2K@5F)%E8Q"J3+-AaUVBN)%$+
+rZJ'I'4e,IRQ$XjA)#PAi'"i&e[iJ#1ANqSmapA1S1QALEKdKe3`!'94E#NL0DXe
+mbe6aR4&@piRLLVmNYC`S"VYEUpp[Fp-$"*erUA62!5MNP"(UNa!mq$a#h[%52#I
+!Ya`(8&8ZclalV6pblK"HDrfPecT2q-R0mY@p&T[@FUre'qA"k6C4qfhk+rcf,2H
+-idjFpSRD9qQ[m08lh$-!aXdklG3Qa0NG`'6p-`$)(1XhNUqfR2i+bqY1ch"2fb&
+meVF[[c1JeAk(rJUrFpIa'DmYF0re6KH#[lTpAb#SqQ+[#$L,V29eTl(d)IM3SF&
+*[3M3S(2U2T!!`ep4h3HP&a`k4r@Mr4(R[GEkHF6UMaDi@iUXhdcfc&eSA6bYCfi
+0MMafqE4*Urf5rJUrR(jmaV'iiZR(ja'M2cT,62hc`YHXrcb[Cfkep8ISmM'k[&D
+5cBPMY1@kde*N*YM%5fEd(Elb-@Z(XMZPb!'6D+kSlNPP&APZYB086U3HZr8p!%m
+pM3qj6+B)UBC&-4"%2@r2DGdYLJrX&P!"!dd,*53PB0AYrDNa8hqc-M&)%k9ZD0H
++-AbHU4ArAcq4B8#k236q3ZPA6!`0GNDb5j++)T`9AR@N'F$V$-Q"!+dB6TbjidL
+3!,V!X9l5Ck8L-9"aHU+9$R%'qeY,RIb4E[)lUjKm9$IjYG8R'lG3G+p-dNAk,Db
+Zc6$Q9hb(AL-YaPaMEQ8&(,@J#&Eq9,d8"Q'SE%*"%eVP6qA"529)50NqL[a!b++
+bdfca`9%c@2a`e#4iK6*5MlM'rff1#0J04*i$AN)P'dp&Tf*A,8&f!)X`fG%r)!+
+"Fk58Y$c!ehKSlaTCIm#V-*P,M&CmKj*GLSC0`$Brk%)9@"LFap4"FlXXfX@T'+Y
+(`aicFE`M36"ACPdXHF1Np#`k1Z&m2k!#DeG&'(rYp)%`Ld(UhK&YR,B$J($MK"5
+-ZU9HA-cMLl-a8fZl'!,KaP%BS`S6#&JQC6Bj8'%`LH`$j!c9)m%0L)DrXVG*ATI
+R#MBb$(,%bUbCMI2`QBC*%"XKF,PaCRqVUGA-*TLJ4+&*0"P"J#qN+$@3!+J11c'
+Nj!5VBcHm2R`ZFja"VI8MB3bl,IVUm$Nk2QX1SUSre(P8)Z8`d1E&k&b'$N@S!MB
+mmrQ%S-KTRc$d0-b2-b#4$#-p$BZTHUMj*J3)1ETR#S3Y)VA)Q0hC'PVHQc[4kJa
+#mD063EHbJK[#3-@hD#HdprFh01hBel$irHk'UX'E'kI[X$Cm0RKc`h,,Fc8a12G
+#,$!IHf%!ai)T8Sd[GI4HR(+G8*GL%`JaR4F0ce4$jH+P#aar&c-6ZXL!-`rL2f0
+ep")"A#FMqfm"&'imN@IDab@k6FjVKF)Ll8!4GEe&42CR6k'6eEN1)%#qMRbm-5*
+ISP$B0$#E0SA0r5ABl'R)9ikBTKaT[QTHl'bG&#Uca+V6QeH02bVQ+85d0DJ%UaP
+EeY#`f0km*,2K4AZBJN!LD-2bkPY([-ak*5@9bd-(iB"#Ck[qJAffrS!4LJ$qKa#
+"S2#YJLJ2ST2SNKb@KfTL1UGN[6S4NFe!dk6EUappD&K)F2$JaFTZHLK9p0ek!Tk
+[4ahJS41@D`Hca#3'DU1"qPFELKhC-AJ@6f8V(02eVXP5"Ml'!fH)qmd$%k2+X*J
+m!2'2&r6$8m6ZNp9"m)a)*JVN04#mj9"harB4*E)D6e(36pH(il1kc0FaA!H9kdR
+cY32AA[8k+64%&kk,P1[3%'Y`l91Z3d13!)V`@-KV%!"jkLBc5*@,iNXI%%L9#h#
+D"#@NQYL%10!YaKJF53CSI(ARM438kcfYj1JZh!RPVU%jiUjT2b&XMFB`2Xe!SBd
+2&Zkm%80,PP'J)2S!!JU,N`CeqCc"Q!Ld51dlDdR8`b$X8-IMDJ"GFY'&Z`2pj,4
+P'%Hjih1kMPkJ2b5M'd"U(ilk(*q&k&$$JHfAf'MrpDNl#a`C1`XJL(N(69''ABM
+K2J1kUaj$IQPjT#D')pl!a6%+SY611j1YL4SU0+CXG#JR35l9BB&XPeBjG(eU6Li
+9+hlUb-M**F80N!#&@4$ADV&el1ZXI!!6FUiRmDJc3&pV16QC3ZZkSMb'fZF-"-&
+5-I!*&Y8$NBdR8%h$UbrD%c%H#eG4j""qZqI3(!MYl#E3khIPFF@c[TcPKLTkFm`
+cL!H%q%EP5(jB2XYY'X6'mN'8cFB#)"NqT#2h4rEZap!&"$*8)S#9LPh*rC'"Hb%
+QCM`&3CC*$"mE)Q#`k@(KYBGCU-YiYU[,(r1R[4VTAVS[BBB$Nehp0"`aGQ#G-Y$
+BJA8J5E[aQ%)b!a&L5D24l@U'q&Y[9KJ(PlG&Ylq@!SFVVG&B!#4U2Lih!hQAhi6
+J+N%BEq20$f#B%a8[B!)TKFmdCH6N*)JF8Sk9K`l)"5L3!*0EXB#&(c&dpACRqmk
+#2!"2%%i-JVX$5M!&-2UZL9CGa282h[c-N4h@4Y[JcIPe+1a(B4%+$M``SG#"JJ'
+&#!SH&+kLi%6K!JU6+0b'JS6#dBjRM-B#CmI9,EF3B'eVh$ArM$JK%M991"$)&Le
+6L&F*9$rJVAcXP-DLIJ8N'XJ2Bb`8@(!J@&R@PcT5M)NjeSaF*cjG&CAK4J,CM!A
+fIN5HGi`jQAi8AMIQ*"M#'8AlF9''!VTNq&JFd![Jb4(T$KfaY$HK1V*2C@9C,iK
+maSDJ(U6TqHU'NCk[CPJ6Rc03j#@J!-LdAT!!D8%SF-UHFV%Ap(eMDfM-SNNc898
+4YV@SV)Kpk*!!M@#mNKlB+N8+9@9'HKUc4RUD((K3V34ZrM1D*@9(Ef0@U42#GZ&
+ESe`em9!QlAN!*hYBf!YLLUieYNHS+bC-GiLIUC@qAef8@G[Y+!)bm-Xp8p3C%EX
+A9D'bMLA296PE,5RR'piUfi',aL-p[9Xq#ddLS!jSZ58lTqXhDaG&bh8$C@cj$)&
+J(!BE,c%YihdmD,6JPGaS$m-r0bDlbP#jqc`QLL)@iilHYmS54EqAKJSI!IKj`Gi
+'p[14T#$B-i+#9L`ZG#b*C*r4L!M`S%[2U!q3!#"id",Z!3!h26S9I`'1D%rMp*q
+j#5LKURahB@jApfq%C[&@Ym1$HR1lb)R,l4UmqDeQDp6f5#XMN!$mIJJM$TNIH8+
+2eK9#a-el"B15*al1MNJ(@J)D93KS-P8#lRi,KlERGYh5ZY#Y(Yrd6R3U`I[dIFa
+iP`SDh,dS1X9#a"hllb1d,$X$ILNbDJMiK0[KFl@pMmMb9Hd14*D[EL,f`ET"(C!
+!!J9XHJ')A0@aj1`GkZ-Y9Gfrm4D(TN!S%`P2STPEUU`C"I0(@JlJRrT#Ye2@M&e
+,+3#PKlKSG""iZ0[9VPamp$iQJ)'-AF[!31'ZT8"qq"3QfRHp38HN6FA'P1Na"R"
+rK5X4K0$q[hB`N!"%&3Shb&QXERTD,9@XRc0dJf%--rQFJBC4(fjr9HRLT5lVTU[
+AMbj6VS[iqQAefR3-C,RT+j!!%ij'4Lk521SB4-)5d!Qbe6C8f6)EQV$"qAJFYQB
+f,1pB)Pfd'*X3S3RGQ*90T0qED"NQmHfq9&Tf(-cF6mYq5JL$&$%CTMIQKSH2G@E
+dHR-K-)L+ar#d+)Pe2r3NN3f&Se'1l[dQF4A*iGC(8JHmAN)@JZ+DZXDF&qYS+(G
+RKK#jiHP3J1cm$0I,lU(L"AM8AS0!0D8A#,jaC3#rY6jYLJ50qh*!dR%icUq5Kqi
+9pQ,em,iEdUEdKf8XGjacLB"K'Cc2q,15pa)+RHedi)K3LHDcbC'285Ei9,a1b#3
+[K[[[0$Aj8!83fUH1[IBBN481h%e`k'UTkX#16E'p,Fq$*IpcQDleRP[lL"h(@TT
+%Ni'@Z3N*Gc+[%k!G)@,C2L"(C,Z2`)3Y#h&PL%j"P0U,$lDq&SLE4lel#h1cpmi
+4*,J%-5I0jpMVmYPkjZq*06-V!-!kSX6mr$e4%'3AN!!#TU8JAAXZUPHlFQ95J`J
+C"98i`Kmk!J1J8[4X(C,2@c)KF0bBI8Lr@BABD43XaeC'(P0HmQa*cNXHPemPFqc
+)52[1TT(fR*G,15++6Z0%%Q+["%P!bYdL1X@9c@BjqI[9##"bEKKThe+$cd*-KCG
+m&*dlPV3Z#6R*3"V'19XlPR`a(aX[AkRMdmX('"`qZiTXI+GMb6m!HFY9E&debF2
+!Z%AV(p"mpHGFr[#!-!CIXcXXIL`0RS&!CYJ,)'JHANAf,MaH&mKblEBicC12fGG
+B[$4jI%$lUh!3Nm[`+V,6ih8D((e(crb)`X6aML@&,ej8+p'riJ52U!,A!,bjfLm
+"lHF052!deDqc)McF8FHA3IRbiY4CYbVH6!T,9CP&aHS'9QH939!a$03N0Y9@(ZZ
+(FQV#f6,REJJXKZGrl[)j2RFealCf&`MT(qZJSU0TEPDq'dMa(RfTS`l6)l(#8qP
+a53KiBjRAiSqJN!#5p(M5+46+#4@-`Q@lj5"8l',KIk9)9*Mpm0%8&,5KDmPC$k0
+JbmbN#9T+h,9-+T4RS83&SIc$YNqf*3BD,Gl`BA%3'DQD`iF$T`$HHL1p-CpK-[b
+pLk55MN%01DPG32%U1E6D#"i,Sb-m+EcDL'[5Mm,k0PHA0,8&cXVr21,mCEXeh0[
+UFBf(H`piA!Dm*PePZ*U%i)')PH(BBNXJ"J30%4e$LA$L!@2JSia4YD,6ak6m1[M
+"IPB'LaI,l6jd%6%I#q'4Z[N6`f4J$FJkhQCYpVK%cUcj`Vler,p)IMbF(lahI8$
+cVI-@qCq$i+eM-R$qiI(Q5@dAXN8p&JEkbHj(CUqE!0DX`r4Mf%C!'mNFTkf&A`R
+M4&FBVf#QGlKAC6!RTQH-+Q$5T1CrX4`CKPj#G"U[I%PUaE4jUeE'3KN@KTS0C$"
+iV,f'rqFB3GDc-Vam,Zr(,6&$G8XXV#irDi'UYU8Bl,3L@XL4%"A#6k5TQBJ`b!!
+#-3"46"%Q'a(QlVGMJHMEkS5e0%'D549J$b*AH1hGSXpf41`'@0MZd1cHkN!X8"e
+%pfCkh&B*FCVEfZL)iSilc8H%FF5$Q&6'dE05M0+NLbq9Q1,46@PIE8UCm2$%hFa
+5Hr8q0BUh843RBRLK'26$b5K%T%GQ!4#`Y4e9&'4Z%JC$c'ZB,65SN`TX"Q9kY1+
+()*qhVIa!Vr#c!JNH8!'FYT2S388eEFRfS06UDL1PPG-$F@QrDhaqle%SrSF(A6k
+$jmlkf&D$)G*Eh5jl0M$mk8J3BM3'iifSGRjD-cBK8,N13eKm"QFqJ',"536MbSS
+Z-Bk0"+r2%12'"HMFE(`4Vc,MKkLq,E`IhBfrCG9r0BBmCKQLUM%0KN(Iim%mjX%
+-'cGB6I'UKS*c+UiRdD`&K1K$jIP&hK`2ad2!apT0,-UQ$JNrB2Idd%%3,K9q#'Z
+K%cpk!#,XAK`b"%53!%FjTPR(m"JcE1!M`XB2HE-qHE-Jh)[-iVLC468ce,(VUG-
+#l[3L(aPLlMQ+Q-VdiP91(pbSkEE9TRpk28fC3FPZ#G6%c&j+bEV#U#G89RIDSEj
+MP1KTbl6iT13i3@*+"6@8!3@)e@)JZjS4J)fI3X!Db+%-JVE,YZIKd-&4GM4m0BH
+Vk$eIc5(&!)#('3""iB8YSR,!e'S[lQmXQ0hA@,$TP#D&+G1IJl)%PQ0L$A8!1MA
+IJB$De8')G"@0M8G3lfNR'-JfZ-,pL+*pMFEm8eV-2!d9M6A@+%r-9LC1ddhX,fA
+LEQ9LF@JL0Y51$B9YPm'@arBmZMDM@0Er4[EHY1bq0k,GDGQR0%-`P$8'H@G!0!V
+U,#*mNUS(pR$i1"FS@p1Dm%RU5TFT#8RAq,,BFG,ZFaa(YL40(Z6+&)#p1I$DKl,
+6!@SJ)a0!0C!!-QC65BN-Y&5"E4%q%5"#5UefMrU)+PCi%""&kS1B3Af!M*'M8LX
+0`Z$kY1c(@Ac&M"$NK&UM*"3*GaHV!mMGJcG+V43G)-353L''XKm0cc0%pL,MSCC
+&+XL@8m+a0k%V8I30lpeL$8#4"1"59(&#XXT"UK)q&-C3J2S6QA--dpe!kHc0r)6
+!N!"4(9)hl#(826PXLF)ceZ9el%Zi'Zi5lC+`1qC"3HCNT@$%hHa1e1lER+E&qTc
+lq[chIQddPSZKQFK,@#5ZTBIa1R28jjf*M&!LmRTN(jcB"kGjV@r2GbI8J3(IX#f
+MLSlf11@Mb9NRCe!9IBS-[[JJUfb(R0V`)05hKZrjqD*B[E"[#b@HSHHVhmMS5aV
+#4N#a@LK5#MiZ(&'2X!KNmLj@(T8TMcU8LbLTd3LY"&A6%4&"K&bJUZj%'&A)b`#
+LqLe&dXm4813kcj-cU3"4m-,PKlSM`pQ$N@`KKMcGFHRANY1Pq)3-qf(A`EKVbC!
+!1*5Z*FdMFF1FNA8fPqV9a5QUN!$ImNNXB,[2ZFjDM`($lA#q+,KjK`HFLUSC"XQ
+*`r&1LlIdibpMqVkpq`IhG'E[2p5jYf2`qmL91Mjf+#-j25iM29Q+aUAEdq25-q,
+6NhM!%FU8i(F!*Vm+Y!SbdS8G@D,$4DV(MSS&0LaXH'K+9CPj[EYcDRM[SIe6dEd
+G,$+jfIVl)%G&Lc!KHrP)5l`PJl,!EZjBmYd,MP6l'!MC%JA+N9#&JaE,@MJq[h8
+XYr[E@pc#VF9-Q%"++6pAQJ9&rRCNeF03BaCrj3"PG0dYD2#Hqi5Km`H'HKfCZa8
+b%b2jB%4`S[RC'fRU8#U"3d-jhV%(fRdB,)bJTGj-i'kC`+41eRK$a$M'Z5be[VZ
+Q[Gcd@j[Vl,+!4-1d#c[3%P,fL&p0[*`#X&`QE`61YVZpeI'1UhKN$)"CUijjYm`
+mMP4ieahTGb`R`BL4-D#TRHfYX@)X`S5HDQp&GP--TE*0`a$ET`mTA-[4)Sb-jU0
+J$-84JjQNkiN32DQSH$DV89TKFLPGbJbG2p5p@Ta4e'01L-15mUk-R*a6)P'F%Bl
+l%ZbMpiCpiLG(r4$bkSiFLd@`V%[T"eJD),A)FreMEUKa`L3%PRdXZrZ--HD-["S
+jP[ekGRH-TJ9jQZ"TCDU`f09M9fQLRbCHIIeUpp,l-NPBZ9NkjLc+@fPEifc4-A9
+'325M+,+hDAq@m#rdh!XRaZYPY#%V6Apb92J6CE8TS2!bE93Ed#Der9UfGP5cD,G
+SAfS,Y%TYUECBQkA9DS9DEU!ii!Rd"lS#YN!dF&XJ+h!Q8"li-2"aB(kJ2M!V8"X
+S$13'Li1M`B(JC("r-$YS$bB(6`DA"fZ#6F'AJhA"'F(0hS$Ai'hcGRRhHl1pGQq
+bpk6hNRHKGkjhLAH4pal[E1r@)Rr48*'TD+,)@R5e++8SVXKGp&(4Hd@04I9&XiU
+Z+pVUmr['I5EIK'qIlkV[L1q-ld[I3Pq6lf9IR@q'Er-khlUaG@hVR1[1VZYFGf(
+GNA@ReKeEGhPGpEVjkqVAIE,ZTR9ceQhe"raPrL&r[hqDrkcIiErU2cU@+ri@Rf2
+Cjf*LR9eC[XE,0'Aj$LmGb[,E['a4PZGjfDiX2q5PT#cIif@cXRbAPejP@8e,heC
+P@F2,fFVbBelHT5aIi1@Rb[+2HIQ@X[b!Pdh+XS+A0FUbNTI,P@89,dmVbkpjQDJ
+X'hMjT,+FbmZ,bV+4Pah+mLYHpLV,9hJj69PqMjGpbR)q,mH9jBZmp#[,TE3X+P#
+@rml,6FTb#5p[9*Er`FXkCIQr[(aC@El"baG4R)'2QiKkPDk)!$5TL5FX9jC-iU,
+6bT+*@T5S,*Q-48rUKUVKSG+8#5V$FJ6i,5pEP)G-S+*fCFP*8#3T3adc$e@Q6'"
+#&!PPb8RNhD*-rlDm"@qYFY4TRM",@Al1bmA+p(*m&[,dqFT`R"cHMhA$IF`6,ZZ
+ZrTL[h%SAMNcH1'A*#H&0d4e`NUG(G&IRqDTAGr85Aa%"rTU)ai0)ZJPIm`5C!"`
+0[6)"1,'$4)"2C1)&Ve1fqaN[le'@bhLj51RiDeiZ8CEXXB*cP59(hq"#(3X,L)A
+JPbKqJmpPRR#,MLMP2#&,eq8dAee3KQ62%Za8PK`*JfGeNH8cRVjEQF!H1lK'BC`
+*%M3Sbh1m$#M,2k*PB$1+2j)C#pbJ,*rRjA6G-Fr6-B&[G&I,q8V[!GlMUaVGeCr
+ae5AGeHGmGB[ZkLri+NYKkprik0Z8#Aq#ckXmS91C`-32R&8BjB3*1*ATabR5mh3
+L`$p3p*FMG5#X1r)rk%SVd&dYiD[C5MG+c10mGBrZLU1MYPMAl9fqNMd!XkjpV*[
+!5DpGePfaPp(FZUXQ[XT3YRH5"iNTbeGj'9'@ahQj6eQqcXX*C9R15j1br!i[Kj6
+P4l`-+mZAD#PbP1@A[0bQ,$RCQ69D,ZIP(3S*AL$L%l0#GJ!jbSJAPH8#ARkQ,(r
++bmq9j9r`%Z,UBV(L8*a!iCm8*mDL,#Li5P')53jpQ[+!(*j1C8&$p5S,1V*,k8!
+4`D3mq$-X4T8&-@*3&K5-HXF@4mj&APH"NdcaV*h"QA-NJ"41e![!%3SD#Yd!U8'
+pGK+AB!$QC3CJ(MJU[*eQXDp4e(QcJdH##ldfp5miR`Y$hRCd("!DGkhQVUh))$I
+Gh(@T@#LX)LSq3HlG6b!qPLb1L#p&PIJBbk2LC5J-cU$iLFJ3Tm9&X8LmJF9PdF5
+ARiM2ae[%Zd4B&'T31)R##l%cH(dF5mEVXeJ'AT@a)hK9a)lLpAAX)PjcBeIaHL8
+@aH[&Q!1[IirY`qYrBfIaHL-fL9GpE"THEmGfir9bV"q[Iij*H#f+$H(eipJBAVQ
+a-VcbBhkmIKJ$VYJ!BBmLUfl6+VKhi+J)Q-cJhQGD(F#kZGKb1C!!cjHdQm6RfSq
+eHl60fJaYYPBB@#1U!ckY)!#2*5S$Dl4,!2c#J@E4&&L$T9[8Lf8JaA44*fUecm9
+XN5qf!B6dDalN2j!!0"-Q1E9H!*0@,8f,DXZdDZf)&J03QFJ$[!9QJFE@&U"`R$`
+R#LG4)#+50b%L(N1"b2JD#R%SR%EK546H3B()@)l#"45q6Ci6K9G4)$+qMS)0"@3
+he1DKm"d8L)`IS6#!`NXSY+&`L6`R#ZG4D%EK-JV&+$b23J#&j8M-!K6q#)8Y+(b
+)`K`8rS3m*`T3CSZl8%$f@c%,K38Sr"L&Rj,R41%p&*DJm'FSc%GK)3T9+2`@K4S
+82L!&,`U0+"!"[P)Ld9Y+*2Se4k*riNMd+8HLrm14k"k140-j%[f1)p%0()Pqcj&
+S0NHLhh!NQX14k1mj%QhL5(3c4k*#MN6r`*(S[cN5EH&)p$mFL6E,N5MSKD,Q&5$
+RIBB@m9d9m4lBTSYBPeeP*!M*LiGFC6%LibFme&rc8$qAK`SX`9#APD%@+d0pTK[
+UY+X03ePjm5![q[$TakFG(kK@A9,-L5'hmMDHj@dm`pXSi'hXiQhXj-0cq(#MqI#
+c1,a#1Icr9`iI`+9EZI`2jA+FAa!EJ8SEcNh!1pi-GG8-+$1VBEB#V2l`G@Bj!,9
+ZN!"BG6m2FD5"B6*%0R#&AK2$S9If(RTjKN-[+ef*5la`dNYm5Gh%M,[G2,RpEMF
+rp+X[*XD2+3XB&B0VA#PFU-A9-HliXGT"(%2h4(Q"4jehZrr+lBVM!Il1GBS,(PF
+l(Xh$T,0dmF$[-*NLH$e)9De%e$p@)QU9%P%EP)MDT%68q8T%rCi58CFU%IAI1+)
+ZiiLkK#2Uhh*%r4&(e'miS[i,4p3kMUKhFN5Ga4(e(cQLhX%4p3mF8Ar&5A`A*r&
+0R-4radPFbdNmJj2iEcL*Ve15q#+5k4rXdC+*&)EBmGb6VYeF11jD3i8AIZdUTN*
+0YFXImf#3!'dml#pif"Yjf"mS`rSidi,3#9RRXV"E,QHU9"&6DeMF0Q`R9*KI8G`
+i56"ElE,c0+%Mqa4d*!PIpM`*4F,Recm*TF*l%$kVN4`ekj!!E85)4FKNX'rHJ,"
+"V6FJcTVFA'M[Gj-B(NbE[!G"25$-Gjk''0YRC'BL))a9,$)hRjCH`FU"dp8"$*F
+BcV$Zb!RBieEG'FHdjhK*M'$R!Q4bK$"$p[(NjhjA`B*cjL&GASJ2pN0%iE5eRS)
+5k`kApp3RXHD(-RBf#UHTFHI5rXDGmiP`&)$,L&,+41'4b*KJpDK*3'$K()3cqM,
+D3,LlJ,iQ-AdLD!j3([GA)[04V%`+rR&ERa8UaH#l+%J1@I@V!!1U+(`P(K9$k-P
+JHi3414$(%56b!50CI6T"dM+r"`RPD)5Uk@LE)P)kkKhcaVc0,e1@0kJpJfh2[Hb
+fEa[c!GAkfVdRdi5PYIieqfBmG#)EU9F+r,$mQ&X+@(YY[5JF1[6IDH*lRkD-55r
+RrA[Pdr403$eC3Y&%DNR3CG""NK46*Pib55GRKHN2LBJA!mQpeG8&K2E@LR0!K@r
+&Ta#I,6#GeUHUl98abST44dq$"i0P0V9,4l4LC19Uq+S!U,5HV`SUIiiZ"Bk'TRB
+A6kJ'8VfT(8*M!a!SQ)YX&$@fRUq-&T%fT4-+lX%8*ZVZEA3m)p+(C)050!bV#1p
+B5qV#k56+B8D40H3,9A3YbdT-ZABlHTV@f[Y*EGqdGJmKjlH3!%SIBV3C+HNXJ*6
+CY0EC)TUVNTbYCU(i$"VUf88XhZANJ3CS)&HIV@I9`a#$3%RIa1UNI&BYjFBN%PZ
+M$"liN!!L*4m(c+DT%8aPJciIN!$)P"[#-FLf&TUi$41hN8L)@45MiGPmGB[fZFc
+D@C@KLU1%j#4K%qUN&pk3!)F,GH@Nf3,aeCb+G*QXL"`bB6pP`YEe("&hB!0(a(3
+-B",6mEN$RcTm2Jd41X'JGM6Q8dGMVUK6fD*V#,AHC+dr)14ZbSCQ6a"+(a1@(K%
+hdZBT+`!B#PE%drA-ER'M1E28G5TM%*!!m0pC+4D$f'XVMh*dmr4N[M9K[1lkc,I
+QX9QE199$C&bckPBSm$L51#V&SNbSr2XI&BXq41G-953B*T4q#,-`SUKMLH%QC((
+ddfA&5cbSM`HkG5A(,bTaI!XIhl[4admSapqfLZ1h869$MT6`&&jm)&$94*'JVJq
+(3$MT8r-%C!A$"pk@(K-,'j5!NkXR)(XSj6KG3RGq+a)@RPrJimf6QFL-hMB#FEl
+Z2I9"cLE+5%-GSFMj@*eJQN&)k)iPMr@TT-[C8R'*A[5B(#*952,'(aYDJD"'aE4
+%JYPb0L("pZGXS``qP'!jQkTZ*FqS$PYf!ZBPFck%U#q%N!$@3NK9SQ`1-JZN*$R
+T0pC@r[YNUqXUXN4VVZLH+DK$VGCSjCH6V5cUa&-V[h5f0R8R62Y`Ama2Pm-QmA(
+*aaNhU&hPDfaZ)MUP-,+IYLFrdN@1,43jj#`m1E-T!iFb,88Pd#-[%bSI3hJ9!K8
+bJ3Vc%ZM[UK3#c5+&6f8b1E'955@)eCNc'm5+jQc#T%)QeQ`cXA$%!e'BXbLB,'+
+5lCACS-h9JB!4%KE)Q5F@B,'J@pGY-N6Z"mTqS@Crc+m`kDl(BIkK`*J$`)!I9Vk
+JG*fQ)dU+5K359Q2#&&EG5NBFb%LRR2e%)3m"2qJ%N9[*dJ[M`PJJ)aHbfUIl(Mb
+"R$(N,#-$8[L1%-&)l,BNb@j+K%#Z5V$#P4!X`J5lbJ6E8S*JG)48#X'N&4+-Z[Q
+9"Cb,p6HZ4M#k[U%8JP(AJ)jJ8JQ#E@'#&HS**MJU+D)jRfirJXUc0a6JIVA9B4)
+CVL%'"@lP9bZp1TEdYlH+LY'B6ldN)(3P"%ScEJ1",R,'[khX@'kViU&SH$JLRST
+%&BMJ#EF#G2U%(S&p3`9P+XLY6$)$E`$0e12$TmNB!Q8PYVVCLHR9!X`+3$RMILj
+Z9lTaS#Xcjb!a(aD)E**LAJ6U%MYZqcNSh8VE3'!HS-$FhXq6$5b86pIVk$V@Ell
+`mm@iQ9P6V$LdS'$Ac2LXN5!I8iBN3ZEjiT18!5aJ8FL&,-$UJqHf6[5m08$QADI
+e[0@1V+[Z%3K*'fG3S-l+6B1D@1bmcf(R[9"fhXh1pCU%$"`1S8cM$-Vm![8LZZL
+Fkl[JA0IU`3S&**QZ6UISJFmFA-mU1E8%%%-26E%,+K#QGY-"'[0N0NS``)I*(8S
+GdSmU3Vk0$%*5B(T%#k"DZ16k%af5F5Zr0[0V#`MRV"SMmP@q5d`S"q8PKb%,K0A
+fa5kS(N,cUPf8c+89-J01%&i"S@EP"D%8NY@4Br,Q%H(6a2YiB6SGA%2NB@mepRl
+Q@`0[Y6Z$NGlhHqA(**bY-UJrP+pH@$(,32[XHmV-YHZBBkq)ejV+q""i(mid)"Y
+qTSNMCCYL$,QKbCmq6P%586YFPD4HAh6[k'd+CI"-K!,DR&R8@%p!LY66&)B*)6q
+%cZU9S4U0pHNLN!"$bafT6@%qaQ3qaS#(-dSp#),@J88P2B9[KTjiTAS3"RU*Q1m
+IdF4E!d4DpL+cfBYX+X@,!)8KHbM&Z1CX(EKMNFd#PHU"2PfP"q)"FAh("RNJSHf
+@$eb*9q%"5qmXYLRHVm3QXJ3jSZ48D'AkK)%Xm2`V8jA6+F05jCRhZj@SqRp9d%j
+VVZZ0fcDVHeE[qi0iK16Q`CNjTkC%`MY@Li4%NVS5*&P-PfTd9,HP&I04@h(`irM
+mA$l5@Kpa`d`"$(%)rma"VCPB[BfGp,@p@TNUIJmMb)U6),-6UYLBNbf-,(2EP)a
+cZ@E2%e6BAV`DfhINC4&4#m#VaL,iVYkCh@JE`FU1caTfEQlJehAmQS(Z0eAp2h+
+D&3HSaZa8qIMK@"iJ9`eib&b!6h@dp"QZ9H$(D`P9aPCGMEKMQ`S#H1IT6%[-9l2
+!)X#pc9L,!2FSc**Q[T9L[!Z,)mBEUDV03Y*MlklCB@eU"hU)Phr-5kkiiK"m&Z(
+c+6jeq0b"ch5)9ReX-q#9JSq%TJLZiq#kMFb(Lj-9Em$d$,T[Yb),j#(E%DhC9UQ
+9-5V!38J%S#apK$5!8c"+8@p(+U%%J#+!UT''d)USmQXd9Tc!SkhFT5b%2)#6F"1
+f8@c-$@I!&&1ZhD)++YfI3N%Y+L1)3$!l2Nk1!4PlYYE$Z&q"pHAPlZA(CjbmhQE
+-1EYXI499MkN$TKUXEhHCi$#q[2`iQC'h[Jf(DcjPCB4Sh2&,*md'-aU0m`'Bj@C
+2lCQ5Kd#(A1[EbCYQRCc[cKUA(rKJ"SqQ!R8eTJ)R9,Nq3)Bl(UPiQKfr&R+k9HF
+X-+D!'E03#IJ[Dl59-l6"+BT5KUQ+E""K#dfaZC`Y3@r9%@FV-Y("QDGQ)pJ4$)b
+dH$ZmRAKeHQ%`kfN2(-i"!ZpF0TLkQS[%l'FQ@JL9BDc$j`eUh!!Q4T4V0PIDdp6
+2ear45dA)2!ecZaLL"N1d+C1I`q0[m&Q'cb,c%-pKL'r3UBf[2e,0(QNIlE"q9FM
+4b#4UCjlijdR0bbrI6'3NercCA!Nb4k12+5TCM"$QLq&MMR*Y9JBr&j-M#$$U$YP
+K*j3+$B4+**!!-+(!3Aa$J@1N9`%!"B&eAaR"f&)95!`F,4e)V%b5LTPS!eJ@)J0
+Q+RXiX'iRF,D`iQF+q&a,`TK$)%h-)dpaU925j-fD`G`RMIA`DR"U`-!0$1E@Uf"
+ZaDhQDY`0bP@E#U#DNEJ&DX6K4#-JYi"0DRc(E%DMa'-#1C3%BG-DL(MY5UH25ZP
+8S"Ldf+)DY!Jj0@4ZJ$eMPKjmAjVj9TaV#-L'-6C"F*5m)bdVIi!!)qlLP(R,b3c
+B*ki1f&-A"DMhU8!p$5!$mfBR5kN`%H-+Ue3phk3c$m*4dp1S9P`imkq20qGPj)M
+FEDYLY!2Gf-10ACPLN@8Jj`"NP&8P3l5A-Q`A6*!!4rpE*hRNqN[RmKV"QAAZJ&E
+j2"&cNUBY9UBG+c(Y'+DG9kVL+M[Eb$#*E*3R8E)0Ne1[CS!AmbIH%!bLJ,M&P8P
+!VQqfU3a[VL3`BeYPd[88B196iaE8Y!@1h9chT"JM*`9QG)#5TqVKPDQU4aRTHKY
+RLXqA)SLFE4cdS%,[DU%'4Z!P(UMDM@@lXRb-Pj)834-Jie)8#"U*(YPFp-!HX!d
+[hCF9Q)6*UC(LUKdd[,f'M%5%M*RN,C!!S8h9$-)T#(FkQeQa-`Y+RP2ia'%C38&
++*594pGeSMJ@!c5)k%)eB2&f*M,J3"aID8KMN#Vab-`8,@T8Dh@5c,56+HULHQU,
+BdR&+S`U59UkEIN+GMLb$"6a8PSP-Z"`M%bid"'95e'"3!*QqfT(0bbZH4LHVDZD
++2#`A9H0+IU$!Yl&a*6`JidTUjLiH&Xik%'P8%FfYf$f[GE,)ZYLL,A2EKkl`JiV
+V)9#mc3(6MC5GHCa0!*+A8TN8dp8)E['LLa0#TZ38S&QFm@8-MUJ$ckjib)B!$4p
+N$hfVZ0+#LFZ4eG*Z#D*E$-Z2S)iT9LUYrm@9cA`DJ!h5C((@mf*l&cmJ8!LC'5Z
+1+0GV1%2kjSS,8LXT4"iCFS99%UKEa1!$f+B65NB%*(B#bIZN9'Cq9#8[$'09L8!
+S+EBYTU3`Q-f[51&$"F*RbYBC`[Y5cV6[q&I),kbeYqfC)[1*IlN-N@pFAI`9-[p
+"hH#r0aF(Be+S)U*fFK8V%qFicBrS)RX0&$+S5!X*Re&m2#1+-4`cfK$6pTMJP)r
+'aR86H4)rY13e5')HYSbL*Lf[R%!9IX)@qB+#&aqrr$BNP@e!`bH!6a!I,cj&aEB
+U(hh+(U*SG"hUlpTaN!$,%Z#APemrH*YH[kCAS!S!bdr83Sj4,H`d8KB%[5QPdYQ
+kF"2BSNcJ6`TU"-C,(XK4K8Ue$el#8"d+1,E*`LJ1H!G@ipM9ELSL`lZ1ZUUU(K'
+Q4L!5D**0RF4NK0'f*%R*i,'C#!GRFcmj@Fi@3l(525`60(XI'KrUTXLI"m!0RZ+
+N0063&Xc*(k$-(R*Ljb`hXaV*bXCQ!JNGB0TRYm)jdCT`i6TVDmpC$L!I'BebPT0
+5m(SNKl%*hL&JA(apa&J&aGpbeA#)(8Sq)+d$0,8EQA4KfU4Gca+%TE0dL`pek1D
+94kBP1mYe%qPL8Gk,R!lGKDjM6Q*)b8EEM`bT`5Pj8Ml-S"cQ'9'0C9&(L42D4!4
+@RBf3!),@@)RXLLCV&+mqDa5$94+iAc&(98mC+cPUcl@``bc%qRhTGPM&5HkiPTQ
+Z#Y8Ec'DbE*&EKdAJeSIKmB+)ePjmLVji@(4#j96&*RI'+1+iMZkCSQSN3%f1F1Y
+m5X)lb"3+4C!!`Ep(G2%V852IfH*r5*PL8U-50m+%"llRe!GU-'@1ZYdZ1KVQ$X-
+++X'BTcNH-SCP@6j*MHVFMQDrN!$P%5p[hcN-)NMS2(!4fGe[MeU"e,`GB[*KIJ$
+#Da*9eLE4F*LFT@K"DQTmFQVUc'R$MfFH6FMU6%Kiq+"PAh42r*iX%@UkL3k@ENI
+ebZq#*qZl2Fh"!DDhkJ,!e0X"I#*cFG89ZEQQ$e13!eBIp*53!$-#'-b"[pT`Lkd
+A@GTZPpkJE%bNB,8EB)$`mD4V)F@V-fMI(@kN$!piA%b6-bFQ(ijjq$)JAeUHX-6
+(["2)h-[LCd`kpk2hT5F22jk8R*ij'"Grj("bHRcb`EMd8VDXEMKRXclM%8`AMI@
+c%BDHlTc0e%4-q"aRYPUMN!!HaXpb0V0TSIlSe$a"KKI4!0&Ri8CL-'Hch3qc&3E
+McYKiZ*(B8kidA(RRJ9%QUYFqJ'L$+*kcfD+0J"4T9PCd`B(*)F5e9R@"QPh$i)'
+BJib@1blCHrHSK2FURS8DbL0cL%AQbAl1-11*M9qC!VNp)mdMAM46YG-LUUj)VAe
+ZbQkJ+[MG1lS6-M*!Pqb%cX0(ikl&29jDI-LHZ5FV'SdhCd-4jND+'1`%#A,kSP2
+UaShjpM&iaDXQDp[YUVPQ0S*"Pa%bXk5rPTXXG'p(3Zf2ZqE+6-pJReND&m$P2Y"
+alG4K&fF`!VX3J#PaSB#Ac*jPqB6JE$+e-&DFU#)#FTH5QKS1ilCqUmQ+r&VqIHl
+clReZ"#EMG%d-8U!#%0$IFBQm*NbM#kAcPV3TcV!C9Vf2P*U'E#8,1JD[hVFh@mP
+DXZr3)!`d6N@c$dee$!Xa1J3'X6A&bGPhq&T@JQ[+3[`QQ8fabmdd3V6"!-E(3&E
++PMCU@Gj#'hM-5"XiSB*'ZlBU'jK0CT!!m-R2XiNqj9%Z1k85SY9k-LR(bN&P5bh
+#k6XVe1&b*@aT(EE8Tc0,2pT4pbSf&Gh$q@5!qbc'*U)(NrFIcNTI1B'c9#,YZ[V
+8#EcVFQN%IJR-l$Xd(%@1V-MHD1F9dI`B'0Th1-Q5N!#8(NQhC$dZCp(b6"*,&Z4
+l"N-A9E4(`6F+3j[lV2ej'@UQDj-9AUNN-qLibkF`ijHGbRI!51I8i$j4[!i-G#C
+F5bRei0Z8JcZHfX%&(j8mq0XiH%m((aeq$NI[bFL5$pp%TJITF#$!0PN-c%#'5Xa
+R2T%6BM8'aZJka)#K&Fh)E%+M2jZSf6ZeHi%rEBUD0laICB5Gd[0J"'P`p9$hhZ(
+Z`Bl)RJiapL!B'Nk21h8BqHbkVf9%$QDB(ANTEl0l,QjdcbE-6HYeNXRZGFB*S6E
+Y4dd4GLbT(bMCY&qp4fRDckqB*f!c"9ia,GLP@9pZ1TRKYBPBHkJ4[Pr2PSH3!*[
+Tqr8pbK$QKM)"R21@[T-GGmdbH1VDiDaV4a'hQA@e%FQU#f6X1TZDM3`$3%1&JmQ
+8+a1&ZLrA%@6`kZ#KcN%EH4Fjd*6&a6c`cU0!AChT+iF"28RdIN(L)UB[+!2r`"G
+N4Q!hAXfL(DmaiF4VA%cl)PYdIC'&r8lJj4@6A`b,H3"$!U)&,bmDbkX#D&)&`,X
++)!X!%h+!I3@5J`b1MiU5*[j3$6DT,0$%`*Rq*d@IY"kL9ekBlYX1%lMK"$m*3Z6
+$15$K+ldC[e"J$5E'Q)PaCX+$Pdm-f9$eaQFFCR*pPr!BCQZ(b'6ZT@%829rJX4M
+&DebX`FXM*,b'4"X%qhVCm1JBUU*Y[l0LFKZ+%KFP!,YHH`B$5Pi%DK)+Bl)K($)
+"L#J`$K-@pdr!%%(Tdk##-%pLB!T$BYYHQ!BDrdZB0*3Sdq![[lkI#pVApaZSXZ"
+A$[8V`ifZm0$9TT9bU"q(qPGiD&Jj0,a"KiBhi0!`$Jf[m&#$FLLEHehPSDY0+q9
+3!`ieV2c3%"LV-f#T*NIIPC*G!PrI6m)j[2"qIEq5G2i962EV*[Z9lDpXFPJh1Db
+`[E,*"YeN3mKEN!!T2a(ZLE+`N!#A-d[lBHkN0bk!#&fXSY'-aXT+"SbiZT1l91P
+k!cA+60[I6CQZpf13!%)HC!Yl#(Q!3[-!KH4KFa-TFL*VHc0j$&HBSJf-h&"#%XS
+SAd(RcC()l%(4erFciL8XEmL8bKF'md8VAhMPL`(e`LpIp+G#U,A,@)$A"&$d6iT
+*Bml%J("5*ehACLD9ArLq[Kq4B-*XI[`'a@"i(aX-[m%e5Nic49Y#fl1B!&#,j&8
+VAb#c8-B#)$TjU5TFL48G3lTMp'TCD5mU0IHbKdI%9)d99'kLEHXf[j,1e+Ab"3!
+J2fZ,YKe'*Iem[ap+)VVH5S65N@Z&3m$8rZk+0rTEGCdhJ(9NPYkR-$mUIbTrLHV
+X9P,YPpVPASN5q!L-G@2bL%rHVYS%XSS+*c#!SYAU5@FLTclX'Z[2CK3jST-f02&
+Q!)B5BZdN-Sc!'-,#aS*CEPlQe"eAe$PS0Z-RaRJINYk%+Y@!'+#%*-99b(JaJ6i
+'VLVe2BaMLPeNN!"a1k[)QYjYHm5+5c``4FRBjS%J)dY30GA#UTP1)((cM6QVCS)
+%JZ0pA9m6)hJ0C,mD18H#hf*kCP9H3mTU8!9Qfp'BCjASLl(KcXlZE"YBVbB$YQV
+!"hA%qSV,-ErDR#3hd@%H4M@Bi$4dYUK+,D#bMaFH*f6f,(IYmGVMIjXVqM!"$62
+)8f!%rQ6K56)$IiHlpQ6Yb4rP#YmGJcc*Zl*KCYQFQPQ0%A55b@Lrj&Hfh@HY*d&
+P@Dd'C(D"&&68[AfG*ca8J"Pjkk"Y8&kLkEpFmk69(qEi-QlGBbcJ9bkrFQLM-#"
+6-"2U%6L`1L&Q4#mE3!'2)TcYE08KIk!mD$kJ'0BQ8k-(&)8#NI,CiMibQM`Nj6'
+RcQ,E3`S3dXa#[E,AmhHF[kJ6BZDTc6++5*N8lMLICd)iK%)U#'8Z#l1*%",'kU5
+QYA9rPm*MSMAHkhP$Y*T5GBR-)[ja@U`X3K94`i1[H%#Vb(%bf`'6(A2d!Z"Nr%X
+R!-k0h4*)'b$cFm!5CC83"%Fh*BK$p(U$`'fS)JCJU(#iVe+d2A3%0Z#mC)J4k(*
+U2#`Ae`CFM`Q[V"kp-k),E!SC-94S-Bk3!0VlAbYI)U29j14MqCqK*3FE82ILqRU
+k*V124R0$cK$+#VX8`U(CQkQB)S+[2CNfCC'9&EaGIG-3K)#'J6KGX`rQ6GD1F%2
+C$J(&XcU84-BNYE'H%aN(Xl*3-6harF(ZB@-YSF15$VXbZ!Rr4%+AS%&i4SC0Y0U
+R-E)-4q*ed**#$kN4%V9jFQI,qM'DaK[F&%+-3@R35')0A-%P0%NZc&jXah"1EQl
+J84Vd@YEK*&U1'"LpMfV"pdLaF*em0%mG`'$p22cQNCBHr&1Rq!ad%$qicR`X0Cr
+KiflEe5i+-$6)`&%L-@hl`0Rb`#r0R6I,RFe%bjE4Z6"K$01FaQc1hZ)M*!JUC0Q
+-[JA+9N(H-L)hK,k&fHGZQ&rE$F4[Sh%a%X3BNr#i9PS@#%-peY4$cZPLlP"-(@L
+k(Vf,(f!3*L9&UibSRC-AS3l[f6H)4P8HUqdVTi`+[(LjVj`V"m@%BMFDjHV"DPd
+pUjV1%fBTK@@P(Val``rQ5@dP[E0d(MpS!Z!DAMlK@`X(4[Ma3[-"Z%,M#&JdLfB
+XaX8iAKlKHI!`UL*$H$dYRXEM86'+"j+3!,"S%ff5rdr[L!Ij#,bfLqf5[a66lZ'
+qjlQ5jH9+PZqKKqN`[(!BVR!B&MJ-Lh'ZMRQi1SE$J(BH"ATr013)6TY16R*rkTp
+R1fYj1c0j#eLX%@Y8)Z'UAr6MC4)Q[!!Qi,9El-DVAE4MNP-imHS5AELD&*0Bc"2
+cX$L,YJZra34@fAZ3!0R$Ua9D-MNjqr!60eE)j%aQ%SX*-D&R%JXd[iAA2V%2,kZ
+`iY8T1[pd)SHHiE8b`f"e,E1Dpe#!&rl921+D`C[VZ[V+)AU2b[bZ)q5*,NlPVGV
+RlF6"+8f1U9hCU,pIFN5R5[(Q'2k['mh$@cGLq&kekbU(6hR+`kHXH[K2FZAKGhS
+fB(LDD&#lFB-(AN+ZV'6SdmV35`VQE0$35d5cfLh[S)-h2rDbDY+8NPK[+!aQ0Km
+99DlaYNI&Cj*fU8,8E"m80B1r%@Zf@mA#eCJD`2#'[R*k`BKA(hj@b*LkpB*Y+fH
+3!!4Lj%aK"E1TXmU-2!`YF4bC9r1[*@)284%L5$9+i6-U2%Jr*D@+LZLd4ZQdN!!
+lN3VBV8kh%Z+a)GG0JKSNS+0FeN#KX4")b5&#LT*BL@ib%i@&R@V8Sa5fjqM8Z9@
+ZBP5,DqbN1U[LLc%SIaG'UX6#qk0'ih!9CqTIJ%P$GSim"IN%YSM,&[ST!*X*UD1
+`P5XhCd0!&3B"5a2%8UibUGc465B$`ph'RlZX92P'SPE#P,%I+Sj19N"#c,,!Bmh
+F9DdSLMFKURiH9DGN@k-3T'`LB%HC5Jd)V#'3!%hpd3pbd!fMDLP5HPaF3Tad1%2
+DQmJSq%-CPS2*`mPiQ$P[(Nda25V%@V6A0@pHHQ*m1ZX@eUlG'bSIQY+Yc-E9c!*
+&1K3IU48*Z#U9Q01Sk@)d!P5c&&1bZ#&M)QrEl335)l-)ARH#e&3iVj+kNNRG$-'
+MpHa9K@,qI6NUBFKi6%D`a6%D5%Ik!PRi#LLC%1%,9N,i6@4%6#(mILEm9KhK'5c
+@%Ij#(X*[P3N[U6rM`lm4*)mrFLeZB,H8G2K-HQVbSaY&IJ*G@C!!R6`V0HJ*",a
+V$AkZ5CAD60DZHj30'94ff4`U@&[YN!!p5HPaqV'&A!hZ9je(9Gfq(J4)kfI5ZdC
+485F(!P85cR)E"[+#%ASG-2mQ"AA+jKcc3$4!Y&pBM%ZTHB,GphFEMFS`%Je$(S3
+cG*S('UGSc-e%j4NbPmA23L)!)EDS'K!d%m3[%k4JJ8U3!)*[&)+-K3JL+BVr$5'
++FV3rcdDS'B&%%L0GlGJqjGMSRqrB8&+3!+G55!C9,*[2c%2krPCi")15FC()R8L
+(kC%5UYRr2"9M3kKL6"h*-3m*4e1'@'UH-#3`E3iDq[&cIV`4piJJ0"NKcM&YP!)
+&1R3P`9D*!f3`P31b$JFb)Y[9a@MDe$!Kd4&8aJ,R&d(TG(YH9B*UK0a%2bM)+hQ
+j3LNHkLB&8bKc1#8)L4P3CD98!+G*$Qc&d+S$@h4U4kHi[R)L#bTHAK+#J,PQ(Z*
+r@PDaGAQ3!#%Q+J8BdJB$*Kc)%lXP3"+ZIZA6`cJeJ&A-ErU9aRf,pB'rNT!!&b*
+ZEQ#J)Gp%d9)*T%dKC)JBS!FPZjZ"8lrKjhEmq"Mp!bQUAeU-%EI$Bbm)#3#&)Nr
+Sjk!SQ8irAFQ'bfbAmfkf*$2+&RdP"Xc)Fp'3!1r8)q1)5-fA5KFL#JdP'e1&b*B
+K6QSkRZk&Z%%C0AhCpPccp''h[D"Y8$U8K`"(9'G9*kbCDpi3CGKapbKJ!"eSMMV
+c,"U*fm$K8$b5iSQD!@5&Z6("dG@mMQGP%B3-eICG@MR4,-(k4MEeklpkr,*Ed[5
+%-5m`h'r+1A,`3Ek[J$MB"+B+YPiA@Z4l3S[[hV1D"mR2id%3,+SHC0X+R3B''%'
+8lqkR)G6)6-!F8)%,+6UDNlbK),UU5&ib39@8LJiJc4Yj69j[X4XE-UiH[IbRp*F
+M5-UFXT*A1h0AZc+M3p4Q*I8"98%X*-`Vc)*"K-VH&5ARcq@2I%h#8E&HEX*&)f1
+Q1AC'KSClTP4d)&f+!3Cr2$b*V`U!D(ef'3YL0$aE6dBbc$rHD6CekqH$e!aN1Ai
+JC%N**2'JlDV+9i`#N9r'i0@5R4-d(%@QrY55U%J9T6"b,kC9bK(E#J5$(,&h(Ld
+pBZqFaa'lQB1-(@"RJ"bNh&-Fe8ej'T261G*h@X`9SP-ElQ!@c&#lVZiKd)5c35G
+3V3SH8E0bc8Z2T36k[B5-c+hV&rKK@GkPVk90T85)5+3)a)D#SHhNCZQfXelGc+i
+UFj!!Z&kGpN`BJC+A'Tk*4HA%LHeIqPUmcE6kN!"$ZL%9mZa+-`qT",(j5q3KpDD
+RjCrGSfbY6PELX'LR2pf(B"3QcT4)aBj5VU(I(+hkemY4BeHK5BdDrAK!2iQ&Mk8
+)YQXh4lNb!"Hd(&FM#!A5$[Sj9Vh8r"Bj839@#8hl!%KQX)!5'XPaZImbGapL"YD
+V,$al+8q8[9f[J*&8jK&iCqX#EpQ,#B-D4$e6-qc@2d`VhaM((G@-3hU(!aZJ`CX
+TH&5pUc%r$d0!lUrQ)"c6QGL9C'8Xc1YULF*a1Q(8V+$`G*bRaPTFJ9I2hA-ZFQc
+CkFcV*!M0H42e2qZ)JH3G6$B2d1#E6B+![Aj%cHM8863MGmrPTFILmhP+8!THZX`
+H#90&IhraKh!iVMY(eD-3@#F&3AD22NZ"Q8d!6J1qcRENHJS$L$+J+KEqr$8L5e1
+M'%XT)d$c`dD!MMiRN!$e(liQ0HpaRp&qf,$dYD0VlMR(LPZc8UA0Ljp!i$CTj&h
+LCb"kK['cX3ckcFR9DSk1b#LS1PYJ[#dkG8Vl"LTS422`M()i'f&%+B18T`PE-l$
+AcK@qdhQ2laHSN[Y980a1eEJYb+,`T!*`2mR9Z&aG0BiViVTUR$e205lAA)d,UTA
+R`C[[@J16kNkdd3%brE$L(*L0JX9Pq'3)ibNCh$a-Y6V*M[UGP*k4NL3Gc%K2Y%!
++-Mf&"-SfVN+Y1(mJ#68E"A,fmY,3q54PRKMKB(VB68e%LH)mcKXL,C)[R1+M)KU
+dD`m&l@BRGC`0)c'iQeBkkQDfDLb(UmM,d#a8@2'L3%R%F[)i1)eU32a8$Q%&h*K
+mP&k*pkGcS'j6G4Yc#!5mX+brT+p#P(BjH2-II(R4E@BJkHD#r0"LPp!pf+Cf[FH
+h1U*1GELH2CehU&dHh8,5,CbkK8&@dDbmkV'VIN9"+6YZ*KE8$jF!XHAUGQ9*F$a
+5bFd'V*iiBb$0GBS+CL8"0h8F*X&PDQM!6p8p-[*9QSQD8TKCV3SJ$'e4L[U$rah
+1%h"%bcGf3'[Q(mTeQkiVFC!!Ef8AH32MNP@NMGM18plLDNG5e@MrbUYX%!(h4aU
+@T8Rd-3GbV@B@0+$&52K4Qk4#AVDJm16%[T83fp1!T1ZcPl@U3Pl6d'Ara5RmUV%
+hmD'PJB(F2K,`0@HZJ*LUU&'FipdK")ND!3iR*+8H[CD8,YNK9`Q%'L(5iV25Vm@
+YlUMbKGaKhMbP4ej(PDXSIeL@Y`UrlDJ+B2l0Q98L,c"ppXFd4'R9l@h[PI3@%15
+DCRBfb&2LCjVJaerj6lS0@QN2AYBp8!Ci-fq&NK+P&FkGX4%r[#BA2`8X$p*I3C9
+2@f(82))ID925QcSSSaq$9R'-K0PpS!AD)rQb)ff+IL!+'U6U*30l31"UpQ)%``&
+iLfA)N!#d8Xp0)MMmde4iFdkYK0,*A$PAM2h36e@jKk)B6@JPiLh*ZG%K3JiYUM,
+-XUdCL'5095N"!Q$0V0l!%Dc$I2'0"0&M4YbV&dXCF'5fcCIceBVA'$++!VciNKL
+4(qB@),")c(-e'eGfr9A1Q1SjFVUBG"jZ%PCqQ+8#UMPS3Pbqh(NGEe'H-UjfhlQ
+9fI$QVF59U,SF%9ej[#e)p$-pDLX8P)k'8(S@84,jSJm1GdeI8A#S4Zc#QV`4UU#
+aT105m"i$e[J4-p+MU!KZ#kq1E[0X&+*YikEhFT82'9P!`RlZD!AKZ9+,hefN&%9
+-3@Z0NKGI3B"8%N@j!Flp8jV-6SG*48XCA[NdTEMY8PTjfVGK0R+VG-LN"q[#[p-
+KC8,0cdMQc['qlG)VRaiYd(G8$[H((250BNmQEPRTT#+!BeFq!4bjNQjKdLdmHV4
+Efk95KpqiK"jR4@V[#J#p(,8L"m44`diTDNC[lN`Vk65[M"AMT98T0CAK6DXHRJ9
+fae59(9FYVdDR&!-bZ8TArQ%!-Q*`*F&r564XD349XM9L!cI*!BEjQ#9L,$S91X4
+B8p+,Pcbm9'!lC#E`M'k,ZQ1-MAQ1qA4eX((Rj)U!'r2@l[jHRFl*cj8&XbJJ8MS
+ekdJf,dr9rZif!N32V6!!M*B'#ZCmA2UfmK)[aei#5&E)R[2M8VBEA3N"adVCfS$
+bF&+hYI%5!&c[kS2Y,&a*BYb@KqhH9E'R*rl29P1@j%%bKeH%C&l0m36+X8eRjPL
+kHffRm*V1Ylhqb#%)LUD'R#Y,Q)`0ik!m$PfHa'[j53NNV@4BFH3T,9+`T`cVK1R
+c9rH8+iXZH40pa4kQG)qDem["*&,TK2DSK)BJTjG%49C+lSe5!9#f5Rd(')M1r0j
+LC$[)r"iD41YVq0lLKe!XHH$)qRjCm61mPS@5*,bNjhA)@Ym)045((pJd`!h!%J+
+X,6$VY4R(hfJD&HRH2Q68'Y#NSNXRS6Uj33S-Y1jZe5G3(`(4K`8DUh8Lcmi2bl%
+`%FV&*%lUe"4-6(@UkF&'FDq(!NC$,8fr1Y-p*&DQ*U+&qrUNp15M"qfTUAG2Ha2
+9K+kCU#)FMNp0BL8m2AP#H65cLh6aUFPae`iR*q%kGArdLDa3Bf%E1&amUF2&dh$
+amR#kc&3TJcGIGi%%E'C[)j(bIeX%Y2GX%89KR#kaU-C#%9mN!395P`rHr$Hcd!R
+#HIMT#me+G@B8!!iQlDUr1&@Db+1DD1lr9206UdbqqDmUqi5k@M%T6TA+qYpNEbM
+V1E8bkc2q9&KI1GP,B4dr5'(',8#hHkN!4X0YNEEbrJMp()Mcri6-"[1)$6#,#l$
+T`E3ep(0UE5kk8TRGZ@MMQ8e3BmR'NCQBpG(a9-M$E,J%Xf%GXf&Q0[c8Q6hm&*R
+pB83Pl!mM'd,Bf[a[*@%h0K,8eUU%VDhG%-)bXpmb`Qi!Xc+VEA5iSJEMBa8JY45
+4C[HEH3lp3MNd)@NM$jbajXpli!C%(2P!je0a&2MiIp8I[c&1F@P-r-fI#K1V*J3
+KDkfXb(S[*5(eLF-Tk4RbH*2abBpEdM'pHhqm161`QPdH61q$%M(3Rcfq3dcc"11
++&KehH1h5a!jUDS,8&a)CET!!d69KGS3[TC@b%6PVZ2ZXXT8h0mV4QNL#MB@iafN
+r1L"RP)%F)PkP,',JER'P*fFPa$q&"1[q9JbrdLfBKdF6,fMI2Yf(*#P$NqEYX!H
+"S4FL@6+Z3Bc[L9,5j3R&L%81'h-,Kf'f-TfDa4MMRbk(Rjj4k,cHiKI'(-U-TST
+mdB$*#9N*6k6(P6EL+JEFYT)"$eSX+aK3r@&%P09+0GX%8-)bVL)IUDRLi#+h`8Z
+Jmm8TfFLjfiPa$bH9-U3D3@Bke5Y#YhCPANYkq)N5AJT"rHpXR"($Te-#P1+&rN6
+[Jm`(8D*33r*`QZG*KV[GGhi&Y!)bDrc42[hePG#$ED90rr#pdUIrLE8NXl1(0S4
+Cpb0kEUHpQATIHNCk(1*CI%*+H[bTC(!1pkm8"`C(r0lf,6NL2Zm4"(cM4b%LN!!
+#N!!m6YjKT8*,K)DJ)ajD@Bb14r*'Zq2a2ciDVh1H9ZJ0U&GmI'RXM'd31pYAiZU
+&Z$%c3j(B3mlP-CL&-m*F'f9GSNah!$MQ1+RD!"BJ#%KQVdbVm'ca1NGe432rr3S
+',Xh6k3G@QpPfQc!lmeTLDPCkKL[j5'V)(FU6T)Sca)f@H$KEq"K)D5!6*h,clqa
+a+p@+VlXG`kjUb%MhBC@'C)p)ap)1G,k@pF5eaj05-a,3c2DT&A+PlpU2VQJ(1b(
+PF)CV&9XKS62Ze)01"c15MKbf*kq!em04T(3NUSY+(SPqkL*q9#B+SmTJdmKCbPM
+K1,cM#%FFCF39$2JQ"N`iQ,b4)iU5@54q2jFpYf&$[IP#[5m[H@T*SUmU!MfaUJK
+%2lZaU6b,-JVQalb8*90kF*@4k)Q94L+aSC(SLC+4+,!"NHL*MBp%6k`N%ZQ6D(D
+jR%3EjY5[*)QH@-hjcB2mF8G9#fKh[cR6qIhdj$KbH4j1qXq8p'6S)j1krP2q"Ch
+T+DQ@DiIM8JpR@Z3chVb@"IMP@R*#A1UHV&6kc%cG6d3(!!!Yd8&%3e)$!&%r$e8
+&GN8M)(2PlP6IhE[CV)MBh4T0df"$5KUUD@T89H2HZhXM5&@3!ie"5!M5*)f)H(k
+9lqjZRT9%U)DLU$('U+SDeGCSBSc49Y9cDcaI2$G889A9@*[IpqdQi[RVIfIHFrl
+IFplcr,hR("TF!34"!!4"SNK69TbIEPe4d5hVK@$pXGdlLcPF3LcARbZ5U9h-b%E
+6b15C3Xi-UN8I1c3MHSEXUCeaAPVYP+@eBf8TXdQQmEki#NP9IUGUH'V93fkT@Z*
+,kCrNF[l(Z+k5AQQYjXF2TTr*!rPAF5fN1L@,[a[hZ645q93G&@qRcH8jDPAm3r3
+[mM0m5Y`d+95jcUI(cC4Z+$28@r&TG+SmKXq+Qbhp3IP!I5&q,*dVYe'pmDr3bE+
+(0iYV*HQ8S@T1r*X9p$Ij,Ij,h(!T@cR!"m3p)EfZ2+[q0IiS(5BIj1ki34,)Acd
+8AdPGFU5k2ri0fPpqM6mDedrDTj6`j,J&dN[+YqVKq#+k5"kK(SYrN3k4Rq-ra-f
+6MLM,eGViKqNbH3@I(lG31U1Fid[LPNTRPF9UG,b2aXJAe9AaX4@dVlb'2arA59U
+VV11GiriZl9"qVbE%Cp)ZFK0[&rHNp+(bP*SAAdJlb'h9AI&lk*rPRIa[FHfP!+@
+"pill50UU[+rZMGp12jDlUGIL%qPlmTIm(h(GT6Y+,l8iIK[pMlb&ra6A4bT6FRR
+2Z*qPhFVMkKIa"E5MI*Vlaphl6IT'ZDhq'(qF4XPheIAa[p+RjHriph%hTFh+!h9
+Mr$rT&ANPIcRZ[V4DfF5[aMdLr9ZjT(i5[i(@bkPU@2ajQL5Ii)&a)G)Tj532L[1
+6[PBZUir&4p"JfF5GFHQ5S+5S&q,$DBCX8-9i-hAiC-8Ka9(*TcK3ie$&YLVAH#N
+Ib'r`3cb49kJ9@N9TaF#+'a@(+VKGRfr-XY5TSmS(Db0,"mU'mMNM"@Q$AC!!&)4
+iHcL&EbJ9T--@34T6,NMj#'N)cb#-"&1(a)GN(i#U%1D--KP'cXNh'95DC6*Bk%L
+6350a)!@cP%3pK3V#-l*9!Mb3!-45%NHaXh2b"8N2c+T4m"N&U936*%d[52Cb4Be
+E3!IlITpb2'&h3QjC3UE[piVKaq*Y[R8CjiYp*@YHHY2hQZ(ejl*p1FihIA*6V#m
+cDQHKlmHYZiX62Yapa(HqF-fa)li!Al&8X0rhB[3@al&B!K5mXh$heYh(m+ClN5%
+,19rmiZ#X8$li3P1#Vc$$*frEAEbc82arJ6DeNY,%a'XqPHS&UXSqeDIhUBT"cj'
+*a*XP2IHT,2VdXN022Z`P-**H&DKHpZNc9%kiHPP5pF"2))%(8`#LaA)p*JK1"L@
+!LBq(p93e@p@*9-p1%'8L98e-&C0!G!#E+N-,eCX0HSD3!$)"N4Q!V9S0C9!eba6
+ASc9L#HNXdjZ!0892mI+QR)U8bNlNA'G+mP%G*d`IPFQ%NJ!3!k*-GDB8"X"e9-k
+`!TST09N48*hS)'bCqNb5MSSTeZ-kX`4@+J-KTq9dTN%R'l!Z1JL)6$5B8jP+S2H
+*e-Gi*LG$!Ydb*5,a'[&5f!6!*S003RbN(m+NYq%3UG&RpaP0"VZ4qq`+*8805f5
+*F'6m0pLj%HpERp'"$%aU0*06!MQ)ml,2U%KfSq`%#MYRa`e'NXPB*'IX)J'P`!3
+)N@"5U0e-CV,$@)eF)@V#Ur9Dd3!%jfL0H0A`$!Zm425`#*3b%FfQ85B#8U2)S(a
+fKddbQ)Td[NmL33aQ"X+6+3Q"m%&&-+I%6!S!+TNbb$TP&)E1JQQ*r96@bfBFN!$
+6E3M)ZLdRI5TR-,a!%5Ka+`Bq$QXB0)K*0R"ffNQ@amRPY"fQNP@VJ8LAj&1VT5@
+5bJkIY61YdYM`SlG9l*i%f5#54J!cUe`4*F*4l)3MAcC#(N`i),KS&aef!J*Mi8d
+RNlIG2B@Yf)+46A#DUbBULNk'AU5L@E+K)hT%!f2Dp!5,9[a-MbMKG!Bj"Ci0N!#
+`$-!Y%mfLQ-l8X2HX$,a*e8HCq)bGbXk6!N3fi%V"$'&m2SAND$dXjBTXm#&D*l"
+'%K*F+##LL5Nk8iCYLYC"`"3(QBLT`-&C-2N8KNXd+'JCLN*p,)S%V6QG`96cL3V
+)S#253*R6TS4a'!k*JD+%&+e)63jbAN6,G!#8m#Q6SeSQXe@E1GA+`8C6p$jZe(1
+l8EKYjb3"m4[e2NamC%*+80*M4VhS)+#Nk3&-$Q6,l#J+9J11b!BF)9*LBNCE5'9
+i#$icMTXG"#G)f8k-jNFdXF$Jd9IT0R5N3'FJ""["B49(4+[8Sh[eE#i#c`8RQjQ
+FM'8f%$NF"#NDV*`"C$UZ8eJKT8G*U0FTV#68J8jJ#"6eLNi[Kj!!"Di(AirL6Xm
+1%)[VC@C$,)K1"L%RX4-Nk%48#biifF`'K"F(J4*Y(TfP*heJGV)6"&8k8Fp4j1)
+)3fmlESCS6#CcUNd3AJf3!!)fCdXC9K(aJQ+D8FEE)%@L4kDU4qUh$d&"filHACc
+TfqpF'jZj-YEAC-KE%bhl46m@ZqEmed,$QS5#BMa-L*DIM2i1YEKa("lGD#)d&)I
+[E%SiAeL`VIM(iYb%f!rP`%BclT%qZfpf%"JCH8qch`6J"++Y5-I!pcDVRm8MDG@
+)Thkf(1`3j2-m8JXdZB*FMq4@%-)36XY5ERXNUa!##)#AcT1Pl9'bEcYmKZcm)S$
+Y-$@K@Q*)d5,#I(Qm(8''&K[0DSY-*%$IiTSJj8fAEqqT%Q2Al0Q4QlHY-$0L*kU
+QK3QjFNT0#XLfCMpj68$aYX)Ge@b#UaG`G8I5QNc8&R-`[iXm"Q%B8$[P[a@(QQ+
+,Bf'*iS6FaVDBP%9-B9Dr1ZH4[MT+*ZTA#ZEjQ'2rAfd%[M1b90a06LNZ1jfEYb-
+h`EIlhX64f)ifi&J83QG"+Q`Z5pY#j+HhkFC*mr@fiNEp10i8TkDCldd%$L[*3$h
+8)lA5NiRD5SGj$mbV%)j!dbjC+MZ&`$h1r[eBKf3djHhBZ@CPJLpAbQ1QK2eE43"
+q0F)Z3GTb6ACZV@1`+8d*K6Z+!`L`)BmCH+2DDKIJ$B#pLG!Hm%#rY8if60VCVAU
+BNaThG+Xf1$S0bA+%SB+drEiXl@f5(40T#)D*LNS`0%[c1*XGBq["HGZ+9qDY@jN
+E@lJMJ5P3Qqd(L1L4QQe'#"#N1b2NP+eeeGec@bK,+#`qZ+e`pmiGKEJZDXSVh&%
+*a-fSfZbq'VR2(#6RlNiSh,QQqS'HEhFUpQff6ZlPj6)-TTfl#f+,e`3`NQ[fVYS
+-cD4C(q4S*XhkUC%&(LR5(`%G(NR9b&4*a2A5)`Qj#CQ0#@0m)QPce$a4iQN$bQN
+$HQZcL8c80ZX`pb%[4$#SN4HKSlh(%GQ4k2!M1Yk@M0Vd'JdCYHN"a1mLQ8iQDTY
+&Q0p(2Y`M6EDSN5JC)P%b4-lap)eXrN0[Kfr#JQ4mU5I[VbPe*Tp8*iHcmQ6bCV-
+kZ3M*4S3#0A*Sil,%)rARimU5b3@X,('d31L$d-0c,l)I`ILfZj[FFTcDUHVN@6D
+e5k#f&j*&##ke[fjmYHi08*eM9HYLDTfe#2N)93L3!+Srl0fra20brkT*1fMmIFp
+DTFjU-UZc6L)[4U"UIqMTIpTcZrq'Gp$'Ch98ChA$q3I)@b+d8IY$V2iJTri0RX[
+pqdfJEEJk#aZ#NY5J4Qm-2QNlR(eQr(Biqi"CR9f**)a-e0RSQ0QKb0%aX`[8rKG
+*Uc6E@Q$+cVcG+pI'lNj!Be`AZl0T@bia,m-3M+3,3NG"5N&G*b5AR8K[bPX6L`F
+#qjhVBYFN&"2SjZVXUF*PCmF*YMYlU$SE'dK@qi-5q[F6k3L4VKFTXYq*p)T)AaC
+T"j%H%HQ6)[e-T,@-faPAG5+Y%ZP()ZdV8S0)YiPd!B2q6U6V4,T,T"NLr8+N8dA
+UC"M[-YHAc4Y%qT0)XaQF*Y+PT'T,23`TUL%QN6TNFK9TCQYT)Kh+d!&kMdJ(XM2
+2-GB,)Yf,+S0)"q#bMq(GcR3X&ZN3N3DcK454RK$Thd@k4+4E4"STdYkXiMk#cH2
+CIPi5b9AD#LDa9k3a6&-cNGi4DCC)Nd6k*828PBNB*p)h4IU852Fa83*%qSa)bd5
+k9D5(4$T&T(pLV!0-1'KG8kd[Rdd#QD!ir,4)(a(T"b,e%qN-N3iAkI0-TQ"QqYH
+B6$mcJ6`LV@1l&GNqd4PG44SPdNp%fTbT9*J%Q5,Ya6SJ9+6h4HS5k8U4@N4k8+3
+bX`LD)US8p@c$k-XEc1lYfGlDL25L5'qcj5&-9PMr"fDG(L,pPZeK!G0aPZhjZNJ
+I&ZQ[)TdZdUXLr8UNL5*G*Y+2QE*&l2m"*NS*-`dfXjT4c%PQeL#4EQ#p"@AhQ"c
+3rAieLCaR&Yc+0[N,!reDT-G&qS#"EQ(@,f+'!fJVN9i5k@-3RAA2+Z"Le,10p9-
+,"Z4MU(pPrI'X5-q)p,")3d6k(YX!8$K%HP5N`m5+&cK9iRdA9mASr%qhbZPB-05
+H'YDmT(e!FPApKMRlHMIddcY0A@ZlC#iIFh2cV+1pLSIP"dHd2Y+ZD9lDJie6$hD
+ricBDa"lR1UeGiSdkhLDlCql`V*!!8qm@YGfe+26UTQRl2piHDFN)EhQQmlU&Bqq
+ZRhZJ6pQ!ZU#6,Bje+"aarIlUkCAGVP@i9%Q1LqiEZpKcljYQEclqa@qMNXjrqY,
+IGLjik0)RIhRYSkf2PUF,Ihcip`R,r[$pGl2rqTpYc`kqr0KRcchji3qhV[acaU[
+rq(+3!1B`rqlXmfZ@[R,lamP[rEclPj'"*cirr1Fphclcb,qR[2(qh[kP+4IqY1,
+[1qDrm25[(lcqdjBR"[TprG@,6q80ZI(bbTQ(hN[8A4Ch&Vp04AE+XBQr)+IJM6m
+&Er`TQmP%RE)+mq[)8A41ZD1kFGP+Zk(`hQ!qERiVZh%Ca#FSN!#QY"h0Zh%+UXC
+6iMdT8fBa*%4TXMUP0fViGZ3aeQ3%S1U4$2")8lhU9#mTe'3TZ"h#6B5,K)(h$+T
+PETmRh9eLI900$9HR4UMZIC1qP[!bp(F(6&)KUFr,KD8HbmY-D1+E%R,c[Xl06-K
+PFi,ZjN5U-"Pji`#kQ0@TlC!!Y#36G5VU8e045jQ+5YR8%DSE'h!R)j!!9c1N6e`
+LqbGf'Mh#bj-)-#0(RB%+bibab,'A'CY9GrY*N!$k*ADDp13GG8D`kSkTJEi-D&[
+YRP@j#%`lGFE(kL$lda2@qKYG&-bBVXj!IAK'#q631-1Y$USkdILUBAUD1[f-1LJ
+JbVUYm0MGaIp&C@rkmBNBf&BcRSihrh5mpDHRNSNkr5EQqj(ME6kpScV)@LFFa1U
+%5+MRCQ5U&GH26APErKXTKSj@LTPCCR8QD'rQ'6*4CfC$LMR))FR-NqSJIkX8p9B
+T,RVm)P2([q#F@$eqCXEi&BLCGk(Q[ZIbc2D0+ajN3Cf*kkqCZ2kDfG`k9fG1"DX
+-dq8H'U1SJcV+cVe00LA9P3ZFMDP5Bp!ac@hUli+0HMrkME6"JfX#BR12q0L5(jQ
+X,-k0h9QmQbhi+UY&ESbZZ[i5CF@8YrYr`S*6fmeU$+jVBMU5#Gj&m0hKe4LB,kB
+V`Ka"HMU-*&jmM#"GU533J[2TBBf&cRYR3YYdf'dkl1TLA,`Y2S"`5T!!lMiJLCI
+fNjeA5KL'5q2EBiX0S49p9'2deV8DUh`rcJ$[k*M0$)Xl3B5j0@CB[)5BBI%ZT+K
+%,hB*d[G$5@)cJij!#-lkc-Dbj[dhXYBBJfLbUdY`ME"N,8)C0*P)`Sca)*)KUEG
+TX#PBZfhGrfcT*AI9*Hm+8[dXMq3UNDAEk'-AhJkZ9E)8JUjeSIE[3RRV3KRX3KR
+X3KHl6Z0LZARMIPf(i[UGUA[AV#kYmdK,J@YTK#$Ga0-6&aVF)*4V,T!!PJX&SJY
+[!pFFUejF9VR3@Pca0VfZhJcl)a2ZmafDFUQrZK5l[368JiCLYhKZi8+*j#,0(Hm
+I&eU(#f@3!![QGU(VA(JIZ3UJeYHiqkThqdk9BXr,XHIPi3M("HNff42f1bM'5`a
++p!ledK+LfNYpAPVPT84hJIHq[HEb`RTaiF2RN!"VQK*LFhRd"1@3!#pkY&FN[QL
+6EI(HQZ+Y"3R9`PAD,S9#',HkD&Jqh&Sd6(UKXLa,A@CNK,MX1RD%#q&P+%DAl4H
+N"fePkB(STIZm92(5-&PkC,LAiZRA)jfmG)-XACVUTD#Q4pCjR3&&h-aAU'H01IM
+%k$Pl5Fl$pYU,fE6@AVXU@cPRTfTLSQ%LBLddM&DXK9I0MBm`5L0@AaM&C&hB`D`
+Zl10a,V54km@9&mLE$Tfi"Qr@0@A&9SUeZCf&aG8P3l!9S&U%qIRUr1[M81)"cAc
+XIMjfIkAh[feRkNH(Njb[2Uc14heX2XU+q5#lq9d%U5pU2he&@ESi(!(AmKF0#,$
+Kbr0NjmYp'1BZNdKG3hN6e`)9D-hcA4iTf3X*eeXP[2SfjqA'3LClc@SbkSc*H1D
+B6!ATq30H@ZqPZ2$Y&)R3%L%Bi3K%4h9Zi95eJN,Le9kD#Qra8Rmm'-L4TI[Y%I#
+SmhjS1,P`'F-Z8NeQ+BYqShCI4$j'p%MG&hfY9X4iDE+A$P8Ai$-%eB[Ppkh,liq
+hl#mDM$SXIfaGrRLmjCM%da@U8G1A@dVYSl*'jJqZ'kMcH&mCmiHa,e3p&2T-fUh
+V0hc4jml@2RaQ4FP,4BH22(IXaC`hXpmkqYF$VqplEImE"eqY2+6%VPf6QE"Z4m$
+1AAZD2Lc-+rJ#&qhEbVBdE0hqlihrA,ebeHJ"pYljmPTL51[Jbd&hVlkFNTS8%SM
+FcrpHe1fEhpppZ[l5e8FHA,RrmX@qRCl[m[[1IfrrYlCrE[GNYrFk2YlcjelrkI0
+6limqIVrl2lUp&arAihGGrpMb6mdrI6Fem"(I9bQYQV@C2'[fh!pmFbUQ6CNkBrV
+-Q-9,PLj2mNqjjaGemr[E6emD@[rJrT9R"cc4lp()rZj"VJVqIfS$@65EK2!,BHG
+2RBKil16ATlmjrZ2QlpErZZ'6AcECM$"DL%h-#&3b1*cT'I-rAdCE)eq`-(R4$pr
+1FiliE8MkCm1(rC)a[Jdk2$@q$6SmeFJ'RlIqc0GLR!hqdYJ'baE16ek`k0Yj2i`
+B-[5hiEm-'mm'Nrb-06re(Ic)*d!6r5N9YLaR)VraB5mfqY&hq'Z-B&@MRp,S9k(
+`dIqU6kX6B&EqkpriZfR-J!NQ&0Bq#E`bQU9a%NekL)i'`B4QkP4YVBRCcISc9C!
+!2YI3NqAFJTZ@l(`8cq)MH6iIc1Y`#j11Hc"8i48-KIS$(mYIi&Am)4l+Rq&Tr"D
+rMKZFI$bDRq0RH5erQ*rK+hJ*IiNAmF2m#(m13`0H4(HrL9[RhX)JQ,pLB0AVI"p
+rMHrREq"'f&Gj*@k23NI&mV9m$HkZ5q$Vq!iH`(IbAA`2Eq)ImN+HKe&LAr"F[TX
+AmffmM'rK$A`Vhmlrc6IbIr,9I#9kr9p"X*IIi9rbDlJl+i4A"22,2)MIj9Ijbcb
+&Tr)NF!1jMHh(rINp(X9[mj[mH`!pcH[j*B!q`Kr`+r`qMPcNIANRrMc[`Rr21r1
+rmrEmEl`Yrc0[ajrNhIKl[#0rR2IN2r0Hr$qm$rq*pqBImBrjql`lr`F$L-Fp4,`
+(rah[b[r)@r)rmHEm8riZj!L%PUr`Dm@Em6Cm-Tr&Cr1jr!-q"lpTI!UIbQI`kA`
+QMq',q4+qP#q(j2lB`6e)(FAN[3ej,r'KN!$j!@5p`TrP!rJ6["prP%IbrYc0"h%
+AVa$rlj1!M(X%c0c%"4l1,r!`ITkIiLGi"(q-Rq4Imp2m'hkFrmJhmqriH[iVhm!
+riC[')i&r"F%i%X#))BNEZ)-lH6V2i22jjh`CZ+fjMEf!,q6*I"(rJAr,j`&S"2q
+0$`(SCh`i(mCr`C'h)i%1r+Qh*3%#%-mV*NB#Rd1'chJ,r#BNJErJ0h%5@!CTjd2
+H"C!!Q-Ml!q3G!K,i$G,q!RNR5J*F28NIP4fP%5IKl-H*'p@(Z5A%C@830l+)Z9E
+%jCF30l!pFe1*maB5&aT-h$-qjSi5GfXpFjR-06$AQlNfc-dPlRSSF`HC@mfFNlQ
+Hc$8RlSD*1ArQTK(R8jKV5ead,A--k0`QjZi6GeC(h)Tfa*@`!rYD%(H3!)RbDM&
+aPHa!C5jaFL4aCT%iJ@deh%lFq8VQQSMlHJ"c,Z*1@iMEXBZjUm6Y#L*Z6`"cla,
+AP-eF2A%I-L0qZ*!!Z%+QZ*!!(5jNiKDbV4DkLFXl`a`$bQ2Qb'1'bjY1A)'AZ6$
+QQ1J&c&Lj$iJVBqV,f#E,jK#hK4PLb`(Q6M%hR,L'lXbacQKJREf9LEZ9Q@$VCZE
+BYVHbl@ePjYl+P'eR`QeIaacE`(D'BLrVmVe4c(9KMK(6AUEQcJML[Mc(A$Kcl-!
+e4M6AFTJE5P`L-fiL!deN#iPX`iQVQ'1NB'#GDV"0Q$)(Cfi-FicX(-`3$NDDMS[
+--3*b-$91CM)RBcQCkG0CCkHcaT!!cSkP-`*+CmC+CjfDFB`j4V)C$$5$Q51$N93
++3jI#6*aUC)jeCbVVJ&5fi54'@#'-F%-)iG)3(fZ&)DbeK6"k#@&p(XKS*(!lFjf
+CBlB-C03DA-FFklIJ!ZEBX@"'kCGC5lh-C,bmJ6QQi$,VbFZXCi+B,%%-44$Vmb$
+@jd&-L+#2Q@2SJPJ2"c(&IUaRr0LHr&K2qV'GqE'5`)reL4mV)IcLQC[&(,1aIcj
+cE2Iql,!rDrIqCFba6ISciIaMQ'0YlKkMiR[AQ@1+lc&D[XHXISqeNRXGQ@[*('X
+V8B`@SPMC%-9S)BV4FK3VHfi6HT&ZPfJmhkMa6JMGMCTDCp5-*S4-SkB9))#T$d&
+)0QVP&U-f#X#MjKUe`GH0@Pf$86X,S$2"#&f0fSSa#!V#*S5l4Ud%KejUJ4"Te)V
+')Za(f)!3J*!!JI!Z`M#MGKL)$f2Km$S%Ik0fa'h8RMZ'8)P`('%Y3Lk#!H%"K11
+DCTbUD4DITP@YeV39[6AYF%Y01c*Fd`kedc6aT+DC5M6Y3UDQKFh4Y21jQREL!)+
+SD4&PQ[EB')4V#,ddl@3P3M&#2dh$PqPSTdQBT@QIC'[DkVDDYK+)-ZXdE9dY`QD
+%B)4N6GZa80-#mK'1DPTDP&l,bG"VEjMdfU[lpGSK*)IDk6A6DVdQq1ZeAcN#&RK
+qZFC$bcAY'N+,FNhI'm&GVPRd#"%)CH9DD@5jCJH3!,ePZ6CUBENfH!a#Uh+YVU4
+F'hLrA2-#k*@ZjGS,aR+Y5N5B9kipK-@(fT9VSF2,Y@FD%+iL0#rAdR,+Y9ZT#*K
+FVdABK*!!J6#LA,Ya'Q%$3J&#28*(K$N)VR,0Pid!JAb&#$F4J-!(BD,Y#&L-0L#
+d4F!QcN'3!(0!I[BB`YabV4E#ejj"J,!V0L)i%6SJ$%AS9kk9i("*Rh,YTA-)Z3J
+2%+#i+"`"'cfmU&alEPUjGQa@ZIBL%,kj[9c,,N*BKr!a`VX)dmZeYi)3HT4V4km
+M(#rArSU0lfY6VVeQ39!3ZTGVqimJV%+iL`"$[`(J0b$8'c$#'jh,YB0H"$!23N%
+P0RI)Ki"18Ic,04Q!iLN%'&#%J1BU""MV!K4IQ&UZKD8K&*GV*f#BL(d)6HMFX4D
+0CeY!R4DYP&XdH`j#-%+b44Ye%Z%Z`K+,PS@&V,B)r5cDb(#%GJLBj*X3ZPQd`9N
+)ESY@YmLL$Fa%!!,GA)[Qk@V4[*8@E@b!43[YE0'H+E4SD9"kkjS&(@V4cN9CY,0
+39!Z%+qiJY,&S4AD%9KEYF)0&1a*MdBl&@l6XA4EYVAd@lHKpLrCk+J)8R9L&J#3
+#5#1'@E6(`(LXY88lQBB!S00R%+iL3,"[)-!hXbcDF5Mm%BGq$E0S'b`)f&JX$XC
+#Z,8`3%!G`MU%RKDY5@I"m(K8N!"*9*`qBcLj+Cf@NRX@TC!!hUDN96PRq%2AZDi
+1`l%9DA#@LAUmKPBN*[0A6$5XHNCeiAL!Q*,-Sqfe2"qh5ihKTF#%jd(pm,!jRQE
+KlZ!Xh"IS3hAZ!&0#eZ48jd&8"J0iq3(FbfX$5ZhRQj!!GaZmf-VM(+-apQrQY8A
+m"5qqT)Q@HUNERc['imjab,,@DqK"C"VZ08`M$kb`JdXE6%62-,a)$cELH4U$i,6
+('pL$9i64@6c,bd[2L)4Pk%f3!%le"[EQKd,T0*kPik9ME%X,b9+-0h!KVpKN#'H
+(dQa,RHNVZ,AdT$HN-km)2FF1(6521e6L$9R)%kY%YZ+cV546CXEJC"jlEMrAR@2
+iC,BfRDaPNS6CkMCXpDpBSAl@*&BJ2%pMN!!D+d5-Ei9H9L[dJYaNDC`9Q1$6[)(
+*[')M1TXF#V8YG@&@521'G1%9DH0CBER9#X[rG5Z%%#YN"I#X@PiZfhKNAhCfJ`Y
+ZDUV2&)2aQ)-'Rq5[dTCmIjCmqaJrFj*RCr&S'X4$Mr*Aa[,S#"1a'clPLI5CD$i
+X+%ZlPTJC63k3!"eAXlJ1Sil@%YUZBAND6fd%!T*[ldhUrEB#26e-6,)$T1cY4%l
++IeX3)1Q6M`[#-G)k[M+IEkcPhqAc@l9mIcjr[CERj'-!)cqCcdr8FP-qPf[jZRa
+H9-[2jR2IDTYp(e#2aq%D4V%YcF*5F(8NCK+QkLDCaqZME0UDC&Jm3UE'cL6$0)a
+0bkbCqS#KC@E!Y-QD'HGkJh9mF48'"0IKdVfQEl1pPj2jUU-RH@J*YiIbk$(Q'VS
+e%B!-Vk-e*fepT-I4cdFXHaAN!U02bNpDcLZF93jme9FPk!eh'rHIjdNDK$k[FLc
+(ehrCHR'H*aLmQ")D4DaDQQqMc"L#SU-h)iEldT6U-QLSR",F!TacicM5j3dBXj2
+6U#5m[-'8iDZ6lR",U%f$fh-TNJ`XfFpI$q8jSIbP8(i1$b"#q4L-&a2C-Ac-hei
+dY1IM*X'0*J@0*TXE6IBeQU69)"+FG3S[*`f-+8q&mZMD6Aa`QZ`icZeTYS9KZ%e
+5CbYa'F5BlEcFZQCPk3*U@'j2#'&*!E5He`'2LBp+XaR8eG1'#'NI+p3'DZ#@kR9
+d@b6Z-cG@iJEcDJNEF$HmG4+*ZmEdC1`!-CqYI!NZ%*+UG0bHhjJQaRK6mE+iAXP
+eqmRB&QPNQTNX,L(54C*,%SlH#U[K")2MUiS!16cJTIEU-JJ`)IJ!365FDD4[ea*
+6HLbH`*52UAQ"A-B,4+[Ec204jS4LN!#ac34NRrP-k[i"TK#el[MS!F)QZJ@D,#G
+9T8h!phQI61EcRDY+q"%lAe(&Yk6aFfPm65h(9re9KI*EY$drKIDlPVq*@3irNQp
+QC0bDk1-Nl88Z(&RDQe`fXR5jaq'ZBS#YN!$D'E2lIhdN(NIf[D-M6KbTDARr&@$
+MC6mX9qK-[1i-(d9EmlTm8c@KlQ00$CqKfZ@*@4EeL,0eQaU4r'9XGBKd[BMM@f3
+p4lN[AmR`Q2MB8)jEq!K9,V3K4EU%A)*c'k9@%r)5f@P3'P8[9U5&mF'KC%L+2E5
+kK9JE$b0[d9"F3e!3-NI"&fPjPF!rH2R)0&j(1r#cG[B#l8Jqk'f@KBqcTT2k%#N
++UbCN!p!rQ5r1fF$(H(P@%46cFhCV,BS"i[BlGMUFVTk!#5KBBMlHPHAl)+Ge+GH
+ERXaMXMGbReGafSq3!0%X"&f,DS!3+lUe%c!"K4IXUUSMh+kV-6F!Fl`K3&KPiPP
+MdE5UAmM@NkF)N@FBMj'QJCG664[(m0fDeKDd11FdfpeB2[MBH,[ll"4Z6lA+Xhi
+#*U"#L$be2#ZYXH*`HS!ek3-ej5pj6BG2f-3cBXI3j*VbH)!RLC48BfR('PirDcP
+9eUJV)iFU4QRe%59qZij[dr'#dc`XJLH1j@&er2ec21`S0hYjC4Cr,CmIeI%A[Eb
+SLMpmKVLMqB4EDH*2E1*l+[Qf+M24d498%mq46582c8M@eZ2SVb0C'CT"!mQf!qJ
+LbD,)`c55h5G2dMJa45&'qqeRpX(X'QEKeE10Q%99cc$m`0M@5Q$'$L3M40f02'C
+MDHGUCBANZ4bMq%jSQFdEYFcr,AAjrb[U(&$RHBI!'HlQeQ%A8YiD84Ti8*!!pQ#
+`fTj0XM3`!-'%F2Um0(#$HC)E``cMMGV!qHU"(*2HYG%)bKH0%E9L8Y@B#HT!9Gk
+Nj*U$'$L&JHblPXK"HkV)f8BV!c&ZC"FqHGq$%9Dk0)L(Q`Teq[15,Rpd)JD2Mm+
+jQ*1hEb$&&lkP9I'X1PkkX9(c#[8kNdHhMr&4B5[@(8qi)1XFaQ`bX)akeA$D4C3
+mBf6*%LC)1HYPkB@0)Nd@T*fR(j-fM(e-LX$0*98`Xli!Bh9bC5QY&rSmi"2(V[B
+Bp3FE#)ip2T,Zf55J&5(&NfIQQM2R*Ll[$(1EQ(-bejZjkH4SJ9F!$E#dTbcPS`,
+h"ESfIaT'Ecd3-)),NkkbXcL8SXEL+#kMX@CRF6FDDa5Gfe$QBj6FYK$L(@8FDiD
+b8p3NP38)KV)'DR+8"42%CFd&2,@QUmc5&Tf!jp5%fB![f-M[)%X0f&aq[@aS-1"
+J`eA"d0#HC0f4Y3''KL8%HUY4-'cGM%()@jZ`Z[@Ui0cDNj+aiYZ0!0VZ*8$E$`L
+'lHZSbEGG`-0VaPS#h"ECX,F%4rFHa0'pk`A$AZ#JHhf%&d9L&a,lN!$90V)dFVN
+XhDP%dP*fhR(59AS4)i3%20`Q#,m-&k3[d88MBCpV2N'kKTXm4Pl(C+KJ5,3!4H)
+jC$P!Q"K'iLV#Si)MX40pdHa)A%,AQ"ddM%aS0aS0SX*e8pCqf5(0)qJ0YB*ND!)
+,+!hqQ,55*AXVQ6V#*BH#("h[b"3-MU'3!0mCER#kS51G$-a1Vi@Lp%V"N!!H3DD
+V5#`Q-CM%"f5e(9EI*G2T*!j(c#!#CrJ%3`Ba6%B%-KabCMbJ2P6h8a3-fX#hS0K
+KLj5H!UU64-682S+8K2H(23f2YX-0)84a#'i"#MNT5k8BVaD5+cK#&K,+#Ka$$J6
+Z%Jb"fk%Y-!5JJHMF`-jN5U`Gf",65'6"GB)K1"[mB"1*Q`N[8m#cES)SQ0#[mh)
+**80r,dF)H1$01"Nf6P["HEN22J)A$CGK&LR),ML$XJQG'S))SU!Q-1TYM)m*S`8
+BNB3KqD'Vr!k!k4FZ12d+E8ar-!ReqF8,"[p`C2kV"6c!*R[aKr6q-B3h3($H1d@
+85[H+"F1pPL$!Hk`G4GN&2*PQk6l"FEX9k0ea-i5ildh-$5AZlJ2LRJjMEKMCC(d
+Q193r5b!AaN[0dY@fJJ-$#M5cid&EX[3J8R"F)4hJZ%*DVH&q+15i[ed`h#I#[Q`
+4R#r2B`*G$"-FI@q5-hd(#)lR$j!!p2RkajbKh@J&1M8YAh#N(8%EP@kC"-FY*kd
+`5pFh#0*eh01NUjHGCmr3a6$$f3,-pm[5@Gc(@BYb5CFM1fXEk0)586S6,$M1$#"
+i9i`4R#X@dJU-`#e**TbA@JL1SJa#e8A[SY"p)"Z+KN%mI0f*mh!9ki,$'p#rKpH
+45+Mc-'R[Kre2dP"C'Qb4(GSeQ-5TYD#,-5T@h`jIA),@N9mQ5q@JVRcFDQA4#dj
+,'9f+p9+8mABF()N[4,#hT'HaZe%,dA,3J!H2%D6""c(T,MX'Yb+LeH'HcUak#)@
+aK&P!jJA58AJT[0)9P)c4A#rJQe&H+-)N5(CJ'!J'1PIKq[fXf9&&QUAMS4+k`L`
+p")NHQJ@S!(`J5XS[ac-j!$)m3`UjCkib6R0`T,3F`CQfJHj!Ik5KifkPNV9ET#a
+fAUqPUP%dA0q%R9r2%"cA1j!!aHXML*3h6JZ''m4#0`T)V!I-MBk#imBF!R2$4IV
+G4aU*$dhFi5XNE0p0aQj1f!Ya)"Vd&je0GjLPD!053MZ1D0++T(2BiMQ-@E0[aQH
+S[HPLXh6f'&SXLVUcF`9(l4PdQk2f2QM2mA!*PJd2hd9*m(!(@J&b@&%V'&DJC8S
+V0JU1&4e3K%NVKJU1NZ-%IiQ"i#p"X9!b(4KlbSkA5%&TH#NABVld!)0GT*IQ#"J
+4)jA#ZNAKj&#42cP8K-+YY%'@$Z0@YY,MX[3FhMDP+'b1`FLPk)dAjb+ab0+EZ(h
+1JMX$XiX%3rCpb*(pXH"iDb2"p&B3`I4@$c!@%FE4ki4a&2HA(L@RbQ6(AaX)kd!
+GTU[`+6%Rj,N[4h$X-j'ZfYG"F,b@5G,AHL&G6S$h(a%FEf33G'pd*S`h)*F&GDb
+$AX&jF"FVD3lHK"J(m9+dl*1P9r%fX*b4RC9fZUT+G"lbd98BAhkS0r'5iNqS9RE
++'qNUP&CbHm%Kpb)[3I'8i""l%M8Lkf"c&D%a-aTHq3KCZK!N1#ld)3XATK)APND
+@`iUa2%H@6L`8("&eC#&L(a%aSZQN)CZZ-C&aLH@`U$S9#DU)'Vi*3fr!jrrNZd-
+N1lDGP82DIKC+&ea')Xh[*MJ(Cp(jH)%2GY1Pk1bk4B*cB$*MkHBbPUHV)(Pl!"9
+3[Z*#FN#@rV#IM&bATE&i#fUiiI%KU0A@bP*SCb6lF)p!)Gj`8KTHlaV'4piLG9F
+dYaZi(GBi"`3B4@MS,"UL%30NDM(kaBM'ZH)1U+X0@5SK,,`"Lr#H8I()YDJ93AH
+BE!fdF35$D95m#)r&)lNT1l*h%B*r#efK`N"(dF69cE,dHUVJH(d43EF2`p'QbBl
+p2[,UhFpH`'pFT%2-dN'-3F0YR*8BP096GKlU3BH-%CfbPeD-&CeL+Kd#EikK3qb
+L8q"X-A`c@lc3LLfH2dB@T9-B-iDE3NpKV0iefA&L&@P$*aB4&e&)L[+)BB,MC"T
+*6d+Qdk5FN!"1Z`A(0l0SRYPa2)SQQKdrXPVCMjh)iSq,"'Nc"J&@bSl[ZK$1HS`
+i,*%GklX6*,q'QI%KJr&8FBLl(AlqFqBSakeKmj`j,GeZpc"AT-Xeh1QFl()0)"(
+jE*,h@i`iC(KL-B$F,PFraKbHf$29jA,G"-FGdQq%ba@ja&ApjijdIcl"kM,V%PQ
+-L53STN8b(qQ+l-Ub'6@-CG2GlQIG6)!"B%'Z*jBlRC&1jh!Va2!TimqAZGfri%#
+NqcHhqcH$`6$!2Bmi`TTTbaMJN!#T"[Bhe2f%dq8HB&-aV$m`,(,fX`,pmZ8Z*a$
+miLC5Mh"Ef8r-FrCc$hHkR!cT!LHa9+5l@8L8blNF'*f'%F`SMmj0p9p%jY@-C0X
+CQjM*l*a0$6XfR'#"m!X)qcGQT-JRKT!!fEG)RkdjZC4Nbkc6jGCNf!)#&&1YcQU
+XSBqfGQeI[h*cqZd32k@6dNhjiF&[I3-rk[iSqqX6eGm[j(Crrk38jCr"k8(TbZE
+j2CqFGqQhHI2R+jZB@j0HIbmN*+Tr80rK2`qrFR(iid&r(rj8I@"5Zj!!%-A3pEf
+ZACA%4U(,JUj`Xq'8Zb%ZCmC(IX6KD`N,pYiGp2rKhplMK)EGr3JT4hlkJCAF2dm
+FkbEFa1"iGpbRNHkj'Hm1bdLmQ2%CR2qeRUk[A)P"6PILiemHQqGDN[JVD#,aCkI
+V@V+KKf'DBE%,24[RFXedZ9UirQMih$mjbZPUL$BBm!pF(0rbDIGrq!dBTY#r-4H
+5d[H4IX2DT`6MTma)5P*kY4[@@HQ%IMY"1UrY!18$*8)jIM0GqBRdb585AcBSj`f
+A$GcfpjC#jES,LeIf(R&9@ABL,#29,cA9'CL4'V,jZkK8aBa`FYcrRe-lT[k8qR'
+UXM'eje2+PIH8pBr,Bj8C#Vi9NEqJ&$T#a0FjRVaRh%bp(455STK5P)LE5Z,h9r$
+&T"R"JF&%)3!!(,*"4%05!`!`eJp9$98f%4!KBZj5rffIUNGjNCp,VHdSL[4FPr+
+Q5'V$!G'#!NqYK"j&NHT+*M+Va9e(Y!b@4&I"1Uf2Y5[dqB)"HfAX58M@af$'Qf#
+#S2&N#HBB6md5afGRFc,M*DbAG6$ff0M"a-'FPa#&IRrrVjqIC-MNpR+I2aZQ*`9
+"N!!%34!%J'Mr1mXlA#kmH2BB-d(CQ(Llk&pV$QXqThd"Vl9,kFrC9N5BX`'9I&a
+rTkDS(AEkcU#DjRcmS-Sa@5k,XH0hXQTSI,&1(hXp(kr5G*rb$T%a%jRR2Q19*H1
+,ReZ1$l[RBjhRB`[-BKlcMQci59[)d"6Paa)ch'[i%39+,a4Pj"'fl*Jm@YF`eDI
+Y"1MrUU$mY$2I5FDTmBIHr'42YSTVGaR+pUKXX2V(k"BqHE4qrifHLGqUf@8YT[0
+336[#,9S&P[,m[(h"rXX0)rcSF10"Q&5'4XNm&aLFXp"`0#I39(CfKmmBJKLGqiT
+j-S6Q[R9#M1+lM&9d6*KRPV$+2QUd#PcXTPGY[QJ4h#,Z84["UbTFLTGkfi,Aehk
+I,m'&`iSc(6SZT$ZDr+pX&l`JQABh0,"V4*Jj$'$jq!m&0DNDJa'KX#3ciH`-5l(
+[LQPZ#pR%22pD5)QNV6(Q8'29r'ZS+V'l)ZR*RY!*Be!iDKaUlTliVAYlm*JJMqC
+Y0bdFG0VLiVm@LTTK3j,+&%mM@DFDcX!@-K2%&!%'9i-"apNGXX6rBZAm'HFZ*1d
+i2dl%-QEM-LUYbF[&59MRdcN,04669b8HGkf+S[$D)&jYNf*KFH2l`fUY6'+""#2
+dUR1KZ('qiY#*FjqGLdG14!eP6[(edA@VmXD0TV!@51DJ1kdfcVq63FGA(Gk68iB
+E(fq40*PYGM4N''*i!-EZbpMDEU-*DDYC*+h1chNT+6+N11GdK'a'Ip%FYpfcM5Z
+S5T4b0'hMDL%f0eSM'S0)lF9-+qCfP`T@UVir,#*90fKdCe0HK8GE0-$--G6mV%3
+M*+4NqU`5dRY&GZ`q-Kl`)pjM)kPTbQ5(aAaA%mbH"SJT8eq9Q!&L!rEj(P)eIU3
+XM*63RXJd,hJ3ecJ8VMGH,N#PS3"KXm+@b@KiMh8-5$1Ec0r41GPckm1'l&8aIid
+ZXr&D5$(kV#-EVp8UK6kV8Z`c(Iejjqf61%jRZ1Jh32#`aYUa(SqlB(lH[L`c,Sj
+c1E`1'b+qr6qPTZ*N*[EC"@c(AkrU3JT'c+ALU3@&R'MrjIJcA-bTF13A&'$Xhje
+YqL-84!X(Fe*)H3feR"hb0-F4EA6%X&,-eUK'hVYi$HZ'$1HF[rRqJeMB4SJJ0@@
+8pbi!B*4ijK!rE-fG54khVBl+b5bMVl@V!pEKckkAL+fG'1a"['a6U&3b'411P3#
+U-UmKim4aUSU6aDkj5cK5SmDH8TLa#BLQk&`U,1IP4&(`-Xc),bF1##e`QA05Nja
+D#$JkQPCeKe5QX,R93Km+6k*6Nj-(JG6"&"GRZ#Fp3+N&AdqGFJ1*!CB-8)K38LE
+m,`(#QDE9AD4NX689J3+FXq95"*j+EPq"a&`M&-#BNmq1KYh'b16%hm54,+TqTl&
+`hDQ(,%8BqbV663lZcM3a&A#D+ff*X',I3QP'V5,ep2!+*iBFBpYQ(K95RQ%Ha8+
+T#!b`K9ZF!%RBFk`FP((UQH%9jP'[NRPp&%)(dR2FKTp51Sj4jh0#JHXiePq3!%5
+(%4NUBbfjIif,F2XV)-jRiV9NMX4`L50PbG2fAf*!1ED`k[94BUB*GYQkA5@B@JT
+5%Hm8A)Zb65!pP#hEGGTAYbZ%j&$CVK*maTI*Z-q2E0fETCMBKSRDMa[I,+@*jXC
+G4jV4m4l@Gp8EC@q@hJ0(21e&$5%VSdE$4L6iMQ9H+cl,me#lXE9lZBDN8T)2@p@
+L#DVJ&+9f409I"E08hX6S)!(Ul6P&*+,Qe1,RVc1Ql!iYXH8`9l3Ir5ikdUFpPLh
+E[&4,6*9YRUIYA"4Ge$ea3&03!#aafiNS'22DMpBG4XIi`k8pfJqhP'fHSreS6pR
+QYl5l9[5XZ*C-Erq3!2j1IAK(jkfH'leC48ZdGKZQAb1m!UpqRXrf`A@0Z5cX8TG
+Q*``63"*lHdlCDbaKA6h(53NJ*+XD$kk(+&1fDfjBNNb8U-8'LlQbZjjTkZ#f$4e
+XbdXT*3K4VhVEqFaV9LN6mc#QL0&`)0GP!rNfV'rrM``")-Q+AP!j1qYm`f%M@qB
+EpYAYILrFBQpXr0P@1"ZhM6r8q-@Frm0HT4kJEUGNh"BjF)%KA8lCd$IFq-e&6Te
+e9`0"jqT[@CfFU@!9hFiBN!"i&ZJF#dp8TVFk'Rf(CaThEZh()UGFf`pVM6qMCH+
+(jPP4R**#@H2l*8+L-c4!`38HFV&fj#`QKh@YIbV2Y4j+a'!JA!r$mVUUTJ2Ff4F
+Q-aFj5JEif#J'Aff2S&5eSmJ!i,p"B-`I6%"S%'R9+Ji*',"AV12TA5(ck&NYLkQ
+FLXR(-(3MG4HZabTU&ZQdh4#4B6Cl(qR,lmbi@XFI5RbLQBN-5-4T5+##3`Mfq95
+PKC(ZRX&9l'JZ[-81+-S(Y2,dM-`'FF$Zj%1MZ0SH(%G`@Z3MfHI$U,Gr+(!BN!"
+)Rf6UDB!fN!$F@ip`HpY0Y0E3*"9i!14R@r@fdl1MJBYk"6qY`Z@L6b6#cj1a[UM
+PE!ZqKh4r*fd'0Pj(kPk%SqZlk#jfrFCD#D8bJN%`B5#4MD%,V%KMRS3SMdE*Dp(
+3(b3Nc!e&dl8%YMT,cDRUJ4ZF9*GRk6bPHEre#`D1dR!T%5H3!'aeq)DYESDFMRE
+(iUi+J#B'd*!!qA)p8qUV0kdG'N@A(e$R$`3kfKCdq3&9)VeQM)61eYG#P6rJ8H8
+)%%VXFMd3#0Y`mf)p8cEP6LLEm+Y0UGaPGNNS(9cp6[p0!e)kR8Ti(8#!kGa)lHh
+[2FXfF3eq0XAjJTHJB!dLJ@YZJT&e$8MXDNG#9Q3V#,%$hILDEP+"pPfZ&H1ReR4
+$T&[d*ac%pDkph$82aDGlhM3D9h6K%338h1FjR"T8Nd@S58[)hC*dI8Y-S6Zai+@
+&j+4SB-(MrSU60[q3!2$T"S#b'fLrVNfM!F$8iU*(21B@Ik''ZMd+EN,hNj!!R*Q
+CXA-Il+`eK*J@EBPSAEr3bb-NA'BlH0k(3)TD#c(Fh[l'K4rFqrX-BpY"E(99B"1
+bKf@f5A5BPa,P&Q*lpBi2(Ua9-a(TmdbAGGi2lJdTBaHYXjPB%Bla,h'P-22jIFD
+K@p(YeqP[jIA@&qq2'ZFr[VHJhZVFrL,pVAaarrAl1pq2eJ[B%NTH,HR(321S&3T
+-HaBGq'VA2ZNbc'mc(pmE9hkDH"@QBArK+Y[!QKVUT&kRfKIC&dhUp8'PZQ&%jEN
+bA`K%6L+-+1%[jX$j+!VSMCmqj0X6`XCr-kiP)$c$C@VdhB"D%53B2@4ea"mB5@Q
+25CE&[FiCYXP+A%edE`%4CHQ'%B%@+3I"%Xq#He%*fHYmBrC'heAR$%-YCfAXKc[
+((r+Yb'@RF,(dZ$c)9ZYa+Z6%mZAD%4f%E41H#A9$GNU8LGUQ3+V'HYAC(bjk58`
+[T@%&r$LHeMN*BcUIei$QSH((p(aEmY-X4!`#QmkR,6Uk+-qeTde$SiF"60mX%-R
+Q*iCYSNkF#&#6'XLr58+PNN-TZheMpH[q0N"Q!3a$+DJ2,iJ#*)Gehe8cA2,`Z[9
+5QHpU[TIc*ef8hUcJlRe$HBL1BVPlC0m3cmiBB!$#c+'"2mC!kbbj5N6CTG4ad6G
+@V21pQJ9lrd%,YbDK2V"3Q)35"B%Z544"-)cID8(-&`fq&D@KNb!f&40RA+l`AdB
+8F8QDecBB+9-AQ-pme+ebX3YYG9GG,*FDEPbqq2Z0[YQad6UHIkZ5dr'Km2)bHZ4
+A5&!Y),#ZeVE&BZPhT9$FPRjPJ%0N3c9*!K'#M9)ZGR4Em1JfJ+-"6(T)P+mj0QV
+PqAaJ`(2bJ#H$!jldM9RkqIKAHZ-1m"%&3rGLml,emZC9r5PHceeVPV&pCjDjIAX
+,Y)9lkRRr0rlEYK#Qf$830D$S`bAVS0BR"`qN[elqP6PUGP"5(3mP9Q4rIC&V#EV
+D1CfZXCJGiPr!ZJkQ8Zf(EhDG&BcTjLiY3@PBPfY4e+T)U8AA51cXB+jhSkZkkj@
+ehAAV$-A85kK@!-S9Y"dqPEX$+#Hd3ENp+'LpE#*I`5Il3ipCHI9eJ1a-rm%TRX(
+(i1-DcrDI["ljMjMHK1QprS*PVQmVK)*%mqPdePj3#BcfH)f#Rrb[0lTF06#De5"
+TBiqVLJcL'Si+!cGM8"Q$X&!'J6'i&mVJCJc'3KN-aL!YP%&L$0Q&-Q3C`p4#'DE
+-GY&ZUDj$F4AYddTp6GDHp)$K+X"`PB(K+MICDEVZ9V,*fdNd8@La'QGG6)kkep,
+KeF[2(H!9[*)r6i&DTI*N4NGhj6cH@a-6TLmP+"MYr@MBh6+YGBN1PbX%P@D9XSk
+idAbp)[h%CUIME"9%%`KB13[8E(&X&-4&I,D58Kkl5-%fD#aIU0[9eR46`bP3ZH,
+*qlSJe[VF@BeIfRRJb8*UmB[VZf0C0lpd9iIbp#I(1jq(FrZ,khYNCp,b0"T$&A#
+H&ZprHhf[l*EkRMjhJV(DalAa),-5C)iXLrQd'qifc%DUBQ$a!L'V3L"JM$#!YHX
+fX[jK@JL+&FX,"p*I3ZH4G8LA6ebrLB#C#Ajhcd6qj",4)I#ka9#H1kA,8"#EieG
+Dqj%mf'4F*X-#kakiZ)Fh$HA$NEXhdXH0XN5cU5l4I,0V#*hbM6e$*1"Z3STP%i5
+a%LL4hR!fkqK35ERmkIpqSVM@12'#@S'#X!TCch#',0&bC3Zrd@GYb$SD!J2bVQS
+-b,-"eHd([*!!T`'hcRQA$(h#TR#N'b6),IG(T3U1)QZZC!J$pD"RG$3ZMN,"#&"
+2@lkkHNV+kUQ2e&0RBe!eB@MGBafNK,X*2"J5@THY"fT@33PRqrd9lhr&N!!YdpU
+2M$k&$0"0)VhkN!!dACcGQVF-IaYf(!6mmLV%BYAb1DBC5P$Fh5Z5d@,rT(pe*kZ
+Jb,$U@SqDKLKKFP!bkqlH!4jJEkZQ`AlpqHPl`6lE3e2[XDNrBSV#Sl&G%AmLXM1
+d-VLdmrN00,M%"U6$m*9Xq,rpFSH,4TmTLZR8hG%"6NN9pji*V[@D(-5#SXEA9-!
+dG1iXjlhM+eh,*6@ZIT!!1(XQirb9!bD$P%N[8Ai9GH0c9Lp4jFpMHSNSIilT*B,
+mH8B[LFLI3hU*@rkmUTF-d1IJPlKKPKIXV9Y!(i-(45k*9T8@'EYJ#NcHQE0Y))A
+$K2P[9e!$VidkKfQKN[FrP%KX5!%c&#d+i5dQ#lR9RjJ[QKbLJmmP9A,l8Apc&J`
+'8bc&aG$`H6)HL-iH(,P9kRZj0kkZMU+bS$Ka%pH*r'1@bmHqb3jKdZrq(K"'N3&
+`d`-+jP4P80cd!)8j44NS0chJB8j""Xp0$k#B-b)$kUB(C-cTPN&fd`-mjKcSIiD
+!adb)[9$N9rZ[l105Re8-A"C+-c#pNUAr21$EY-8$2QDDb#Q&Xf5'MIb9N@GTQ'L
+i)DiRMSEGP,#Tf($Id5I1ABp5TDJmFE%AAAGm`dlQ+15IH2&SY*JfcU+TFG5i*$8
+apABPd%8d8"0Nd0k-T*9SL(0HPr6qEq,-Ek')Zc-Q5LfNa3mH[-h6P[((TrJ(pk(
+J96ZhFI%X25FcmI'$&++3!%Pb%HEHVlA#U#rTch-TpAT["j+)QEk6[EGJ"[lXqZ!
+9P5-NE2R'cfqAE[`*9j&-&T)T8`q*'*1pUhYrrmMh(m4L&ZG2Z"*581$H-Nc'$NU
+*&3CI`N-caSk2+D&hQ)+BkIaKP6A3VPYY@"D$@"*K%%C,a6$MP4rq!&QJH&'MlJi
+"L&I-c#L'*TTRJNbRjY&`#j+6eDYkALe&U'29%qF"X+TZhIS)8TJ4PZB%dB*jr"Z
+HDiKSlJVr+B(M+L'qj[i!DL2jKmdT(Z(Lca&LaTV&DMBQ*mX#)HV8r'DGb9i+GJk
+,0hE)"ZFS$fG"B#p5[`M3CYGld`RcE%M&`ciZ!1)4QTaVjJ)"2Cb!Da9GM5R"(GL
+-YeVel&BZUm&&8)4C[+E3LY+iQBp"caf"6M2$5Am9@'m4lfD*'0&D(LpP(b'2ifS
+maMk1H6k'23a,2)jem4EfFF-cS-($N!$aI03-d3X)58hY[fH'I6CKB8HK3iTCJB,
+9!fB#J%h*jVLDU*B2F&$3q2"6H%ATGBP9,V'+Ne@FV(+H9Fj([Gd6THfSNcB'T50
+mbTLm)5!GpQjaiZq!)K$Z8`C,5UDfKk8T2$T3DFN-3U'jNa3DV54k`TBh,XihFH1
+0#j11@a0332Rkpq*0LHj`X9+SQ'E-!i`j"@EPMBZC&@#GZA8H$B98r@+Cq!J2*kG
+'$&ij(53V[(caMBX3NaM+I@GQD04$AUPre"KmCCC2MDp%!Sc3DX5SjdS!Q3K4-QH
+jN!$*mBJ"&%'QJiX-j81QI"HK9(akEE6FCU6qr[ViibS(B&-[4eR&+'S!TeY,["i
+0ar"6"4@EdU*DJJ(mU5b-(iBU9ibBr!(ccK3*iX'"!RjDb(35('CU2`M+BddJ%"3
+S,AlRrk&20PbZ(G@8kQNb*%*a-C5"XVr-$YmV`H!()G'$h'5m$0e"eF1RVIYIi1X
+LaV4F@!*)RCVM4HV8&d"U%ekri2HPBqR@I'Qq0VmcIc$p48VqQdSY`HY!4L56SH%
+Si%Kie#&2K6DR'Jimk'-CETC4&QB&RM)4+e)F$K3iLhc&QM'RR1DV@5J4fh$cd+J
+(dAQU9&i1K"4'+"mJ4'4br02,jSphL0)54KM'UNXJE#a*iJ)C'0JP#B(D5L&&**6
+prbAKl$SEqr&1@J#2j[320dpf$Bf@Rr)83M6A1d5fm",rK58pk!`H+X1$6P[!QI3
+k5i1$HG[PF3MTUej"b)Mfm+F2$m$T!*Z0`-B!i39rD3!3k8F@"VS[DrJ[f1EPPlP
+jfDpbUG*fC1AYp"`SV5m,T-B5li8N,EKGTGLZf+F!CPXQ`'4ebIRfM2MPS3UC2rM
+lIJKUDhI)`Yp'D#b!T(Xr1)8NG)@R1Q4i8)mke!b!!%@T)Qh[PS492k(der`*2Q'
+eX5-S`em-M6*9RQ&%pN'KGE44k+8l6N%VSDM,K9JZ[ZM)H,A&cSlml69Y(qd3Q+#
+4BFRTiRQV`ETLL!bb8MJF-&p6LP+!103PGb&VSh8RQ3NlN!#+ZamGC6RVD#0PSdK
+`dH#MeL03,[4S!+S[CCa4G1S@UQ4fjQcM*-JFeFaqNePb2VNH3X[pl(-lI@T3BAX
+Ad'1SE-L3!$`NFikZ4F(K9*dINBmV#kA8GC&!0V'B,qILa'*%NN[$phJkHUBD-ji
+3H8UjHcCV8e(H"V8IB6p&!(lZXhb'+hK0F"82G%D!VV3a(9b49Bmmm+8eZ%M%$a!
+R!UCaA1ii!+Pl91XZeh%)$KEjSK!ACQ$kRB-3UZ-)#%8+c(8R#kHkFJN"STH3!&k
+A%!i&drr+mF9i!%NeY[%THYb6KJq)0j!!j[)6-`EqU0FCi4B&aYBk0bTL1$DTKf[
+`NlHU(P8Z")Ghd("V)M0EQ$%q3M(#CJlL3$LS`QIQ6R)0D$)apc`h@a9mQ[f[L!X
+Gai9855dcZki-iRVSIX8-VPUfPdm"Q4Cf45ZZ94Xq`kiiK)SjE-2e62KCBUfK"iZ
+059CXNRc'(qP#GQY$ENI!,5-*dSml''KCeef-%'2`Q,&faq5Z!p*N6[31U0N%%Bq
+ff6D)lMQcM@[cpp)fii9YKK!d)`Smb4Ch3i39jN1XK&ZM3(lA#6a1,&J&jX#$'94
+F'F0-`3b5&JpDf'5d-)m'%JP,UrQXpR8mqF'eVl[SNE[G!%SY(mQGjE0FafZ-cq!
+ea$@mV(`Lpb3l@X8b"ii&"YThmaRmD2J*$JQ'&UK-@F4`9C@8U9`X-)9#!G6Mi3K
+H+LAH@&&kB'`8@md4pK0"m[b2$IT`+a@K1'rHc8@%21'c!%(`idiM+KFZ)mI&eYd
+m3T1SU*J@lQNchGaZ@Kk-SJ&jYi4,16k!X"%)84#NK&[RDLfY4rqjbpNEYMabp$G
+GeP0JF)GMa)"*CIp46#N2Al3HT%B5)pX*3j!!frZ`(K9T+"r4fBa3*Xfj!2rZJ20
+(+b&4Gqa!X9CSNP#f$!d3ejd[S)Rkr3G2GKQ"aJT8@hId4#m*L`((pHMaEX2QGCb
+,'VE@D&&rp*V4jh9r%VfMCbdD2Uq+p!VTUa!HHAY,2(da5Z'X+-V,8C39UCFZ3!d
+)r("+dZ0R1C!!FMP6A4Adb*C%L"`aABMV2dLJ'9U,d"!K6!T9-+kpdSq`V&hdq$i
+F%D2VP4Q[31VGFV#)pDGCN!!UQB'`*#1[de"#k2S'6,Ma%m&N4*kNa&r14SlJJ2I
+!2)#1VRYCNbL+#RkiM$McGFCmKTDS(rRbb#q$K'4e,q3L3L$8MP#+8(!Id#9[jaZ
+XYP[AEleBUkJ*h[6b[@Ki!ZeNa2#LB-)2"9%4'(VQZ1)$8SFYY`8%Rj!!3i8$i@#
+eGq+KfkF3m[J8d%iP4L`SIV'E8$HXeLR%6LaX+43M+K4q#+r58LTkA36MZ'K#RJi
+B9FLi'XTA+M#pIi!Q`he)-kKMSk%U*ilD0"#5eCFEM385eJH'QkdR$DIA`1*Dc!+
+,C--$%@L&DLX0G(d[a9&GdbD)%HjNpkGFp`DkI1Gr4YIk1lr1YTTpGY!RGEE2-K'
+!15[m1pX!5AD*9GiUUGjJbVMZhk`EE[DVfZ8U-fmdETk4JBHA`YA$fZBC!L!T"KL
+3!+!8T,233MPH02VYcCN*0&08HJ!G*TDRLJia`XfK2DB,iJlZ#1ACac(24fA)E6M
+FJUK`-e,IL"Ec$J3C2&j($5CQR(`PM(p3JY!r-Q%Xq&qA`qbIJa#M%20p0l42V1+
+[K+j8FU[E5*ABC#%b9U9eDRIYMmCEpdFcD6`0q%VSPY&[G!@@B)-fb5pR,"3N1EL
+5Tkd,6"Fp9lCK+&dFMTBBd[-1,bXlLJh1Bc)$@)pjTaQlQDAd6D'@Y6[#Qkf#-q8
+pSN`5%mm%KV"Y4lSlISc#Q4'LC`[E+2QGXQ@dXG($jhdPJ@#qiQXCEdKDQDm%LB*
+YrSMMF@jZal5fRH2HGSir""abH)JIUIA"J+4'A`N,*',U#N'G3DCd&C!!,@B06V,
+J85q*DTVf$e$!JjLT4'I*SBFA"0ca&"kE&8mI3N)KbPJkfkT+E5mPr[pjkGd8r*L
+hSaNq0YSf+2XMQNUh#85@H0VIj0iJrc-"*N5LH%I`Eh@+NJAr@-I)p!0a&DNrBdN
+UDhYrRmrd3F4%q%aZQUjI4B)0JM3K8"S)ddU0F"E`Xb3N,ZVkcIr([`iT3[3bi&6
+K9*bpjDZcPRC"YN&a(D%A-5a1!B4#q0AqPIJdP9Fl68JTa-JNRVX-)iBP4f%R[r1
+VI1&AqF5[iMrJU&rP!&#C(S60*JrciYSHcj%8S"JPPT*9h0R,$K9cpU(lI4D2fX`
+BUAN0mr&[8)ccEk8#*Y,!p3-T'i6f#K@m*HC-mR5i&ZLG$Pp&*4qZ!RUhB&[b15b
+)(f0ip6d(lYCjbM`+KP5)LN)qY!IrL-L'+aPPcr)L3X+aF+i2`5U4m5Y-$"2PEEl
+R-3KYaBSdA9&3r#mM)`2#E"Ak4cAlJDa85,k9X1rP,HbcP9jVX"[80FX)!KAbdCr
+2cRcd`Z9[frpmXHHLiprrpq8rRYIEFr&$#L*m1IhFNE['rm'a9NI1K1YrrJpAp(q
+R2k1rd$hqp!XeiqmmrR6V``FIIZ,i!`mmX22iq$mYrEZ$hHpFkeVklZIkqmppH*m
+HIfkh[Z+j$hA6KBZ,I[l1Mpr9rdPriG3hYKr8Klldfi2k2laliF@Pc3!!2D&"4%0
+5!`"TA""9$A4'%3!aihj&IpqfI"R,'NBBFFBdqCacAI1mbk5D8Sc*XS3`4Jj*4k3
+4FhAP`*CL%RBM0bIPPdZh2#qJ8Jp&DQf[YaFj(K[3T#(f8%l+i84-P5,e4QXa8'U
+T"bR'L0a)-D8Khr[[lr[f[)RBicfrjcmET#FTbS8J#*j!0[8hH&$"1R2qM5k$!ZM
+,(d)4lqh2'I)IERbb2HM)J+$8hfhcL[jr$1"6&Ae!f-i9*eIm)'i9MrHr,QD+a`9
+9Mk6'mMPEBBVT)(A0e(BPpIPBd2&Upr6kL'LFY@P%+``d[RdZLibI#%`CcK@23`%
+Q!--U-J@-BhL)j$jLrB,&EGNCD@*iAbEBcM&RP5AHh-&9QdJU[LFqjK(R04KX1X9
+YA"D6&RpX'a#%kZ&U`0cdKdTKQQdjG4*hC[$39CXrH0`6r0PbLmETYb63A9)FjT'
+fE6ab-K)mEQkkTG+DD8jEkbUq#br(R1M@N[bdfh'1biFE[eBKcYU4K@bIP1e$GJh
+,pYPa,$a%l&9iPDkU8&bQm`JDV"ci@&ReDAFLEAiP&,b0AkZ2cd+K'VErcIihkA@
+p@5&f'"0*e5N-9LR1@V`d(03eIITA01!m[*SipY(S)*J32,U,UjT0A2eK4",8dRV
+PQCM1M30Y'GELYJbRPXa9Y!e1"eiAQdA'1cG"MGcf)f4f)L(9$$[DXN8[J+,+X,#
+1bKLh0lCPHp)cdSMJdT*0f+[dT$%FdE3d6f(+!8Hk$!5a,!HG(Q#G0N9h+UJaHI[
+3D%k%Ha[qACbp5GYfL@9@&FLmjXba!"e""HH('L%+')I#ql#Y%SJQ6McNqqfdbB'
+f(d&XZHE%!5bqSB'f!cK#Chmh(3LCfCE6"3#[mcm1$P(EEFC!f@$bRb&#pAHMqAB
+l$N,+A8-#J*k4U6K9'5T1,HGR+RYjp&C)mB[%jF-"8F@4SMK*UYHXdeEM)a(jm&H
+K`REL2m((H4!mbK*ZGhCmdfQl,B0lM(JmEZ[!Bab2)cB4Mj0ir'GE1akVm(MBPX5
+M&irGYNJ'N!"Mp-&-`*)!JS"bSaU%1Q,Tb0$%LpZ1")p$qGB$Y+B4UpTH1"Q*1hI
+9KYF+QECU!X6irf4)`Q[UD**-KJcT!pddX8irBTfZcY#!r%HN,J0rAm[pYN6c1Gj
+NmkhIaVdfIpcT58B0m)aBET&0Jd`@8'B6Qbqmr"B%#1l(VBTl[`LQRcG02F`6%(I
+DMD0mZlMQqr18911DG"iDjZeMSecjT&Id@eflR[5f5dIafFHP)CG'ScYcGGi"X6K
+*jcE9CfNIkP"p3m14#iFEErA%H9HhaIp%MqV$bbEfXZP4,j[`XSUpV(V8bbUa3`#
+-"%mbm,#0ac[8-aE080M31#BdlPA2Q)kS&+%"8cpa(a"*%4kD8$R$k(JeZjfM5Ub
+bb8kmX(K4A4Fj+Mfb1+SS&EFD6!i!2DV35EQ0c6PbH4mpc-5i&NZf80r)6dCH+0f
+5(UmihrU52E%[fjN0m6)F1,r$CDZ146ENL2jp18K16H,mrTIX0i42@kNjA1B5)fM
+1AY&8iG0@'M-B2BUL53Y`56M5`kma&GZej$#IjC'ZEUM6rq$Ki3j#I*6mlNQ"lRZ
+#EK`QMJ63r$d`lQ2*)cfeK&BTbqTDU2-1mb`HY(Mj0ZK3Z#UhAdf'Z@LT`XeS5H,
+fQ%A'l9RE"*TSp8d-f634X+6+CP*,Akh-Y)@mBCjPUf)C`ea&PNaCE!L41V#$f,3
+33+BL(BM-[k%V42bfchL!4"5K@eI"aL@N0!YjT)BPTSCD0$31mb!CB3iTK"$1Aa0
+HLAL9Z&USK9'bR6+iLf9iN!!KQlAZEDVX[BUMb@B[IB!NUY$B,1ScK-B*eTK)TH,
+66jp2I-D[UclFaY3Qh&DV9EL0U1fiGDRMF+@3!08XS0Jr)f0D2B0E[hSB0ipU[HF
+c5$+RF1Y94h'cUG1iR95eZ$R9-66U9*IJ&PGeZ(@Sep&CQNV'mP'fE1F+3e!cEe2
+Yl2-cKpDZeArQ3p&Xq#M@2qTqkR#I8ahXBiJH2Cb[C!HMJHaXS%leZR!!DEJa#!C
+aKpC4HBq@(6#QDT(9)@ACN6@SpKkPVA5#q%CB$T@M@R82ZZU,H#aD2-a&6Y,')VQ
+*Ua'Z($UUMH5ccV-XiicXAN`[MK4lj+-T2")TaQGZj$1cZ5,R#@fN4##BaD%RQ8d
+p3`XLG+@HNVUDP"D&1[Y-I9rS6(dIRpp32kA1+VC&6MkK9HHHk!dASTZ5F!CZJA!
+k'Ihd#1,2NJ"HPF*KP[kY[99CVKZJLPP)C+N"*2KaHq*Q*%"Ppp3#jFi9S6&#0,)
+al1&CUjbAE"UK%[p6TBiUF0Pm!5mf3qK09GBLZITU@RN6"1JGE2,qeGc'Xkj"J+i
+&H'm3ZKhBSb`J0DE-PG+Eb@#pQ!4Z('9,$)+fk)HBAYU@HGBRKQrN3&JU69&CCj(
+9*&S[80k%Bm1#q3rc!"*8)1Epk(9-Em1`E'J-9IT*Up,Qh)@"Qp$dcH3,riJrLh`
+!+%01G3lc0)Yhp@J&R&lN"3a-r""00IK*i#H*(hTp+ejAS2*YYpL"$0Z4*)f8*$9
+hdUHj!NGF1X3G!!N)kX0F,UbSF!paXa(XP`mr66!,-+5VU8I5$Gcm'4MeApTaFp#
+2SE0Xq[ark1a0["E"R[k51QA(r"11f5&-Jj*NDBR-c2qreEc0r3#,0#$'clKAPA'
+6J4jaia%!QBmPh#Ce(,FUPUcE@E)H4l)Z8AB`i*RJIN-&*!JQ81M1Xi`1!+#8"V2
+5pMB2f(`'G1J*B@)$5rKaP[!l'"MVe&0GPqFZQjYUA*qi22Pi%@#[iq`e+V1MP,$
+kF4Y32ch+*Z!fT,lrRA0U[r)h5cXYX,QTiSUSlDP929JXRI+hK6SmG+MpK8d9lVK
+f$5RX&pDmrXRVb3l`AUG18+,`UkHF!'eEh#RE!NBiG$NUfc+,3`4N"N#bFApT$'!
+%F&PUK&X$SHA5P9$!,1r[YM44PZJ94k#F@Ej30iE204r5)+cE!,UGJ0(@G6T[PbX
+-A5,"KT&J#meU),N$B[(4199Nl+eip'@[LXm!q`c3TbFKM[4G[UF,6B5(3(r1TjQ
+Lr`D@(SNjk$bR"La334Xl9,&LQaT%CSap"X!`)[0Z9h`+TV#re,MAI2L*QlfD3+*
+T$[J[YLSlm'TMLqXX!FY59*K&B$Nh!P5Dml9iE,l4UQb-Dd(#2p2feR`SPYpl6Te
+Jfa5ac8PRCNQH6BBh'6C*Leq*aCH5EQQLDRiP%Nrl2R+C@X&ZTA5,f$dmFJ-EKL"
+6LDSNb83DQaH6F#4)RP,94BZ9c!4CVTmHcc1S`c!SL*A%S4Gm"C1"#TBUT4+*Nq*
+)6l@LL1'&ZRfAib21UiBN(NjL1r0XikakJl(9NK!ULF,Vc2'Pe#1EJr4!D'-Y5d*
+3Z#ceb!I@i(!9Ba!EN!"X)dLF%5J@PP+b6HaGLdqUN!!056$5N!#KQSZJ*X!J%(j
+#8X*"e@b4h$NJhQ#R4h[83B#d(m#X)dFEqNH'"KR6KJafA!kS-"`B6Q0)-X')"lF
+BUf3')lQ8@#,R+,&%2U0U+C+2fl14i[D1b$N,#EVAHfSMKGJU#%)*)j*rJUY*5KU
+4I,$,N3GE$VkGPS%"pb3YJYP2a$%YKEU4PX,MBbq@dNX3[MCmcHaIU-2dE3rDm3h
+@XDM[@-c6X8hU@-c6XBL1VBrU9QEGVQDG0ZNlEFV6DCA8DG1M1f@)2H4%0aB5P0[
+CiLB20cHYP*4EpII#`BNY"KK"92%"S)5)f"%ZV,K#&6E%pX1@5E%M8Q+SFMe0d8h
+818)KFA)a"@MEFQ%V9@dDS+e1jMU$+SBqjPF5F!#a[KILU+L@8eAX1+I+%!'Ac`"
+Y$CAMm6d)lNj(CC`6m#fi5&hKN!$Y0XekRI+HTHNSQULG9'8R)!T6!Z,+@CQ-Peb
+"LRFja0mX5KC(Hm#mBJ#`[cTP1ETb`2%-l+r01j5&cpAph8,9,&A(*FTD+3Rf'Y1
+LP(GhN[+!Q0'#iJ&8"SZSkJDa5Lcp90&2!3#"6UQ#lBJ8@jSNe&$e+X4q6cXK$$1
+(N!"d$JY%$KqPp#%-EL!V%RST+8U%*F8JFb$lR1@-d,hU-A5[[[pJhD[pTZl9IN2
+hkKc3U$9[p`@fhk[II0LNA&$X*$K"8FAF+XKK#1CNM8l(3aN+9#kaSE3Crj!!I,M
+jIeA&(@)j&XPRd4$,fA-h-Cb"'Q)iVm2!$68M$`IKGYSd[c+ZaE(Tq,k[%m+-!jR
+XKL1aR!&4*E)CDZl#+F&SFX"XaR'2X!0H%p-U,Z(c#PkHBU5"6XZXrU`5bl##J!J
+r1c,8T!j#a`d`06TZa)2NTJ980)QXak4AcaCi"56Pc)6)EkkS)p$%)(I5"bP0m91
+0M(I&cVB'IZD%(i1mLk9SFG!2X6Bik04fJEdThaE0b1!"*YMb6d#5d&$DN!"2b#J
+G(q1-UG&)`Qebb%IUj@8[Mr'jlNFPHDlHD3FE$H6elTFrr1YHG2)T%Qi35T)X)Mb
+%dGJB4i,pP#818TT-JKfTP5TLcYHK'KAa820Upi`IdrX10jDf'@H&DK8EZiaNFCR
+8Rh%(+D2'C[ZkE9SNQ-YR9p-8U*p8J%k`iK)Tp8T,aQCY!DQVbd0ANI@AX9P$3h4
+&hCG!(GYMXpf-kPZa@jl$8$V&(Me8l)F0&6[Q8*S((3TEarCF@*BZr)cJai'IAUK
++M1*a8Yd1l&1kS)JXai4V8%)kS"TX&dIBUcjP"+q5dUYH4PJG25JMq((JTi[)215
+E*98#!r)&p3c%BkKiMkrS)$8M1ZYJC0F`mrlVq"!Y)Ab)iQ98fq@XkH05dmG"'K'
+*C[*`m`-[8h)"'[B*#BLKZGY)68'*ci"i"(8B'3e`2!fT+ZPRU)1I0#JVi1hB"k5
+TC5a-(`-ZdCDN9j5e`0V9(DhJBLS'3Q43JC&k!iK%,r`M+F*NS3jQQ(',CaLTJqS
+c6NkU5SEi[B)!ZXJ93d8[qNdUQJ5hM&#'#PG1ffU'p!XLHX9`G1U#bc-FDX3X,#h
+F1(f,(*@,A,4aMeGi(6@!&k*%9E63eqqqflA),BPFK%#QmA-B2aj2SC4iFU3MR6B
+(&lPS%`pIC*Z`XJTYK#(QFb4%,h*jT[0-d[9RHMVbC)kE4669j-RfQjX@ZF4`Y!U
+@&%2A4p8aFAl`"caK92G0-@9D5(Ld,AhFcK-&e8KBJU6(Ehh*HN@chq)0*5cqArS
+Y+a-*KkXUiR"Ie"V9Q%NjP@DD"!5F%#EZUl-N3jLX`H6e%8XeQlcI-,R$S&KD5-k
+d'FUVh42VIFq&CZ%4$SG[S+k&V2!"h)PB0E!&MmmJHiICZp#cQPZm-fR2rX6Rm9`
+(`P5"eU&1JlL!kJj,Yl$KTPRrrTriRN1LM-T'8[%eM)r0#Lm*P!dZYmSQ!r[08,A
+!J*I4G#ME5T3b3Nc6C!a!YSHR0HYI9H,9YQNSjp0H+eK9FapF16"Ja6C1P9dU-GC
+qcN6D9$(-@1P@T4,-Y%kT[*&*e5'1@AUiHAH%f*fBJm3#!%C58-02cf,BAJJ!bj8
+&3Z8i$I5EGMejBGrm[XG3e9b-Maa3NfmAMRclrh!IASAd,'F6+H+HB%`Qa&3rUIr
+9$[cSm(-G!&FP'B%5RR&c1`S%H0NYk8PL8X,`b85c+SRPpK-k5'-'4bUJiHZ+I`c
+hlJZMXq6#6mXR--C&m6%Z,'Db4e(!`(&eJc""r(MRKlE)!EMSEIf)h0VhR6KSSB)
+@V+0I'-R8m4V3$bT1!h+-cCip+1kl*aH*EP,Fpd3ALMRNBM-KXfmpf#KNjA)IRc!
+ReV[b9i1eR*48m[,T3Ee+2SMr*[bhJiPZJNSb`LFpp*!!KJGCb,$r$FJ+k'pl#'V
++bEPZ6mKq$NUAFj`Hf['M`FmN6!S6F&hrY`GrMBF!c%pmUKC)'k5SY3f0r[2a%cm
+50NPE42A5J5h'$4X8Cc&N30`(`6")+)8(&ZTS%0j"'NMl1C8+LicD#rrVk`8)&83
+R)UF#8kUTUa'!'[id8*(&U"0-Mq-Rb%MpMB-p"ESJ00q,,X6S,M!e5&0TbLX(Ij4
+IB%Sl93`&'XHTX620iXH#rRP'h[S4a+52iL03"Cd%Z#3FaCqR%XKmYFDTr6T8&L&
+q)*(L*r$a6"V6V,[D[m3j+AU,5CRlal15i$12`cMSTD)J3%meq1#4ANIaMJ5B2Jd
+k1qA8GR8$m)e,K[PT-)1Rim2m1E`mM5&2dR#46I4TIPP3id$SAJ#PqFQ1-,)bSFB
+j5Dj@P$J0DTc)lQQURJ)3DMD[ae5,GjUaNHUGqU4N"6ZhMb@Q2TDBjMJTB2Z45%j
+5)RQSi,#phl!NY,"5FVa154,XjEl#4+8EDVh6+-k5R(TJaf&(&b8LqJ("iDa[#p%
+V%(9"`4H@C+5$2me98Zei*X54VXZQC#+S-*!!G%Ek+A[#h(6[0TjN`iPJCNFP&8G
+3HSLM#&qbh`@'5FHUYb"%FadqVl221+[XJP6CrGV3$5QXGG,d'0`M)#U0M"SC'2C
+PhK)pQ2F@G)DIkdaTZXp#kZ4*!RiB[H5M,aZ$eKiBqT%!b+c@PP0F(IGE-adI(,Z
+6CQ5IP+G*L4*rBTH%TLB*66($,e9,j)c)&PJPjpMfD'CVhHEqEJ'45f*EQ55f3F8
+$8bh-hXC,8'hpeL6`T*ia#$`CQjNid!I%kF"2lpI*L$k0lT!!'"dPU@HS`S#3!$M
+)MJ(KL!P%JQ#84)06dB,4Nk1#B&63e1Ii9C+FE9KKLji(GXb4Nq`5MCLfV`iQ'Kd
+FHj&3%U&!C+FliQE&2TiGjil2aFJkPe!-j%8iZ`[0EAF[b4Rj5F)S9A9PU1U-C1b
+$+@Im#mY6Z$2(4JCZVMkPVpEHT3fXRN@a1M++[iZAEi!X94E[HT!!q&qjDYEjihj
+ap1`VSSML5FZIE`aFB3EVDqC%*C%i44c0+#l`FYUXXPGMiQMKYiZMA`80KIa3&5k
+rF80f+3S(4NV@S9VRCqAQc2a)2'dS,$K"8'@iHPEdpF(!jYaPL6b9+IT`I(@Y+hq
+cmbe5L%l#6F,QM'FCTT!!di6&Cc"Q&jb#4a&0XdbG%fUf5*AZDP5kr"1RE'PLl&%
+C`'5LiCqBUm326%VcU!SrGF!+eBB4UUV5pCNRr@"B6BU2mD(b)8%8@B#U8I`)D!Q
+G,#Bd#*@i(iX`Vm"3SM68iepBlNPJXTq-Kf$%GV2LM$"U(VXj9-"J!5fD!S$pVJ$
+BT$*)eNH"!A2h!HY-$Pd*X-a9Iphlj3mTi@(4la*F&-Naq)"kZ2NR(S!GUQaR6dN
+)l1JPS1-iA#HDIpiAf"1idYm0P0p1JLqQlM8S8p+r0`mZU*la['i#)Cl`8a10b`L
+A6BJlmd4[KBX+FiMHqmRYTSb+r8(B+804`"iUT)R+4@![B-bB"9[jmqI'+FRiR'N
+`Q[TY9+#cR0J+CGAKjXdliP#L8)CKd3'q"m3ND`$RrXd,Bp3J@D$"+A69MZlVKmT
+4%!#1"8mQb-'BP'HX5')U&9%ENXPG4$V)CZDUA#d90+fRk["Vkm'SE3#+f3#R&Kb
+,hjN1"a$&$IFJlAHXbVd(1-6('UQ$'JLQLjNUk9iJ*dj1&ZY"F'B)&JqSk5$ef4!
+F-'[%cS44bpZUL2c@YkbpkhZ+Uc&)$80M+1#kZ4dUSc5,*jd(Mk2`hZ+c4QH9,@L
+%FTd+JPedL5SU(K@#4@5K6T2++r(MX[Edp8*%4hGVHdXUX*cpaTkBPbURhqA3JST
+lJPdXi@M&i`'R5'V%-BCF5F"[KfQ43##SRp49B**2l*3Q3A%"eY*,+VcIQ@P4m)'
+UqAFRiAE4r22DD&B5C!4!3S@61-)*$&QP@i3NJN*bQcG3`9-)j8A1hT**N!#'8"'
+2p"%!EVN,E%H9")*f3TEYLINIL'%*#(hQle9Q%S[RQFJ,KT40M@J5R%4liejbL1d
+)hrpG12"9ifFlf2FL5iJjr@$48'!2$1'@$CKB4-"()'EX*3*Xk6S'b+depSU-(3S
+FAkM,`1)iHmp1MrSGliS3YPH((EpTGZA(`Ba@fX3N%r*X)5`8QF998Ej4Y`p'FI[
+i[PjV$eZSR[8p*6Y-3,cQQ@-!F5p-J%QK@-ZDM@3#T)bS"X&fE'(q"jDaC%N@LJ&
+CG!a`Nc1%@U"QH0+hQK*9NkdGT&BB@6BTVTY6U$&F"9F41D!Hb,40jThSe,+*R1G
+iV)aS)bc4V#,b$*9(*CTe8&MS@!'*$8)R5$4Y(E-@'$4XR@c*$31lp31R`0ec-9[
+bdjKFIlLjjLPKbF()#J$RK%()58k(!,PT"UBq"UBh@0&0QKUMjD@PURNYcq3N@b)
+RU@)pNA3#DkCiVGP"j"9!YfDY#A4VYK(SrXjSp%F,"A#@BiA0$R"8TYXL&k6UG*b
+fEImE9I(2f*F`Y4U-YAkmi[&cN3X!Q#BXI4V[1mQbH5fb1UJje2hS"XcI1*a*ZTj
+`4#i)blKN9ZL!9aj38p5K$ZCXNKiRp8&*[)0l2,N'4BCH$421+fc89L`4P$#G*+D
+J`6R@6Ep`3*Z4*N$pd3IP6#&8#,TP(X(8#'%EV'V4aSV@C@mZFMPlEI,DE9!i[S&
+(%8205FIa3"#HFkC"J!d*@d(#E%*9j4-ad)V(lGJB%5mCjI3f`DUKJS`NMQY(Yle
+$[SDEQ&!PIC+i5``m-C4J$l00l#49rH0kKR*qpe3ZNV[,`,BXQ39aGFPH4@Z*26m
+HFjM##Ma)mj%90f&V'L`m+YqY&`QphqULT@$)9XrSQ0chP!X'-)MHbZSIYT9`e&E
+@SQTB!6Ilefiqaqd++@VE"XlaAU8-!X3&mrQ&RS*E$E'Y5JAQ#f`!'jdNPdC5Q8*
+Xd,mF'[LmGZ[E$*3eH#%XPhQ5&KEXr0C'J9%(QbA6jMbdaEm@2&68JA`,260TY2e
+N!HG&TJLNCDp`DT'ib-M@'4mSQiX0P(Q'V@9c`c#qP(N%S35SSjPIGfVR!#V$2AM
+C@qC"#)lLXMQBmQic4m"mqr!L(br-j#DK9rH[(!T6&e*6Re!XJ36mrA-3'9E#MC1
+-B+Q'cJi4ZUQR(c4C$HA,+TJ68`(XNqb!%diJ!%[lF((CbE+$Z1@@T3qMQl+6'$c
+A90`EbBN+U(R*R!N%TIRlhjj-YS@BLPlHqGX6UmaUl'165T3)B6VN)4ZB"T!!*E&
+*(#JlZI-LEVNlYh&"9B`AKcUC1T54*2%4(8f[$UePRG%Q+Hc!hD5XBFT*9FL+F1Q
+K'3qe`NHBM$qe9)h!"FZ&+9MmKESCZ***h9#4+p%d""@8*B8GQ!'0e13FZB`,M!V
+,q,-d6&r8-+jd&&AGKD(3hEJRNDKUqj+4%h-rMi58(XDk%`0AGf*$e1$"K(qZfe3
+J9R$9#i&G!c"NNaX"Ci@+5AAjr!5*lN$ZK,#GH1PR$JEqU9+S-Kf%YS8*#h@1G$p
+F2ZY$T,!'f#AJCZFMC$ej*HiJT$Cm[1d+412C!Ul41LT8aXRPp-VKjZpB$5pJHVX
+#45)Y$AXekCNMCp3V"4FAk$@AKJaHS8HJq+V$M8UpD(dXaE,VF@LCkI(T(lrp%J4
+e2(l8[,N)E"`H%pIl-VJ'KdUBf$`"H&Qa'Qr"B8M)TklV43,5rZkcP,M`L86Xe#m
+J8eX5D%*m6ik#)1DCH&r(e9MDlX[cX2a'q9FN8'qUU'YfrD[I#[F6X3p9jDClE`L
++&8Z'Z-GkbHLhpJEkVYlJS@3[epT1(H$TI-m#T6,B4`8G31MV5mE*`3ZQp1Y,EMS
+BZRpVYSYPhr(6+bih&3'"irhe8#M(&FrZIpfkUlmAi6i5*bT*25Vf3He#l(Gp1T!
+!MD61H5Y+m&YVB%4%kd#AXJ!hU#aJ+*`4VB1*h@rXG5%ib*,mT&&'@)mP*-jkI1`
+MR6k3!"b+be)S'4@Y!Y*FQX)"rQXKb*&lMbpZa3E)bI",qJem+@S$Ap*[3-B'[N3
+EJ*USAXcZEeAU8B4PDAmRLP-e+8Y2V-9@eST@D5Xk-U14D0V9(D-K)2+)Yiek"EB
+EhB&GZ--9kSp9LEfLFG5llSV`+S@2U[YGZCpf9)Qlk)9Gkp!+Vj!!I8TA*HkKE&-
+B"f5rMf-8p@-S(-5[&*fi%88iZ1JI#T%c*N5Dj%&%-SP"$AUecG([i+XMePf1hp"
+RIhmr(ihdG8,Xa'GZIbkIMTcCihL22Y2liHm8kBFV(3+*)'0HrcaNR0)bpLm9`B,
+ie6C[I`LCFd*QIA6QFd,Q+P0QPcd*%d)a9c,XciT!fD'988!DSQ-5N!$V%R%%MZL
+)JI&%8"8ah1QU["B)lkM,GJemAkQqqbZbqjCclk3riaDcdZrBhK$,H[Vb&9F0h'l
+3X#lJhj'*KYm!-HV[hXVpXR[lHcmlXpNYbS@DTaS#mX%N,@emkTBbX4`6-J2P1h,
+B"+p5KJPHf4d8cErEiKE68Jj90`bQ(GarIqYPeqEA44R0Fp$m'QZH9#V32#Ql2rq
+l1aFXFS[K!llDKSl``IEl'ppbEB'CYp-9++pd"p+N#3PP-bBNC2HI8JlpSXBYqM2
+Zf0d3pcrpqMAASVS#@d6i,'8l'QYNpjj,lhEFmVPBIN5cS%&AMU2riJhA-jPL&YY
+SPV64%!SLEH8KfGeJl,c+0RU)EA5rY0(hp"Zpa#C-+T@B-#QlPh9q3@8EpE'0YNG
+Yp**qSk+b&me&fId0edFeY&&'mM!Mq68L1GZQAfSH9'V32#LlAqqpp4Hd3)cS@3,
+4iFk8ZNB+,F!fM!H*q$&P!bE'C,HL[,q6EIN3fr*qYQ@DP-A)Rl8$(fc+S,)58`C
+PpdYcYfbNEE-&N!#P"EK%#e"*S4R5T'dEP8fBB*6GRphB(cMQ!Pc5,m"YbM`d[Jd
+NqZKr[r"VkFKX+hJ30K1E@[0",0N*0fNX49*DLLA+ACLi4(DrpU1H0pMf$l(Y'jC
+LVkkmmj+B4BX461l)CT0'PA@B0#Uljrr5qpJaPU-Ffdi5H9'dU&jf,jeiiM4EKTY
+S'4i@PN&Q#jE$'Uf5hCAD&l9V2KH6KEGMq16"mc4mB1VAC4))RjHk@bQlimqGqMi
+MGa8MGa-MpdYX@H%)MU2QZ0cN2##llP[lhVE0,T!!1FR)V*()I*i4lM`4$PeZPpf
+,KK,rJj(h*L,[``*j"B!0de+Jf3EC(HR9l2[ejq*jGX6c`K'*T'cC-V&KSF0eXV[
+QqGeZ4XSU4XSQD60lDFR)H8`mAjR*$VPCG[hUeeqGYm8&%LBC#6@-K#q*5@NlbFT
+VV'Q0l(VXTcrH63*%!6+HCd"jAL,NAE,lJbpQ,FT,5)BiSP!"QPE)lP9rq1BPfK!
+Mj(Q*N!#[#mNMLT!!HfAAVP1D"ij"b()Td3NERbHlYrl,I@Rr#5(,C(IUdrp@6`[
+)MPLZAfS$)3d,8bQl,@FMDiL3!#P9)!i48L"1@#+1,*&aNqckEXI)@d6'p#5)3f4
+m8dMUIiHQ1ph#-LZ,rfKR5'q5N!$HIGr&*R,%Y,ph"@6@C+rX[[5rPlVC%KpP5e`
+Z%HmhB[R[A3%rD`B!,2lrh`j3iU9U6LFlpYMh--*P"FTIG!A5@$-Xa,,lPb3C-Fi
+6-3lHI[rE)-FP-I`2)#pVK)6acXEDANSqkC0dl2ZN#Z&RVN!@Dl*CGKprjVp[CF3
+kbSK9VNm@jh(`-'X'3LhprA%2%BU10*MPk,4h-N,*JI-['Ji1!0li$j[-M!$R'G+
+rhB$dp86#%XEqlj&hfE%RkGMh5BMQp`BL9F[ZfZHrYCL"c9%'0Z8'p2ic`qB"@RF
+pED`cN!!S)$ZQl&2Xf1q*jrr"F'`NHIq9lk3aj('HJIlYd[)+aaC)8#1lepa9m8H
+'2)K)iIXZjeRB6E*lpqrqHMp,ENGCFLXh9CAka8@LR&fB8Nm(CmYf2Xqb#83#F*D
+pHHB%3mcR'DMIEJ*e9jed+""Ke3m#[Ba-id5Q"r5!lXU8L)"&kHP3[Xb@VTdYR5m
+DA355f8M),c)eY1akqm,MIhX'#Dj`2p[!S3,SiMbD*PR6lE)VpB89If6)STb4l+J
+*@ELZQ3Kbi[e22f!N'bH52D"(&+iFL4aBSRp+lVh)d%3l3a1qD$34+-HJIMES"TJ
+XRPlehhjGL3AIcaEmN!!*6EJZQ8#j,ZGrh-X)9mi)Gr3BK%-#1pY`T2Z(%Ji,965
+iHeeH`KR3!b1(3,K9XZ[Ie"i0%5jP2d-2KdcS38m1J24KlrlR@5)VCkMKU)3DSJQ
+#K(EV[L2C,('-8q*i3%!1-MZq2Z(rhHV5H`L%-YTar2-ifYYX!rkS$3#%1QkjqrG
+%#NB`@5*B*KdI"!XE`2VKDlrq#T'#,D9I@XT,[l[am`EZrdN$ppl5`*-30!dLFD@
+"PFMJjN-3pUZfZhHiM'&V$jL#bXIFITiB,ca8kAl-G4ZhpL4l)+c@T2-$+&m#m9S
+PPcG5QKFHZZLkflhVJE*0ZdSR83a2H*cMiY809`S2MING(acmjPfCC@lU0'JFj2H
+rPH-+CTX2TC4[cYcV%ShjI-19B(JZZmaYH2h6YqSZQJrT`QFZhBN'+@K`d%GG'"S
+il(Bl03Q%Zh$Jf&6!1-Nh["3-@l2,A&)MYcRddfeeIcE2&"ikH*iQ"klHpe*ffb$
+Ii3Uk#`m&`hdB-1!)2*[2$5pqqP,Q464[BXd4VGA`JK!0[3U'6p'NCrIUAf'3!+f
+C&r[U`-,eJK'%+&qd2BVKB%S8J9hPii*#4C8P03%qq*9S4b1*3Ep$BST39%KdQ6*
+BBD%ETJ`8&iVkG(pNqRK)%rG,%frN2B+ihm41*5V&r5D@Lci0M"NqlM"P2k3*dT!
+!#CG*N6&,+K3BDXXfaDqQU)(``GN0@hGF'`a[[REC(804PJ0U`)qXZJlrPVUhh%G
+JQYeq"8PYNT+DH-I1(20-CFl8!aq1aSe*ETi*q0HpY--epF"[4kqe6I+!hclPQ++
+-pk5-Jb&dKScIX)aB@Z#1&h1SJlh)L1jJHCi1jNNC`[4hKHRbB&U(rfGeeMh*2Bb
+"XiPT6ed*T"fFC3M[Fe('Tm`qh#-rmCTFrj*$j86U2GKdl2MmDTK5MZrFHe+1VrR
+ChK1,iap(UF3HT'RJG`@E+ZN82M!Q"E)$B+9$09)jN!#L2Vl,SY32T,cdpSqICUS
+p"R+T63LZ8(plLI)eVZ+fQ%G`qbS2ijE+rEJYifQi&A%C0i9RCC!!JlE2%`XHKkY
+"-Z&(BE([l4bh6c*Ni-hhKc5f@UK'+53@!T9eG6XeYV[J%&NK(D5T[cXUf'!Y1bS
+8,U`ST+6``dCp9&Lre1PNTK5,EjE#*%r$0'@$SU$+(&i,XbJ9E)IM5KHF,#)#)-(
+)ZMLTj6SBP$Ti%f@U(#(bT!B+16(bHf"#AV+*4c"3K!ebRAAH1dH',h*,5h810)E
+)m$Y%UN9b6%deMUBGfTCVR%f5SAUacHJNXmmi#k3+-T)"dQk"%h6jYPHBJHLLFk#
+e"NjDEqh$!c+b-I%Q6,c1*JB0%iG'cGpqj48bkf"b&8fQ&eZ,-DA,,N`PP*UK,,E
+im(!'AA$HE0SDe0e[Q[RcJ6Lj`TD5)p(3D0qZIP)[PQjG*X,p3LN9P2Z#Le&mYU$
+l2$Y1Pq!qLf!Mp465Y1$KM$d`2&de(-rdmT86q5I)I3e$,FecH!4(lRQJYDER2TM
+IB!bkUDHeKKaM25RB`Lb-UJICX%iFH8("`G$C!R5QfIB+Z33R@qQ)bS,md)13!(Q
+3!!"Pkca2-$R!PGDDNqe@N!!-5!bh+4aJIbY!'%TPS4N0#XF"`i)ZCJVBiSfaVGp
+PYjMGDZq63-a[(q,6%S!HK#Vj60&5-[i8T6BF*%9R`bX`k[&f$!1(&Yi@2MPZa3-
+VZ%8U-ljr%rp(@#(`HAShECiQ#DiJ44LfD+PTf)ERk6D%!m)8Xp8iX,($8GRRQN(
+BJSf$MXU[il(K"4b80q43f&!mA)C,KIEHBM4-Kr[%DGE*3R`meJ#$(Jli#P1b(d4
+KIKD#K!@`*KH8kSD$+$!HM(r-+TNS`pE@e`R-',K2Ne&ApC+"89'fTJ3rKTRP&3S
+$E##C)3P3*KCN-5QMX4K0E$&'fI5XJY2eNqXP-qA+VGm9-V'8p8-$VCdXm`dm1XQ
+9IZYA5(bJBYYiL-"%ZTXGVB-"`')pQ+4cCDSD+)+fYKe(Z%T(#,8U$hZDD1%$)kc
+J'BI6RfpV*J`bXb`imLY#Tf6b-BAT,PTP-,Dd$c6H)5`b22f,fdK0(Q-Z5DDL#pP
+!$`[TT61Q[Q#aSm'VNQPm6*L#m,NCp)K#!ZNp#iT@3D&H8V5+XKbjkJ@iS`D&C6+
+VAB4URU0ATQjXNh#K5F*Y%L&dN9LRjlUPjM#!4Uic0a8XRbdK1Z(```fEp(6#32@
+F)remJN!%bP[C5BBSM60XS9!RrDC1e!@'6(5@)&"PaJ!!+K8DCp-E5kX0aa@kqpT
+kjPSB&lDPAU#Ki6+X3a,`jQRk"X*BQEBk6QBVflb(4TMlNm`"-8&Cqj%)e4I5+H$
+*'#1'+K#$(0Aea!p&%6pT)#UD*"mk54&#rL'502@A$dC5r[*r4P)6+&(!S2X28-C
+hF[Pr+4`+m(5"0%0NHP+&L43ZqrkeV-TVY`4CPjM5Fjpk`G4a!6)Pp&Y8SlHB+"!
+`*#S!KeJ`!!F#T&af9&TdR`TZbe@HS'4!mk+l-`"6M5&M"NfaX16+iiX5eCC-MbD
+h'2H)hZFR%1cN$6)($ief[A,L)"P+Ykk)cmC(N!#JHS*G'HUq2F8T)*LAA*ZfZcc
+qa2MmbN&qi0$bDiN`QE[D14b(JRQEG)!"UDclL,HA'CV"56f0(hU`TMA46Ef*Y)m
+jCHhENjmc20,fcP5e1S@$0Na94l,am1BM+EbmV@fB`SSVE5h)[SMXY929i9rMSAQ
+U1Nf$KieSpXff(G5XA'NV3hB3fI1QUZ86H0Jl9Che'KiUd+bTl5jUGP9T@i6XYFM
+H-PAY[482cda9qjEJi5Nfj'jTb1h)GL#lHUUkr#8mV*bU6Ll(`bV@V&jUYMLkN!!
+))D`BBaeN9'#YNh"Q'fJl"31d&XMbGX%a`Pkmmbf2&3&(6MPccMVMIUVd&DR59j4
+Kjmir$rIXr!ZD[IC)F9[4cS[faThAB1SED&[Y+0jj!)Da+p34J@a@c+Q&HlAmK`m
+qbLaC1c1`mbeNDLM63N&RLJU%TC&%8`TU&T6-S+*G6!3d8(MXhqQ1ZbR-G@#3!)2
+9$rb!JmhpeK5-D2Z$9rrG&B4B[c-l!%-%A"Zc,EkRhZ,CP)BpNDIH3Q%+I`%4@#S
+1)c&3ZQ1DqjV)d(FX-aq4-#Y%Ki5C,h'!(q6%E25p6YhB'r`bIL+&2(!mi"C9UqY
+a"0J3e6jkm)VU'AT)LQSr254%p43pD%4eMKj#)N+biQ%5JSrBj8kk#Cd8VdqKc[B
+MqGl@cb[FGlNLf56@"&iFj0pb$h*VAI-PFYl[ImPk,AQ06EPEF0[K#'F8@QFkp#%
+L,$03dF'$Jrj)E0![Sb+-H(6@E+(E$V#i0A@4(2SB0)l`aqV`Ffd3$&,&03T65Zc
+`LhH)@IXZ83LT(pMpN4rdqQ@iXkid$!43@+8RCTJKh&aqLPhLi"6F)I'DI4afdU1
+2'JcRFXr19E3B3`1Bh-aA%c+(19raa1,)SZd-aG3QDM`8Bki5ZF2DRDZk++L#3Sp
+Lf"3)RPb#id+SpU3RJFBh)%MIJZ*k#Y$Y4h5%MA!RAY[BQTX2"e[UP)+f-*-i+qb
+fU,%eAfT'J48Jp(d&(mb&KdcC!fh1`mh,2f&19JPf5,ZT'm'*J),"S0'1LXbZEPB
+mE5f+d!PGDSCm3UA&QUbJVVZk#iBk-SJ6'A!C8Xp%EjV#f$#@TPN*#54#U)R692`
+*#dD&Uh*Bq"Z43ZJ8R-L#`Vbc5-ZUiNe*eYa'di0`)"qMUNl,E4&Vck1R!S&IcKX
+iDN`Sf1NPCaPEKl1iCGU5Q"PSQDCKEUTi40X#0a*Nfj'%"PT&&*dPJ5fVi9[1aKB
+(Fi8&)6&"+aDh1!lIJ1JA-BCRF%N)L3a-q15FR0CiFZ[YiQc5pFV"NcB+UM8M*9a
+Xjb!QqSh)`03U0Xh($PJqj)ZA#)`J'lk6(8@,LV,UqblE%Q*m@)&a&1HJ"PK#(iS
+hC%&3MZA0!VX`d',IHX51,R$iAJZa%H8NZP*PaME3+fc!c'Hej#J5rpJJm-0j!3H
+ea#%bqZ#-0m'1339f%+5(qd`G8`#aRFX-de$S5("Seha+&mm`EIk8Ff$R-XYSBQ"
+R%99-$YFBYb1,N9D9Q*&8aV*pPa@Z+YjCY28j&+(ek6mr&S4Z!`',lNV-iY!kaUV
+Sp+42#"FBS#h502ZhSJSdY$X(@LBXV!0(FFZ%@,bcr[!06j-"N3SCV"X[)`",GQ#
+PEX%eH*SKeh$Q01bP#dh3YP[qQ@kYYe#6!X8Adp84S0pH+VD!N!"%a+6,M%Q2Br%
+d%Y-k6KFeNY4C1VU`Km#L3B4Vq[GkYFXL"kd3DcB96&V5j5mD@`kIL10)-B3l%bd
+*)EY`S-)pV'djl%N+'A-ZqM4F&Q3S$1!Er5SjcQ`Ah#FE21fcYL9Lm5q@iP)M"m3
+ZZ%P%S"6*j6)BIE!D#$p5P"qL)[*i6-e[JPZkV'`I`!5P0N1&i%&Z40XKq-(j0XU
+Y53KP4U3Me1+!`S13!+@@a%NN0aG,Y0H*S8E&AB1&f832HGJaL(+mMN3jJF$'m*a
+qL+)DJi-I&Fk1#i81UPK4ar%mD)cFJ*LE1TbbU$KRk&%0aS8'6+#&DZ"*RAfJTBq
+Ubp+$*1iL1#[#Qe!4G4*2Lh$FHLm3'#T`r!!Y2KNJ&LCYM0$'Rrj#K5iY9JV`&Bf
+!R+kZEN0`L(&qdkk@2S-!EhY)hI[aiXN4r+`QdFBf3N@#JFDKiU"LHN1MT`rm5-5
+"YaKR@6$1)d`XH@KG(f&NibU%prTqA#`QR4L%HJm0",CP`M!8%P!%5ah(-(G*`i6
+kZPQad[a(Y+hM`qFL*eX+FI1dP!cjl"EfkV-C,J3%%"l#QG*$RI3L(`mI8V([)8*
+iB5VB(9jUeP)@82b%44iq&cl58N+!""INFV$+!2MN$D"P)N15&F+N)hf%3JJ$V40
+Yjb+jPZZXq5"Fi"m06YPSh)ZYhdBG`%93&N"V+)ff6#(lRZaN3-,95GB0[0d%XV!
+"Md@-1`9L,%X+a&"2#F43V83-p6!4Jm#-[Ia8f,Ek[N5'E1NK4hTa#KINBU&%F1f
+6,jT)%YQ!`Lr4*$R38N*(C3@1IBB&J`0T!6+9R`-$P"DeP-FJ&i,,r3I)aFK%"-%
+9J9J5(jH1fPK+46Gp4*!!VkEf%9XIS@4dka)R&paS%AMQ033jf)D#,'ANLQT`3N9
+i"ahBcJXN,KS#Sd5!H*4030AlF(JFSH99L`iZXKfX)-T'5`"$2fi*H(A!R*XXij'
+5)JAQYj+Gkf$qSpY'MbaN%TNXYb&"AXH2$SHXCiNkJ-HLQ!2,Z"ir[m3@NQ`,TH3
+mrU5I&HP+3`!Z)9bB"NHFPSlBCcML`$QeAGQ-flLbEV*UrV[Qb#C#mH&0,LMAF'%
+Y"2+``T@*A@!,(jhi@0I96CXh1,ZblXFX4-D!TB-fD`[Hh&ZdEU#Rk#NNfGd-(Cd
+E'QMTabFkUD)#i`P893D#j`U&95cYk#S,J3qD$##+PlZ0Xe)iK!03,mBN9rNB)4i
++@h+M!@lFA"!$IqX5a%"E&e5$-DD1R-C#fCQUE4#GR8Ea6$!A5S`&%$LZ60-(h1S
+%KrbB&%UJ#jZE`qB'cE'&(YEmF4BSEJ`+Ji%Ihf`Ki419m*16q,'5`rZLh3A$P-i
+51eH&UQ-5,SF6#"e*!Q5!&BP(5$H,pa%%b@l9S+S[EY9!k$J$KGfcjQ4PMLh*'S'
+K4p+02G,6GYQ3!)&L2!LrSBB%CBMkJL"d6(0b)M8%!%-3%5mHR"#V,k2SPdb&rF&
+'SlKmL)SCkj8lXe3`6+C3*"irK6YaG%%!('JT0&3R)%-Ab+Map1EYKTV-aU!HbP@
+rm&#lB3R6kpc$P#Uh#FS*9[3ilI5B[ZJa@$$mkqMRNFk@-dM@ih4T+5#3!%0J+4*
+ID@`T0(D+ARV`9,%QKNpL@5p(ABjP#e@S)$YG-S-%ckCdRVc+Crr9hlk*cl)L&J`
+Bf@2D$%*#((U$!8d9+H(R,e#f`2bLQKTQU($LAEF,lX+SC*)S115(fr$(F1(0C-U
+EG@YGCfZY[953!!16YT!!!-"HE-QBq%4,L`-@$Fd3b-VrR4jFVS00!QLYJd)CKI+
+KC*BbV5l+RPVT*HIG%D%6K%$U$Iq+A9KVN!!blY@aSP65`CX@XB2lF!%5+bXQYBi
+1E!C5-!(M-V["j%[LKBkFH[08k(%YJZP"6#!hBUMaFJd+-i3-Q#h+TA#9+(D#4k%
+D5CY!!XiPdB+UF3NKS`"`$#L%%-JbZi!#Pe9(SlpPU`cS%b+&Pa$IXU8frF@hPMe
+-50''iN[,(SjUQ*5#83(kSaVA3LA(80LbbiBKk%K$@5c!Gi3TfA`@Ri$J)458-%5
+54Be!)M-@D0hBl"3f#KGB!BA[+BM##HN[p6)&#IFETl#9[!MGLB0DC(CSQ4Aqh)L
+X@U"@(1T4U(929)%!#McB+R3GAU32m),3*mY5"D5f,29B5+hX63QTp6R4e(,BhPT
+8"H6D6NLYL%Y)lEU)kB68K-d999('3&H45)KY@DU!f)U#!hZ+X+NL,L!f6(QF,Xl
+fTj!!G#`Y31(EUe'"jf9dij`a#+m5'&#KmR#l*fPJj2(T,F$%lbl!a1Fq#"1IDf$
+LG@%6'ppF39XP8Uh+%3i9HI2Bc(ccd[q-Q@qq5f$Qml,3FFl!c&'JF30eKL9i'B*
+'SU"`kGa&D)`&+Y95b%!G!HBPaYjIBZbpEYmZE25J%'kCS4DBP"3c!)p#ZU4F4[+
+L*%C9-G6CGb8[5B'"5Tb[@mMj@LCKqLCY5amC1[5!#A"9bQj1!3SX!*a2jJZ%85m
+3f1V!cK#3!#(`2-*B,V-VkpUVjRpJMM!@$BbDS3)[[fLU`-Z[#4Ai-B%E!'#4H3R
+#F'akF,"qG"+)"[,5jF)4H5Q+fX4[lPhfcX#HCDm4B#,C[S11%0*eS@k@XFR,hJ(
+*-L!'0lEd@kC*3*!$QH@V13V3lS*$rrKSf[Fli5V[25YhpDcY,&kmGPHqE1eCZkY
+iXG5i`ikT",B8&+aPcY+1!6XaS!-0F2(9C3J#lY-!GCrFYkX!@1B,B#N1Y1BM*&m
+q,Ck`D$"kE)TH6S!2&GdU+ELXTBkSCBdaiC'RTNBjJa3aYFaSH$Zl*19)pjiCI0"
+P8LhpC%`M`%I5DbaG3S8i'0*L6[0NB#0fGrMMPY15fD`+KM4lY#(0YS"-B0BHIGG
+KkYM@N!!R1(F5&j%,#UacB+$PY%bUbm%@edP@A0i)953cM'UBZN'M9hI88p(h8@B
+UU!HkV-q&L$)*mH5@iH+fcVBaGV[q5'GE%460#9**fiXE1r$cMVfadBkI6G&9Y`8
++R[FTN!$Lk+Ydkk@!Jh')#-PLlQql$15hk)MD%4E6RTp!d43["3&lUJk&f[Rhk[0
+V%DcEhM&+(dI)+(-YPYDFH6B5#cZ+'bm-q3e,5Fi)IZ1Z"aS[S)TQ"C)20crGi,5
+@e-qJ+2K+,30&cbFj#+KqQBRDceSQcA"*YIL-!beR(*891Ck)k"pL)HTf[p[96DV
+b'AP)#0mbJXlQQ2+m1@fF4!4R*SRrmbZV3*!!VhrHUmlr(%%6i3lLc++3!*%`Kj1
+63#dTjVpAAq`9MZq*G)5&6[b,k2#kY+%drI%(fZaJ&-fIe!Q6D*!!BQp-QNLEhBN
+%jIm,*Sl(Hk1f2G!fMBP,2XP")F4QCae02)Y#M`C#J!#T-`10lf!$de*LI)H4)-K
+)-!%5e1P*J)"TBKDVE(#BqhISLC!!*@6j1jdj40Lc(R3r(Y9p"`CIalV[c00j3I+
+@Xmjai2YYV(11cXZP,G45dQ'1),aSZ8#QF*Z`lA!$-IAmC54N-)QhVU$Lbr`0*2G
+c84@#l#MqfJhmT12(KCmVKaXAHmGQ-HNFFi(*LmaMe)'c"fb6(B!kfDN&NcX*jaD
+AVB!#M"R-I-GJ*+qCP$Li8'KMIISM5"kY%e&"!eBD,UY)$MT!5B8P6-fY1Sd3me%
+!"H"IFBA%A`#jm*P$BF`T)mlTJLR"emP94DV3E1,!aLD`LIAjF`2&'jZ8e),UFFB
+H)DbD4309e"S8bd*PrX#)@5'@PGIN8E62)dGq),[kHbp58@!Di+c-ZUd[d'dp&DN
+UrFX53kAUTHC8P3CITdHkj#0YTL22CLKSdbGe(MmpI"NERhTb#EQC*3)S*2C`$MP
+UP&5KH1ND"+8#NUeq$@S'aA1GJ8k5K3p!J[fAALaAQ0`((Pd0%l-Z#,HQ`R%ipYM
+1"pUZSm"eFGYe!&8R(XBJ#+BcN5R*9(CN2Kkc0VD08DJd8p'JN!!aVp*Y,9XZ1Va
+RcNkh-mFNZNmJ$`9JNS*QV6V@F@qp3G1@B*SN0'8JY(-U,K@9DK+@0MD9[-b5M3E
+**Y2Q&m-HVj4d-Z2FrMC2IK%P@4'kCa#A`KDreF1$3$)4U32rPh&$FH8B)pQUBj1
+-%FaN+L!c$&60YGHBN6%XQ)5MM)aq1(k*`b"-ibq(HaVA!l&AJP900,j*U!Y$3-R
+GhdeJ9VZl,eT*bJadA@pe[8A)33UkRd#c5P``qZ2S#c*3q$!fZ0iJR@Gih4j#-IY
++8U&U6L!d%#lEM6,UiK0d533%!q+$pp!&%8,-"1L5$R1UVc[kJJe3miGXi`bd0)b
+m6C+5(8'4eMd&)P%Aikc+Up+6*F&#T'%L61*&TJP&bkN#c'"Xa9!2Rj!!A('U#)K
+!B)3LjXPlJ96-LBV'&KX9pj*8fR!Y2Y(a`a%4UqCY#(C8hpmp@pak#m*U5DTk3L2
+X)X&dQGSN)B5aU`Kf@%pNYPm3NQp,iGR#JH+@3UAHFmi!U$0A65!+Y1#GkH&,N!$
+dhj%!GH@a!98!8$428GCJ`N%#h,%'VKd$m"U3!!DafRqS[2H#AS5A%&0a$KQ2'0V
+`(4YYX%4IjH`&HN,#hpikdmYA!d%e#3eD#ZqpJ+`PdBjCR!-%QaTIHi3!F4XqI)e
+P!-@f+94[*!BE&[V4c4k"Z2cSKQBHl6+ai['S#hZ`3)S`EFKd'5#`Q@piHXR-)cM
+9GB4MiC%8,39Lk45GjXk+ZK9")F`!L%YUrj!!ZA2%$qLd5Q`lK@2XA+KMS9HAQ%`
+FNZ1&+HaBT`%0$B8K1+m#qNrb$5Zq6kJcNNQALfE"15J)Xm`c+3,(,6JH3-dERH6
+)!#*el5)(XM(1"-,jI5-cC+4E%I`B'kYL*Pa5h1)#2k8(k(,[TK"+21S2!!!aL8&
+%3e)$!&JL$e80CNB4%#(MlQ(rEEq@U[6QcehIA%rcq&c996e9@lfJH5Ble)d"Zl*
+!Vj[*l#cbjl'e2+6MqQCZ)B4`4I[jC3HF-L1Ldb21KF2%QQ3mccUCabe%VfGK28)
+i[B%4`[+X`fM!3*0ZdZem-alVlprIrrGe(5#rZb6[*5mr!"9hAL6c)$)L%L(a!"%
+L"PpVP-PB$$qbVeN!+5B(X%N)SYRX3H!NXqKm-bI",%8XPH"lmrkmEm))rVUc)1-
+pA,eYPL'2D24)bp"(KYjZD*86pm1&LPMX4ppKaB0JVPf00MpV"2[Er4EICiUN%86
+i'PB-T%ihN!"&B5"H'%MK(!,T!PpkJNQF,kHf)#!Xl@q9T6JL15B1Pj(AVFmkhZJ
+Im!m!E(r%(mI2HA9EFac+SM)DP"EI'%bdX[JI!Cq&q8!X'3%VZ"`QA$UCK!QE-0h
+p-"Y%eALC0hZ+rp%@i@)C@UA8J!a16ac`88YmM)Z2U%EmkAI01*!!4SZ[jB",@I4
+,b@d!L1[%j4#)bZ050Bh3VcYcb[(P&NGhLQ(2i1aaGGGGmB$fkmk-mN#RrS!fAA,
+!CAV%CAbFM+MbT!VDSkfbCd1(VeQG-$4EUfa'-0d-%$P%d(%G3U`kAmDBIpVQm"[
+*BQeU58EpMhLDe9SUrUKYkB*Y3)jEaQd`h#SMe0m&J#$-ba$%q@KjL!6bN!#aFE$
+E#kJa)k"'&LXUd0q"TICX$i-4`qqa`EpMmC3B3C9!bT4eF'RTBNBK#E`8BC`G)Cc
+9HE@`I&[hC*!!8aF)[lr0hGe[HF&T,)F5E((Qe4iMfGB1d(LjmXKajC%SPJCfAam
+0pRFC)BF&X1l*qb(ed02[UPT"HqckC&*Ci"F,lZdbNJ,@*`1YB32P-,+3!*-Dc0"
+ZDfpXppePNd8#85Z+l2UY1p*N@I!C1@QfRD9LbNPlfpP#IMM(`83f-LNa65@Q56'
+GA1i#N!!`'F#P1Hb`-QJb"S2pdqZNkQiBq3U#4"Fc-VcLjR3SG6-@mb80+Qa!LfH
+4bZS"3rU)XA%2UkBDEdjD$jdY,(QA(l)B5`5X-EbP(E)!1UNl,XpVJ*5XI2&[@p6
+8dP1a1Rr@*8&qZTGe,p5kYBCZ&KC50jShML)+'k+EHE'*P215$-1!!SjZAQKQ*FT
+"-F(p,,jdd,$d`1*#VM+p`%3"m3BaYG+dEJHXReALC!46-c'G%00*U4I@ZZH9`UV
++SCLqcHU6bA!A#9immSJLH#P[8b(j@%!qqfKScfqcFDKl16c2aI#U4Ge"PBMke0%
+3Ec#,T!Fpm*ji`'hqHJd5)55`(I1mPBD6@bhBG!Z,&iEAEH4cTXI,Pb&Jr04F6SB
+&+$LP5GPfPMIQRrH*`Ra)p@Gbd[!NM94E"iYE$3QiN!!,IK)Ald-PZEJR6A4T9Te
+KRL+9"-%p$--"Q!4SCI0"90#ECU*9J#82,23,A+8-LRchf85"9rfeLKQGSI)Z&l0
+5U2aK6"5U4kr+m85PhD2,ElA#k('jU8ZZJ03'#m%EQ)UJ'$BT3Uj%p9Y`"+TIb+Y
+BA-KrbkS[6kXiT6@qGNLTqQ)k4+dR"KMQZF1+!N8"86,dA*ZKlFkFk20cdK5Upp"
+FB2cG2Hd8r$!cG#@$K)-5q&3C5dJ"DGaGr"dHcBp%QcJ!#ereDX`m1CIQiMZ#A&c
+qNallYFMEMhJbek,iUEJ@a)p,[A34"I2`aXN3U4@)+rB&E0UHN@V[NDqUEbU[9Kh
+jUR+&mXSimY@Ah-UV%'hYDFH*9!G[d4GZ3L$eVc,Q0E5KDTL8&d0KGLjXB4$CR#`
+GYc9f6*F@Y$hAM5N!AECYRB8VZ3pM9@-IaLVpADMqM64PmaD%"P1q-lm)%3j[C1'
+b-LI!1%IJm3#V9Fq)@R54KDC0"SJXX6K6U1S&hRC"UZr[kr@k1mVVr,jHIfQ6mYT
+la'Y!X*XAP*FKBMHHCXBL[I+Q523j#Ul#U$5l@U9pjK-3%19`%N)jNmY"GS56G%6
+i$,!GB'+#d!pmI!L6,,2++GX5Jr5HX'b(9X0,6%$[MD#H`KYdPk"dPU[J-Mj%"lJ
+1Q!SG`jMU'jm-6pT"VMq8,3qD2[1Ff%$#@@)&#+F*NlB,dm0LV5L+lTb$b5icjY'
+09Q3rP"cqfe#*-&F')66J+fP9#)QCNIi1!)04lP#'489#KDEYq$&rH38U3[X)kIQ
+T[`YEPH$26SRV'Nkb1Hm0%YkPcG(e(0J[EBkmJdR9c`mLU39cL*clq8'IRBkedV%
+Y4VYEiS82RD`'J'UYFE9h(!'fI8&'XN,&L656k'4@Fla$T#Ji!H3Brpl"qm,8rKF
+1mBTAa3'B8fQa4JE'TV@+c'bF61i#M-qRhK2-d&%PpI!N-pD9rr-qLSd94IHX&b'
+)BIi%Re1YNR19P3ZKZDGLeHSi2TMmiAjSVM+f6Ph8Lf+fS,@b`BM$Lj1lkd2jVA,
+1"JDe1TS2aN,jFYbU1Y%&+p2!m$SAXF9BhX$K"KHdKBJYX8U4&[RrqAq4rm*rd52
+q#bVrDIJ[J2rdJl)@T*!!,-(9KQ8cR+mH`4q#&QS89L6"JX+J06EN2pZV'(,0Rqh
+GTb([j03Z'r*rCp(*b+hK&L9*9jI#i9[PG!92IK"Ef2&RHr(!m@%F-aG*Y8YC,UF
+0R[aGE-%DXX4L'9QFI+bqV6f%"8lZ#R@p8f`ddJ+)5cXH89em'jCd'e9R8X*-q$B
+)pJ5JZA+VUB98UbD9fi"U6EAq)b`Y9VHJ(3qTbH046K2%eXAU+J*JB8)8d&ih"N3
+hP&[Cl*kaXI1)adQGDa9e,KGe,KpeV[28ZD5m$(,A#-Eq(hLEd'hrSrqUFCA#llS
+D5ShqRhkTT*YCHH40di*(a51*lZ)9Mcc$UIHAlcE%,U'XT@elE98PZB*-,SGK*+0
+[S-GbBMA-RCd)'aI,""@)5B869j[P'iM(T$V"N`JVINbLX[$jY)#(Nl#Q[9@qb3i
+Fd5XKb4#%&@5$%j4m-m`[PL)5ar,K56SmUNBGFI'+PN5+hpbphTHd%c!6afX[+A$
+c*0+ReX'8,j'*-)+je,A8caiTqipI,(&5PbT`a0DrFMi@Ne%9LFH[j$%*Z5-mQIY
+34KG4J"X'2&iP(3r`iDX)Dj(-adYQFVDFj"6e9r-b"(E2p((B9hN88li9")5fm`U
+c'HFN!XTJl"8QHeP1"rhm)`D09k"3l%DFB)pPF1%%mBRC#UIBPF+6iU3FZhALid%
+FrR1IM&E$JHAR)'F'NcH3!$3l#&55Me0PG$G)hFl*i'2A!FcBM#X2+bc#PjQ)6ia
+*Z(CZ"2Mr5"a(F&%!mYbqJjMFU8KBfXGLch#"YTdXLT!!%LrM!!Y(rKarAXRD8hQ
+%9mc3NY-+1m2X#2jXKJALX&b8$iH8d$Se()SZ,3T",GqpRK`'ee1"Me+"Ab,MJD-
+IG6!TGe0hNj%@kR`!)!!dZ,2fiMpZA!*jp'AY[IRLDYX5#(VE$!jQ#2"ip-8r%)0
+khEMb9B6M`hB'j`$NKBdCI0!@'FM)iC!!#6V%Ql8lmX84bli1U4Tb50A33f5*[K(
+jI2T'LL0$$UNEFNMG%BHXd6FLEk9[T$Jkj*!!fL'(e!ij4"ff$j*@[-M$p8VM3eJ
+NRTP&#bHEpkcGH4d`CSB-%fi[Eb-8F8Ia%e80'*i'!l%10Ch+ChA6BC(CK-JQGUr
+h@'H@#R*,qlEVcLXI,-@UKqhiUHc2,eT5Bfc!#+RIKZQ8`)Rd&%bMR0dpm@FerU`
+%,,LDder-4-C@JhhEbf%5`*BjU+[9-+UY-1A9Z0Rk%dk5`Ed5i@ipf)GP#*YA'ZL
+ZX49lAZSpfF"`S%e0TQk`![2PcdR!I5[8(#Z3!&i19EBcXpBh$R*9aL5XGiSlHpp
+9I,Dl8q31@S,0V0L!SkGPjAjPkjF3r"R&HGY*hrZiq)T'IYfVG`Fq(+jm8Ee$8$F
+!!lB+aDeh!`9ZL+B'P-k3!"`1VPj#d@R8#4"FIkQC1`'+Z18L*8`h0ifF(Za`k2U
+@G"K)T1+j#J#mcTbAKDQqUmiTPerYaH9HR3`93SpG*e1r2GLG*bDi1fFN3)068!V
+rPH!iG!!8iEHr#Y)+f0D1&fGm53+`cRad%fRDQdJ3G4RcM9d,[qHAk'KM@(3@4G#
+!'bm+kkbM2B2N-)#`(Aal22,LldlJb1a`9VkiDAJi,aZAN!#4)1MGj9m9CjMIG68
+l[m-be`dch`k`i@aKbR890`FA+f4X&,#*fP`)2(DG0cDAcFS0!l2DBR!-%%N6,VX
+`SErdZl25Ymd)SF$Va59"A`IB[5QcFFmQ%1S5*Y3%i*FcD-`2i1EjdBeU45&`0h,
+iGb)KJ53Gh"-,!IT3aaqJQ---IZ!bYl!$b3N'+LD,+IZlQlS@E%S"eh$hJd-8Ak#
+'(QQ025qPSfXCYMSYBpP"N99[eH&B9YDrb&HA&FQ2VP5AM!E(JZIPc&Ke&C&AXcK
+SJa&Aeq*2$3GBaY9R5L3Vp!([q0($dS5*ZNK!%$F-ZTc*3*pZfVS4Pr'0Lmfm"1T
+p!++EmXb#Z"JH'(bXI1QTkNUhDIcJceI$A4NQad%1`VmN1Tp,"('aFS!#$+Zfj+5
+R`![B&Ghe4fl6Zj@A'5%3"&jX&@k59DQ4dc$&+4B1NiGY$5,eL@VIUpiq'AKB6K+
+)Z[`f'b'`NV(Uh@cDU'Dj##80&`!$UhfXZSb*b93NV`%3dVCdS[-2+-jXilqi&lX
+Dbi1e(iF,*BcDBbHB+H,MN!!`jBiEcr,QN!!3(&F#D4(@1)L!M"$Km"%CF42a1%k
+Nifla4L)SYa"qR[38&lq*Rk,L*(hX+Pl1(e8h&hPe&9M"VdYCADFqPrJ3T3mML3m
+DICK+I!M6KiV%K`Kpb)d&e!a-ZV@k4$A'!ZiSLeaYaM4#de51'E!IL@@SYVqkc0&
+Y`NKm48MaPK8F)2,2'B%YR6!kebq[5kNSdjeFq!A6R5G6YP#i1rp1af53!*QqYSj
+*LDB&8-&YC`#5aKmd26l,DMBRIFe'R02E6QB1Grk%A@Qf(Rd$DV5,e'McHDNc'h#
+[#I0'2(,G*YU3!*5e%%8,+dG2NVEplqM+j5*%&d+&X-YBf&-bVlQY,bI@0,%0N!$
+BaNPX8fRXG#q*VBr%GS(%9Na#Fj!!d#k3!0"8%PQ[kNJ)kd&#6!-*!De+L#DE%%S
+"3[%U3ZP*#-9-##8NK1+NE[Dd$3lXQ8+J[hh$$6MfGAYD$#SLlmBYrh(XU9M[XAm
+aCF-E4qY4$201Llr,0j'k`Fk`dq+BImFR+GFD'ad@l[CSS+2GPD)VUk8-RC2b[Xb
+G5%"S8!h-,SBG(5YZh(qH!Te)GFRp#39b!86aY4VAD4aK"HLR-C%6,Ye`b)(E'UZ
+FacSCJ-B@akTVETkdRE5d9YFk,9&,V$B@`dfGd`*bNpI*$@p*YC,+L1qVq`m&TXQ
+&Q"c#@+P4F'#(%h`G1m&lYc+lT#Lq-,SE#hH-K"XQXFkSjq%SMp3#1Db6d`*Ak+N
+(QBX+"$GLA'9`*r&!5M!LXP1"l#S1H!!3PM`PALZ(@2GeN5IhkaIaa$q(ce4dpPr
+HLe@KqL#'!&@jL1d-D$eTFCdQ!%J!K0mM1$!YY@)51HBZjdG+`M2m$4C(bUA$Vf!
+'5&L!Q#ERaBB"@r&(Up(lS+&`8Bd@283`fb"JaN%8QKUKL8NT3@HQMH'ahdQ1DdX
+Tk$K1Vi[dB#NfSX#f"T5aQJj2i@G-CSSYB''+*T%HhVJ@PplaS1R6%GGT+!#TlB*
++ZF"GQAkX(YGB8*dVE0abA@HB#bE5MpPC**!!1+%,-(M!fAimmQJhZk$)(BE,RiQ
+Xm8Al,cYZS%'5mq2fkCq*`"m*0Ra!Fjq(!)iY`VRUNCRAa-@rh`I6j-@X"NE301+
+5r0K)HLE`!!6ir98ZGY&IQ(N0+Qm%CPf-M`AkH"q2M%CDmD'C2XbLH%BjSHCMdmM
+`mQSEGiIBb)RpmL&Ud203hfPqDI"K'9RkS1R&Hhcjf!LE1QrH-iCM-l,R3G1L6Ec
+bAT)paTIa!&*0q%RqmTl-b@EmC#@#2clqXhb6r#br`%2SB2TRZr6K*bc[q@(d[SR
+%"K-ZrV%[RYJI@31bcBjq)qiNNHf9G$0"0kXcI02m3r&!R$iH,2"0k62dFDP%ISb
+2EI4!-6h!kRq%b2j@RK+E@di2q1L"l@*KT&@`#(MK&5`[h46STNCjk"h&f@M%I8S
+dNU+EHh3$Z$mD*V'@#UDPXAh"6XCQ#SLJ$`D#P,)6Lfaqdc-!KQ)PXm%SRY9'[$M
+IGT)*N!!"i$afX1dbEZ`2Q[C[9BL4M+`fl!c('RD3!)PA-Nb8A[R*CE$&Ab6a,ZI
+Mm+F04ejL4d1%#fZaZ)F@Zf(kbh$KVEL`Xc!IE@G`JB%MJ!0fRN5P*b@!#3%di1&
+b5JCYTk2,(M3G,Q@`&lfiLe4(-9FGM5HmV,6Zcc,mLb*MakA9KL[,cN%e@3X)m58
+i)1edaa89+DVH`SfU$$Xkc3Si3Ec5d('dJ3-)T@)(A,TNcC!!5`q3!1%J6HpCG6G
+b8H-&KLNYS&`5KCCB+&bJ0aGKFA01rQ)JYS`1q*j2`if+P!0!KYJb6kqbU3P5#(D
+!1#Z10R!5-VE5b9@+rk5"+K@r'bQT2eb2VI+$FCl%YZ141Z@4+[%4iKB68e%0*Li
+PeqdA&mH8&ihi4p'e8NJ1M(,AqQ$Y#(8YTDZR)03&lTiIh"ijMC[lJehpJl[dD9C
+dp!p1JEhm4+L0$piI1Fd%&C952@%LTpp6Qa9@K5VREr!*-RZ)&&U5&"(-&GX2X4*
++Fml+LZBeihZDbFdILDk*)Q0Cqq``Nmc',YrSD2cCVUEfkHLYpN*Jbh81Tk!!iL"
+QJFFk1FMl+JT#GMVHNL!(fU@daJbQiLBp`3h@10N!eUR#E64CCZFbmeZlLi`912E
+9GLEf&%4NC#FlVIZXSYNC-8RXXS)806Pk@%4$Y("DJb26++,NVl2pXeGS!q'dPl3
+"U1,8Rra1DXqmBF`A'Bfij*qmJ82#JqP0Uc8ck#!5T`63a--D%PF+qa!ECSBG$HY
+BGFhkcrL'dHfU+1(b(-LAbBj-Acr($a@NVc!crf-d4T!!%I`!'-221KP81GfSF4H
+AR1T-&U5rh@HGR$rb8Y@F'*eJ%QLe(Z%J%+iBib3rTeQG[8Jif3YqGmXcYR0)$[9
+E1%%r'YcpEe4`Mk1iDm'!GKB#Hkic%*'00pjFX(25X[(QG)SHUX9$MkZc#!'$Khp
+(K@mfhVaIDQ`mA-p&cVF,TK&3MTE2hYMpEb#&JipRq,"CGN1U8CE3TqN*-)mhd05
+KKTCSI"N)lA'IM&h$T0BcD`6fk%*PX+iZDZ(@AjjN9!'Fe3[C%#I*[B%pD3eBAV8
+iHq(5@8FQ!C-VQ%b5Sqfdf13!2QVK!kKTMIdM3*)r+Sp98A(9SF+Tf'F-EJJLd[P
+9DB`E`IJjGZ3(Q`Ia1e(8Q5,!14NBQmbLiic*(+A6DpM&KpP#&KB)3#8FcTVGNEh
+j#cmG#)ahMrm84FlNhR3J550FYmLGV&*[&N33B![Bj)Qr2`mS[EBJZQfbS#H"cp)
+P[m$'a5bDD0JKFcUlpU"Tcfe+QdZIbN`ZQ1mHBjilYYGX2!PR)5Br,5!lJ+6l,h0
+&MjkKl32D4TI2UBCKll8dGL``JFVeYXSFJ[EDhM1UlNb9G,c")!G#pP@m&9p"040
+(QSpemV(+K91$&jiY*iC0GaEBcZBkKX*%3HE1Sb$aB-B3KFQTq4XSbZhdf@Q`3a1
++NaSF-lXFALV4l%aQSI+E@H@RZ`B"P26Ua8[0!FUXNS([,8Ub(BehVV!$b+h,e%L
+,S$iB'6E1#E9#2MX[)&Ji1i9BFBfL3Ec258j-GK,),S3XZij(&@9Db1PLDBT6-a#
+6hHF11"C9b"6L9,dGh%aBD85a(Fe*@6PHCcHF"deE$LPNr6RZ-%F[Sb#3!%M)j&8
+R&BrCeYeiilj3ipp4arRM$aT8EI%(hqc'*UZ83QqK3M-6!NmPK0-1FH1PSd%mdYJ
+U8p1bHZH3!!#P6P%MKCNVLm`-MfEECi+BM*RY[d#B$*3aV+F4f)(,id"PQcNK`J$
+CX(#FME5eFp!UH`TjNb(m+"cI4'Ve4dML9rRad5-q2)d2*AJS#%(9CHITJKBp"8*
+1TD@N-Nafe[+h8`0e1*QaHeA&HllQ465cPelMZVrAFdd4h(1UJjh"6U+VSVK6jf5
+T9&h1UleA9leRaR'C[aAQ`-E`k!dfJ3d@Af'a@cRSK#FR$[+Nc&%CSBTE91X-B&N
+eVL5!VX0)d)!ElSIerPjI!8CS%YYKGdFA,A3305!6R9Ca8iN1F8kU9ibI'c*QS%b
+bjb@CeJSbq*a"kJ0N[`9N[mAJjQG`T5mfMriRM,lHb)2KC'"VNjUN!,)HIcBTEN0
+@+*!!4Qbp"e9p'e[V)3F#cCh&&P4mr!X8bJi82VZU1A(`+kc!U(XTcIP*FI8)a3A
+'e3Ib-k-EV$,`3$Nj,Bc&0Z&2[Cld"r[a&fM#dXJK)EUHrD+T1-+1jZ!b!G#L*[B
+f`-ZYF&(G(LZ(JqkZ@"QlkFC+m2,*@!hBSD6#L-P)P@&h@"T[c!lJq#IaCcrql1)
+K$ll&T8Z'A(U4,id+ELA5mQ3cZT0e,2Ef"Xdhi3r#M!jZ`'G-9XkFm'XHk`E0Bam
+11%k)TJYJ6jGpG4QFP54-UFBcc$q0@1l*!1#1a'VBM3VSa%G3%$`Cfi'P`SQ@PJ,
+f"1K@YRZF'pZUc05@p`,dc*VlIK!ZiQ8`TUed-DpbX5FpeReYD%B!TmXi91'QSh`
+*L#pAL1Y0d1)Xi-A"`$hfbZ4b8N,Pa!3$U2ce26edN!$-AYG"c5`A5NSG)2-cdE#
+K6$6)K)T`*K51bUre#i%C0JHV0QIlTQML9qEEM`fe3!eCLF`B#49N3!8C3JA&UN"
+31)bU421H'XHCJRh$M@QjlTdKLQLplP*P[#"E-Zbm`Q(1HL,9DkLlE#S5hD@GP'2
+lm)I#U4!2e!Y'#FAdLM'PG*F9qqJ1bkJlb1$[S95b5TGS9'A`(@TddhTH%JZdNS&
+h0Lr6[#ZY8R%C39#LUcd8Ble3HE%9KA`FkNe*J2D)KU`%ha3)QKXP81k1fNG(2`U
+"VP3[c!5K@Kr&Rj@UAeH6`3H+bZp#9`!TQbl9A91#1ijia5Dq8KbS*Y4UN!"CrNF
+pe#8FA4"0kkrC)&[riekX9EJGFN%TU[HRH(JP@+q@Q@-JBUdk%8-)$!B+LB[E"Kc
+B`I6QmISl5R1!eA#F-jqa)AfVSF(#kJd$#be`#!Se$NcE4`(ES*&!lGl@f(T1$$4
+C"K[VarEkT8rcprYq"MBCEMQVZ,JL6AP2b"eYb[[Hjb32M#p)UDQ$p"'X9HcJBjb
+i23Jc52&@1'dP2KpY*9$!PM9*E51&H#kD&84R#5EHjVm%BL2PkR-DXefFE,iE4+S
+jc)hIZDQTIU56)GA9j'#*+JNAbbf@Tfd-pB,Tbf04k1p(BQfqm*d@Z'AB9'C6Pm%
+*i+HSe#&ZF!Kh[A*eKh1UGfT9#j'DlkD4'T(dB')6[K1J!hBSj14XKL(k0UL"0VM
+VPkSIdrB$f(kF0iIQ3khRSZMd$%2Br-Gm"@iUi,(MdbEqG#j+61chBQ[8&%dI`P4
+'8STDf*K3#M-kk!ded!M&Q5@eB#1eB([3p+-qaCee$4cES5!*e,iX1JDR%f9@[DQ
+SKieTbN&Fp$Ym8INU+BL03Mf`8+!FE"cbbbbBb'c@mXeMU-!Z48%BZKRh@ej18FM
+-MrLJ%UL,Yp445PU)EVfG1[03aUm-`h*BGB#'MkE1)5Xj*ETQD00jUj98KdQU)k@
+!IGm'f1FMX1m2)R6qZTXK6*!!SbC1ChS'+$`H),M[6LDS1JZD![IaKRA!ckN`P9D
+`Iqf1$JEh%,VZh$Hi&r'aNfa4a0EZ#5F*T*Ef3A#1KiVKMEb*!B!Bq%0bk`@`bbj
+$Z$YD5Dhi#Gir,T,lFK1VUSXIb[F8Plb8!RMEQ9"LN!!,*d&#B2AC!#D4j2bA$"2
++$$F&D2h,,+c,+`Z,r[V,Q-(p"`d,al$`cPpZiGGUPB@+ZbR"d'N!4QEI!)BQ!!b
+V04h!!"5Q02@L`8G'5CfdF4&#f(Cfd"ar5SCMfd%BcQIm2,$'HFNKFbEBhk'1)H!
+pGRmL%qM['0@HlA*d)hMY36,dZT)BM6BHQfh1"4aGr(Vh[qQ[PR9-2fS%$RHbZhC
+f[[(BJJcHjSlHH'aD"Ld&9TK)"+#"a!3V6+J*'6c&kT3'AhS!"9qZ+#S-&D2'5GQ
+AUf2q&c#-@)E9-"eDUaaCSKaBTaaBK`0hURZKX-T4UEKq&,0(G"&5PG&A4GI9hF[
+h@+"DYi)&Y&$k4)2U!m-`a`m&YeY@bHJ*Y0N04JI3HLbJ0"R#S5,S86DDp2GlC(3
+YEa"ESJCPbTDUX+AGl$lD1,$`,#C*N!#03dGX6&(K8BAJ3Lf(KfiYXSZf&U5YfDJ
+a%4KJ%PiP5)X0SMAEEKIbaf8ZZ2[e)H),pAINY2*Z4pIZeb'qd1(V#DJ#iZ181Vr
+HrEVqUJRL+i6ZDJaT%%J#!8Ef%N`#!8CXIAiMILS-pRNRYZ8DI*4K-D9+1jALMBY
++6&@3!-GJ#PAK45e8P5K9CHA33Ui)4Qr+Q2q%M`dlL6jJ9mHiXR1ShSB6f-J-0K*
+[2)'0,!T4#2)T"MA"!U[r"V[pm++RrqpaQI(h6DR@0'1mZ4!Q`lNj'hCd'r('lSA
+Gr!2(J")'iNiP1Ih#F,PkM6mN+K4+0jFK&4+1K4&8Ce9LUmHib5jY&88QAaI&)ED
+U,qB0Zqd#QPGFkTj@Ri164*XlX-%#"N'$fA!$hUe)Vm8j9DC@m!"Kf6L$FA-@K$h
+4(m1K$*-J*N&-!TKSQ)3a#@$bjSrCK3`0+6$Cb%!KKQS4PbSI'U+4`lT959'Pd&a
+!!e1MjHaMmmYZH#DJQZ''CAb-SCpZq*`VZZN6S$eM%`m'jBXA'2#$`@,E5AGXJf9
+`k#CV'Tb%aJ00%dd-'"RjM-YYrY"f&ki"*S0G9@!H#dCqrHHB@ADkN!#JpXFUGIJ
+$lRAR4C+Ki&FAf9&8lL3SNJ()QbiHeUY&54U6Hr#,R6c)KR[l8CX4aX2elY3c0T!
+!*T!!Vfhmb"8HS#r9!4%%TPI!%E4C6aK@EqE$I(C@J6!0K(")830JaA"AjHQhdq-
+33eA"FHa&H4Q-h4ehC)l"qPV[H&(UZqqkXaL3!!rKL(Hm$`P4[S'c)&iE3I(#k*l
+*'`iNDbpc3``-qBA$eSmDUE6'&A9F@+Y%3kb*Zp*)FB&Lb,m6D&LcpN(6(qpLm'i
+Z`-0#(6k*+VZB66M8@9J#Hjrd23FeQI4pJC4QPI-&%(a!k8Cm`2)6Lm-#0Uh+C'L
+(3CR+KcRG#%&2cQ-3ZVH&qdmf-'ilE+'YZMJ%EqXXj$r"`c+&m!r(VIFcc1!40jp
+$`R2#J3XDr!N+$@N,EE!USLN!1f@qX!SE(h2QH3JZ(1r3MqE0HV4qr0#fl95&#E!
+f+3(l*MIhR8jVXPLT3pIS`R%`4-aJXjX*8J8)K#8U"##jqQ-"*2YkQ0$5Uc'UE$0
+HVK8['CS,Tc@%("cNLN'Pp10aBcd94`8cF%qTj1)fc)a&lCRNLlBS4b0CA$fZA2D
+iFPRp*4)Ee6RPjIZ6Y*h%5c4%U$D9Pc2S9"$%,rSb&a0!Cm8eGl'EZpT'G[mbm9J
+,TCe$,#"d&iJ@J`2@5HfcR*31%q#BF&89#H,dbL5+b0Gh1Ue3q[T1*e,%qbaL@XL
+9(%XXj'SCL9ZZ5*bhhh+VF&(C0SC4flMAGAU`S*'@BY!iM#DKc"#Qe'D#I9`cq3r
+bdMS$%)H$ABMJmmbqp*h@'dHBLiB`19iXQ%N6c'3[c1-j9LGq9T1Xe$j@AUeb1rr
++@aJhP[Y5hcapCdA8Q,XirLi5k*aDN!$b#D2I@-CX,a+kB,9kRU!dFpLiRZRRe$-
+2)Y6c2#@1+d@5RPeKhPZ$!4h"J2TQ%)M8'XrbrlpLej!!prjF'I,a2EpaF9,U!d#
+qGi&[Cel$B99Ld%0Hq0%iUUh0j)J9"&ZjZD323a3D5Cm!QTpAHifN8$AF34SkTmj
+c-NmDRf2A$,ph#Li@+DJ4X($iK#BeSJ(4*"UhZ&Yi`XNbFVp%ZS8G'L#@fhfF'Z1
++hN4L$)`h%[QDFAApTb`kTESjT0f#A(M#[F$i[1ZdR[J5aP!N2lN5H3GrEVRP*rR
+)Rmjm'&Rl,35l3`L@8YkP*&ii)Z#QL!C[UJGlldGkqL(Zi&XZp*hHKpM,@1a-LV$
+G)`@rr8&6q"ShkMj!m)p5`rC(rmUE'6G5qa*qT-2S*H'[*C'I*B&M!%lV8b6`+Y%
+&Il9#%IDXF98IUY'leHMp-J3H@8-#4l(pkJX*JI1Y6aIiVm)Nm"U!jMAZr&pj[Ef
+IMX04)(cJKZ!LcZEB1`2h!J#K[A!Lk'&494fL`8A,Z-'eBKK5lZ8`f*P(TlUVUh`
+d98QB##q2r"i9JPPC$A*3+22fAMNFHCY-"VFJALPX*Krjf$"j)[I#eCT5526jVCP
+2R,e-GZ%5mI&N%L5V%XYE*pm80qlLlpT`!j&YEZ0%FN(#V(#a(pHb@IP'NAJl&@P
+&e`,$PKkSrMmi*AhMY'K@#*KbCjm`3T!!0'1+M,"+L1$(pIXf3P*)!KCElSNlqiQ
+B13b6Qi&Xr)0(+hT)c6jS#Xf#N!#Q`!Bi1(RfBUI4+`J-0b6L`6mh2`'Mkerr+5H
+UZ"%m'jaqSEkd#c%$K)2LK9jfNNGea)A@dSAZB$$C5ZkZZ"!U'[Np,Z3iiN)fG1K
+q5QU(M&1b"d-*pr*P-bpc@3C6*3h53Zj`P+!!XAp)KFS*0-!!",2f-60VJ`1-YL5
+'f')'+V45$'AV#a&VY%X-5FXrk)*@L,51'#Q'(q[F1H(%NHPhArUK64dH$1Ra`"9
+XS"X$$&"!cdbDB4i@V&5Y`NVG6V"4082CU,X40B@KLEXp*V0eMJib",@aBhDr2Th
+1mk#Za$3eJ'QD8jLQNN%f#4eYm+E%%!aBKm)X055BTGTp-8YF'%8S$#h$V"'k!3p
+cfb181$j[B"C6qDc4jh8L&)r9389Z!Z`"mdRVE)G5hGIZII&I!G"h-bRcK088QPq
+Qk'G#$49amUX9`a$)8eB)d!5i*Z!9#aha$&ihC$@&MDSDC+23q$0*JbT-%E0cNeL
+dkRf`D0A1Uqa##%DYfY0-$4E$F,q&DST-#1@ZXf,SHNjL[hJE5@E!a%B-'QVCb!Q
+(03bChHkaTYU4"Ai)+H'8*iAMK)[FU1Zd3JK3&(BR19@JF'*9Z'hQ,TP@e!`NJB@
+2VQ3e&&bJ`@b6RQ)U5LMfGE1L)$dUNqZ845P#Le+%ILT#MB[32r"#aCbQX)*3,Qd
+0K6`(c8F`JpC%JD8aK()r-i3Y3iBXi(#)ZcB'T$e6F4&EI"hG&0Y5!UfEECFcHGF
+8"K01X61bqirIFUbkk)i"D)9+IZNlLaI('I$ZI$M`dU[k"pm)J9%me)V*Jd8A,0`
+C-d+mqF4MFe!UrXRjPblc*``P(RdTKNqI,8LKkZQK1*SX3(4IVf*`$@U2e9"X@Gk
+M24akkG@QQjJ%AVU9GS!fQ$,@AIcmEf#3!0d`PSlLcamP@$@6"hVJ"lk"i9aMkh#
+4j`XA3H6BR@FG'*hUEf+B@SZFV*LqHqhHc#Gik$MqR(I,qNmaZ#fjN9"bi5c58XG
+Ml`"dZ6A$!cCq'mlbUk!b,L0eG4i*VZ@H1HXm"Qbjk[8$#NH$K29Mr"JB'X[D&")
+jD"$hQd[2,F6@`iQeGIVHrD,B'Kp$p$3dXJGGR3Hc8Tf*amc%Bb&q$%i*G#%--C3
+ie(1)&S2!Q*IG6`ZQJVDjJakHBjIE@!XHh`&eCU"D)#i4Q-DF((rA!hEC(0(9V4J
+Q9eHhH$8MKK,'JV1Nc%0-6PM"*SB+jTIZa%XNYTfI6bcUSaGK3@J1@,C+Ire,GZl
+6dKBDD3[$"bb-$PQBGN&CNVB`GH4#ZAI)`T3cd551AQmDmYT-1rCbfV(f!ikp0Q5
+KII"B(VTpqAVMmr`L5Pe3rf4Nm#%aq!L6X`*5d2$jR#r#S,MCH#SIJC1$bqpShp!
+aAEZKBeBcNZQ$Mr$!d'!0hbCQQ-'$CQ)9'a'Bj)N&r&!80`d&VF!*iF@l-@ABBM&
+m+N(cXHrc!,+4EGm86!GB(&2Tp)XA(pC%&qF"aCP3!(3)hBhKmAU3!)%5'Mi%3m%
+2,iYN"E'Bf#T)#!h%HdUD)fMm#'DSb[[RIAmNh&Li-bJ+&#TcSJ`U%dSRH1Qe)5`
+SAj!!YbmZLLkkb+c6ZM0`1F8N8NlXRRM9l-i5)cM,"bA0elaL',HA1dVZ%ZcRZR0
+p#L-D[$4iR2cBl5,#kJ+lPb,Qf(KY5'"d`)&Ra3#LB*G3B@mr!SkEDmF`V(`rQR*
+#HE%c,"qNLDh9[Zc@jN3BY)lBH`*(A&k,1dpEd4#S,#FA(P3r@X1",84cDbD[jMJ
+`B5DkFTGH)APC&*0m(dI&9V$La--m2$%8TCNHY!UcFjYS#P0*,V#9"92Y)D+54N!
+f[p9hZVqGb%flEhGk%-0'5)aQ[a1$a%09qhNBH,'K,j83$#'raF1I*Kjq)[eKCP"
++&mQP'CG2GBPJXq$LSGrrDIShX`pA5)[bca%!""-NDG9&GTQ+h"2X!`hLcDR8j+L
+!#2'2'e$B8IAJYdpdj5iDSGG+-q0#$,c8S`qi0%EK$3`cC3T$jJ1p*JqbJH%fTSa
+3Z['Q-L1R#fH,R$pmedKGX0bYY(9NmR!Gepap2+cf"BZY`jR2!2CY1rY*AM44SLR
+pdb!d06NXTDQGJ'LH@M'edl3&8bY0$8aED1V%e+"T"P-R6A1BCQLDa64(dafBCQQ
+kL1N1QPCJZNM62+B90"h!0%r6F8`(D$U&k6K0ACK1dE3A8aG0qc$YTHN)R-qmQ3!
+e&j*rSf8#!afI$%J6IqciBm@I&[`aM-!3mT`N-IU+Ib2%k2bm`XMICU2!2eC`@9F
+hZK+Y[TBBdSLELA"h16LjA$H2)#HC8J@`#@$+p4F`IUdfrB91ePGHQlj,C(dYrUa
+KXXkKTDFBYffm)AF%`m2ppSR9[!PqKHlGT5rqebrHrmf"Lhfc[+9UE[$AKZiG"FP
+G'`Z4Dd#+"X3ed05Me[hQ@T8*V@m1(`dN3RIXDjNlYZpP81C"K1SG5(%91I2#PIp
+00aNS3b4YANHaml[r'@F3I&$"eY*MA5-%&94Eq",9Yp%NlR9Q,USEPQJBc1SZ[P`
+e*i1ErrjHpHhB#&hqIAk0-(i"KpD,3pH1#9D4Km'(dhU#3*!!JN(5A#F85V(G1LH
+G[8S$kVV41!Bd@ZaMjmp+RF&d@BKi6+eh$SEi)%F3&LXV-*HASG3C3Y@`QC&#B+S
+Lbk1Eh0afaRY&U&JS4)8PMe5)iAjm8FF0j61VbDF'2b1pN64k(3L*q"+$c15+Qji
+iA6#94Z31LN*ah10LUVj'c*@XhXfZ"%06a"HYBf,)jVJB0J5*h1E$ec2fE4f&+k`
+ZMB%F$`I@M&3+1bYML"T+CphM`-24cBmdG8fA0AA0XMYbMp'YqSaH(Z"R@BG[F94
+c'mpD1$AS0M&NhC34e)Y+f@BPN``8dJQT83VUM,KS!FcA*mHNpK9F"JeCZ8&,NJ%
+S#R0kM#iZ"S2FRY26$"I*DC@ljV9,Xm9T#TD"3MM3`N$HBE+ihLqJYJ)B#,K)G%a
+V'cVZL`IFp-"34Klr$-LN-X5iPP-5jH1*)daL%KcEISH4Jck8XihYF!$f'm($RF@
+AfNlUe981LS1eZL*RGE!a9%cQAkHVJG!#IIKE2K`%cDi60)E8B)BUJ[,EQ6`(m"6
+XZ8EC,DN5L5q6!dpM(K!m4-53!1(-PHpIN@(m39,QqbJf1)1%24PbNf,$-M'i8`@
+(DCcF@EHCBCf-r$i'lSHTGIJHd+)*,%SHX)MKA9ldD0UL#5cU+6+IH4FNK05JSak
+&XE(r"M-@X9-AaB#4U($JB`ScreC80p!i3U6qT6qN$jmN"LI9"IP23`9CSJXbHSZ
+K!K*NL5,)8,SJSpISJ5-%'AfI"!R3+6SV""QG5KaK6`L5%eSTAC!!,hB@QdF+-YT
+-JNcT)+,feP""DVF5JLa4S"L4dUT*#$2mSK#QHB!`l6$$"LHE`&6K@IkI6#e$`'m
++LGXH#-HFbH-R6S+bcm%!2+0$"I92erlQ0bbSbY)d3GNK+2a$AE5XQBr&d[JqPT*
+CI+NXE@Nc,G9SU99CDMpJ+FJK,AdVEDQ9PmUpY,4(@GUmMkAhDDNlE@N2,@fJT5h
++8ZZ4"SQPBVYcD8YEX23#,5apqBArM5kjZ6TYB5N@PJ*1EaAra%M#Q-1k-9IVaX`
+Qp%5k-8I,b*K,KKUc'+#N3(#G%8`-mbLJ[@fU)F`"N!"1ceE,0pV"PRi'@q!J+#3
+H'6Vib-9&"[fHk#5SCC4CibGZ+f&5#jMGU+FCJ"!23"8fPd'6%E31JT[R6c-)Njp
+i3'"ALpX33BU("41NS%1Mikap&-6)-m6L9r)rTLAV!HrkA9I(iZFjR*YA`VQVD-C
+qBlTff3hIqh"%d$EFm,P'JlhG82#"SZ#HHTGP5)FTF[Cq&JUHKdaN*`AAeGa'06j
+cCDlp+eIBIC!!Q8dkXRYk2alU&!r0)4KcA+EdSbB'6k(0V8%B%rDBR'*k2)l!B)!
+rk+%)!6TKHSPd&BD6Uf!Li4RPVQ@ii'4X6l$XqLFcr40qTJ3VrhJ+KD%TX'f9$L6
+`)'0i'D)`'8!J-bH2Ka3K52QR*!BTh`'3!%@1H6$JfaNiVP"K@aide@CSUCdArXX
+!*d2%j@T(FAc62aqLebRpmcqAdqF1%C66)JYpZT2fD3E(p!kT@Zq3!'T0-3M048c
+$RBRNB&,m3db!DL5FlIhVrcH(#$4m+Lrk(+AF`NCF$'A'F%`D["!Nf0VDM)GiX&F
+!`@2i9b8i4BG$eim1$XM'$aCrhADbZ1HaHKi`*hU5r9HZQ9YHXQ"BC'Rb"c3[KZX
+MdT,#C5Ne#)cc2hl%$9I`m3M)2'S*aU3X0[QI1pRADlD5iTi$Ak-V5[lRm,MCAbc
+'4[,NCcM8Cb!dSba'db6TeG+f"[&,ka((m$#T+G&e!3dJ38CZ*LBDLD!"--%9%c$
+RGU5EZ2&Mb@"Mi24KZ!#3!b%Q384$8J-!613293Xp"#55E4,rJ`-[H1YF#A'STIU
+6R1H&)%FcUFYB0J)525rdS)HeE*D0+0bG'Tl[!+'-kf61J*EDE"H0c@3bEMEVC"0
+MJd[8X23fQl'C0*006CBBBkfe$Z23P#4UV3)b2KriI,rrrqrZGh#JDHCphhfI!"Z
+Yab6)"5!)!L!bfj!!,m[+m%Iecb9"5TpGH6"GU[)jMP8Xd8RMcDYBiV!02*'L%U!
+d&Bj%3jq[fkEXe8$1HBlQ[9$Qe$,[IMY%L48[1faIU`!)G&-"2apL`1kFUTEQ4`q
+$rEh4QTcJkm12(KlFAI(KB+IU([-KFipkrfT`GpPF1PMJVE"PUXU*"52S-&D("dJ
+)a*1XpqiIKh$8V[THG*!!k1LUYf$[DJ3E%0b-J'p`@f@HGmM4[,f&"Hm,(MhFi`r
+Ai-H8kA8fEdQ,CRS6e%11jYC4NeIc&Bj!N!#,EXMJPX+4ecrDNTECai-Qp%&QI9$
+-B6Zm')2k-8KIG)YKd9l$SJ9Ed[TQU9jLLhh"PM5(l6XacJ`e1(S"QqjKPVf!Rm8
+SeYXRB+)KmHYLr*b#b2X&qh)N8abfbIFSJCqj$Y[hD4,m90K`X"NE2mA'5Yki'6r
+h1'bM(NV3*,5XpYYT#)@R,kQBBi8Fm,1&[09Q#SNTXa1#YbE+bX6f2D*!NlmX#KM
+@Ze)8k%($SS"RA[5)!PeLLbM3p6i%%el,4&m%i0j9-HI!K2*RAZ2#A'*ZH0,&Q+e
+ATj!!S11KNA$h,6$#AZYqZ-qa)RZN$m%iJ%D#6R3kC@(Q9CUXl"Sbp$8Xpr`""8#
+X6YQF@B0JC3SaSa1Nf1mm'GhP6%2(4fj95aYiq9fZjIrPqD%4qA!'V8j4!1MD#m@
+&#+c[&J'!rMHDETd-%[SB&GN01IjdBQV@eUf"K)a!6LVDV01Rrj!!'%Mkh&9@kYa
+$@1JlheiYaFhK!rCb4h0AM5AG&0IQ!ra'+BJM"E!-fXZTX(FERY(Y4'1Bkk1$9Ue
+`4(0DVTZZZi4b(M,'X9#1a*J-G2XF0RA(%%!@!0hF03R3EqkD-LQHhY,MEr"M@Nq
+'a9[303U6bM2H)4+l)hKeL-&F19aJ$J(b(NbD1%"24rB)aV4q"-V"'Kmp)M%ek9*
+H@-[)c82bLic8h+5Y@TlfM&C`-1&kiU96J3L-iB2mh2#PM1Z"T+6F*2dSN!!A6Mf
+NRdPfN3KB&rSD@$GPJLP#QarZlRNekQ%f(V$$F%X-'KSTK9fGqL5@1@JDjUS3)4i
+BGFE!mT!!!9P!$'rbRre)K6,,jI4J4ld1FPC60K)"D%UB,SKXa1+S*4d2pd#pLTP
+)m"1MCFaaH`a$2"L3!%R,)#YB%1L`9a(kC")p4)-cGk&c5X8,Y#J)8X8)JClK)#5
+%4*m@ej+p"Bdrd)qp13-+b3N#PXa4)rJB(kk6M!AS"9Y5[!9,0b+4l'KHfLLRE[A
+5%c$SRp")(++"C-SGA2IBbp2TRi'Y+S3r(T!!i)UE+$T*ZQQB*EdSmef!1ZS@(TX
+*6G)PPp3$b6-J[JD`Df0!h)2!)JQ)`@SA)-S0G@NN5L5$*B`&h3$(+C1B5J*e0*X
+cN5hSFbU`f'&r#m&b*j!!4lM2(2rfip%Dc3QNPFBC!eR2(0GLR29LNE1H[CURU,1
+N$ieN1MriHE6A(ZTlN3GI[Nf)V)UAbm(JLjP6IFI&35B5p+aAL$KHQI(5G2,4B-f
+TQa51(%a%4T!!f@MVeS03L-0j@NjZSTEl4DU@'p@5$ZD&!fHFLE$VHQld1Zr5-e&
+18#FACDGT-TPmUD8ZU`E&'&`,h&QXl!Nbl"14#16!j%FJSMc2D)3Z-'N0iX5H8J"
+l2GJd)mJ@%E#p"BqpC!A@%eUm$afqNJ'BQDDE0,X!8#cN*LF#IY4q0c!48PYF"+R
+Y0!!6,@`MX)KfhbCJV)EaQ`jhmX9fF@%16hK9&NbU!36-UPQGh*!!&YJ'mY,a,,l
+'"kjXk&Ab)PSD(mCS-3Lj)a"D)MZ0D6HMDI%!F#AK85ZU2`c8@IDTfeJc`aQZQjQ
+%E1,+F*Apc+59VJaAHF6!*0j3Pda+VR4e!*&Y5fe6(ThGP1'1p-SLCma2aDBEk,"
+r1Z3Q4Z8i,h5RLaL9aiSXG+-aE8cTK!%3lH,!K[IS`5TS0J+IbDXMeCRjp[Nkm*N
+Pm%dKF)qpKUHkUe"[!R83A-j&&fTe!b#$TK["1Y0S3hJCJ'-8S$(I#XeZ4,"D2RZ
+kDY@0ZU1NTXUT"[F-+"TBU13QrB!"S`r!XX-ef5%'&Y00A3PB%#pV)T8M[)aG-#+
+L)mY2JEcHiH2j460)CXijRe9Hj&PVLPff[1KPmI#GVX!K(FK[3MMMe,XMeZ#G&-M
+*2jJ4+)V([QP%&RN"BcCkH)S''X*dd5$qX)3'm@eZm##DF0KQ&JkZ@m@0ifGH08S
+Sp$5%mKldT`b&`hTK@#NR&G"Cd%5L9b3F)K%A#BY)Q,d*)6#ke5`@'5Yf-'QP'1Q
+0F"mp#kjDSe#',"JqLB4C*-C%BT)5I@&UTQDZ8R00c9(%*KXGp9j04b%*+ZHP"Rp
+"6FjSJcrAbie$mpiZf5P5QcL$`mfJ23GC2Pmfcpb3!#F*j0XS-la3Yc'dU`d,AiA
+$R4DqN!$cNSfRYXQT1`a60r$8VCMkSTLk9B+lHqS@UkNaY'X46Gd`9fQj"iSc`TN
+m0*+VR3Tq[GP8DkmPKS*G&RZ95*V0Y4[44G&#30TX6,f8Ph)`re+@PKIiRRBN2cI
+MAUd%PGC+cGHh"4)Z*DB59MIX,AdV1Z(Vf6P1Z$BJUcp)DUP&UU8aqq[U!*(1XR0
+S")jGcq$J'A4CeS-K$jTI9eT+m)([)K1rVVDLHc@%cP@[Bm@BJL,e$*al9-kYkBf
+rZ"-+lhH9Jj8PJ&PC'ERF9+#TEbZR"(@5&l`[ZN*dh)ZKbrS@dP)1fpR'UDV#%5#
+KZf`,Mi"B&IYFa!Sb'&5!Z(Z[5@*9!!`UZPc%#Qif%SZ'lYY$a*+6(hq0e656+"D
+De1K-QA)Qir#BeKeIU0fVc&p+mkQHj1LHc(%al(f6JLK"`BP&'3IaY[,2%ITmhi$
+URPY@eR-C'pZq2ekQa&9Um'`jb5*H@*A0L)F41cZdQZ`4kFS&4k&JC9@SYQDjlkA
+UqE&rXqZ22&mUIk[lrSYr1[UcC6rTrIl9fpVTkFmXCdh(c@p-[6kfB-BqqEAhrqE
+GEacil`2rX[8l%rrhQ9[$JhdRacmrI-*laIP4rqmG)d1rL2GFq-1ahaEqZiIq5rC
+rHr*kjX%M'9Q"D2M3T@[hjKINjHEmF9*LkKFThd[iNe2rpIbI[r*RrU22*UIGZ2Q
+Yp"pIrZNlrr&(rljZaH*A&rl`YApiqerIr1G&rq'&rr6mIelbMmrpRjGIR2Aah1p
+qfMcRrlGmXQA(cJmDrPrpYfhrklhrmH&Ilrr"(ApjcqrZqUXlrqIG2erck"2rZr'
+a9Bq[I(VeVcIqDY0[0[pb`pmhrHhk[qMimL0IlhcJ`DI@VY[pe6eIfEHhUleYHqX
+rECXhHfP&QB6Ih"4Jc#rbY+`[Z-1AC46JUR-#YXYjC%U+r6c1+I8Z3,U@-kRYILM
+B+BV-U%(&b-0QAU5$*p3ifpj8mc9P'DYehL$3K3PLil*3JKVYlEPj'`fd!(H)31*
+cJ8bR9,cr'QBkl$bD24+0X8N"fHB0+#8c#'V,1Had(Sek&TaJP0*&!kDf$Se!J&G
+E$rI$P'"QAM`CVMRqJZJTY3`,DE8p0q!+FH`q,$Ja0'+L"DX-#jjd,IM'h8!f2'e
+dESTbhSbUXM'"b($PI8Y%!F`irV*8*A8KkVcRJC`0U[Um4VJ**YJA2'iL!4311R$
+3"I64VAGU@E8Sap%b'NlCr+a'Nk+65fMb!)lV(FhYP94!m"N-l69XpS"8#0('fmZ
+'4V"Y+`kfBYY1C*Ff$2I4J3[YM+ULKm[S-'4pQ245ie%6R'3mSD6"PU0NH)KH*#)
+N*C+lTh@M-fq*!Gh-)A3cEih$YRZf4$IceZ$R8`1kQ@0%0ccd@8Bhk++jK8mHaiS
+VZqGeA&NEmTRkdINS0$a[e,'LarrErH2UrQ(e,V[)ZMCf1eC!R%+Z(-CME$'6Q#*
+N1-3PXDc&HQ)Re0V`3J*`"1*ihRk(EFpL5K"J("GL0MjH4%+AmUe%@$%"&JFM0@Y
+'QK56[ENVJ6[#-f&Lf21'T[4$CYKl$YZk0B*K%$V1Hml3P0jYa6!D'QH'-8KmGPi
+%L1"#K%JJdc9E&!"bjAH*!X#aI"Q*I`'bh*!!jZ@QDJIcY-'Na%$HT3a04af",!d
+UAH"J`EN3b-Ri55hM8#$MhX3[#V5#5iN&"e-c$Rf(G-XFU*GC"e-2DTF50G(`RK-
+CXEVhQP$hrV%%GDmH5'ZI%,k`dZGl!HV9C9,!TY004!j5ldl+"&3fRa1QP+'4U*I
+&Ebl'(p+9Sl8A[!A)Z&)j3JD[eJ6MEaCAMTlD*!(9S2$ja$,Gh)AhIRB)hU)a+K5
+15&I48i'NA#dh#DT+q'$UTC5!GZ5,D$53!-4D"cLMpA%jN!"e*3mXkf'Z'f9fT6,
+YbSL4JeBUTjQBBNN(N!!3!c@T@#jr8bL@eC%85hEHC-85L01c2KdSXV["If38c*j
+5-6P9ekUceqL+4"!c"Y$3ZM5ldR$-!K8)q`6`H`MiFmSBl'2Kd+rRUQkpbqekUK2
+(dA*fd[*6J8`D1@@Ch6dSB0)Bd(M-ij&ZVFD(ZK9J6i)b6$*KQ#31*EEEPTaPdUV
+UEYK*a",MVTE9%mhU0@cKlUkm*X!+er6LZE&r3'KM-NeFdD'&#0RUkUF!eHF%U(j
+5!UJf-DL'l&8X9R-$E%hDi,V(G`Q!C6(2kA%$Z+C&!0CV1V!q--XD@*HR#Q#pA"a
+B(jL*$+a')-A#h6U`QZm6Z)j`$Sm!V`m$B"rI94aJDreR"V!!43q$DeVBV)AUNZe
+%CTmeU3'i(P50F)1[&6!bBFVQ%$2JkKpb)I3)i1TM8(X@6p%"&#*V!YLL$b-!0I2
+$-M6HeLm3PpA6#,3bc@3Ui8&Q+2,,h!1Y`,(i``&m@`33rR9N)*`(mb%8'cM$QS4
+)cT4f5PNqkS-E++SaC@Zem&L$$J3K8@Y1%1+K9QUJ!%$0lEYBrDiQ!r6kp'rl-fY
+NdU6)(B@lG-hY2Ki8qVCd+QeGlhG0&+e(0C6C+P4i1AiMGS-@+EM-$5Y8&6L5IM3
+diR+-P3,3db"f+14Q1@F0LcN8dLUEdZ&-'l[b!h2PMV6+0%)'jXRqd#GTTmG$)I0
+YpaC8P$%,35TP1FYB+14-#dm2VP8KcmqZl*qZr14Sj9(D6P016rDU(Ak,kNQ,VRq
+MMbBbAlFQYed+-'fak1#$%01"YHd3TMqHB%QR2c#5@Y!elHkEJU$"55bhA#r5m6p
+FG!28kp%`!p%IG4D1p)A&j,BUR`6kf$-#k#1,kb[X954Q!J(+*0Kk&J(0"R8d#m4
+A6Fl(%Q@Dh-a")aJ,pe*6',jSYd*((RBES+S0"V$D,m$Ud4,!DU!SQqB2ZpQdE($
+GbKUkpXUD-f*6Ip%0c+CGV+k*V'KNPUp3-QYqH@R-8UiV-F[F9mihC(c+B%YB*-H
+&GSf&MR,JZ''JN@9M"PBp)9MeQa*B9@GJ9E8%SCATP[5cE,64R)8M%4Kb93k5Pe4
+lk*,C)j'[@!aPa3`S5cbkf""2FD6'cb+5E6U$Cfh5Re@cZV4Rh5kkm$Ia0'QmHVU
+QC1-9U`+-fV!K0XAU!,D0!E@C8kLDTQEX%TUKMT!!k5"FIArDJ)SR0p`)0*QV5+J
+8-cEVQ`9*(bL"T%e&J"qU1Kk+M+ijKdTJ(B@CGFeGqHFL+"Z#9TbqT%)UK-j+5(X
+TA"PIiEUbKkrX,DLr$0,PQ9LNhAj)2VAp5)0rD#4V9*UjfV2&m6%,+V+aBT'!bQm
+Z`99jhiYpah()KV#b"$Da922@)GjU8p0&Tk)'L`6--CrK83-4(M91M`RXdUVLIVX
+mHSD&qj4mhq)P%am-!aU*rY[(d+%P8hXj1b(SC'-A"*%e6CEd`K'AUE4X2CjD*8%
+Bk"!#prBAZ)VG2"+*YbrQlR%X(%e4-$bdb80aLHIL!)2S"%3*!f`UT1!l)RM6IB4
+"U,$9h(l+U8J&#BH%5(mp1cG8K@2ZSDRC`Sf"Rr'fjXb'3Q8!K&,-iqdYCf)H9r5
+3!,NZ`*)A0`R`DhHbmFM-'BX2TUX@NiX1QfADhbZ8KN*EX*p9M6(ATLc0DNKcH`-
+C%LB8)jkhLB('Lj!!SCJD@#d@cQ'LMCX9XKR-Eh#BU1+Mpb@JKHA%T4!e6ZBkGZa
+!ma`M80[`#K9jQMX-D$dQf0([UZJP!%j@MZ0U!aqXL3*YC6T*h@er$mYqY'+0jP[
+[EdURrf[6'p-l+1-cF&1hA8faQe$rLVZ,$p01VTK&+0"SNVG#rmhYQ`b9H9M8BaE
+)"p@)#rRLDkQ5qkSE@l$S%DpNFBQ2mRJ6Xh8(MMlZL*!!5E#@$mTr!dF)ETk9UT!
+!"*VZIr91l5A$0$rZm-p`pQdI-!e"f3aY[-(&*jaeR!%NL$bKHD"@SM,JQ$,9e0r
+-J,Qd2[R)0TL#UhM!5J(q6A"dR5fRddLTQmmL*RQY!3cbM#hrmSqZl$fN["G)N8-
+&H3j0$`eqj4#EVV)9ZS3KEf*-d48UlT!!bp0@D4Kc,h8R#erNCF8NQ1#2cm0&85e
+$KH53!(KiXZaik3)fL5*4j5Jf6D*+2bVLVbK-lr&(@dXJeb-'e2kJ31hE)k2ffDT
+iil2k()h2U,[a)B86QkDKF&kP6"%H[Idq1HBB"*)!qHb43+HXLPP-35RBdLSIYk1
+fK-GjG+F29+H+*8%`jh`fM'ClpGA'PPi9&iTYpGG8d+GDRJdm%PQ9hCikZ1ihD@L
++jV+6M3Fr[T)E,4l+cIhf)k8e@RKfMAMq@b8mIp*!'Q6f[IQk!Z!p&-,"GM5JQjI
+*EQV)3`8SJMjai)YS8YY+`miDKU2J)a8aj#0dX[f`E'lEpj@Z)VT8P9$-4DcEEQ9
+[EiTlk5VUcXQ1QH(T-&ea4LXhLU6f*NRND@"4Yf$4k4*BP%2+25jc33S'd*K8k!)
+!Z4bD#GX[fec,-hLhbJA9KBK-HTFQY+3cQRe3-@0m5K4$92a9GHRXN92"pI-D#pT
+'#dGZ+45!P2I0REcY$LJ4J,PrAmZNZmQSQ+8h93L'50&'e5-P#k4SNqRVj!-+&B6
+4C9&,C[V#E&3Jjp@G1F'jF96N4a)+5Pl&YTc+ZI%$Ym2p+-`b#%DbGG2@aMS`Z19
+@P6"Z`@e5qj!!h3&Sf,(LjUf0j53FZ696X8eHBEQ$ZpklD)[Hj'8Fc#2TD'j1)%q
+,AXTRmFGK*'!#apPp%(6mrQ"'FF&(aG[I0'YXEYEBFQSSbBkj0[[%,Ib6IqLL15%
+h`pid-1`pCPL$`rEV6$I$'U6,jHdIZ4PQXf)BKUpH6`b65c&"@J`%HGZ`J)dAf))
+&P(Z",IKCK!9Qh!Xd@#f!iDZI&34TN35TrC!!#,,dP3J%bB$)+693M#6bp1%3T@4
+b2rc*bFKQ)$JZ'(U""5FTHKB+I8KC#0RRl31ha9'Gmb5'p%Yc[C["$Pd3q26c1S0
+C'!1hdZmri@E`8(&Ki026a'#"mQ2&@CUIQdJA*SPpXEY6k'&HIDeqG95*mC60KTJ
+Z"T'VT`(U46jAE()LQCZJXk*U*b-6-ZU`fVr["B"C2(Dbl&I-M,8'CX4e&i59#ph
+-)"2HEVK-hq&QaZ(LEJJV,a)c5*Me'"j##CdKS(5@G&PamB!1(bB,0KX8GJm,BT4
+UFLEMcbCYiXr`qB3kBSJr`i%(EM"Fm"lpJSr[j!Y1P"d99hc3BIY*8q6Xa"[HT5X
+5Fh@f9MjCM+h2bFc,VZEkJV1%BjlYmA%h3qN$0%eB,XQph*Y@bf(iUVZ-$'8aUa[
+%i'SXBBVPaj+PhdZkP"Ti'#cP#35GrQkQ*$'pZe'e"5[CrE#i#2k`R[9@QDa&m&r
+G*d6``m@ch@1I-Q[NTc*L4VF9khafEYH9SS*cU",63U@`Pk"5e,R9j6P5D5LL)1`
+U@ER9q)-I,AA(B'BeU$%68$E+#CL%iR(4Z!%IBUR8$bE*r,fIPrFE*TMd&Xa1)$'
+`R+cXb5(aF"`-8a!0AF'1IS6'$D%KZ3e#[))Gf53L0`3c4E!5KA`%Bd-Z9N`+9Mc
+[ZMC2Na!NN@#PVKDV(#K+E55qB9HqL-S`$4!#ZC4c+--jJM"rAJ*K@U`8me(Z"-Q
+ZZkffDA$G,l1&)%i+6$f4(d6$K*'Nka`2HN8mk+FP2'LrHh*bDr+43aX5k+i*XdM
+FF&`*NDc-+Vd)$C!!fi!)KGbK!B5Z'N)qGqJ#3L&$b1-1jD#cq##68BBdGqJGK"S
+0S@&hD"C#$C+J(2+l3kK-8l')36L)6p8e#G0D"bI-UT-5B-$c%9L,5M0#3Ek(&15
++bk)iLi[R4I%G,ZD*BJiA-dAa!KIMSMM!aA&4l1AL!4CdN!"CF8bShj-44IhlK0&
+T5R9'3fLi1pcLm&%5KmG)a&pp"#kiNpqTV((-3e8N$I8l#p84G9kpTPV8'Y8CV&3
+AFmV`LDqQ62$T,(fF#TqKibP9F)#&3Nq3!0YBF)b$PHjJ,`HhF0#6%a46e+!jkA8
+piS+I!ZafYKDK!F2cA+&9#&e`KBCFSAU%FPbK*%rM8AG`%B,[')+D)HK(F*BK11`
+1CL&dMbY83bc5&bb1d)GeK,lQQ-%edZ!84`U'08,rq@C#k**!1LT2r*1#)lRjK-b
+&$i@VqQaZdZm[(2jpEPBJIq[@F#"9RB(lJdZN#85MXC)BJmV83H6AUP!PB%Se'89
+b"-T1J2D64M3YM)p-q)k8i2hdSFC1L)DDBQN%!0%DQ"-l-MeFV)ckY+T'2jVZMY9
+XkPkDlKU+jHq8`m,lBF$TK,'c)k)*[b0+MF9FeD4rFXS+!EdM%0#rPS#!0KDT6R5
+'$43D0XpT0PRFPkeZ*iIb(Rp5m'mr2MXSK5&`FL[A3MeT%#Ve'Jbd%!Fd*Urfba!
+8Jikc*pN4)))3CmHEiUS[4VlU8S1!#5KmS@j``CpZqR3I'DK*Y2APG,X5MUmqGkE
+(3dS@eG"N`R3q59F[,-@m3*rYkMFMDhL!('-`-2LQb3J6l$Q+UmHQ1k%8Fb(Dj4*
+JNe"#Hd2&'Mp@RXq`6EXNKA#$Hf)+!FpMG44Zq9KeCmcdI3`&%!1Qhh"2Zdal#aq
+i5MIjHC*rjLRN)Sqi40bN'KIXdX9l,4$$&JK`-V"iPQ$a"b@`1*-'JL&h5$&+4,$
+UTJ'P#IEFKM&EcBE"G4Y#T"U8C"+MX$#*h9Pb3mc)"3+GYPkhHE'jlD)dY,G9'i3
+m8-lE3XCRPe4`Q44%ia*MX@U&D&bDfcbPQT&Eb4a+h3AaQ*NKqVKLUqJLd0'dQqf
+kiE5jlE$ZJ#l9"6U@(G5fCm8R0kQ3!),+0l*)emZKETX)cA"SV3MeXf&P01aP!`i
+GCC'Jf!A`,26S&-(#Fdc8'kehZfALqYNM,RGjq9bGa@,)biBR2frej$F05`eE,C9
+Hj-N,5hRbMmiaNG@6fbX-6qE+N!#kD*NfNXQXl9hh*(#pD$2c4iBSF*i$RE,jiN#
+V+-6&Jj9k6aaGdiBq@38d4T99C2GZYYK%L5I&jYRZcGfSJ#N2p+fp*3k149HbfkA
+mE1NH-K"88MH9+NA[%3rBBRMHTlc0%ldU$TiXm[3B('qpaLUe1Q1FVj+UaZkk,YC
+d'9Lcam#D2BCV@Mpj0%`I1*RY[K*AC2,H5f+iY[UL`k1VqPlpr#NJE+F+@5j(HKJ
+[HhF2ZF()*c6#&@D2Um+9HUK)j6G$a5jCP8Smi"kBD0%`R"dL9-6+1-5VE4r'Aq8
+#)3VkU*QQ2b-I04UfEVf8KiV0UGDeEaj'9E@0HV9$V[*3X%&8aYaHimeA)5&%EYk
+Z6L"j(&9b66mPN3+Cl0Uf-HXh#j*d%EM$$%XNfXJ$G[1!MB,"A3CQVjCJ%Hi6"jf
+kFE*Y[6MDA'4iGh49*MX!,YdXM,404DSP9ZK%`N@kp3U3!0YV4)A+#LKFh+dFI%T
+F+qBLYID4l"LDVNG%aF+m5p9HZ5SHJrB3QIEbZ'Y(&mENq$!d(AJN+EHA'cE%aDA
+*R134Ka)FjdZKF&Ypcq)L'dDMMGC,'*q)4V*"0*Cr@8*MQ5iEb`dcT6H@'fE1V,'
+mqc`'ee-P*kK6adTS-UId39"AMVNU20fpmPb1IVfZ+U8KhV,0T1T4P3M9KXEdbFJ
+8RA[e92#"CUh@S%3GSq*U2hhN'00@ZC`ij5GYp)P6b)PeV+pP3Nq%4-)R%M'4m)K
+%YdL-LN6[8()XQ4hG'YJ%U05G@ZJAI[i)UDrHMkrS,-*3-i6k9#N'Qq)Y-H8q#KB
+jULab9&AN+&6NU,E)88f4SqAkd9!b",'G!99fU#%YDl6SmpK-hiRLC&pG5K$1#j-
+8d[jQBRCMbm6XirKXT9NrI(G#i9#piCqJMlAciI6RfYFQ3Sh%bXp2qbGmBhVJ-!+
+q4Q,YB34L-hVJ"!+a4Q,e#33m#c!jM0!83RC(d00)l,q#B$F(@d@`&F(Z4L)*"8F
+jf#@#A3L10K+C+#L)T&S,m&%I5Djm%frB)cEX`3Dq(Qm!#`440dQL"Xr2K(la,8R
+3i$9L@5mBKSSSa1E*k@X!YmPXp9NbXhXbhT+Ya+!JZF%B"dl63(p[mB'9@Y@&-aP
+BT98G1j1")DfUm%`'eQT9$jh*`"UY+V[dJ992qQN`"NP3LcJ-S2HYJ+VBRfPa$eC
+@,,cTBQ%mHD`+J,KDSb$3TfNb"KR(+5+)3k[P+MapU-)cc3B#fpi+9TQ!*0U2#3@
+,MqR6',5B9K1rL@8XEl8-`"HB*M90JY!hE'Q",9U0dG8!b(103++r+J'*cV*'JVp
+,'&chpmI1M36P)'XNq,['qiS%IpG@1K,m#bXNf1L2K!6RZC(Jhc%#P)D14ZV-%4+
+F"b6B-SFqS[T[*aUF*p%J2A&C4%5)81#4qiS+c6TU'hHM`R&#K9BS8U*#3T%a+a3
+T85'K5)m9LT4Sm)3E$4T4C(%dD%54NG(J!5XdD%5E*D$"%l[R%E+F0%P3Q6bHJqq
+QKd65Th`L'9-aNI3SMdKfFk815SkU8C(X9EdRRJ)3kdXmPi)2TK-*%VMbk##@Xdr
+f+qQSY0e#"r'@IMb*XL'6CC@SAX(1EpZ[QK3l'A*K5P(e#lR9A'@UVBI)L"A'$E6
+T2&A0!R,ikKS*X""iH8@93%)S9(f2%FPAGQ&+N!#!XehcpP'HPKF`+d)RH+lP5cG
+m!NaSJB$Sf[(dDD,+UK'aE"+)jHXP)*EkSXil6emHA0INXk4r3hlST84K%!f5+1A
+TmqF`$A5+Cl3ERq&FX'-HGlim#,AKQP-rJ3Kaalc#%IQiXKD!cTqHl$kC2Vjpm!q
+$IB1[$rp`q)'qGF11iH[$+mEI',iaI',BfcFmr-A`*bGIke[50cEX81)I!!!VaN&
+%3e)$!("H%&809$B5!$&LlN3hZjY`'aGC3XM*f##AX#a,L%NDV%e"i'jLG&hmLmX
+Q5XUal1EjpQkLHEkG*-E!Dh%ecfG3XBN"%3V@8SH+L%I!j`X@D#SYjBK[al(8@SC
+5X5TLe@(%imR3(2IlrIrIZmm['j1)c2c0qmllA"e'05-L%`%4!!%"%I!3)1ErdD*
+k,"CmUERP&%MaUh*)4El`1lLN-"%,NB(i0i3RED`c9ZX4%$6&[12"QZ4ZbAG[Y3R
+"`4dhDfVYefUX0QASA5NjUFVEM5C)%@r$Kj+d1iKJXF8#Cq!GLq9E,H`L8D)YY49
+U8p)lUPVi"#i0mFXBZr5#&&"6CUI!cH+6LVC*AKCX5MVhUY9DNQke2MMmH9Tk5@p
+QGTUeY$"0YcfINj1PYEYV8fMT(d')DKbU8$qrRda+`pjjUNX1AGd[U-2I2@p`)db
+lAUhhYb&BVFHPG(#E*G&6S'Vmd#D64p++YJ@IJS13!1I*UFa5'0N%3TVR488P'QQ
+jhU4D#KMRd8[c(ICYcPfSd*E5eRrC9,60HI+M"e6*Q8+Q!rk`aBZ$a$Df+"`D`iq
+'(aGq$2KTadm6IMU-9T19f*fFQC[TJ&dlq&A)Tb%HST&XArdfk0'MB54AX#ljGE(
+LbF0UFfdaArLkI@aabk+,BbKR#$DQIR49MDNa%ai'Be+2VBT3hU(4)J,[@+f&DI&
+90&TY1V%RqeaZZUl%RPkZ22rHGkh@M1bb`JbG062(ErfH[2rcB@YbCQi3c`IDD0e
+ZklQaC(-dRCa+*-KlF('A@1r*@GcVH3QqlL92cV*Vm,UGQNkreJjc%8H'jpYSR-9
+G")#BmLUIFNQHFSq!emN1TlbU6,Q(6lNM2U8+Ve-F6VQ(69Rb1%eC8NG68QHaC5d
+j6&0kIa8jCFRMbT4(qC3UH3SYDmNDKe-H9DCBq*4Tm5PB9UAUF)U&Ql81[TeRqr6
+Y2'p!90d6ZLE0)AGd&RkZ!8QJJV+88-I"+iA%&'qQBZeXim"9Z@25(#q+c4cm6!8
+CS!Rc#A&m`QkDF2mcS41f6TUc!*A!C2`X!qM5K0F*EAb#Urq%m+3j0,!mEp*3@Dl
+N%`VL%h`1*hKVFZDS(hV8imV,!RU4F"&HTMC#@1,6GXY*N!$J1XY*q0UUT"ldR+4
+"E'*M3*P5aDE2lF"fTej$KE'4(lf2QSXIcFRA3bFMMjiVBX,1#Jf9paem!QmX2U'
+6*[cR!V-*dc""AkmGh'jCabFBUDRiK$D(%pCLJUY11lM$FKHIS-8Rh14`JPL6-lG
+$BBCHTM&8c*fQS1)d8*((8C%A4m98S1)dSB*2@8Y6B,JT3%8"-*!!(UZaef5#M!r
+'(djfm("+riG,$MYiZ+Er`dSeqK$XH-K-)&H,MeLYC83J2imJN!$(Yi*XEQG%%QD
+AP(KPGRFb`"T1h#T2cK`[*ib9Z&`3[kaLPe4aiC81cP)e(+dP$5S2[IaK,1,K!JF
+2Ud)IHR,QLY3FV9QiR"DrA-XZfC5j(If2Qb[f&cehQS1(Dd-I%T+S%SfX3)e@"@%
+PI5%-S9I$hKCBEi'f0`A94KHm)RJm6CGHHNk-%q$[B(*QQ9A-c0$4ml-b)6jHPP9
+BENd[,ma-6m0MkhElf3c(`SI'+Vc-SI!b%PiQ#kmP!`d%HV,8$PBKFp'Hc*c5FcT
+Cm[([-FPTkH@k`T`MVeZZQ)kbDS8G`iC*JHqN[C4EGLa5C63VJTj+bmSqQe1Bqp+
+a5L0K8,L`-((RFNYdj@*'pYPV)3k$LNB+RpEZ9JUH2QR`U1VUX9L+YSPY4h'B-m9
+i9G852S-KT,M4Kk%CDm4RcPh,Sk1-q%X,bkk+KCNCab,ZV*QiTl2cMadVCkmGH!d
+-Z8F#Vl'!aF#L&A6ka`i8I3Tc""3Q(,%B#JeL,0rLG"&)f!!5--B85f-(LM'c-3D
+3!"KB@#BI,T2jMJqAZ4RjSYSd1!@'!3p-9pTm1-BCE6XQ@[+FX4d6982&3pN904I
+9GQQ,e&NZcEqXLceFjp`&deK+cBq+eb8(a,YV`[m$!rBrr16[Q!Vh`T!![E1e!d,
+E[jUL0T8Bi!+efl#KYEY!EAV)f3T(d9H,UNK"Afr5S&keEr0E+J0"9c+QfdC*51l
+(8LHUYPl'FN'DreaklV(`DqmKUXKBEJTPf3@@0FFXkiRP,GLN5E'"@2l$Vri!Kq8
+9Q@@"YS0K9mNZ-+b"B@VqKjb'1+2e"#C&f`K3JX@Q,EDCVGfFhA(1ESX8N`hYJDF
+,dS+kBf3hAJ@JJ,Vm&LMGEB*V3f*4ZHQZqV26MN8Zqq$l)Xh20+mbHl2pZYbFl",
+G3%GITD1c4I&BMXi`1qhl*+`NXrb)Lh!-hT+fXCVq*PE2UPi9),1X!e#ADMYK)+P
+3fiQ`jIDD1KGdriD!q`B#EZj#8(-rG63+i06Jl3RBG,5lpb&R-BbF)D$GUqlEjYT
+TX85!pZD4J2B4KK)pCim!fRfcUbGfBf"@Bki&f)dYk2l$$Ep4!$[+EKbiA36FB&B
+lDJED4`(D9#d5D#I-2"S+fTY(!YTM'ML0(,3(PRYMJrE!4amED*qLkSH'Y-%DUS,
+Ye8A9T(*D8dd!B,p8G)Q&U2#9b,mfdXG`8c4kJ@2MiYXIV+QQk8Bl#4KF#"AACqJ
+"-FBq3"@rLcQdkP3%BBiMA*,)(SaRI*06Q@!jpGl"bJ4kc0f%q5B2G!bPH*ABN66
+BU[)"ZEbPjIiHYCH%!kaUiP9LPZ+c4!ad-aRkMN6Q4Na)4SDm93Ii9eX8HD[DpK[
+bpR$Nl@'S8GA(PjXKMaHR514pGm6)1d*"'M'SQL([!%0H+1SLJHjfQi+i',di3P`
+8EIpl35hlaJ+eG!Uck3NXS,B9RSLIC@UcAKXbJ2bHf[%he@fD5D%M+GPNJ,+@AKd
+@E3Hce103ND#[$8%bdEr1A')iV-Re"QNlhjE#99a2199eNE6pQbaef2*2IUKA&GG
+CrZP+i$dP-0,`#!+F-%p+2Ac,2'A,2,l&&pq5,b9,GLaXZ%llaQljk6HjPTpD&N2
+*C$'TpRT9X9ADJ3mqp6IckCpH#5#`-Qki,#8IY#1BCHI#(mDdKbec%"5CLJHI@qC
+LF!IP!6jPlZB!`Zp+Z!A08mR#[M"PI+`f5`PJe3LM+(fYJAVi&U$Uhi'8PD5f%'e
+F9&`[qbd`JVk-`E@AXrr[cL%TJ4CHS8PG@1,EbK,IaK+l,09BBJ*Ic")XC3NTQ8(
+*1,U-@8V`'FFK#,,!Q2$046#b9K'bpNVJrM"#j1Y9SpM%2pV%2pKd*4#HSJjMZ*K
+ZZ)`22VHXjapraKPHccGpaKQ'UKiD[)!'PZ&*Yfk'L61["SALejAXNN,Q4G9N&Jj
+2@MRGBkIQ+0KNJqX!P@J+81KabG@ZkI9Z2G['(Q$Vbd8m4)R,+a6![#"3`"fEjT-
+S-$BI30pa-"P'AQUQC8ScIB&&IP(HfA)CLLQ[L"9Ba,+RXp4'bhb%YZDlH@J,CTT
+LD5H-3`4k-q1JYd81,J9kaBacD9N$PD!qh0QaN3q&l$iA*4qVRVZ@j10'*EEC0aD
+a[Bh34FJK4pYc8ADbSmbp["l-lHA-lC@C1hc5j)'*T6k5(3c[kN0**CQhZI(MYUM
+a!`3c('GeHi362rEBNd-A(TeGZ$*QIR0"-a@UB0f,UM*`0T4eH!TJ%JXC,0I$`Id
+i!(15qm9QEkIS,P#p-E%B,($c8ZC1,cRBlRc9ki2jLP5LSFiG+q$,rRjS#'VXUik
+DMYjVP%e(G9#3!11,hH9[JQ*NRGV8dJ"bL)'I+6$dQ4S$D9dBJYDQT-%+$(l0$8V
+j4f"8Vj+c5icQ0i1CP,KS[pp!K`9V[1LH&Hc`MQBdX3E[fHM&)@*dkrDKhh(6Xi+
+FUa1p!4UZK`JcQTR8fK@c@K--JB)*!r0hGkJBQ,YBmEDD$D((MX-4$+#MjQm&dBC
+)4*TN4+k-)V,#aaY$mei)'VcGZ5(0d1`kIb3N#hl,1bf%j220hVCJD22GjDT$piG
+f-3DK4SlU!plZM%-4U!kGX)')[0UH$2HII[B%JT+cTJ#G$JUDm8&VZFDVQ%1bil@
+QfVQV`1f-0N8Ta,YI9'YM8QF00d6%CL2m-A$6$4qTkH5*&fH55mHQ&'f,NqP--iG
+Nl!ejE1l)"VP*HCACKQ+TZPF#U82"[AM8,YVMVZ-`#+q'(cI[j[*a[,(DN`C4BAk
+-+R%G+[SU)-1J#(S%9@iM5(dlIJai%A$4a-h&!Si)Bp$3!!-[&(I9Y8hYF%b0Kf+
+H8Fp21#K`deV13Lq+@8lX[-9C,hfYkT-r8r8)iKLNUkS4i6QMB440fqPd`9$1$9"
+LKReER9Tr%`a1L9K-JdKN"SCb3m`@%(FHa''@kpmKF"XQ`"YF+QQSe+qAYJ`8)X)
+f!fhl[d!&XG5md$B6BYSYed"-ZdkeH2Q@L6!P+T[JSV[)*)#+qPi-*5CrNk[HDPQ
+058E,-P6LUcd"6`XDIK9RNMUU4GP%ja&mG*Y6S1SG(8IdbCXiZdhd!!B4Sff6DLb
+HCeR"Kb`Vi,icaHC9-ZZBIKH*J!,(E9!(TN(A8Sk#0MjPY5h`Q,)d$*jSH91*+I9
+8C#'QlJ*+-Gi3,FB`T4ZF*9,2H`DZTX+,fT1EQ@)m+I4c9BNKMZ*I,9iI4r%0(-@
+rNRU1L1)EiLM1XR9c"%q&N!"fAC@#hUPX!`DB2fFS$TVHUe0[09[+,,k8@A`TEAb
+JqA-`qR0He4MB40kP,`DcM5YHi"ih$kH2[F4PUR)Pb44-6+35K+D@GR1d&e%a%[8
+Fe'XSD-JI$`&Bq4"Hea+[4[#aXd)TD,&5fYD4[*ik%b(3f%BI',S9!9$ji1&S&S`
+jh#q-2+,9KeDF[-M[3j(Aa,eMVq+$[+#VXd1*R&,SBmU&TPbi5(L`,Li-)AFSIPV
+HSL%"%c16@!@SSKXA"9qPhFi#)TLF-"&5,R*8'SEHCBhqc#S63R016b6ikKe8jGj
+aG1Pj&i%b2R'SfU4b-r)Z@95iQ%6&QiLK@"NdRcXff'#$jMN1L'Xj4h8@4h8T32T
+RF@3EcC%0S&l!JAS"%-j!qQF!kCmaY,[eBd%lS4"&5V2F&`d"JU$F4iJ'39[*NAV
+)1mpb(a'(pe3CZD3F"[4Qp5-1'a8%ciNL'!4RSf8UK'c-PSJa444ea9936Z)idTY
+#0LM)CdGa4PFb*$8R`5Qper*V$M*Umf'PBSj4efU6jMI-VaDeMbj#6l-a2fEVMV-
+qV4IQIFXX1"beK!+`55mF$E`3cB0)AZfS!HI&rTA-Lp#%#+PNGXQ9$%G9#YYFXVP
+S@leD3BA5C4J&BQ1@dlCZ8P,DHKV(%k,cd,(iY"V$9ai8YlB`NZ#&d'#jhl!iS'X
+!)+1V5AB*d$E9XXcT!4K5PaS&9B`S%,+#3rbBFAl-0ECZ[-E#er5U8)qJJa*aa$A
+mS%3FY)-cDD4U!iKFTQ[MKj'#mXSiU6[Fch3f3S"@9A,NT%`dacd8RQCLqaRh4La
+@*U#XQ!aH$f)3'-(`1iBT5A`Bf"Sa"+32M[,"XPFHG'ApL9b3!+$le9Y3D!BFB%X
+2a%PXEeP'GTVZ@!R!CYN0K#-mZmB,4H8"P13!a+5+`e6cZ!,H'*Ac0NH,BAM5,a1
+B8dl1l`GFC9!*DqVjK9i9Z+)#$F#'U+-b("!Ya"QGTMLMTf9RP!Z+1U5RQ80+Mp(
+9fp`TEH),ZLqk)(iB(&1Qi+)iTcf1h2!aU%@`6ljVhEje5jFk0KIllaVBHSblf)r
+*,[C6cQ[KBMmi4KGlK#SB4hDaZG*T#2"6'J#,CGpqGl(l8['iX9eXFdCl96+kl6Z
+bLfd2GE'heZeA&pXqBKGl[jLSi#+-cF9H25BAqe#)Lhh!(-P3XMrT%KLDqcRC'mf
+FE(ZSNkdJ1h6#r(j1GTfc%8lfd3JR@qrBZ,NQB1Cb1dISFMFHU5QM,VGH--dFSF1
+p[mer6d3-#M95kh'U2Lp3E!X@FCIE&KqU(Bp`ZGmbFlRILR#jC9'UQG0YMc[GGKc
+b)!C8Fa5RHf%[GlUTHr"qFER[jLjh'eq)Zc&'S#@@FTG`)AHkNf5R1l6TdDNJel+
+`EaFmG0+X!,Q$M''h)B'jj0-8PlaHF4UR1CVNbV9BiJlk2H5J2ieLTMMS8lLLk1S
+3phc+!1lj&$2hI-S!l[Q8!Ghc2r%"ljm8G-ASB%+BiU$IJf%qPYGmJ$(CA0p['(j
++)302Q,RSL*T,28r5iDGB8He5j@,1(@2@)0Ga&ce*GY(l0FKeI6[X!c@)'NKJ,[a
+%lX+Vk-R''Q5LSdRNdV0'#4V4"FGPY[$CmB@(1[3-DDeXSUK*H&99#R)dMXLaleY
+*,L)p!R2XfH&C9&c&4PkJ+P#!I(l,SS$bi4DjD)3iq#EqdA$Fa@GEDrD!B('9#ql
+N0hE65j`K5RVJNp-LM-(9ld1"N!"A,*,LkYZ#,h!(Y'MX3ifJ3Q$8G@0fpKY$RIf
+RN!"[LkYFbS)SZ+14SMSTSj!!UVVc2"&VjJ6`64NF`9'(AcTk*)Grp8!1rijC4md
+FrZd**)UM@bCA2MQC3amZIepQXNT(j0epL5-pk[6I(NGlMB0+q6kP8QC!IcZ!rRB
+Cr@jKM%krR6Z*Gm5VNK53!+Nl'XRP2mR45Llr(4%Z[i5M9cYdq9FT++k-F2PAFCG
+rPCR,[dT'1SPcl2*[6f"(83'fV*D4e#bLZpeUbcV&k8q3!*eqNlEa"2e02,'JHP8
+hZNM-3J#JQ`F!YL!!i)i'!#6IV%"iQNC"J,[Jq0FT3B#l3S-!5+1bMP@$kVJcppS
+(!4T(iCMMB"B+B)%!VDp!3$jhcUmiFhNJ)%X*"'`*$36XQ-8'`$`3X*dI04jbe$8
+X'+#0*"L`R#UC%33$qP4[MJ`'K",h-3B'aU#kIH6!3"p1Ja`BX-Z"!@AB+JF'l$G
+DB+![-K%5'2MPri(!`-VAqJJ-f11"!9YSB%"aSDFT,[4TfBAH,i'""mFH'1M62"m
+5''"J3mVG81&@3UUK4Eb!LRJ&L[KkTBLMU#$F,"Ia&,Q)Qe5pca66qkJ+9kS*bBZ
+"3,!*A850FJMI4Y9l5#8LJ`Hd"%Uq0h*q5Qmd&LJBF)!cd0U2J@M3Hbc,(cK+%er
+qJ9kNaY5mReBfL#Qf6bZ,[XkT,+TX-"fXE*!!GZVYaLf5Eci![Z3!8eTYN!!NhiV
+U'R[iIfQUb@0-PP*35&@e*GTjeFJkVaUJK,25b!Y,H0++)@1eY00N0cqQ(XH!1,I
+0KjZRDrANV,a2DV-&i$bb$UpN(R)a3MlkP03T(kchQ,ESNb8AMM%PVe9MBNcDiR3
+2APqKkE[3LDqBGGj63"ZGN[CY!mTM*R6UVM8iBS*emHeJJCIY9ZXj%!ZaX%bA,RF
+l,8YrbDqM4VGDkB&jD%M"m6#+49Bf+%djqRrf3qq-%-CR!,dc4S$HMrZKei9`#3H
+Hj)H4YS+K0Z))S(E'rmG3qrrh4bhJ%Vjf@AikB",+P#2$X$Q+*i3JB!*32'%rSIL
+e1)SMMJ#+*rbRK1+cai4L*03N&)2!)C'9bqrk1&$'$)$A82)8$`p"8`T8T&0m%cm
+'6iDUVkf29bbZT-%Q*%LM,LJ8U!8*I%B*1VAK4h2fFQ%EcMFM)HMT-*6NS4JiJ$2
+VG#'-`K24TPjIrb1%8KZb5k$HHGUBS4TE(r*dHflS6hlc+6!5*Em'QIc#4)XP)6#
+5`SJVZI`9UUQcJMQ(4'4hf8lBaLXEFTEc8*NKMZ4RcTCRTZZ'Mm''bj+16*%6K*e
+AmjYI9&dqM+B4`0[+%@#jQ44Akc5rLea8EPj6(9FXq@1X@23U95ZQ'$HBXUDECjX
+TGGT'#Ce[MQZ8SR9+l8hiZKNr%fYG(Rq@kVQ+C[`khSb'IXeS3[2Y8TUahGN%`AZ
+9jTP)cH0XJe(`Y19QBJrTeSCjC9CRkN5DD4*X61kQlBE'AT98,'T9X`SZaGXYVZ1
+KQCZM#T&8dAeqM"8GSGdK'#Hq5)$NP!&T[b,kNGCa!0(SSSDF$B4NTDK`0"2l(0(
+d-,,)p%Gf8dL4DD1`Ue0Jk!9D$8"V'eJJ%@0!Dfi8V3bF[d0S24CS,QAN)9&'E(k
+c!XUr`L)5!FDaHSdZqB#B8MkhN3R(M0Pf'RBHmP'3!",-YS2CiK$!mMYcS8+4MXC
+*P"j!3U'mNKGiBIrfY5rXV,Q8`CEU0#b"H0h$VNi1VPj+Z#XAph1jD9QCB[Ua'KA
+lNdmjT$+Y(`%Y(K-"24`#$LR1Ca4a'mklib6823)5+Yj)**30Xed+%9h61!)51[#
+)1r2X%8MSDS@%8M)"Yd*#jA"&E$m58EN"j`p!4UH0J)cUdBJ'T6&ERBHiD$0#qM3
+9p@N+)DhRK,54%p++2JJTD`)0T(3"JJR6aNK)qh"h(""5'5&jR*5@lQG5+SYI%bH
+Q$iF3dfNM*UD()SBI,LjHB%MQj,54Np1+2XKT(,Qj-R,(3Nk2!0RrK5#RIB9L%Vd
+(+rmLlT39",`Y(!djPFqa8!XZrG40Brb`r$$4%kNm3'PQ+[m#p"`)6m)@5R*8PP'
+B4SZ`4Jb)C80k)M%+jm$Jf$RBZa-TE&,N"598)VPJ)Z[BYL,JYpJ#hLEaEK05Vp-
+$G#[KNrCXi'S2GFcKq0DQb#950`M6HbaKaU-jK9GeeS&A+#H3!`I)T+5E"@&X0rB
+XRPQLIl+BTB9*UTDmJcI8D"ZITEq*cmkZARAjh`*0DX+PZ8[hEG1Yije1@$$KD%N
+fHV4CcIhH(ZVk5[qBXI4lMH`6RVdMTc$YDXK5Q#Qm'1'bA8X@PKR4!4d,`e*FE#Q
+Y+S&2blKATC!!1CC`Lfi9Gf$B!Tl"!Y,+#R-GVf+!ipRLMQd4`Ik,H&aH4'jfqXK
+A38"c8JNB8X)j`paE5[4(LedpcDSZeZKcY[2%F%KRFdhMdhj0YC`NBmVa!&r'1Kk
+bC#'f'L`M2IZFh`pAc%&lb#b2lE#*BcN-dH8M(iBd&*5%JS-C3T6YAbdY56%dH3,
+$,9mYeCf5YZJjd!BqK,LcQ5@kA)G`9%ErSLBl"Va'4@`V9",!51[FT590lrQH2!5
+&!NEDMS1dYFaGDYqQ@aB#VKrKU0c#m[*S@,`Ib*ECbq+([8Hh0R!4HNVLU*RDf0L
+SUD6Z3-Sh)(4YIJd$KZd1YrRNE@55EP)GEQS,hA3)T*L-+95"G-3m$ClV@KT`4$-
+UY*8(1MdA2,qAfPSZi*'Ee()0-ANcIdKU'Qmj2%5+,cI*i3C$I%2-hqJXF,K*#0R
+NG#BB$U[,R8PpEK@F&Aa6Dq3QISZ'J)a##!X`95D9T8PL&%amb8%cbD"3`m2V[ej
+C8rdKLLk&$*I0jbmZ9AX)S!%Mj4F`alP!5+p3"q'K,f%ffFV"B$Jd'+h),U21qJ-
+8eG)p'@DTQBET1'-eM!qZ)+8LB)'J4S4@8S*Y,)`j8%UMb)5!mG0$%TH%&Xl@BUT
+XikV,P-!49F2I'Y'GX4'G!T[E!lDa%i)bJR)U6b-jE%VIKcNL"2d11d!KEi14NQZ
+$&!cH%QRi`d0TF#&#@VjeiqI94H-PK[20TXj9*l!8Yr-`2Dlai[Bb!kEki-C"T(F
+%@$5K-qFd$edDDkS0E9JX'dTmMX9QRi[MhMc-eE2GPXP)J)fq33GXSD5Jhr,pc5h
+G39TH&PZmAYXiNriQcPaA[@Um`RGHVB[GGZ'YlK,AqHD+Qd`hL4TMCG9-cXU!D9V
+#0rFUE%JaC[!-BB80b)HTdXdp-LH%HaXRRAC`G$B8J%QKNJdX%L3!FM8#l9ll0JD
+HI`dY'qDLYdF@K"""'H&*pkiGJk#b5%&N)UUKK"K[cUr+D+1U`KQ68fbPjS$(c'M
+`-42r("4p&brkKi!Z9VMeS5F2IflGSF[9P@-X0!!VrBAG1c4QB4(X)#flNXc61)m
+Eq@,S+Tf('c*j-4L-456Ta%ed6!'SUFDFG3j5AXk+QY,LAD+A+4fc[A+LcF$C##+
+frj0FfJIi,#**(CQdSF$)LGcG468f#Mp3-e,DY!',UTH-hJa-!Jm5R3r'BIQlhiR
+h`X8#"`k9b,(R`JaDA(TfZCa'D%q'-U"5&[JlfG6jdmQb#4BT+qq)JZlHMi&HQ&"
+A21Ha+qQbA*bG*U@$XD3X9BU!D(1da!&+(NlU@I*J!a,3eNZa&G9+eh'i!epk9Hh
+,R@T-2fk+`Ch5[1-!#FfB@R3TZ9Y-M!iU3c1TIYjVYHEVbSK6IhD*G8q'[*!!ck-
+S`&0DKkeRMjb%"5l02Xp,j#)SL3QcQ-X46D%*jfJk'4h%0ZlQ6-H$9j@A9r%b@AQ
+CM*GAP*GAm2+bm[)bA[kZ[2`G,imS,irJj9(Pj9'mV&&HeZ$PVmV,Ar'bA(PCMTG
+I+#qrL#Ie,8!r%A)[Ar!hIbe82L`r+'UN,D1&TGRPkBa4Q&NH&SrLkiRX3mRiNJj
+@2V%#hG6I@5aK%)Xd[hLBZjSVQFl$blaJLT4615qTDJJ[-S!80C!!f(&G3@Dk'KH
+lRJYF$i(V5@"P91$kh0AiHTq,HTq,H[q,db5L`@S0%5+V!C!!UqAh"EU4ZYIe%93
+!HK0h3-&Kk(IN&2UAcHTQ*L"9I@df[@+EjNpX)9@"pl8m)L[di3r*203K9ler(N,
+$A`8TbN9K19H@(PGSiq"(0a+"L,8!`R3YMlUV35AL0H-$qBRATHTpLdG,$KLKFS,
+A#CAG*@kpEqiY)J'PKQh(&ir#ZI&9MCEE8B"G5,A%MrpA)p*rFC&IBQ&B9JTcMPk
+l5%4I6T8dJbdVl9`T[iUL3ADak0"8rhrm1,8,eCcr@cqHm"'5qM2"ADHe2&0aX&I
+UH4GT*6(-ZXU9%&c[fLK9-#iei`NF@mbAXpPB,ErX5b$e@+6i1r%Z0Z%(KdLfkkS
+@Ve@eXYLA26cj*NID*EDmM-aFH@P))l9EVe4#jBQE"rhZbi2qf1@[QP5fU"eBe0Z
+r&@1Q,e3A,V5Ke#')4A*k%,S2-[NbmB9,&e"YCHl-6(E-ZGb3!)0i48H0dKb!dMP
+Z("U6,L2a8MZUJYMP+P`f36AEIEN+Vr1ES"Vi`H@Q2")f)9P"C@K,bd-5(Y#%!VR
+VI+,qSDAMIRI,Z1`1Q05ZQ`Y8rmN@'"TaHcbIr%'&@U[kBbhMYF6k66,3SC'48%Y
+UUlT3UkK`[6DETmE@"eZ4CYR&%PCp!-,e%D(BL`GH16Ji)ll%0(p'#1#lZ*)F"m4
+Bb`4aRl%#$HeZZB*Nc9iR&(0HhHbrkFHTrN5JIF,X+jX$hDRi1&9-+8LmIX+k+qq
+1Hr+N,U0KcL@S5`l9G09X8KCaNC!!$M8XP`65qF%@ZVND9"YS1C`XT-DANk-V$qU
+X51!I(eM(QZ3EXVfBZ$#ejqBLh1c,q'E,&G''49bC2FS@e(,j-PY+l&dd!Vr8!+K
+[0j%#DZ`b,N`*5rjCM1Nr!dMF*EU(ARF%$&YqeL3j@P#ZVL!p1[$`IVTS0C*Yj#a
+DA9-P2IM"9MAf)9i!(2L5R[ekkk,9cK6kURRf`kdXQG9i+2$Z*SCUN!!'qqeE4(I
+U2bqCY'Le'+-*dSq#@NdU%dR+m%1TdPBfE+Lf4J)QKDVS4UGYhDTUq$GhY`9DCUj
+Z@"$9NMEFB+LCEJ()LE!*BD`84E@UUGE(`+4S)E[BYj*AkLij#$@$MJ#cCkfPN@5
+JN3j$SpmkZhYc`06XYbm1P,Mcl4`4EF5f8`N4rZ!Le&XmaJF8dT8%9@1Y0(l`$jr
+"3'Uh(D'BVlfB9!pL&TY,l+q6TiFXYcKdQReEq'p4TD4APGS6jZrbl"aVIL&9VpN
+CDC%T*"mm`3S5EYX6*m9q0bPMYh3MX&[-5$AGYK5!e2eq3%lE6X&80Z%(*L931N5
+NNKhq5SQZMq-2m!+16LUZGmQGT8l0l5ZUZbBYfpJ&T`"N86-9&hAMF8F0ClXcKYJ
+V()F#9HT-TPZd0TcrPcY'k38hDEYF9Y5&$Sck%aKqa26HApq`2blY-06S0Y%4PB'
+5eY!$E12XX@k+rJ3Y[0c&ZRL%*beD$,A'')C"GU!8K%m1p%lBRPN`%+RVi#'II*@
+BGmD+,YQk+bH8*NSq-l&3EU#`YplMV4,hHJTZAFk4[b!%'*,mcH%TPV`+VD9+6*'
+k*$Y8+$8RVf`YL3m'S-jpHKD))cUEZ3!f$p'`L6@G&HS8T1TQ60"M'%PT3k'i&j1
+V[9FLQe,-,0#94$BQ$eUjc&NJ%[R$5rdCd60'Y)q!*'QRG!P+(jSS'4-3A+!1(BV
+Dm`X09%$!fP33SCe$9I,3mHrQS09[3A+ajdLTmHpF(#MGaBU1FjI4!mI$T45N"I3
+UHH@#hC!!`b@E$@k`V'Imc6Z!@#+@5&J9J93NA981B-YfcS)#BiV-3P'm3)b,j6T
+GR,69TJ"9ec3HEQjT!F0628&P5YDI3"Lm+2"E[&qVZi++XNcK%eMd)II9NdrLPJ"
+Ae4DJ,5@BJZ$-VL!4`#e5LMK(GTa1B"c206["5a3G['P#$c5`!ePhZk!lhd+(3Y!
+GNNp'"d5aI%Ya89aK&K@-d5#jNkq!!038[qPU9Zm8fiSrKU*d#Pj5a"KHlV3pblD
+)YbNK)8!pHM1NXaB$k33*eD8G8@`+&hXR&hXR&jX5+ID0U0MdE$1KA-%6LB&9)li
+NU)RUdF&[NeSr#*942'T#q"3LRVG5$HUh`XiLkXV0KV5jXJY99ZT[TV59e-dI5YX
+3Ki#B"i@),MTULe&a(dkU!L#i&`Gi4bCb`r4)Y"mcND%)346*jk`K`a%kM$6KTZF
+qY9-db!,i%EX`q&4P8(QHI+r#NJ'A4@BR+*ChQ,4JdNFpUYk4b&*bJXbA+G!bTGf
+db)M&YFZ,Lc1X4J&hKJ`'mRVN)XqlBK#V!-3l49F8Z"49Mmd`-L"`1-8&Xf8cdN$
+Xm[GLI"CEV9%k00(!1h6G53,ipYIp[X@"R$T$,&RpQiEl!Qpd9d$IAVX-%I344hd
+Md1Tl,)"`hE$fTY6XI)&Y8ZNfmKT,6Uq`m!K2N!!!Y`q+ehV44!X3AG%MR3BfP6p
+b+BX`N!"C,p3!L`i9R1"FXPU4,p4+,RS)qh+3!"i*GSR0hIh0K4#D`9R(%*(5B-6
+9@2F55aN5@0,c@jlSii`iHF*H,Y!TX3ZElfqlh6iC)4FUSPX)'IH2Dfp#%Ga&#@,
+N"6HFbm@#ba`XPYp5XH8kDUB(iNdAJcQF0GP*!Q'4Tqr,F4[S%%hFlRIRpej($EF
+EiF"H$(DlJqM16Khk',[aVScS[N3T!H2-5!LJ+3"9Y)f*5eD$jJerbGp'B,&+fk-
+bmcH"0T6M*9'+0QM*-+%dZ#YLFP*SJaR'mpYSQDYf`dMX$YC"HEl0R`+%pb@'Jh!
+SqY$Fb)8EfYa%2N%#2[eNLNJhKiBMMXXkKLEFjSM5[VQm3J+#((lhem)R8jc&iIp
++YrMjfP2j2VRfRdc*EbDbbJYh@CC1'30NbpfRH5L(+c)'jhN$r"!ph85%%HMDBJV
+Qm'2d4KK3jdq3!*dG3VXb),9DbFSHP6Z3!1#1%(%()XA*JFdr@keF&b9bN5`0qTr
+PbLAL3jNBS2SJm,D(N!!#'LS+FP8$Sbq4SCe*9EL[p8@Uc)BQJ(M&N!"qEaXh-R6
+)P4e!NQjX&1hqc3"Ej+H($1f9BrN"TEN!Tm8$%+-e-[&*9N8'U$-C5,T`chDG+j5
+3!,!2pUL-M-F"0i9Y`Q3l[df@FN!b'`iVeII&QD5dhJI)+F3(T,Z*!9pmq#&b5KY
+LrKN')jXcFG"@9)*)BiN[0iMDPqUGk$Mm)8"V)J6@Yhq*4D+kP,j%9i8$F0+-k0$
+58I1PHRafYFX0"LNPMAY2B%*!DQBK($&GPa&bN`BH),TSj'%Rj61cT%#'+%S*KB4
+QN!!eH3PUXbBM5Y6hBlmeK2hi&(8"*mUi8E##1U0Hr30F!D3Q"a%+LR+$2DB'Af2
+9L#Z'JYf',jrSSI4(8'"Z+NR"6E#19f*LQFE3LLk+q,"U()$@3800G*XbSRTVUX)
+QZUe8D&-lfpLV3ZS%$$el8@eA8-8*"3FD!"3RTA,bCJLf1f$$3+5AhpK+D8Uj!`*
+36$fTSbJfm)#XM1SR'+VC(NGE-RTP)d&$MLi(0q+)+RCc`!""TjYb)i'8Ai)63Q6
+89r'MRD-,8GP-(T@ffTieG#H2LUG3`EG+2Sm`*06idTY@I(%P)2PZV`jFEJM8akC
+!&GlE%$`ZE5ek9ZSHqaF%,chrhY,aP8a!5[ca+Er[qJ#+EBUbJ((a&-bG"3T4K6T
+,"S)%13SV4#)Ykd!LjbN%$-(Hc'`Va[64i#+D8[[&!@8SQ[C5QP8CRFX$[1A[+F,
+T`j!!iAAF%3H)jE6jfaE66IfKdN4+iMXQI6)00dR,-bElQqHf"0e$UI`LKFJ)"dN
+UcUhd1[3l&Sa&XP0IdS63)G%S`[4TZZK#M(3M#[b2F2"#NK8RI%2q4[5Il9bQFH@
+U4[cSRIAH+pQlh(VerkQGU2`PYG0Tm&l*F-8I'G61'VHcV4cr#`,P&PCF4dA5()J
+F+T2jiCI9!aSJZ((R`PQJZm`2e4rmpd1KCmeU)@(Q'jFqZA!Kl,ZArJ[R,PZfl!E
+mK!Zrp5fK[1Zc3@'0d$!B[[2-*i)(2e8A*JZr%)*9`RTK3rLAi4H%qH&j`Jr19#i
+@-[R$)9pi92JUr'2q-(c`#H(C$F,c'lVHZA4KqIS,3cpjIXMhj`ZMSm)f)IMC(fG
+kRKSDa%*-i8rZ[9IiblhhlPL+dei92[fI`VSh4VZ&'8*Zq'GG3H&Uq0kZ4H%hcUc
+j@2MYQH@,K0rJYkZbkjU`VbGAH2!c!AF*92mK&'("K3hK@jNXBBrJ@EC-b+'[F$-
+q@a+Z(FS3cSCh#fXQ#+2Khcph3rL0#F),9B*IH+j+q'q9Mi3lcc`[[('Q@mJlmdI
+KVm,b4ji9RK8q2R0eKK#H,[cfHH'&KUq%IeAf2r'24m,I2R0@q1a-6VMqc!EK%f%
+6pPm5IRr'182`6KGqc[E[QrlkNZQT12-ViEl*`TlT`Q2#MZP#N[$I*`ZTNi@pdi8
+I#TlTJKd2hK,#&e)VK5jKU#GR3rJ(`NY#8I9R3Xq-ImcmBi1`rP5iq-5ii,Ppr3T
+"Q$`Z,2STNSGG@0r`bSP2K3PIIE&'+2b(82V'S,$cjm+@m3h20MakUI,e4i5KDQ(
+[&p1&r%(K*`#3!aJ!!"mS!!"6i!#3!`J!N!-J!!!r2!!(UI!!N!-+@-!!AF!!!&h
+!!*!$'Qi!N!-"GJ"1F8U$CL*"l3!J)$`r2!!!)MbTm!!"5N&Q"%T!C`T)3%K"))!
+K33!%3UG"q[r1d2`"!#m),c`!!"PZ,`0K!!+X9)pR3%)i#Pj#Tbmm4%&836mm"0@
+S(h!"%F!+ANUICaK1F6!mUA#R4N2k!#SLL%(k!#!`2+P`TNG+JfF%F!&1G8lY!#*
+1F8U$CJ+Tp(!!6R9J"J#3"3&1F4mkrrC+(fB551IJi%(krqT3d%kk"Dj-h`F(,cV
+rhNjeB(*"6%&%4%008!!$!*!d8(*"E8MRB2"d8*r#,dJ!)#"2)P3aD3!8!"JK3!!
+N-A`!!3!XdT%K33!ZS!,I`NcI$`C1G8Si#PjR$#!U!!KR$#"!)""R"Lmkri41G8M
+R(`C"q[qHF!`L+J!%`VJ$'Q'NCJ!"2NKkrij1ZJGZ@%q`H[pDCJ!"$U%D,JJ)+J"
+!!!4R"L"i!UDJ'b`U!!3U+J!)'#S!"*I8PG3J1[p@S4ir1!)JCJ!!l&42,%JJ1[p
+%)JE#Z!-D@%&K!2p-)$Vr2-#i!aT"q[mi))"+K@B%S5*J"#"&S#GQ!!#d+NJJ$P#
+!3IVr###!)$Vr#P'!3IVr!##!3QG)HJ#m,a9)H[m#,cVqiLmkrZ)[1[l+,cVqbLm
+krXTK!!e1-"pR)$m!5S9R##"0S#UJ+f!%)%fJ)b"1S"mJ4k!E-Gm#)'"J)%kJ(b"
+(S"Yb!")%j`RM'H34!!%!)!)"!1!J6D"T!J!!(i!")%fJDYA8ep4"q[jf5T!!C`K
+`!D#BF!1JQ#"0*8J!#(!!60pJq%je60pJq'!!rVir!#"1S"mJ4k!E-Gm#)0A8ep3
+`1!)J-F!+B*()*8J!#%cIB2K1G8j@!!")j`!i+'i!$%IkrLT&q[iU)"5`NQd%)")
+SJ%U!Ea)J8b*Z!!LL,L!8dC14NR!!B!3`22rC60mF!%jH6R919[r)51FH1#BZ!!J
+S,J!-+'i!%%(krESY52r83Llrb+%D,8Mrc&92U"``(cS!$%8!!'pF5'lrl$!&8d8
+r!+J298m[,[rXU!d`(c`!$%B!!'rF3LHTQeP2,blrl$!'8dBr!+J1)"mY32r`FJ%
+I!DQE)'lrm%U3!'F398m[#+QQ-"p)`()%`)&Ra#mZrr#TSf#m%#i!&'F+@8mZZ!+
+Q)&qJ'cmmS2a1ZJ5'9%mY32r35S"R!!'H,`"1ZJ2@@%p+!'F+F!%G3!!@6[S#'%K
+Zrq4)E[rJ5'lrf%kk"@T2l`!-)#lri+%H,8Mrh#!)C`!"C#!Zrq5K(Le)rqJJ#'F
+!!93[,[rN,`K1ZJ@i8%mJ!fB!!+CC6bmm3dp%48*RU"mJ(be!rr"+J'F!!)iJ3#*
+3FKM6`5m*6VS%Y&K2FJ1`3@Cf)!dJ3(!SdF!Y52rd)Qlrm#44F"M9`#e+rrJ[#Nk
+k",TB6be!rr`JE[r`S#P35LCZrp3R5J!S@8m[,[r`6VS9c#!IFZM3J9'!*d!!,&9
+25(Vq-LmZrr4)E[rm,``["#mZrp`[,[rJ,blrk%kk#XC86bmZrr#TSb4Zrp3PE[r
+3!!`PE[rF!"!PE[rJ!"3PE[rS!"Jr2+'B6VS$9P42*N!r2+LI6VS$5P42)J!J#l#
+"CJ4`!'!#F!%J!#9!!"`P4!!J*8`!*%Kkqm`r2+$m2cbJr%kk![K86am!6VS98Mm
+mSCK1ZJ--9%p+J'F%F!'JQ#"m!!!"@M!35-$JJ()'X)&Q$%(k!+iLI!!!!c`LL"e
+m!!(rb#"ZrmbJ'e92U"``(cS!$%8!!'pd5'lrl$!&8d8r!+J298m[,[rXU!d`(c`
+!$%B!!'rF3LHTQeP2,blrl$!'8dBr!+J1)"mY32r`FJ%I!DQE98m[,[r`UDB`(dM
+!FJ6!J@F),blrm+QLB-)NE[r`5T*R%&92,`UTTM!I5-"b"-#"CkS[#UQMB+33,[r
+)(8!!&NcI((K1AL"I6qm!$Nl36PErr%MR!$"#,[rm2cbJr%kk!La86b4!5S"RA#m
+!6VS"J&K25J"R8#!+*N!J3#mS!!`r2+$m2cbJr%kk!Gj86am!6VS81#",)'J!%+!
+I)%XJD!!BS"mJI!!!!9S`%%M!i)"b"V#"CJT`!#"m!!!$2##!(A`!!Irm%#lrr%c
+I$!"1ANje6PErk%MR(cKC6kPe)"mU!%KZrqLSG#!0)%!J%(+'d)%Y32rm)%"F5%2
+Zrq`Lf#,B@8m[2%4"9%%r2!69UD!J(bK!)%!N8$)U!!L5DJ!%2!%d+J!'P'S!!Mi
+#0LlrmNM$1#lrlNM%PS3i!8M%PS4U!P+$iS-p3rrf0Llrm%M$1#lrl%M%PS3i!NM
+%PS4U!P+$iS-p3rrd0LlrpYC"282rqM)Zrr653Me"rrKC6d+R5'lrp%Kk!'Cb!4m
+"FJ%r!A,r,`&#*d+RU4-J(bC!,`#SF`D&!*!$H#m-)%Y`%0(!,`LSpPP2UA8J(l#
+&C!*Jp&92UA33(fB#B2C`rcm!3QFJ(k!b,`ZT&#m-UD-[,[rSU(0-haci6Pj1G3!
+#!!"19J!!51F!-#4Z!!JJ#LC!)%!L+!!#$)&"6%&%CKBL+!!'$)&%3de3CJS`+!!
++FJ1`3@F%F!"J!R!"60m-!%jH6R8[#PP22cbSER!"(`"1ZK*i)&mN5&P22cbUER!
+"(`"1ZK*Q)PmJ5V(*CJB`2!)!B!3`2!3!*&p1G8j@!!![!cBZ!!J`!dM!!S!!!!J
+!5S"["(!"B!*`!#BI6Pj1G8j@rra)ja`!0Li!#$m$6VVrc&42(8$rr()"X!&Q%!*
+$"rp1Z[q!X%0Z"(!!B#KC6cmmU*p`!4m!6VS4m#!I+J"C6cm$(blrr%kk%H!J(bJ
+!X)9Q!R!!60m!1%jH6R919J!!51FB-$JZ!!JNEJ!+)%SJ%#C!)%!b%!a"384Q+$)
+S!!)-3805CKif"(,rYN&R'L!S!!4b'1+S!S!!N!2r-J0)`E#"C`4`!'!#F!%G3!!
+160m-'%jH)&pF6dl36PB!!&925'i!#($r2`"1Z[q5%"pR%L"Z!!JJ+!!%FKMLU!*
+!!2pJ!R$r6Pj1G8j@!!"96dKZ!!K`rcm!6VVrC"!ICa!JEJ!))#J!"!+!!2q3!f!
+#F2p1ANje6PB!!%MR'$JQEJ!)+'i!$#",-,`$!A!!*%`NJ#Bm!!!"*0H5"T)!!!*
+)"T)!N!-J+$`!N!1!fC,CNLJm!!!%N!$CNYH5fC)'NJ#3!h`'NJ!!J!"`!#4Z!"!
+NJ!D5!*!$*!D5!*!$)!D5!*!$5!D5!*!$2N*!60mF'%jH6R919[rN51FI1#CZ!!J
+U,J!-)!XS3#e!rqK`*0R!,8crl(!JfF!Y62r`F%MC`#e-rr4`2YR!)!b3!)Z`K@-
+'F'91qJ#b3N!q!%*!28$rj$B(F#5f3'4)F!5f3'3%F!"J$(!!-!0CJ'S#9S$NJ(J
+!1!-Y42rif+lrk#4%&)!J,[rid)$3V[r`)%!`V[rNF!%8%R)!%J,MB0&Zrq454f#
+`3N!q!(!"2!!f"h!IYN"N4(!"YN"N"(!!B!a`!$!$8i"U!P+!iS"i!$J$,86rr0L
+Zrq`N4"5!)#lrr0#!d+lrp#"!-)C`!435FJ!5!Z0Jh%"54f#d3N"-haci6Pj1G8j
+@rr")jami*'i!##CZ!!`k,J!3+'i!%N*!2!!b"A!!-!(3J$3'FJ!b!V#"Ea4#3$3
+'FJ!b!Y+"dS`J36#!8NCJfN*!2!"`!Me!rr)f"VC&C!!!Z%*!2J"#3$e!rr"`!$!
+$jB$3LL"!)"!Y32rd-JC`!$!"d)XJ3"J3GJ!@",C(B`!!JM!ZrrCb!F""d@lrm(!
+!-!06J$3(FJ!b!V#"Ecii,[r`GJ!f"#e$rrc@JpD-)%0+8'B5)#lrr0#!d)`J3$#
+Zrr*8E[rb-Llrm(!!-!(3J0#-)%!`%$e!rr"J&M!&d%$34M3Zrr"b!$)#dS(5M#"
+"-)"54b!Zrr6LL#e!rr4J!2pX8NCJ!2p%60mFq%jH6R919[rm51FF-#4Z!!Jf,J!
+-*Qi!$M)$F!!`!HD!1!!`!h)(`%%k!(!!,8$rr$3%FJ!b!Y++)%%5%(!!%!%d"A)
+!-J,LS()"`)(4V[rm)Llrr11*dSXJ36)3F!!`!5e!rra546!&FJL`3@B'3N!k!&*
+%-Li!%R!!-!(3J,#ZrraM!Q#U%#lrra)Z!"25!C!!!8cI$$K1ANje6PErr%MR(b!
+NEJ!)1#i!$$SZ!!ib"(!!-!(QJ$`!-J4d"m*#2J&f!$B!eSSJ3a!3G!!8!#e#rra
+`!$!"0!9b!$)#d)(QJ()#X)&R$()"X)&R)%U!Cc4J-M3'FJ!b!P5"dSSJ34)3F!!
+3!A)3ikL"V[rm0!Cb!$)#8S(5LL""%K"`!"!"iBL"V[rm)#lrr$3(FJ!b!Z+S,8$
+rr($rFL!f"A3!0!15JZ+S`'lrrNcI"2K1ANje6PErf%MR(cJQEJ!)+'i!$L!m!!!
+"*0'Z!")J2!!!!NM4VJ!5)#i!%Le!rqab)01Z!")L,J!5,8(rm#3m!*!$J0@Z!")
+N,J!5,8,rp#4,'"*f!"B%,82rq1D$HJI'49*$282rh#BZrrMLJhS$aN983ce$rqC
+f!6SZrqEVBce$rqKq3-J(I!!F"$e'rq*i!HYN8d3p42rJ+Llrq(i"bSGR#(S!1J4
+6K@!#H[mp4IrHH!Jp42rN5NCR4LmZ!")[!$m$8NS[#NkkrcT2l`!1jd$4E[rN,bi
+!%LmZrr!r!bmZrqa1ZJX)6qm!$LmZrr3r!bmZrq`[,[r`6VVmV%r[!!j#3$e!rpJ
+`,[rBX'i!$'3!!6S`,[rLCcSN3$mZrqJ[,[rd2blrj#m,6VVpMNr[!!`5!#!+F!!
+3!6e!rpTd!$3!e+lrl#"#%""b!")!dflrj'!F2blrjMmZrq3[#dkkrI"36ce!rpS
+`,[rQd@lrj$!ZrpU`E[rHCKBb,[rB8Qlrf(!!-!(3M#"!3K"J!2pk-#lrfV"Zrq"
+Q!!#8-#lriQFk*%!r,[rS,blrp$mZrq3[#dkkr3C2l`!-%J!J#R!!%!%p32rDG!!
+d!05Zrq`J3K!3FJ!5!00Zrq4J($mZrqBr,[rN,`Y1Z[eS8%mp32rD-#lrjY&Zrq4
+@E[rD-#lrfP0ZrpT+3'F!r`!i,[rBGJ!f"#e$rra6JpD-)%-3%#)Zrrc5M#""%)"
+5E[rBB-i3,[rGd#lrfc3ZrpK5E[rBFJ!b!Y+-)%%3J'!!rVib,[rNF!!`!9k!jS"
+-haci6Pj1G8j@ria)jami*Qi!##SZ!!`SEJ!3,#i!&#e,rmK`*0I!,8[ri(!Jem!
+Y5rr-F%MA`#e,rq3Y62q8*M`!!!%NeklrP#!m!!!#50'Zrj4`)0'Zrj3S2!#3!i$
+CV[q8fDlrP#eZrj6rY#Jm!!!%N!$CV[q8,@lrP2qieklrP#eZrj6r[0QZrj3YE[q
+8rp4`I0'Zrj3YE[q8rk3J2!!!J!$4V[q8)#lrP*!!M,#&B`T`C6e!!#K1qJCkF!!
+Z!%*!28$rM#4Zrk69r!!!J!!Y5[qS,@lrT2q3!#em!!#!!2rS5'lrk#mZrk3JEJ!
+N6T!!8%mJ,[rSCJT`Cce!!#K1qJBd*'lrN!"55VAZrkKMD#"Zrj!!8NL4l[qS,8M
+rp#"Zrj!!NHlrT#e)rr!JE[qSNHlrN!!Y52rX)!KR$L"Zrj!!)QlrT#!ZrqbL,L4
+Zrk69l[rX,8VrN!")E[r`,blrT#"Z!#41N!"36b!Zrr#`V[rdC!T`Cce!!#K1qJA
+!)'lrN!"5V[q3!"!3(8$rS()!%J$5390"28(rd$!Zrp$33$e!rp)JEJ!F)"$3VJ!
+J,8$rX#4!,``[,[qi2c`"*#mZrj!!6VVlmNr[!!ib!#!+F!!`!G'Zrj!!,``[,[q
+d2c`"*#mZrlK1ZJHk6qm!$LmZrl`r2!%N,blrZ#mZrl41Z[PF6qm!$L4!,``[,[q
+i2blrd#mZrj!!6VVlS%r[!!ib!#!+F!!`!G'Zrj!!,``[,[qd2blrd#mZrlK1ZJG
+S6qm!$LmZrp3r,[r3,blrZ#mZrl41Z[N+6qm!$R!!,J"#3$e!ri`YEJ!Jrk`JE[q
+XXHlrX'3!"+K#3$e!rjJ-EJ*)rjKN!!$#-#lrM'B!!)`NE[q3!&*+YHlrU'0S)'l
+rN!"55*(ZrkJY52rd)'lrN!#4l[qN,8Mrm#"ZrkL4l[q3!#e)rq`J#'F1)'lrN!!
+LE[qN)#lrl+)Z*'lrT0AZrq`Y5[q3!%KZrr![,[qN)'i!*%k3!&"2)#lrm,#Zrr4
+N#R"R28!!+%lk"%)JE[q3!&+Zrj!!%K"`!"!",J"`#$e!ri``"h)"`%(4E[qB-Ll
+rQ(!!-!(3J0#Zrl`J3$!328$rQ#!(iSJZ!&0ZriaJ!2mi"'i#52qB$'i"!2qBC"!
+JE[qX8UlrV"#ZrjPJ!2m)"'i"!2qB1#lrQ(B!0J3Y3rrieS2@V[r-)%-`%$e!rjS
+L,[ridUlrb#""%K"`!"!"28$rR%T!C`!!`JaZ!"MrM')!!*JNE[q3!&*+YHlrU'0
+S)'lrN!"55*(ZrkJY52rd)'lrN!#4l[qN,8Mrm#"ZrkL4l[q3!#e)rq`J#'F1)'l
+rN!!LE[qN)#lrl+)Z*'lrT0AZrq`Y5[q3!%KZrr![,[qN)'i!*%k3!&"2)#lrm,#
+Zrr4N#R"R28!!+%lk!bJJE[q3!&+Zrj!!%K"`!"!"0#lrM()!-J,MU)k!8'lrM'!
+!rf*`rh)J1#lrR(B!0J55Jq+S`%I4E[qD)!IQU#i!Q@lrM%*!28$rQ$!ZrjL`E[r
+5C!!!`M!ZriaQ!!#-*'lrN!"55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHl
+rT#e)rr!JE[qSNHlrN!!Y52rX)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8V
+rN!")E[r`,blrT#"Z!#41N!"36b!Zrr#`V[rdC!T`Cce!!#K1qJ*B)'lrN!"5V[q
+3!")3F!!3!5i!F!Jp32q--!Gb!F""d@lrQ$)ZrjK`!$!"d)$3V[r8)%!`%$e!rjJ
+J"q+),J"6E[q-B!$r0M!Zrp+4E[qB1#lrQ(B!0J3Y3rrmeS2@V[rN)%-`%$e!rji
+L,[rmdUlri#""%K"`!"!"28$rR%T!C`!!`JaZ!"MrM')!!*JNE[q3!&*+YHlrU'0
+S)'lrN!"55*(ZrkJY52rd)'lrN!#4l[qN,8Mrm#"ZrkL4l[q3!#e)rq`J#'F1)'l
+rN!!LE[qN)#lrl+)Z*'lrT0AZrq`Y5[q3!%KZrr![,[qN)'i!*%k3!&"2)#lrm,#
+Zrr4N#R"R28!!+%lk!9SJE[q3!&+Zrj!!%K"`!"!"0#lrM()!-J,MU)k!8'lrM'!
+!rf*`rh)J1#lrR(B!0J55Jq+S`%I4E[qH)!IQU#i!Q@lrM#"Zrk`b,[qHF!!`!C(
+!,8MrP,(Z!#"PB#"Zrj45V[q8%"!JE[qX8UlrV"#!)'lrP&+Zrj33%#"Zrka5V[q
+X%)!JE[q88UlrP"!3)'lrV&+Zrk`3J$!ZrjT6E[qD5N"R!2[H)'lrP&+Zrj33%#"
+Zrka5V[qX%)"Jh&CZrjSJEJ!BdFBb,[qHF!!`!5*Zrkb6lJ!JN!#*NF!Y52q8-#l
+rQQFQ)'i!'0('XHlrP'-D)'lrP&+Zrj33%#"Zrka5V[qX%)"6E[qDB03YEJ!Jrj3
+`,[qD8flrQNT!C`$lCL"Zrj45V[q8%"!JE[qX8UlrV"#!B0`JE[qXXHlrX'F)F'F
+p3!!SB"3JE[qXNHi!)#*Z!"`LL%*!28!!+%cI(2K1AL"I6qm!)%l3!(!m!$iJ!!"
+i)$i`)#BQ)(JJ2$dc-J!!1N0[EA"bCA0cD@pZ1N4PBfpYF(*PFh0TEfi`-c!a,Q-
+!!$`!2L!!!(JJ2M!J*LBJH#!m26-b!!!k3fpYF(*PFh0TEfik4'9MEfe`FQ9cFfP
+[EM!c-$%ZB`!!6PErk%MR(cJq,J!)+'i!$$BZ!!T`!$!$1!Gb!$)%N!#"FJ'`J@m
+!!E3p42rS282rkP*ZrqJ`,[rSX'i!#Q3FFJ!b!0+-)%%3%$3(FJ!b!Y+-)%%5%,!
+"C!*JeP0ZrqS`,[rUX%GM(()!-J$5M#""%"!d"h)!-J,5M#""%K#`!@-#B0J`,[r
+SX'lrkQ8#B()i,[rSGJ!f"#e$rr$@M#4$%K*`!"!"28$rl$SZrqTi!$J&,86rp0L
+-*N33%a5!&Ulrl5!Zrr$3J0#Z!"!J3$!328$rl#)Zrr65JG+Z!"!J36)3*#lrm05
+#e+i!%#"#-)%L,[rddS(5VJ!3)%%`J'!!rc)`,[rUX%GQ"P*(B!$r"$J(GJ!f"#e
+$rrM@M#4$%K*`!"!"28$rl$`ZrqTk!$S',8Arr0U-*N83%a5!&Ulrl5!ZrrM3J0#
+Z!"!J3$!328$rl#)Zrrc5JG+Z!"!J36)3*#lrq05#e+i!%#"#-)%L,[rmdS(5VJ!
+3)%%`J#!Zrr`L,[riN!#"0#i!#R)!-J)N,[rm8S+5JV#"E"i[,J!3,``r"Mm%6VV
+qA%r[!!``,[rU8N!q!'!!rP`[,J!3,``r,J!+-#lrkP*!2`"1Z[if6qm!$$eZrqS
+!#Q!!rMK-haci6Pj1G8j@rq4)jami*'i!#$SZ!!`QEJ!1+'i!%Le-rr!J2!!!!56
+C`#e-rr4#3$`!0JDf4@3XH!!i!be%rrMBLL"%%"!L,[ridUlrm#""%)!J,[rid)$
+3V[rd)%!`Je*'B-i[,[rd,blrm$m&3QG1Z[fb6qm!$%*!2!!f"VC&C"*`!$!$d+l
+rm#"!5K"Q"&*'B1K`!#e!rq3f"VC&C!!!U%T$Cc)J,[rNH!!i!be%rrcBV[r`)%3
+8%()!%J)Q,[rm8i2@V[r`)%-@%(3!&!15JZ1S,8$rj$3'FJ!b!Y+Zrr!J34)3F!!
+3!6i!,@lrj2rXF!!Y32rS-!G64dT!Cb!J,[rSiiJL,[rXG!(#JS#",8$rk#!Zrqc
+LL#e!rqaJf$3'FJ!b!Y+"dUlrp#""-K"`!$!"jB$3Lb"!)+lrk&*'8Ulrj'!!re4
+-haci6Pj1G5*I)&qJ*5k!DJ*#Pdl4)Pm5(c!I5J&R"+G'B!+M4Lk)6Y%LAa)I-"m
+JAdS"C`5Q4f!#SNG1d3#3!`S!1+!"!!8!N!B"!!!"Pi!!!CD!!!!&5e028P3'aJ#
+!!"`%FJ!@38a59!!+!,T"9A-b!!!"2N*14%`!!3&+3dj86!!!!@*$6d4&!!F"EN4
+"9%%!!!(14%P86!!2!GT%6%p(!!3#QNC548B!"!,@4Q9KG!!!!a**3diM!!3$(NP
+$6di!!!0D8%P$9!!%!fC3Ff9d!!!$SP0*@N8!!!1Z8e45)!!"!lT69&)M!!!$dQ&
+eFh3!!32HBfPMEJ!!!rCNBh4L!!%%!Q4XChJ!!33DD@0X1!!!"$*fCA*c!!%%2J#
+!rrmJ!*!)JIrr)!!!%!#3"B,rrb!!!#!!N!@&rrmN!!!`!5Cim!#'rrmN!!"!!3!
+HX!#(rrmJ!!"3!*!&L2rr)!!!B!#3"!)!rrmJ!!"b!*!%!J(rrb!!!))!N!3%!Ir
+r)!!!NJ#3"!5[rrm!!"K#!*!((J!!'&)!N!@!rrm!!"Kf!*!%!3$rr`!!'+i!N!3
+"#2rr)!!BcJ#3"[rr+!&leJ#3"3%!R4`!*TN"!#-8!!)!Ta`!S[S"!#-3!!-!X4`
+![l!"!#,m!!3!Za`!r98"!#,`!!8!a4`",Z)"!#,d!!B!ca`"8!`"!#,i!!Irr`!
+"I!#3"rrr+!"e*3#3"B$rr`#3!k)!N!@#rrm!!!%!N!D&rrmN!!&H!3!M)!#'rrm
+N!!'d!5K#Y!#(rrm!!!)e!*!&L2rr!!!#K3#3"EArrb!!!ed!N!3""Irr)!!$c`#
+3"!%(rrmJ!"MT!*!%!3Mrrb!!'BS!N!3#!2rr!!!%I!#3"!)"rrm!!!5k!*!%!qM
+rrb!!"3B!N!3%!Irr)!!&(!#3"!4,!#d%!"SY!5H6f!5[rrm!!"Tp!*!%!38!!#!
+!"C`!N!3""`!j)!!DZ`#3"!%)!%SJ!"VA!*!%!qMrrb!!"Ei!N!3%5`"Q"!!Dm`%
+QH5J!J2rr!!!E$!#3"B(rr`!!'aF!N!@#rrm!!"XL!*!&Jrrr!!!E,3#3"B6rr`!
+!'cJ!N!Err`!"PR)!N!@!rrm!!"Y$!*!&JIrr!!!F4`#3"B,rr`!!(8X!N!@$rrm
+!!"j2!*!&K2rr!!!I8`#3"!4,rrm%!#"A!3!M*!##rrm!!!AD!*!%!qMrr`!!"[d
+!N!3%62rr!!!1#`#3"!40rrm!!!r%!*!%"%lrr`!!%Ad!N!@!rrm!!"-,!*!%rj!
+%!!&lmJ#3"!)!!!FJ!"G#!*!%!J%!$L!!&e)!N!@!rrm!!"GH!*!(FJ!!)0)!N!@
+%rrm!!#%Y!*!%"%[rr`3!)6%"!#-B!3Arr`!!&ji!N!3"#2rr!!!L9`#3"!%&!"F
+!!"I2!*!%!3J!J3!!)SX!N!@%rrm!!#+9!*!&!Irr)!!Af3#3"3,rrb!!'"`!N!3
+'8h4KG(9c"R"bEfe`G!M%)(0eCQCTH!C6G'&dGA-16hGZCA)JFQ9cEh9bBf8,5@j
+cCA*d)%4TFfX34AKTFh4TEQG3BA0cGfpbC"Y&H'PcG'PZCe"KFh0hEh*N,8&`F'9
+KFQ&ZBf8,5@jcCA*d)%4TFfX16hGZCA)JFQ9cEh9bBf8E4AKTFh4TEQG3BA0cGfp
+bC#e"F("PBA*KEQ0P#90PCfePER3J-3P6C@GYC@jd)$)*8f9RE@9ZG#!c#90PCfe
+PER3J03P6C@GYC@jd)$B*8f9RE@9ZG#!fUl3:
diff --git a/tcl/mac/tkMacRegion.c b/tcl/mac/tkMacRegion.c
new file mode 100644
index 00000000000..4582456c6c4
--- /dev/null
+++ b/tcl/mac/tkMacRegion.c
@@ -0,0 +1,248 @@
+/*
+ * 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 "tkMacInt.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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSubtractRegion --
+ *
+ * Implements the equivilent of the X window function
+ * XSubtractRegion. See X window documentation for more details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSubtractRegion(
+ TkRegion sra,
+ TkRegion srb,
+ TkRegion dr_return)
+{
+ RgnHandle srcRgnA = (RgnHandle) sra;
+ RgnHandle srcRgnB = (RgnHandle) srb;
+ RgnHandle destRgn = (RgnHandle) dr_return;
+
+ DiffRgn(srcRgnA, srcRgnB, destRgn);
+}
diff --git a/tcl/mac/tkMacResource.r b/tcl/mac/tkMacResource.r
new file mode 100644
index 00000000000..742e0852c98
--- /dev/null
+++ b/tcl/mac/tkMacResource.r
@@ -0,0 +1,437 @@
+/*
+ * 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"
+
+/*
+ * 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".
+ */
+
+#ifndef TCLTK_NO_LIBRARY_TEXT_RESOURCES
+#include "tkMacTclCode.r"
+#endif
+
+/*
+ * 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, 260, 412}, dBoxProc, visible, goAway, 0,
+ 128, "", centerMainScreen
+};
+
+resource 'DITL' (128, "About Box", purgeable) {
+ {
+ {143, 147, 167, 201}, Button {enabled, "Ok"},
+ { 14, 108, 137, 314}, StaticText {disabled,
+ "Wish - Windowing Shell" "\n" "based on Tcl "
+ TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n"
+ "Jim Ingham & Ray Johnson" "\n"
+ "© 2001 Tcl Core Team" "\n"
+ "jingham@apple.com"},
+ { 19, 24, 119, 92}, Picture {enabled, 128}
+ }
+};
+
+data 'PICT' (128) {
+ $"13A4 0000 0000 0064 0044 0011 02FF 0C00"
+ $"FFFE 0000 0048 0000 0048 0000 0000 0000"
+ $"0064 0044 0000 0000 0001 000A 0000 0000"
+ $"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/tcl/mac/tkMacScale.c b/tcl/mac/tkMacScale.c
new file mode 100644
index 00000000000..ef214fd3df8
--- /dev/null
+++ b/tcl/mac/tkMacScale.c
@@ -0,0 +1,439 @@
+/*
+ * tkMacScale.c --
+ *
+ * This file implements the Macintosh specific portion of the
+ * scale widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 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 "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;
+
+ scalePtr->flags &= ~REDRAW_PENDING;
+ 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->flags & SCALE_DELETED) {
+ 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;
+
+ gc = Tk_GCForColor(scalePtr->highlightColorPtr, 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->orient == ORIENT_VERTICAL) {
+ return TROUGH1;
+ } else {
+ return TROUGH2;
+ }
+ case inDecr:
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ return TROUGH2;
+ } else {
+ return TROUGH1;
+ }
+ default:
+ return OTHER;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ /* TkScaleSetValue(&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;
+ TkScaleSetValue(scalePtr, value, 1, 1);
+ Tcl_Preserve((ClientData) scalePtr);
+ Tcl_DoOneEvent(TCL_IDLE_EVENTS);
+ Tcl_Release((ClientData) scalePtr);
+}
+
diff --git a/tcl/mac/tkMacScrlbr.c b/tcl/mac/tkMacScrlbr.c
new file mode 100644
index 00000000000..ce91a43012c
--- /dev/null
+++ b/tcl/mac/tkMacScrlbr.c
@@ -0,0 +1,1069 @@
+/*
+ * 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>
+#include <ControlDefinitions.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. Leave the proc fields
+ * initialized to NULL, which should happen automatically because of the scope
+ * at which the variable is declared.
+ */
+
+Tk_ClassProcs tkpScrollbarProcs = {
+ sizeof(Tk_ClassProcs) /* size */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(scrollPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+
+ if (scrollPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(scrollPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, scrollPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, 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;
+ WindowRef frontNonFloating;
+
+ 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 (TkMacHaveAppearance() >= 0x110) {
+ frontNonFloating = FrontNonFloatingWindow();
+ } else {
+ frontNonFloating = FrontWindow();
+ }
+
+ if ((WindowPtr) destPort == FrontWindow() || TkpIsWindowFloating((WindowPtr) destPort)) {
+ 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 kControlUpButtonPart:
+ return TOP_ARROW;
+ case kControlPageUpPart:
+ return TOP_GAP;
+ case kControlIndicatorPart:
+ return SLIDER;
+ case kControlPageDownPart:
+ return BOTTOM_GAP;
+ case kControlDownButtonPart:
+ 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 *) GetControlReference(theControl);
+ Tcl_DString cmdString;
+
+ Tcl_DStringInit(&cmdString);
+ Tcl_DStringAppend(&cmdString, scrollPtr->command,
+ scrollPtr->commandSize);
+
+ if (partCode == kControlUpButtonPart || partCode == kControlDownButtonPart) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (partCode == kControlUpButtonPart ) ? "-1" : "1");
+ Tcl_DStringAppendElement(&cmdString, "unit");
+ } else if (partCode == kControlPageUpPart || partCode == kControlPageDownPart) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (partCode == kControlPageUpPart ) ? "-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 == kControlIndicatorPart && 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 == kControlIndicatorPart) {
+ /*
+ * 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 == kControlIndicatorPart) {
+ 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/tcl/mac/tkMacSend.c b/tcl/mac/tkMacSend.c
new file mode 100644
index 00000000000..e470536eac7
--- /dev/null
+++ b/tcl/mac/tkMacSend.c
@@ -0,0 +1,548 @@
+/*
+ * tkMacSend.c --
+ *
+ * This file provides procedures that implement the "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter. This current implementation for the Mac
+ * has most functionality stubed out.
+ *
+ * The current plan, which we have not had time to implement, is
+ * for the first Wish app to create a gestalt of type 'WIsH'.
+ * This gestalt will point to a table, in system memory, of
+ * Tk apps. Each Tk app, when it starts up, will register their
+ * name, and process ID, in this table. This will allow us to
+ * implement "tk appname".
+ *
+ * Then the send command will look up the process id of the target
+ * app in this table, and send an AppleEvent to that process. The
+ * AppleEvent handler is much like the do script handler, except that
+ * you have to specify the name of the tk app as well, since there may
+ * be many interps in one wish app, and you need to send it to the
+ * right one.
+ *
+ * Implementing this has been on our list of things to do, but what
+ * with the demise of Tcl at Sun, and the lack of resources at
+ * Scriptics it may not get done for awhile. So this sketch is
+ * offered for the brave to attempt if they need the functionality...
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Gestalt.h>
+#include "tkPort.h"
+#include "tkInt.h"
+
+EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+ /*
+ * The following structure is used to keep track of the
+ * interpreters registered by this process.
+ */
+
+typedef struct RegisteredInterp {
+ char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Interp *interp; /* Interpreter associated with
+ * name. */
+ struct RegisteredInterp *nextPtr;
+ /* Next in list of names associated
+ * with interps in this process.
+ * NULL means end of list. */
+} RegisteredInterp;
+
+/*
+ * A registry of all interpreters for a display is kept in a
+ * property "InterpRegistry" on the root window of the display.
+ * It is organized as a series of zero or more concatenated strings
+ * (in no particular order), each of the form
+ * window space name '\0'
+ * where "window" is the hex id of the comm. window to use to talk
+ * 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;
+
+static initialized = false; /* A flag to denote if we have initialized yet. */
+
+static RegisteredInterp *interpListPtr = NULL;
+/* List of all interpreters
+ * registered by this process. */
+
+ /*
+ * The information below is used for communication between processes
+ * during "send" commands. Each process keeps a private window, never
+ * even mapped, with one property, "Comm". When a command is sent to
+ * an interpreter, the command is appended to the comm property of the
+ * communication window associated with the interp's process. Similarly,
+ * 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 DeleteProc _ANSI_ARGS_((ClientData clientData));
+static void RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name, Window commWindow));
+static void RegClose _ANSI_ARGS_((NameRegistry *regPtr));
+static void RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name));
+static Window RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name));
+static NameRegistry * RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr, int lock));
+static void SendEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int SendInit _ANSI_ARGS_((Tcl_Interp *interp));
+static Bool SendRestrictProc _ANSI_ARGS_((Display *display,
+ XEvent *eventPtr, char *arg));
+static int ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr));
+static void TimeoutProc _ANSI_ARGS_((ClientData clientData));
+static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
+ char *name, Window commWindow, int oldOK));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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. */
+ CONST char *name) /* The name that will be used to
+ * refer to the interpreter in later
+ * "send" commands. Must be globally
+ * unique. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ Tcl_Interp *interp = winPtr->mainPtr->interp;
+ int i, suffix, offset, result;
+ int createCommand = 0;
+ RegisteredInterp *riPtr, *prevPtr;
+ char *actualName;
+ Tcl_DString dString;
+ Tcl_Obj *resultObjPtr, *interpNamePtr;
+ char *interpName;
+
+ if (!initialized) {
+ SendInit(interp);
+ }
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry. The deletion of the command
+ * will take care of disposing of this entry.
+ */
+
+ for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL;
+ prevPtr = riPtr, riPtr = riPtr->nextPtr) {
+ if (riPtr->interp == interp) {
+ if (prevPtr == NULL) {
+ interpListPtr = interpListPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = riPtr->nextPtr;
+ }
+ break;
+ }
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ actualName = name;
+ suffix = 1;
+ offset = 0;
+ Tcl_DStringInit(&dString);
+
+ TkGetInterpNames(interp, tkwin);
+ resultObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObjPtr);
+ for (i = 0; ; ) {
+ result = Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr);
+ if (interpNamePtr == NULL) {
+ break;
+ }
+ interpName = Tcl_GetStringFromObj(interpNamePtr, NULL);
+ if (strcmp(actualName, interpName) == 0) {
+ if (suffix == 1) {
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset + 10);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ suffix++;
+ sprintf(actualName + offset, "%d", suffix);
+ i = 0;
+ } else {
+ i++;
+ }
+ }
+
+ Tcl_DecrRefCount(resultObjPtr);
+ Tcl_ResetResult(interp);
+
+ /*
+ * We have found a unique name. Now add it to the registry.
+ */
+
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+ riPtr->name = ckalloc(strlen(actualName) + 1);
+ riPtr->nextPtr = interpListPtr;
+ interpListPtr = riPtr;
+ strcpy(riPtr->name, actualName);
+
+ Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd,
+ (ClientData) riPtr, NULL /* TODO: DeleteProc */);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "send", "send");
+ }
+ Tcl_DStringFree(&dString);
+
+ return riPtr->name;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SendObjCmd --
+ *
+ * This procedure is invoked to process the "send" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SendObjCmd(
+ ClientData clientData, /* Used only for deletion */
+ Tcl_Interp *interp, /* The interp we are sending from */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]) /* The arguments */
+{
+ static CONST char *sendOptions[] = {"-async", "-displayof", "-", (char *) NULL};
+ char *stringRep, *destName;
+ int async = 0;
+ int i, index, firstArg;
+ RegisteredInterp *riPtr;
+ Tcl_Obj *resultPtr, *listObjPtr;
+ int result;
+
+ for (i = 1; i < (objc - 1); ) {
+ stringRep = Tcl_GetStringFromObj(objv[i], NULL);
+ if (stringRep[0] == '-') {
+ if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == 0) {
+ async = 1;
+ i++;
+ } else if (index == 1) {
+ i += 2;
+ } else {
+ i++;
+ }
+ } else {
+ break;
+ }
+ }
+
+ if (objc < (i + 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?options? interpName arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ destName = Tcl_GetStringFromObj(objv[i], NULL);
+ firstArg = i + 1;
+
+ resultPtr = Tcl_GetObjResult(interp);
+
+ /*
+ * See if the target interpreter is local. If so, execute
+ * the command directly without going through the DDE server.
+ * The only tricky thing is passing the result from the target
+ * interpreter to the invoking interpreter. Watch out: they
+ * could be the same!
+ */
+
+ for (riPtr = interpListPtr; (riPtr != NULL)
+ && (strcmp(destName, riPtr->name)); riPtr = riPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ if (riPtr != NULL) {
+ /*
+ * This command is to a local interp. No need to go through
+ * the server.
+ */
+
+ Tcl_Interp *localInterp;
+
+ Tcl_Preserve((ClientData) riPtr);
+ localInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) localInterp);
+ if (firstArg == (objc - 1)) {
+ /*
+ * This might be one of those cases where the new
+ * parser is faster.
+ */
+
+ result = Tcl_EvalObjEx(localInterp, objv[firstArg], TCL_EVAL_DIRECT);
+ } else {
+ listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ for (i = firstArg; i < objc; i++) {
+ Tcl_ListObjAppendList(interp, listObjPtr, objv[i]);
+ }
+ Tcl_IncrRefCount(listObjPtr);
+ result = Tcl_EvalObjEx(localInterp, listObjPtr, TCL_EVAL_DIRECT);
+ Tcl_DecrRefCount(listObjPtr);
+ }
+ if (interp != localInterp) {
+ if (result == TCL_ERROR) {
+ /* Tcl_Obj *errorObjPtr; */
+
+ /*
+ * An error occurred, so transfer error information from the
+ * destination interpreter back to our interpreter. Must clear
+ * interp's result before calling Tcl_AddErrorInfo, since
+ * Tcl_AddErrorInfo will store the interp's result in errorInfo
+ * before appending riPtr's $errorInfo; we've already got
+ * everything we need in riPtr's $errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
+ "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
+ /* errorObjPtr = Tcl_GetObjVar2(localInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, errorObjPtr); */
+ }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) localInterp);
+ } else {
+ /*
+ * This is a non-local request. Send the script to the server and poll
+ * it for a result. TODO!!!
+ */
+ }
+
+done:
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetInterpNames --
+ *
+ * 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_Obj *listObjPtr;
+ RegisteredInterp *riPtr;
+
+ listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ riPtr = interpListPtr;
+ while (riPtr != NULL) {
+ Tcl_ListObjAppendElement(interp, listObjPtr,
+ Tcl_NewStringObj(riPtr->name, -1));
+ riPtr = riPtr->nextPtr;
+ }
+
+ Tcl_SetObjResult(interp, listObjPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SendInit --
+ *
+ * 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). */
+{
+ return TCL_OK;
+}
diff --git a/tcl/mac/tkMacSubwindows.c b/tcl/mac/tkMacSubwindows.c
new file mode 100644
index 00000000000..4b179d78ce7
--- /dev/null
+++ b/tcl/mac/tkMacSubwindows.c
@@ -0,0 +1,1258 @@
+/*
+ * 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_TopWinHierarchy(winPtr)) {
+ TkMacUpdateClipRgn(winPtr->parentPtr);
+ SectRgn(rgn,
+ winPtr->parentPtr->privatePtr->aboveClipRgn, rgn);
+
+ win2Ptr = winPtr->nextPtr;
+ while (win2Ptr != NULL) {
+ if (Tk_TopWinHierarchy(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_TopWinHierarchy(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) {
+ /*
+ * FIXME:
+ *
+ * So far as I can tell, the only time that this happens is when
+ * we are tearing down an embedded child interpreter, and most
+ * of the time, this is harmless... However, we really need to
+ * find why the embedding loses.
+ */
+ DebugStr("\pTkMacGetDrawablePort 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_TopWinHierarchy(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;
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ MoveWindowStructure((WindowRef) window, (short) x, (short) y);
+ } else {
+ 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_TopWinHierarchy(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/tcl/mac/tkMacTclCode.r b/tcl/mac/tkMacTclCode.r
new file mode 100644
index 00000000000..adbd0f66a02
--- /dev/null
+++ b/tcl/mac/tkMacTclCode.r
@@ -0,0 +1,71 @@
+/*
+ * tkMacTclCode.r --
+ *
+ * This file creates resources from the Tcl code that is
+ * usually stored in the TCL_LIBRARY
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMacTclCode.r 1.1 98/01/21 22:22:38
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+#define TK_LIBRARY_RESOURCES 3000
+
+/*
+ * 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' (TK_LIBRARY_RESOURCES+1, "tk", purgeable,preload)
+ "::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, "optMenu", 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, "scrlbar", 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, "bgerror", purgeable)
+ "::library:bgerror.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+15, "console", purgeable)
+ "::library:console.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+16, "msgbox", purgeable)
+ "::library:msgbox.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+17, "comdlg", purgeable)
+ "::library:comdlg.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+18, "spinbox", purgeable)
+ "::library:spinbox.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+19, "panedwindow", purgeable)
+ "::library:panedwindow.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+20, "msgcat", purgeable)
+ ":::tcl:library:msgcat:msgcat.tcl";
diff --git a/tcl/mac/tkMacTest.c b/tcl/mac/tkMacTest.c
new file mode 100644
index 00000000000..7df886f25c0
--- /dev/null
+++ b/tcl/mac/tkMacTest.c
@@ -0,0 +1,82 @@
+/*
+ * 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>
+#include <tcl.h>
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+
+int TkplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+static int DebuggerCmd _ANSI_ARGS_((ClientData dummy,
+ 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/tcl/mac/tkMacWindowMgr.c b/tcl/mac/tkMacWindowMgr.c
new file mode 100644
index 00000000000..cfc61d6b589
--- /dev/null
+++ b/tcl/mac/tkMacWindowMgr.c
@@ -0,0 +1,1791 @@
+/*
+ * tkMacWindowMgr.c --
+ *
+ * Implements common window manager functions for the Macintosh.
+ *
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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, UInt32 savedCode));
+static int GenerateUpdateEvent _ANSI_ARGS_((EventRecord *eventPtr,
+ Window window));
+static void GenerateUpdates _ANSI_ARGS_((RgnHandle updateRgn,
+ TkWindow *winPtr));
+static int GeneratePollingEvents _ANSI_ARGS_((void));
+static int GeneratePollingEvents2 _ANSI_ARGS_((Window window,
+ int adjustCursor));
+static OSErr TellWindowDefProcToCalcRegions _ANSI_ARGS_((WindowRef wRef));
+static int WindowManagerMouse _ANSI_ARGS_((EventRecord *theEvent,
+ Window window));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, frontNonFloating;
+ Tk_Window tkwin;
+ Point where, where2;
+ int xOffset, yOffset;
+ short windowPart;
+ TkDisplay *dispPtr;
+
+ frontWindow = FrontWindow();
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontNonFloating = FrontNonFloatingWindow();
+ } else {
+ frontNonFloating = frontWindow;
+ }
+
+ /*
+ * The window manager only needs to know about mouse down events
+ * and sometimes we need to "eat" the mouse up. Otherwise, we
+ * just pass the event to Tk.
+ */
+ if (eventPtr->what == mouseUp) {
+ if (gEatButtonUp) {
+ gEatButtonUp = false;
+ return false;
+ }
+ return TkGenerateButtonEvent(eventPtr->where.h, eventPtr->where.v,
+ window, TkMacButtonKeyState());
+ }
+
+ windowPart = FindWindow(eventPtr->where, &whichWindow);
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ switch (windowPart) {
+ case inSysWindow:
+ SystemClick(eventPtr, (GrafPort *) whichWindow);
+ return false;
+ case inDrag:
+ if (!(TkpIsWindowFloating(whichWindow)) && (whichWindow != frontNonFloating)) {
+ 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 (!(TkpIsWindowFloating(whichWindow))
+ && (whichWindow != frontNonFloating)) {
+ /*
+ * 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;
+ }
+ gEatButtonUp = true;
+ SetPort((GrafPort *) whichWindow);
+ BringWindowForward(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();
+ /*
+ * Handle -postcommand
+ */
+ TkMacPreprocessMenu();
+ 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);
+ }
+ DisposeDialog(aboutDlog);
+ aboutDlog = NULL;
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ SelectWindow(FrontNonFloatingWindow());
+ } else {
+ 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;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->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_TopWinHierarchy(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;
+ TkDisplay *dispPtr;
+
+ /*
+ * ButtonDown events will always occur in the front
+ * window. ButtonUp events, however, may occur anywhere
+ * on the screen. ButtonUp events should only be sent
+ * to Tk if in the front window or during an implicit grab.
+ */
+ where.h = x;
+ where.v = y;
+ FindWindow(where, &whichWin);
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontWin = FrontNonFloatingWindow();
+ } else {
+ frontWin = FrontWindow();
+ }
+
+ if ((frontWin == NULL) || ((!(TkpIsWindowFloating(whichWin)) && (frontWin != whichWin))
+ && gGrabWinPtr == NULL)) {
+ return false;
+ }
+
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+
+ GlobalToLocal(&where);
+ if (tkwin != NULL) {
+ tkwin = Tk_TopCoordsToWindow(tkwin, where.h, where.v, &dummy, &dummy);
+ }
+
+ Tk_UpdatePointer(tkwin, x, y, state);
+
+ 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;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
+ if (winPtr == NULL || winPtr->window == None) {
+ return false;
+ }
+
+ TkGenerateActivateEvents(winPtr,
+ (eventPtr->modifiers & activeFlag) ? 1 : 0);
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ if (tkwin == NULL) {
+ return false;
+ }
+
+ /*
+ * Generate FocusIn and FocusOut events. This event
+ * is only sent to the toplevel window.
+ */
+
+ if (eventPtr->modifiers & activeFlag) {
+ event.xany.type = FocusIn;
+ } else {
+ event.xany.type = FocusOut;
+ }
+
+ event.xany.serial = dispPtr->display->request;
+ event.xany.send_event = False;
+ event.xfocus.display = dispPtr->display;
+ event.xfocus.window = window;
+ event.xfocus.mode = NotifyNormal;
+ event.xfocus.detail = NotifyDetailNone;
+
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ UInt32 savedKeyCode) /* If non-zero, this is a lead byte which
+ * should be combined with the character
+ * in this event to form one multi-byte
+ * character. */
+{
+ Point where;
+ Tk_Window tkwin;
+ XEvent event;
+ unsigned char byte;
+ char buf[16];
+ TkDisplay *dispPtr;
+
+ /*
+ * The focus must be in the FrontWindow on the Macintosh.
+ * We then query Tk to determine the exact Tk window
+ * that owns the focus.
+ */
+
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+
+ if (tkwin == NULL) {
+ return false;
+ }
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
+ if (tkwin == NULL) {
+ return false;
+ }
+ byte = (unsigned char) (eventPtr->message & charCodeMask);
+ if ((savedKeyCode == 0) &&
+ (Tcl_ExternalToUtf(NULL, NULL, (char *) &byte, 1, 0, NULL,
+ buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK)) {
+ /*
+ * This event specifies a lead byte. Wait for the second byte
+ * to come in before sending the XEvent.
+ */
+
+ return false;
+ }
+
+ where.v = eventPtr->where.v;
+ where.h = eventPtr->where.h;
+
+ event.xany.send_event = False;
+ event.xkey.same_screen = true;
+ event.xkey.subwindow = None;
+ event.xkey.time = TkpGetMS();
+
+ event.xkey.x_root = where.h;
+ event.xkey.y_root = where.v;
+ GlobalToLocal(&where);
+ Tk_TopCoordsToWindow(tkwin, where.h, where.v,
+ &event.xkey.x, &event.xkey.y);
+
+ event.xkey.keycode = byte |
+ ((savedKeyCode & charCodeMask) << 8) |
+ ((eventPtr->message & keyCodeMask) << 8);
+
+ event.xany.serial = Tk_Display(tkwin)->request;
+ event.xkey.window = Tk_WindowId(tkwin);
+ event.xkey.display = Tk_Display(tkwin);
+ event.xkey.root = XRootWindow(Tk_Display(tkwin), 0);
+ event.xkey.state = TkMacButtonKeyState();
+
+ 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, frontNonFloating;
+ Point whereLocal, whereGlobal;
+ Boolean inContentRgn;
+ short part;
+ int local_x, local_y;
+ int generatedEvents = false;
+ TkDisplay *dispPtr;
+
+ /*
+ * First we get the current mouse position and determine
+ * what Tk window the mouse is over (if any).
+ */
+ frontWin = FrontWindow();
+ if (frontWin == NULL) {
+ return false;
+ }
+ SetPort((GrafPort *) frontWin);
+
+ GetMouse(&whereLocal);
+ whereGlobal = whereLocal;
+ LocalToGlobal(&whereGlobal);
+
+ part = FindWindow(whereGlobal, &whichWindow);
+ inContentRgn = (part == inContent || part == inGrow);
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ /*
+ * If the mouse is over the front non-floating window, then we
+ * need to set the local coordinates relative to that window
+ * rather than a possibly floating window above it.
+ */
+
+ frontNonFloating = FrontNonFloatingWindow();
+ if (whichWindow == frontNonFloating
+ && (whichWindow != frontWin)) {
+ SetPort((GrafPort *) frontNonFloating);
+ whereLocal = whereGlobal;
+ GlobalToLocal(&whereLocal);
+ }
+ } else {
+ frontNonFloating = frontWin;
+ }
+
+ if ((!TkpIsWindowFloating(whichWindow) && (frontNonFloating != whichWindow)) || !inContentRgn) {
+ tkwin = NULL;
+ } else {
+ window = TkMacGetXWindow(whichWindow);
+ dispPtr = TkGetDisplayList();
+ rootwin = Tk_IdToWindow(dispPtr->display, window);
+ if (rootwin == NULL) {
+ tkwin = NULL;
+ } else {
+ tkwin = Tk_TopCoordsToWindow(rootwin, whereLocal.h, whereLocal.v,
+ &local_x, &local_y);
+ }
+ }
+
+ /*
+ * The following call will generate the appropiate X events and
+ * adjust any state that Tk must remember.
+ */
+
+ if ((tkwin == NULL) && (gGrabWinPtr != NULL)) {
+ tkwin = gGrabWinPtr;
+ }
+ Tk_UpdatePointer(tkwin, whereGlobal.h, whereGlobal.v,
+ TkMacButtonKeyState());
+
+ /*
+ * Finally, we make sure the proper cursor is installed. The installation
+ * is polled to 1) make our resize hack work, and 2) make sure we have the
+ * proper cursor even if someone else changed the cursor out from under
+ * us.
+ */
+ if ((gGrabWinPtr == NULL) && (part == inGrow) &&
+ 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;
+ TkDisplay *dispPtr;
+
+ /*
+ * First we get the current mouse position and determine
+ * what Tk window the mouse is over (if any).
+ */
+ frontWin = FrontWindow();
+ if (frontWin == NULL) {
+ return false;
+ }
+ 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 {
+ dispPtr = TkGetDisplayList();
+ rootwin = Tk_IdToWindow(dispPtr->display, window);
+ TkMacWinBounds((TkWindow *) rootwin, &bounds);
+ if (!PtInRect(whereLocal, &bounds)) {
+ tkwin = NULL;
+ } else {
+ tkwin = Tk_TopCoordsToWindow(rootwin, whereLocal.h, whereLocal.v,
+ &local_x, &local_y);
+ }
+ }
+
+
+ /*
+ * The following call will generate the appropiate X events and
+ * adjust any state that Tk must remember.
+ */
+
+ if ((tkwin == NULL) && (gGrabWinPtr != NULL)) {
+ tkwin = gGrabWinPtr;
+ }
+ Tk_UpdatePointer(tkwin, whereGlobal.h, whereGlobal.v,
+ TkMacButtonKeyState());
+
+ /*
+ * Finally, we make sure the proper cursor is installed. The installation
+ * is polled to 1) make our resize hack work, and 2) make sure we have the
+ * proper cursor even if someone else changed the cursor out from under
+ * us.
+ */
+
+ if (adjustCursor) {
+ TkMacInstallCursor(0);
+ }
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacButtonKeyState --
+ *
+ * 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;
+ static UInt32 savedKeyCode;
+
+ 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;
+ }
+ }
+ /* fall through */
+
+ case keyUp:
+ if (TkMacHaveAppearance() >= 0x110) {
+ whichWindow = FrontNonFloatingWindow();
+ } else {
+ whichWindow = FrontWindow();
+ }
+ if (whichWindow == NULL) {
+ /*
+ * This happens if we get a key event before Tk has had a
+ * chance to actually create and realize ".", if they type
+ * when "." is withdrawn(!), or between the time "." is
+ * destroyed and the app exits.
+ */
+
+ return false;
+ }
+ window = TkMacGetXWindow(whichWindow);
+ if (GenerateKeyEvent(eventPtr, window, savedKeyCode) == 0) {
+ savedKeyCode = eventPtr->message;
+ return false;
+ }
+ eventFound = true;
+ break;
+
+ case activateEvt:
+ window = TkMacGetXWindow((WindowRef) eventPtr->message);
+ eventFound |= GenerateActivateEvents(eventPtr, window);
+ eventFound |= GenerateFocusEvent(eventPtr, window);
+ break;
+ case getFocusEvent:
+ eventPtr->modifiers |= activeFlag;
+ 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);
+ if (TkMacHaveAppearance() >= 0x110) {
+ if (tkMacAppInFront) {
+ ShowFloatingWindows();
+ } else {
+ HideFloatingWindows();
+ }
+ }
+ 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;
+ }
+
+ savedKeyCode = 0;
+ return eventFound;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacConvertTkEvent --
+ *
+ * This function converts a Macintosh event into zero or more
+ * Tcl events. It is intended for use in Netscape-style embedding.
+ *
+ * Results:
+ * Returns 1 if event added to Tcl queue, 0 otherwse.
+ *
+ * Side effects:
+ * May add events to Tcl's event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacConvertTkEvent(
+ EventRecord *eventPtr,
+ Window window)
+{
+ int eventFound = false;
+ Point where;
+ static UInt32 savedKeyCode;
+
+ /*
+ * By default, assume it is legal for us to set the cursor
+ */
+
+ Tk_MacTkOwnsCursor(1);
+
+ switch (eventPtr->what) {
+ case nullEvent:
+ /*
+ * We get NULL events only when the cursor is NOT over
+ * the plugin. Otherwise we get updateCursor events.
+ * We will not generate polling events or move the cursor
+ * in this case.
+ */
+
+ eventFound = false;
+ break;
+ case adjustCursorEvent:
+ if (GeneratePollingEvents2(window, 1)) {
+ eventFound = true;
+ }
+ break;
+ case updateEvt:
+ /*
+ * It is possibly not legal for us to set the cursor
+ */
+
+ Tk_MacTkOwnsCursor(0);
+ if (GenerateUpdateEvent(eventPtr, window)) {
+ eventFound = true;
+ }
+ break;
+ case mouseDown:
+ case mouseUp:
+ GetMouse(&where);
+ 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;
+ }
+ }
+ /* fall through. */
+
+ case keyUp:
+ if (GenerateKeyEvent(eventPtr, window, savedKeyCode) == 0) {
+ savedKeyCode = eventPtr->message;
+ return false;
+ }
+ eventFound = true;
+ break;
+
+ case activateEvt:
+ /*
+ * It is probably not legal for us to set the cursor
+ * here, since we don't know where the mouse is in the
+ * window that is being activated.
+ */
+
+ Tk_MacTkOwnsCursor(0);
+ eventFound |= GenerateActivateEvents(eventPtr, window);
+ eventFound |= GenerateFocusEvent(eventPtr, window);
+ break;
+ case getFocusEvent:
+ eventPtr->modifiers |= activeFlag;
+ eventFound |= GenerateFocusEvent(eventPtr, window);
+ break;
+ case loseFocusEvent:
+ eventPtr->modifiers &= ~activeFlag;
+ eventFound |= GenerateFocusEvent(eventPtr, window);
+ break;
+ case kHighLevelEvent:
+ TkMacDoHLEvent(eventPtr);
+ /* TODO: should return true if events were placed on event queue. */
+ break;
+ case osEvt:
+ /*
+ * Do clipboard conversion.
+ */
+ switch ((eventPtr->message & osEvtMessageMask) >> 24) {
+ /*
+ * It is possibly not legal for us to set the cursor.
+ * Netscape sends us these events all the time...
+ */
+
+ Tk_MacTkOwnsCursor(0);
+
+ case mouseMovedMessage:
+ /* if (GeneratePollingEvents2(window, 0)) {
+ eventFound = true;
+ } NEXT LINE IS TEMPORARY */
+ eventFound = false;
+ break;
+ case suspendResumeMessage:
+ if (!(eventPtr->message & resumeFlag)) {
+ TkSuspendClipboard();
+ }
+ tkMacAppInFront = (eventPtr->message & resumeFlag);
+ if (TkMacHaveAppearance() >= 0x110) {
+ if (tkMacAppInFront) {
+ ShowFloatingWindows();
+ } else {
+ HideFloatingWindows();
+ }
+ }
+ 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;
+ }
+ savedKeyCode = 0;
+ 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_TopWinHierarchy(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 if (TkMacHaveAppearance()) {
+ GetWindowRegion(wRef, kWindowStructureRgn, strucRgn);
+ GetWindowRegion(wRef, kWindowContentRgn, contRgn);
+ strucRect = (**strucRgn).rgnBBox;
+ contRect = (**contRgn).rgnBBox;
+ } 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)
+{
+ if (!TkpIsWindowFloating(wRef)) {
+ if ((TkMacHaveAppearance() < 0x110) || IsValidWindowPtr(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;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpIsWindowFloating --
+ *
+ * Returns 1 if a window is floating, 0 otherwise.
+ *
+ * Results:
+ * 1 or 0 depending on window's floating attribute.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpIsWindowFloating(WindowRef wRef)
+{
+ WindowClass class;
+
+ if (TkMacHaveAppearance() < 0x110) {
+ return 0;
+ }
+
+ GetWindowClass(wRef, &class);
+
+ return (class == kFloatingWindowClass);
+
+}
diff --git a/tcl/mac/tkMacWm.c b/tcl/mac/tkMacWm.c
new file mode 100644
index 00000000000..91a33dd623e
--- /dev/null
+++ b/tcl/mac/tkMacWm.c
@@ -0,0 +1,5787 @@
+/*
+ * 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. */
+ 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. */
+
+ /*
+ * 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. */
+ CONST 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. */
+ int macClass;
+ int attributes;
+ 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 TkWmStackorderToplevelWrapperMap _ANSI_ARGS_((
+ TkWindow *winPtr,
+ Tcl_HashTable *reparentTable));
+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));
+static int WmAspectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmAttributesCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmClientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmColormapwindowsCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmCommandCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmDeiconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFocusmodelCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFrameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGeometryCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGridCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGroupCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconbitmapCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconwindowCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMaxsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMinsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmOverrideredirectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmPositionfromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmProtocolCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmResizableCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmSizefromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStackorderCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStateCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTitleCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTransientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr,
+ TkWindow *winPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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->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->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;
+ if (TkMacHaveAppearance() >= 0x110) {
+ wmPtr->style = -1;
+ } else {
+ wmPtr->style = documentProc;
+ }
+ wmPtr->macClass = kDocumentWindowClass;
+ wmPtr->attributes = kWindowStandardDocumentAttributes;
+ 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 (!Tk_IsEmbedded(winPtr)) {
+ TkSetWMName(winPtr, ((wmPtr->title != NULL) ?
+ wmPtr->title : winPtr->nameUid);
+ }
+
+ 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->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;
+ }
+ 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_WmObjCmd --
+ *
+ * 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_WmObjCmd(
+ 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;
+ static CONST char *optionStrings[] = {
+ "aspect", "attributes", "client", "colormapwindows",
+ "command", "deiconify", "focusmodel", "frame",
+ "geometry", "grid", "group", "iconbitmap",
+ "iconify", "iconmask", "iconname", "iconposition",
+ "iconwindow", "maxsize", "minsize", "overrideredirect",
+ "positionfrom", "protocol", "resizable", "sizefrom",
+ "stackorder", "state", "title", "transient",
+ "withdraw", (char *) NULL };
+ enum options {
+ WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
+ WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
+ WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
+ WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
+ WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
+ WMOPT_WITHDRAW };
+ int index, length;
+ char *argv1;
+ TkWindow *winPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objc < 2) {
+ wrongNumArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ argv1 = Tcl_GetStringFromObj(objv[1], &length);
+ if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0)
+ && (length >= 3)) {
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC);
+ return TCL_OK;
+ }
+ return Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing);
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc < 3) {
+ goto wrongNumArgs;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case WMOPT_ASPECT:
+ return WmAspectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ATTRIBUTES:
+ return WmAttributesCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_CLIENT:
+ return WmClientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COLORMAPWINDOWS:
+ return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COMMAND:
+ return WmCommandCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_DEICONIFY:
+ return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FOCUSMODEL:
+ return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FRAME:
+ return WmFrameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GEOMETRY:
+ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GRID:
+ return WmGridCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GROUP:
+ return WmGroupCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONBITMAP:
+ return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONIFY:
+ return WmIconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONMASK:
+ return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONNAME:
+ return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPOSITION:
+ return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONWINDOW:
+ return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MAXSIZE:
+ return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MINSIZE:
+ return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_OVERRIDEREDIRECT:
+ return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_POSITIONFROM:
+ return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_PROTOCOL:
+ return WmProtocolCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_RESIZABLE:
+ return WmResizableCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_SIZEFROM:
+ return WmSizefromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STACKORDER:
+ return WmStackorderCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STATE:
+ return WmStateCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TITLE:
+ return WmTitleCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TRANSIENT:
+ return WmTransientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_WITHDRAW:
+ return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAspectCmd --
+ *
+ * This procedure is invoked to process the "wm aspect" 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
+WmAspectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int numer1, denom1, numer2, denom2;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?minNumer minDenom maxNumer maxDenom?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PAspect) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
+ wmPtr->minAspect.y, wmPtr->maxAspect.x,
+ wmPtr->maxAspect.y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~PAspect;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
+ (denom2 <= 0)) {
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ wmPtr->minAspect.x = numer1;
+ wmPtr->minAspect.y = denom1;
+ wmPtr->maxAspect.x = numer2;
+ wmPtr->maxAspect.y = denom2;
+ wmPtr->sizeHintsFlags |= PAspect;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAttributesCmd --
+ *
+ * This procedure is invoked to process the "wm attributes" 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
+WmAttributesCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmClientCmd --
+ *
+ * This procedure is invoked to process the "wm client" 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
+WmClientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->clientMachine != NULL) {
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (argv3[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) (length + 1));
+ strcpy(wmPtr->clientMachine, argv3);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmColormapwindowsCmd --
+ *
+ * This procedure is invoked to process the "wm colormapwindows"
+ * 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
+WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ TkWindow **cmapList;
+ TkWindow *winPtr2;
+ int i, windowObjc, gotToplevel = 0;
+ Tcl_Obj **windowObjv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?");
+ return TCL_ERROR;
+ }
+ if (objc == 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_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (TkWindow **) ckalloc((unsigned)
+ ((windowObjc+1)*sizeof(TkWindow*)));
+ for (i = 0; i < windowObjc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, windowObjv[i],
+ (Tk_Window *) &winPtr2) != TCL_OK)
+ {
+ ckfree((char *) cmapList);
+ 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[windowObjc] = winPtr;
+ windowObjc++;
+ } 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 = windowObjc;
+
+ /*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmCommandCmd --
+ *
+ * This procedure is invoked to process the "wm command" 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
+WmCommandCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int cmdArgc;
+ CONST char **cmdArgv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?value?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->cmdArgv != NULL) {
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (argv3[0] == 0) {
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ wmPtr->cmdArgv = NULL;
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ wmPtr->cmdArgc = cmdArgc;
+ wmPtr->cmdArgv = cmdArgv;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmDeiconifyCmd --
+ *
+ * This procedure is invoked to process the "wm deiconify" 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
+WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[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 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);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFocusmodelCmd --
+ *
+ * This procedure is invoked to process the "wm focusmodel" 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
+WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "active", "passive", (char *) NULL };
+ enum options {
+ OPT_ACTIVE, OPT_PASSIVE };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ACTIVE) {
+ wmPtr->hints.input = False;
+ } else { /* OPT_PASSIVE */
+ wmPtr->hints.input = True;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFrameCmd --
+ *
+ * This procedure is invoked to process the "wm frame" 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
+WmFrameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Window window;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ window = wmPtr->reparent;
+ if (window == None) {
+ window = Tk_WindowId((Tk_Window) winPtr);
+ }
+ sprintf(buf, "0x%x", (unsigned int) window);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGeometryCmd --
+ *
+ * This procedure is invoked to process the "wm geometry" 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
+WmGeometryCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char xSign, ySign;
+ int width, height;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
+ xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
+ ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
+ if (wmPtr->gridWin != NULL) {
+ width = wmPtr->reqGridWidth + (winPtr->changes.width
+ - winPtr->reqWidth)/wmPtr->widthInc;
+ height = wmPtr->reqGridHeight + (winPtr->changes.height
+ - winPtr->reqHeight)/wmPtr->heightInc;
+ } else {
+ width = winPtr->changes.width;
+ height = winPtr->changes.height;
+ }
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\0') {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+ }
+ return ParseGeometry(interp, argv3, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGridCmd --
+ *
+ * This procedure is invoked to process the "wm grid" 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
+WmGridCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int reqWidth, reqHeight, widthInc, heightInc;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?baseWidth baseHeight widthInc heightInc?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PBaseSize) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
+ wmPtr->reqGridHeight, wmPtr->widthInc,
+ wmPtr->heightInc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (reqWidth < 0) {
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (reqHeight < 0) {
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (widthInc < 0) {
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (heightInc < 0) {
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
+ heightInc);
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGroupCmd --
+ *
+ * This procedure is invoked to process the "wm group" 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
+WmGroupCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & WindowGroupHint) {
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (*argv3 == '\0') {
+ wmPtr->hints.flags &= ~WindowGroupHint;
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(tkwin2);
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->hints.window_group = Tk_WindowId(tkwin2);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->leaderName, argv3);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconbitmapCmd --
+ *
+ * This procedure is invoked to process the "wm iconbitmap" 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
+WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ Pixmap pixmap;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\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, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconifyCmd --
+ *
+ * This procedure is invoked to process the "wm iconify" 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
+WmIconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ 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 ", winPtr->pathName,
+ ": 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);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconmaskCmd --
+ *
+ * This procedure is invoked to process the "wm iconmask" 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
+WmIconmaskCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Pixmap pixmap;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\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, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconnameCmd --
+ *
+ * This procedure is invoked to process the "wm iconname" 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
+WmIconnameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->iconName != NULL) {
+ ckfree((char *) wmPtr->iconName);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->iconName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->iconName, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconpositionCmd --
+ *
+ * This procedure is invoked to process the "wm iconposition"
+ * 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
+WmIconpositionCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPositionHint) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->hints.icon_x,
+ wmPtr->hints.icon_y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->hints.flags &= ~IconPositionHint;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconwindowCmd --
+ *
+ * This procedure is invoked to process the "wm iconwindow" 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
+WmIconwindowCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->icon != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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 {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]),
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[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);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMaxsizeCmd --
+ *
+ * This procedure is invoked to process the "wm maxsize" 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
+WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->maxWidth, wmPtr->maxHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->maxWidth = width;
+ wmPtr->maxHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMinsizeCmd --
+ *
+ * This procedure is invoked to process the "wm minsize" 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
+WmMinsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->minWidth = width;
+ wmPtr->minHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmOverrideredirectCmd --
+ *
+ * This procedure is invoked to process the "wm overrideredirect"
+ * 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
+WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int boolean;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ Tk_Attributes((Tk_Window) winPtr)->override_redirect);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[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;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmPositionfromCmd --
+ *
+ * This procedure is invoked to process the "wm positionfrom"
+ * 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
+WmPositionfromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USPosition) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PPosition) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmProtocolCmd --
+ *
+ * This procedure is invoked to process the "wm protocol" 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
+WmProtocolCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ char *cmd;
+ int cmdLength;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?");
+ return TCL_ERROR;
+ }
+ if (objc == 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, Tcl_GetString(objv[3]));
+ if (objc == 4) {
+ /*
+ * Return the command to handle a given protocol.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * 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;
+ }
+ }
+ cmd = Tcl_GetStringFromObj(objv[4], &cmdLength);
+ 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, cmd);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmResizableCmd --
+ *
+ * This procedure is invoked to process the "wm resizable" 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
+WmResizableCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
+ (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[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);
+ }
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmSizefromCmd --
+ *
+ * This procedure is invoked to process the "wm sizefrom" 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
+WmSizefromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USSize) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PSize) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USSize|PSize);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else { /* OPT_PROGRAM */
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStackorderCmd --
+ *
+ * This procedure is invoked to process the "wm stackorder" 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
+WmStackorderCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ TkWindow **windows, **window_ptr;
+ static CONST char *optionStrings[] = {
+ "isabove", "isbelow", (char *) NULL };
+ enum options {
+ OPT_ISABOVE, OPT_ISBELOW };
+ int index;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ windows = TkWmStackorderToplevel(winPtr);
+ if (windows == NULL) {
+ panic("TkWmStackorderToplevel failed");
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ Tcl_AppendElement(interp, (*window_ptr)->pathName);
+ }
+ ckfree((char *) windows);
+ return TCL_OK;
+ }
+ } else {
+ TkWindow *winPtr2;
+ int index1=-1, index2=-1, result;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsTopLevel(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Lookup stacking order of all toplevels that are children
+ * of "." and find the position of winPtr and winPtr2
+ * in the stacking order.
+ */
+
+ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
+
+ if (windows == NULL) {
+ Tcl_AppendResult(interp, "TkWmStackorderToplevel failed",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ if (*window_ptr == winPtr)
+ index1 = (window_ptr - windows);
+ if (*window_ptr == winPtr2)
+ index2 = (window_ptr - windows);
+ }
+ if (index1 == -1)
+ panic("winPtr window not found");
+ if (index2 == -1)
+ panic("winPtr2 window not found");
+
+ ckfree((char *) windows);
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ISABOVE) {
+ result = index1 > index2;
+ } else { /* OPT_ISBELOW */
+ result = index1 < index2;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+ return TCL_OK;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStateCmd --
+ *
+ * This procedure is invoked to process the "wm state" 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
+WmStateCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "normal", "iconic", "withdrawn", "zoomed", (char *) NULL };
+ enum options {
+ OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN, OPT_ZOOMED };
+ int index;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?state?");
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ",
+ Tcl_GetString(objv[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 change state of ",
+ winPtr->pathName, ": it is an embedded window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == OPT_NORMAL) {
+ TkpWmSetState(winPtr, NormalState);
+ /*
+ * This varies from 'wm deiconify' because it does not
+ * force the window to be raised and receive focus
+ */
+ } else if (index == OPT_ICONIC) {
+ 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 != NULL) {
+ Tcl_AppendResult(interp, "can't iconify \"",
+ winPtr->pathName,
+ "\": it is a transient", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, IconicState);
+ } else if (index == OPT_WITHDRAWN) {
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else { /* OPT_ZOOMED */
+ TkpWmSetState(winPtr, ZoomState);
+ }
+ } else {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else {
+ switch (wmPtr->hints.initial_state) {
+ case NormalState:
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ break;
+ case IconicState:
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ break;
+ case WithdrawnState:
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ break;
+ case ZoomState:
+ Tcl_SetResult(interp, "zoomed", TCL_STATIC);
+ break;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTitleCmd --
+ *
+ * This procedure is invoked to process the "wm title" 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
+WmTitleCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp,
+ ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->title != NULL) {
+ ckfree((char *) wmPtr->title);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->title = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->title, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED) && !Tk_IsEmbedded(winPtr)) {
+ TkSetWMName(winPtr, wmPtr->title);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTransientCmd --
+ *
+ * This procedure is invoked to process the "wm transient" 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
+WmTransientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window master;
+ WmInfo *wmPtr2;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?master?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->master != None) {
+ Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ wmPtr->master = None;
+ if (wmPtr->masterWindowName != NULL) {
+ ckfree(wmPtr->masterWindowName);
+ }
+ wmPtr->masterWindowName = NULL;
+ wmPtr->style = documentProc;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(master);
+
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[2]),
+ "\" a transient: it is an icon for ",
+ Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ wmPtr2 = ((TkWindow *) master)->wmInfoPtr;
+
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[3]),
+ "\" a master: it is an icon for ",
+ Tk_PathName(wmPtr2->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->master = Tk_WindowId(master);
+ wmPtr->masterWindowName = ckalloc((unsigned) length+1);
+ strcpy(wmPtr->masterWindowName, argv3);
+ wmPtr->style = plainDBox;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmWithdrawCmd --
+ *
+ * This procedure is invoked to process the "wm withdraw" 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
+WmWithdrawCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, WithdrawnState);
+ return TCL_OK;
+}
+
+/*
+ * Invoked by those wm subcommands that affect geometry.
+ * Schedules a geometry update.
+ */
+static void
+WmUpdateGeom(wmPtr, winPtr)
+ WmInfo *wmPtr;
+ TkWindow *winPtr;
+{
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tk_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ 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_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ 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
+ * the interp's 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_HIERARCHY) {
+ 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;
+ }
+ }
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ break; /* Punt */
+ }
+ 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;
+ TkDisplay *dispPtr;
+
+ /*
+ * Step 1: find the top-level window that contains the desired point.
+ */
+
+ where.h = rootX;
+ where.v = rootY;
+ FindWindow(where, &whichWin);
+ if (whichWin == NULL) {
+ return NULL;
+ }
+ rootChild = TkMacGetXWindow(whichWin);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, rootChild);
+ if (winPtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Step 2: work down through the hierarchy underneath this window.
+ * At each level, scan through all the children to find the highest
+ * 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_HIERARCHY)) {
+ 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_HIERARCHY)) {
+ 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_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return; /* Punt */
+ }
+
+ /*
+ * 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevelWrapperMap --
+ *
+ * This procedure will create a table that maps the reparent wrapper
+ * X id for a toplevel to the TkWindow structure that is wraps.
+ * Tk keeps track of a mapping from the window X id to the TkWindow
+ * structure but that does us no good here since we only get the X
+ * id of the wrapper window. Only those toplevel windows that are
+ * mapped have a position in the stacking order.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds entries to the passed hashtable.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TkWmStackorderToplevelWrapperMap(winPtr, table)
+ TkWindow *winPtr; /* TkWindow to recurse on */
+ Tcl_HashTable *table; /* Maps mac window to TkWindow */
+{
+ TkWindow *childPtr;
+ Tcl_HashEntry *hPtr;
+ WindowPeek wrapper;
+ int newEntry;
+
+ if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) &&
+ !Tk_IsEmbedded(winPtr)) {
+ wrapper = (WindowPeek) TkMacGetDrawablePort(winPtr->window);
+
+ hPtr = Tcl_CreateHashEntry(table,
+ (char *) wrapper, &newEntry);
+ Tcl_SetHashValue(hPtr, winPtr);
+ }
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ TkWmStackorderToplevelWrapperMap(childPtr, table);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevel --
+ *
+ * This procedure returns the stack order of toplevel windows.
+ *
+ * Results:
+ * An array of pointers to tk window objects in stacking order
+ * or else NULL if there was an error.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow **
+TkWmStackorderToplevel(parentPtr)
+ TkWindow *parentPtr; /* Parent toplevel window. */
+{
+ WindowPeek frontWindow;
+ TkWindow *childWinPtr, **windows, **window_ptr;
+ Tcl_HashTable table;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Map mac windows to a TkWindow of the wrapped toplevel.
+ */
+
+ Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS);
+ TkWmStackorderToplevelWrapperMap(parentPtr, &table);
+
+ windows = (TkWindow **) ckalloc((table.numEntries+1)
+ * sizeof(TkWindow *));
+
+ /*
+ * Special cases: If zero or one toplevels were mapped
+ * there is no need to enumerate Windows.
+ */
+
+ switch (table.numEntries) {
+ case 0:
+ windows[0] = NULL;
+ goto done;
+ case 1:
+ hPtr = Tcl_FirstHashEntry(&table, &search);
+ windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr);
+ windows[1] = NULL;
+ goto done;
+ }
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontWindow = (WindowPeek) FrontNonFloatingWindow();
+ } else {
+ frontWindow = (WindowPeek) FrontWindow();
+ }
+
+ if (frontWindow == NULL) {
+ ckfree((char *) windows);
+ windows = NULL;
+ } else {
+ window_ptr = windows + table.numEntries;
+ *window_ptr-- = NULL;
+ while (frontWindow != NULL) {
+ hPtr = Tcl_FindHashEntry(&table, (char *) frontWindow);
+ if (hPtr != NULL) {
+ childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr);
+ *window_ptr-- = childWinPtr;
+ }
+ frontWindow = frontWindow->nextWindow;
+ }
+ if (window_ptr != (windows-1))
+ panic("num matched toplevel windows does not equal num children");
+ }
+
+ done:
+ Tcl_DeleteHashTable(&table);
+ return windows;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontWindow = (WindowPeek) FrontNonFloatingWindow();
+ } else {
+ 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_HIERARCHY) {
+ break;
+ }
+ }
+ if (topPtr->wmInfoPtr == NULL) {
+ return;
+ }
+
+ 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_HIERARCHY) {
+ 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.
+ */
+
+ if (topPtr->wmInfoPtr == NULL) {
+ return;
+ }
+
+ 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;
+ TkDisplay *dispPtr;
+
+ GlobalToLocal(&where);
+ if (where.h > (whichWindow->portRect.right - 16) &&
+ where.v > (whichWindow->portRect.bottom - 16)) {
+
+ Window window;
+ TkWindow *winPtr;
+ WmInfo *wmPtr;
+ Rect bounds;
+ long growResult;
+
+ window = TkMacGetXWindow(whichWindow);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
+ wmPtr = winPtr->wmInfoPtr;
+
+ /* TODO: handle grid size options. */
+ if ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) &&
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
+ return false;
+ }
+ 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,
+ char *title)
+{
+ Str255 pTitle;
+ GWorldPtr macWin;
+ int destWrote;
+
+ if (Tk_IsEmbedded(winPtr)) {
+ return;
+ }
+ Tcl_UtfToExternal(NULL, NULL, title,
+ strlen(title), 0, NULL,
+ (char *) &pTitle[1],
+ 255, NULL, &destWrote, NULL); /* Internalize native */
+ pTitle[0] = destWrote;
+
+ macWin = TkMacGetDrawablePort(winPtr->window);
+
+ SetWTitle((WindowPtr) macWin, pTitle);
+}
+
+void
+TkGenWMDestroyEvent(
+ Tk_Window tkwin)
+{
+ 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;
+ TkDisplay *dispPtr;
+
+ 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);
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ if (tkwin == NULL) {
+ return false;
+ }
+
+ /*
+ * The following block of code works around a bug in the window
+ * definition for Apple's floating windows. The zoom behavior is
+ * 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
+ * "::tk::unsupported::MacWindowStyle" 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. */
+ CONST 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 (!Tk_IsTopLevel(winPtr)) {
+ 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 (TkMacHaveAppearance() >= 0x110) {
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " style window ?windowStyle?\"",
+ " or \"", argv[0], "style window ?class attributes?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ 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) {
+ int appearanceSpec = 0;
+
+ switch (wmPtr->style) {
+ case -1:
+ appearanceSpec = 1;
+ break;
+ case noGrowDocProc:
+ case documentProc:
+ Tcl_SetResult(interp, "documentProc", TCL_STATIC);
+ break;
+ case dBoxProc:
+ Tcl_SetResult(interp, "dBoxProc", TCL_STATIC);
+ break;
+ case plainDBox:
+ Tcl_SetResult(interp, "plainDBox", TCL_STATIC);
+ break;
+ case altDBoxProc:
+ Tcl_SetResult(interp, "altDBoxProc", TCL_STATIC);
+ break;
+ case movableDBoxProc:
+ Tcl_SetResult(interp, "movableDBoxProc", TCL_STATIC);
+ break;
+ case zoomDocProc:
+ case zoomNoGrow:
+ Tcl_SetResult(interp, "zoomDocProc", TCL_STATIC);
+ break;
+ case rDocProc:
+ Tcl_SetResult(interp, "rDocProc", TCL_STATIC);
+ break;
+ case floatProc:
+ case floatGrowProc:
+ Tcl_SetResult(interp, "floatProc", TCL_STATIC);
+ break;
+ case floatZoomProc:
+ case floatZoomGrowProc:
+ Tcl_SetResult(interp, "floatZoomProc", TCL_STATIC);
+ break;
+ case floatSideProc:
+ case floatSideGrowProc:
+ Tcl_SetResult(interp, "floatSideProc", TCL_STATIC);
+ break;
+ case floatSideZoomProc:
+ case floatSideZoomGrowProc:
+ Tcl_SetResult(interp, "floatSideZoomProc", TCL_STATIC);
+ break;
+ default:
+ panic("invalid style");
+ }
+ if (appearanceSpec) {
+ Tcl_Obj *attributeList, *newResult;
+
+ switch (wmPtr->macClass) {
+ case kAlertWindowClass:
+ newResult = Tcl_NewStringObj("alert", -1);
+ break;
+ case kMovableAlertWindowClass:
+ newResult = Tcl_NewStringObj("moveableAlert", -1);
+ break;
+ case kModalWindowClass:
+ newResult = Tcl_NewStringObj("modal", -1);
+ break;
+ case kMovableModalWindowClass:
+ newResult = Tcl_NewStringObj("moveableModal", -1);
+ break;
+ case kFloatingWindowClass:
+ newResult = Tcl_NewStringObj("floating", -1);
+ break;
+ case kDocumentWindowClass:
+ newResult = Tcl_NewStringObj("document", -1);
+ break;
+ default:
+ panic("invalid class");
+ }
+
+ attributeList = Tcl_NewListObj(0, NULL);
+ if (wmPtr->attributes == kWindowNoAttributes) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("none", -1));
+ } else if (wmPtr->attributes == kWindowStandardDocumentAttributes) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("standardDocument", -1));
+ } else if (wmPtr->attributes == kWindowStandardFloatingAttributes) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("standardFloating", -1));
+ } else {
+ if (wmPtr->attributes & kWindowCloseBoxAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("closeBox", -1));
+ }
+ if (wmPtr->attributes & kWindowHorizontalZoomAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("horizontalZoom", -1));
+ }
+ if (wmPtr->attributes & kWindowVerticalZoomAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("verticalZoom", -1));
+ }
+ if (wmPtr->attributes & kWindowCollapseBoxAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("collapseBox", -1));
+ }
+ if (wmPtr->attributes & kWindowResizableAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("resizable", -1));
+ }
+ if (wmPtr->attributes & kWindowSideTitlebarAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("sideTitlebar", -1));
+ }
+ if (wmPtr->attributes & kWindowNoUpdatesAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("noUpdates", -1));
+ }
+ if (wmPtr->attributes & kWindowNoActivatesAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("noActivates", -1));
+ }
+ }
+ Tcl_ListObjAppendElement(interp, newResult, attributeList);
+ Tcl_SetObjResult(interp, newResult);
+ }
+ return TCL_OK;
+ } else if (argc == 4) {
+ 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 if (argc == 5) {
+ int oldClass = wmPtr->macClass;
+ int oldAttributes = wmPtr->attributes;
+
+ if (strcmp(argv[3], "alert") == 0) {
+ wmPtr->macClass = kAlertWindowClass;
+ } else if (strcmp(argv[3], "moveableAlert") == 0) {
+ wmPtr->macClass = kMovableAlertWindowClass;
+ } else if (strcmp(argv[3], "modal") == 0) {
+ wmPtr->macClass = kModalWindowClass;
+ } else if (strcmp(argv[3], "moveableModal") == 0) {
+ wmPtr->macClass = kMovableModalWindowClass;
+ } else if (strcmp(argv[3], "floating") == 0) {
+ wmPtr->macClass = kFloatingWindowClass;
+ } else if (strcmp(argv[3], "document") == 0) {
+ wmPtr->macClass = kDocumentWindowClass;
+ } else {
+ wmPtr->macClass = oldClass;
+ Tcl_AppendResult(interp, "bad class: should be alert, ",
+ "moveableAlert, modal, moveableModal, floating, ",
+ "or document",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[4], "none") == 0) {
+ wmPtr->attributes = kWindowNoAttributes;
+ } else if (strcmp(argv[4], "standardDocument") == 0) {
+ wmPtr->attributes = kWindowStandardDocumentAttributes;
+ } else if (strcmp(argv[4], "standardFloating") == 0) {
+ wmPtr->attributes = kWindowStandardFloatingAttributes;
+ } else {
+ int foundOne = 0;
+ int attrArgc, i;
+ CONST char **attrArgv = NULL;
+
+ if (Tcl_SplitList(interp, argv[4], &attrArgc, &attrArgv) != TCL_OK) {
+ wmPtr->macClass = oldClass;
+ Tcl_AppendResult(interp, "Ill-formed attributes list: \"",
+ argv[4], "\".", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ wmPtr->attributes = kWindowNoAttributes;
+
+ for (i = 0; i < attrArgc; i++) {
+ if ((*attrArgv[i] == 'c')
+ && (strcmp(attrArgv[i], "closeBox") == 0)) {
+ wmPtr->attributes |= kWindowCloseBoxAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'h')
+ && (strcmp(attrArgv[i], "horizontalZoom") == 0)) {
+ wmPtr->attributes |= kWindowHorizontalZoomAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'v')
+ && (strcmp(attrArgv[i], "verticalZoom") == 0)) {
+ wmPtr->attributes |= kWindowVerticalZoomAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'c')
+ && (strcmp(attrArgv[i], "collapseBox") == 0)) {
+ wmPtr->attributes |= kWindowCollapseBoxAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'r')
+ && (strcmp(attrArgv[i], "resizable") == 0)) {
+ wmPtr->attributes |= kWindowResizableAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 's')
+ && (strcmp(attrArgv[i], "sideTitlebar") == 0)) {
+ wmPtr->attributes |= kWindowSideTitlebarAttribute;
+ foundOne = 1;
+ } else {
+ foundOne = 0;
+ break;
+ }
+ }
+
+ if (attrArgv != NULL) {
+ ckfree ((char *) attrArgv);
+ }
+
+ if (foundOne != 1) {
+ wmPtr->macClass = oldClass;
+ wmPtr->attributes = oldAttributes;
+
+ Tcl_AppendResult(interp, "bad attribute: \"", argv[4],
+ "\", should be standardDocument, ",
+ "standardFloating, or some combination of ",
+ "closeBox, horizontalZoom, verticalZoom, ",
+ "collapseBox, resizable, or sideTitlebar.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ wmPtr->style = -1;
+ }
+ } 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 = {0,0,0,0};
+ 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);
+
+ if (TkMacHaveAppearance() >= 0x110 && wmPtr->style == -1) {
+ OSStatus err;
+ /*
+ * There seems to be a bug in CreateNewWindow: If I set the
+ * window geometry to be the too small for the structure region,
+ * then the whole window is positioned incorrectly.
+ * Adding this here makes the positioning work, and the size will
+ * get overwritten when you actually map the contents of the window.
+ */
+
+ geometry.right += 64;
+ geometry.bottom += 24;
+ err = CreateNewWindow(wmPtr->macClass, wmPtr->attributes,
+ &geometry, &newWindow);
+ if (err != noErr) {
+ newWindow = NULL;
+ }
+
+ } else {
+ 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_HIERARCHY)) {
+ 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;
+ }
+/* even if AppearanceManager 1.1 routines are present,
+we can't call them from 68K code, so we pretend
+to be running Apperarance Mgr 1.0 */
+#if !(GENERATING68K && !GENERATINGCFM)
+ err = Gestalt(gestaltAppearanceVersion, &response);
+#endif
+ if (err == noErr) {
+ TkMacHaveAppearance = (int) response;
+ }
+ }
+
+ return TkMacHaveAppearance;
+}
diff --git a/tcl/mac/tkMacXCursors.r b/tcl/mac/tkMacXCursors.r
new file mode 100644
index 00000000000..18176d1ada3
--- /dev/null
+++ b/tcl/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/tcl/mac/tkMacXStubs.c b/tcl/mac/tkMacXStubs.c
new file mode 100644
index 00000000000..53ee5a91fbd
--- /dev/null
+++ b/tcl/mac/tkMacXStubs.c
@@ -0,0 +1,828 @@
+/*
+ * 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"
+#include "tkPort.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(
+ CONST 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));
+ memset(display, 0, 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));
+ memset(gMacDisplay, 0, 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+void
+XClearWindow(
+ Display* display,
+ Window w)
+{
+}
+
+/*
+void
+XDrawPoint(
+ Display* display,
+ Drawable d,
+ GC gc,
+ int x,
+ int y)
+{
+}
+
+void
+XDrawPoints(
+ Display* display,
+ Drawable d,
+ GC gc,
+ XPoint* points,
+ int npoints,
+ int mode)
+{
+}
+*/
+
+void
+XWarpPointer(
+ 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)
+{
+}
+
+void
+XQueryColor(
+ Display* display,
+ Colormap colormap,
+ XColor* def_in_out)
+{
+}
+
+void
+XQueryColors(
+ Display* display,
+ Colormap colormap,
+ XColor* defs_in_out,
+ int ncolors)
+{
+}
+
+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++;
+}
+
+void
+Tk_FreeXId (
+ Display *display,
+ XID xid)
+{
+ /* no-op function needed for stubs implementation. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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[8 + TCL_INTEGER_SPACE * 2];
+ char buffer2[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
+ ProtocolRevision(Tk_Display(tkwin)));
+ sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
+ Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
+ buffer2, (char *) NULL);
+}
+/*
+ * 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();
+}
+
+Status
+XStringListToTextProperty(
+ char** list,
+ int count,
+ XTextProperty* text_prop_return)
+{
+ Debugger();
+ return (Status) 0;
+}
+void
+XSetWMClientMachine(
+ Display* display,
+ Window w,
+ XTextProperty* text_prop)
+{
+ Debugger();
+}
+XIC
+XCreateIC(
+ void)
+{
+ Debugger();
+ return (XIC) 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDefaultScreenName --
+ *
+ * Returns the name of the screen that Tk should use during
+ * initialization.
+ *
+ * Results:
+ * Returns a statically allocated string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+TkGetDefaultScreenName(
+ Tcl_Interp *interp, /* Not used. */
+ CONST char *screenName) /* If NULL, use default string. */
+{
+ if ((screenName == NULL) || (screenName[0] == '\0')) {
+ screenName = macScreenName;
+ }
+ return screenName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetCaretPos --
+ *
+ * This indicates the cursor position to Tk.
+ * This is currently a noop stub for MacX.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetCaretPos(Tk_Window tkwin, int x, int y, int height)
+{
+ TkCaret *caretPtr = &(((TkWindow *) tkwin)->dispPtr->caret);
+
+ caretPtr->winPtr = ((TkWindow *) tkwin);
+ caretPtr->x = x;
+ caretPtr->y = y;
+ caretPtr->height = height;
+}
diff --git a/tcl/mac/widget.r b/tcl/mac/widget.r
new file mode 100644
index 00000000000..d28cadcfba3
--- /dev/null
+++ b/tcl/mac/widget.r
@@ -0,0 +1,18 @@
+/*
+ * widget.r --
+ *
+ */
+
+type 'TEXT'
+{
+ string;
+};
+
+#define TK_LIBRARY_RESOURCES 3000
+
+resource 'TEXT' (TK_LIBRARY_RESOURCES+114, "tclshrc", purgeable)
+{
+"# read widgets demo script\n"
+"console hide\n"
+"source [file join $tk_library demos widget]\n"
+}; \ No newline at end of file
diff --git a/tcl/macosx/Makefile b/tcl/macosx/Makefile
index fa2404bfc0b..8bd8befc713 100644
--- a/tcl/macosx/Makefile
+++ b/tcl/macosx/Makefile
@@ -11,7 +11,7 @@ INSTALL_ROOT =
BUILD_DIR = ../../build
-TARGET = Tcl
+TARGET = Wish
DEVBUILDSTYLE = Development
DEPBUILDSTYLE = Deployment
@@ -35,7 +35,7 @@ install: install-develop install-deploy
embedded: embedded-develop embedded-deploy
-install-embedded: install-embedded-develop install-embedded-deploy
+install-embedded: install-embedded-develop install-embedded-deploy cleanup-embedded
clean: clean-develop clean-deploy
@@ -72,3 +72,15 @@ clean-deploy:
${DEPBUILD} clean
################################################################################
+
+cleanup-embedded:
+ @( \
+ cd ${INSTALL_ROOT}; \
+ rm -f Frameworks; \
+ rm -rf @executable_path; \
+ rm -rf Library/Frameworks/Tcl.framework; \
+ rm -rf Library/Frameworks/Tk.framework; \
+ if [ -d Library/Frameworks ]; then rmdir -p Library/Frameworks; fi; \
+ )
+
+################################################################################
diff --git a/tcl/macosx/Wish.icns b/tcl/macosx/Wish.icns
new file mode 100644
index 00000000000..060bfbd4502
--- /dev/null
+++ b/tcl/macosx/Wish.icns
Binary files differ
diff --git a/tcl/macosx/Wish.pbproj/jingham.pbxuser b/tcl/macosx/Wish.pbproj/jingham.pbxuser
new file mode 100644
index 00000000000..72932e79a82
--- /dev/null
+++ b/tcl/macosx/Wish.pbproj/jingham.pbxuser
@@ -0,0 +1,1502 @@
+// !$*UTF8*$!
+{
+ 005751A902FB00920AC916F0 = {
+ fRef = F5375568016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXXStubs.c: TkpCloseDisplay";
+ rLen = 0;
+ rLoc = 5311;
+ rType = 0;
+ vrLen = 417;
+ vrLoc = 4894;
+ };
+ F50D961501961F0201DC9062 = {
+ fileReference = F5375551016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 902;
+ state = 2;
+ };
+ F537552A016C352C01DC9062 = {
+ activeBuildStyle = F537552C016C352C01DC9062;
+ activeExecutable = F53756AB016C4DD401DC9062;
+ activeTarget = F53756A0016C4DD401DC9062;
+ addToTargets = (
+ F53755DF016C38D201DC9062,
+ );
+ breakpoints = (
+ F5B2CDC10175829501DC9062,
+ F571FE470179562E01DC9062,
+ F571FE4A0179695001DC9062,
+ F571FE4C01796B1101DC9062,
+ F571FE4D01796CAF01DC9062,
+ F571FE4E01796F9201DC9062,
+ F571FE4F0179702301DC9062,
+ F571FE500179702301DC9062,
+ F583DC0E018D092D01DC9062,
+ F583DC0F018D0CB501DC9062,
+ F583DC13018D2B4A01DC9062,
+ F58907BE018DCE8F01DC9062,
+ F58907C5018DD1C301DC9062,
+ F50D961501961F0201DC9062,
+ F566083B0197283B01DC9062,
+ F566083C0197823801DC9062,
+ F5A5146F01D05DC201DC9062,
+ F5A5147001D0758C01DC9062,
+ F5A852D6020F6C6C01DC9062,
+ F5A439C0029B609C01DC9064,
+ F5A439C2029B60ED01DC9064,
+ F5A439CA029B620901DC9064,
+ F55BC4B602B2DFB901DC9062,
+ F5978FD602B3190701DC9062,
+ );
+ executables = (
+ F53756AB016C4DD401DC9062,
+ );
+ perUserDictionary = {
+ PBXPerProjectTemplateStateSaveDate = 49921092;
+ "PBXTemplateGeometry-F5314676015831810DCA290F" = {
+ ContentSize = "{716, 618}";
+ LeftSlideOut = {
+ Collapsed = NO;
+ Frame = "{{0, 23}, {716, 595}}";
+ Split0 = {
+ ActiveTab = 2;
+ Collapsed = NO;
+ Frame = "{{0, 0}, {716, 595}}";
+ Split0 = {
+ Frame = "{{0, 249}, {716, 346}}";
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Debugger = {
+ Collapsed = NO;
+ Frame = "{{0, 0}, {952, 321}}";
+ Split0 = {
+ Frame = "{{0, 24}, {952, 297}}";
+ Split0 = {
+ Frame = "{{0, 0}, {468, 297}}";
+ };
+ Split1 = {
+ DebugVariablesTableConfiguration = (
+ Name,
+ 126.803,
+ Value,
+ 150.074,
+ Summary,
+ 172.123,
+ );
+ Frame = "{{477, 0}, {475, 297}}";
+ };
+ SplitCount = 2;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ TabCount = 2;
+ TabsVisible = YES;
+ };
+ Frame = "{{0, 0}, {952, 321}}";
+ LauncherConfigVersion = 7;
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {781, 452}}";
+ LauncherConfigVersion = 3;
+ Runner = {
+ Frame = "{{0, 0}, {781, 452}}";
+ };
+ };
+ Tab2 = {
+ BuildMessageFrame = "{{0, 0}, {718, 0}}";
+ BuildTranscriptFrame = "{{0, 9}, {718, 236}}";
+ Frame = "{{0, 0}, {716, 243}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {612, 295}}";
+ };
+ TabCount = 4;
+ TabsVisible = NO;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {300, 533}}";
+ GroupTreeTableConfiguration = (
+ SCMStatusColumn,
+ 22,
+ TargetStatusColumn,
+ 18,
+ MainColumn,
+ 245,
+ );
+ };
+ Tab1 = {
+ ClassesFrame = "{{0, 0}, {280, 398}}";
+ ClassesTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXClassColumnIdentifier,
+ 237,
+ );
+ Frame = "{{0, 0}, {278, 659}}";
+ MembersFrame = "{{0, 407}, {280, 252}}";
+ MembersTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXMethodColumnIdentifier,
+ 236,
+ );
+ };
+ Tab2 = {
+ Frame = "{{0, 0}, {200, 100}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {200, 100}}";
+ TargetTableConfiguration = (
+ ActiveObject,
+ 16,
+ ObjectNames,
+ 202.296,
+ );
+ };
+ Tab4 = {
+ BreakpointsTreeTableConfiguration = (
+ breakpointColumn,
+ 197,
+ enabledColumn,
+ 31,
+ );
+ Frame = "{{0, 0}, {250, 100}}";
+ };
+ TabCount = 5;
+ TabsVisible = NO;
+ };
+ StatusViewVisible = YES;
+ Template = F5314676015831810DCA290F;
+ ToolbarVisible = YES;
+ WindowLocation = "{49, 213}";
+ };
+ "PBXTemplateGeometry-F5CA7ECB015C094F0DCA290F" = {
+ ContentSize = "{690, 721}";
+ LeftSlideOut = {
+ Collapsed = NO;
+ Frame = "{{0, 0}, {690, 721}}";
+ Split0 = {
+ Collapsed = NO;
+ Frame = "{{0, 0}, {690, 721}}";
+ Split0 = {
+ Frame = "{{0, 0}, {690, 721}}";
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Debugger = {
+ Collapsed = NO;
+ Frame = "{{0, 0}, {484, 208}}";
+ Split0 = {
+ Frame = "{{0, 24}, {484, 184}}";
+ Split0 = {
+ Frame = "{{0, 0}, {236, 184}}";
+ };
+ Split1 = {
+ DebugVariablesTableConfiguration = (
+ Name,
+ 123,
+ Value,
+ 85,
+ Summary,
+ 62.123,
+ );
+ Frame = "{{245, 0}, {239, 184}}";
+ };
+ SplitCount = 2;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ TabCount = 2;
+ TabsVisible = YES;
+ };
+ Frame = "{{0, 0}, {484, 208}}";
+ LauncherConfigVersion = 7;
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {664, 208}}";
+ LauncherConfigVersion = 3;
+ Runner = {
+ Frame = "{{0, 0}, {664, 208}}";
+ };
+ };
+ Tab2 = {
+ BuildMessageFrame = "{{0, 0}, {666, 43}}";
+ BuildTranscriptFrame = "{{0, 52}, {666, 0}}";
+ Frame = "{{0, 0}, {664, 50}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {612, 295}}";
+ };
+ TabCount = 4;
+ TabsVisible = NO;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {313, 531}}";
+ GroupTreeTableConfiguration = (
+ SCMStatusColumn,
+ 22,
+ TargetStatusColumn,
+ 18,
+ MainColumn,
+ 258,
+ );
+ };
+ Tab1 = {
+ ClassesFrame = "{{0, 0}, {280, 398}}";
+ ClassesTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXClassColumnIdentifier,
+ 237,
+ );
+ Frame = "{{0, 0}, {278, 659}}";
+ MembersFrame = "{{0, 407}, {280, 252}}";
+ MembersTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXMethodColumnIdentifier,
+ 236,
+ );
+ };
+ Tab2 = {
+ Frame = "{{0, 0}, {200, 100}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {200, 557}}";
+ TargetTableConfiguration = (
+ ActiveObject,
+ 16,
+ ObjectNames,
+ 202.296,
+ );
+ };
+ Tab4 = {
+ BreakpointsTreeTableConfiguration = (
+ breakpointColumn,
+ 197,
+ enabledColumn,
+ 31,
+ );
+ Frame = "{{0, 0}, {250, 100}}";
+ };
+ TabCount = 5;
+ TabsVisible = NO;
+ };
+ StatusViewVisible = NO;
+ Template = F5CA7ECB015C094F0DCA290F;
+ ToolbarVisible = NO;
+ WindowLocation = "{48, 3}";
+ };
+ PBXWorkspaceContents = (
+ {
+ LeftSlideOut = {
+ Split0 = {
+ Split0 = {
+ NavContent0 = {
+ history = (
+ F5A439D1029B6B5501DC9064,
+ F5A439D2029B6B5501DC9064,
+ F5A439D3029B6B5501DC9064,
+ F5A439D4029B6B5501DC9064,
+ F5A439D5029B6B5501DC9064,
+ F5A439D6029B6B5501DC9064,
+ F5A439D7029B6B5501DC9064,
+ F5BE671E029B6FEE01DC9064,
+ F55BC4B902B2E09101DC9062,
+ F55BC4BA02B2E09101DC9062,
+ F55BC4BD02B2E09101DC9062,
+ F5BFE59402F984FA01DC9062,
+ F5BFE59502F984FA01DC9062,
+ F5BFE59602F984FA01DC9062,
+ F5BFE59702F984FA01DC9062,
+ F5BFE59802F984FA01DC9062,
+ F5BFE59902F984FA01DC9062,
+ F5BFE59B02F984FA01DC9062,
+ F5BFE59C02F984FA01DC9062,
+ F5BFE59D02F984FA01DC9062,
+ F5BFE59E02F984FA01DC9062,
+ F5BFE59F02F984FA01DC9062,
+ F5BFE5A002F984FA01DC9062,
+ F5BFE5A102F984FA01DC9062,
+ F5BFE5A202F984FA01DC9062,
+ F5BFE5A402F984FA01DC9062,
+ F5BFE5A502F984FA01DC9062,
+ F5BFE5A602F984FA01DC9062,
+ F5BFE5A702F984FA01DC9062,
+ F5BFE5A802F984FA01DC9062,
+ );
+ prevStack = (
+ F5A439DA029B6B5501DC9064,
+ F5A439DB029B6B5501DC9064,
+ F5A439DE029B6B5501DC9064,
+ F5A439DF029B6B5501DC9064,
+ F5A439E0029B6B5501DC9064,
+ F5A439E1029B6B5501DC9064,
+ F5A439E2029B6B5501DC9064,
+ F5A439E3029B6B5501DC9064,
+ F5A439E4029B6B5501DC9064,
+ F5A439E5029B6B5501DC9064,
+ F5A439E6029B6B5501DC9064,
+ F5A439E7029B6B5501DC9064,
+ F5A439E8029B6B5501DC9064,
+ F5BE671F029B6FEE01DC9064,
+ F55BC4BF02B2E09101DC9062,
+ F55BC4C002B2E09101DC9062,
+ F55BC4C102B2E09101DC9062,
+ F55BC4C202B2E09101DC9062,
+ F55BC4C302B2E09101DC9062,
+ F55BC4C402B2E09101DC9062,
+ F55BC4C702B2E09101DC9062,
+ F5BFE5AA02F984FA01DC9062,
+ F5BFE5AB02F984FA01DC9062,
+ F5BFE5AC02F984FA01DC9062,
+ F5BFE5AD02F984FA01DC9062,
+ F5BFE5AE02F984FA01DC9062,
+ F5BFE5AF02F984FA01DC9062,
+ F5BFE5B002F984FA01DC9062,
+ F5BFE5B202F984FA01DC9062,
+ F5BFE5B302F984FA01DC9062,
+ F5BFE5B402F984FA01DC9062,
+ F5BFE5B502F984FA01DC9062,
+ F5BFE5B702F984FA01DC9062,
+ F5BFE5B802F984FA01DC9062,
+ F5BFE5B902F984FA01DC9062,
+ F5BFE5BB02F984FA01DC9062,
+ F5BFE5BC02F984FA01DC9062,
+ F5BFE5BD02F984FA01DC9062,
+ F5BFE5BE02F984FA01DC9062,
+ F5BFE5BF02F984FA01DC9062,
+ F5BFE5C002F984FA01DC9062,
+ F5BFE5C102F984FA01DC9062,
+ );
+ };
+ NavContent1 = {
+ bookmark = 005751A902FB00920AC916F0;
+ history = (
+ F5BFE5C402F984FA01DC9062,
+ );
+ };
+ NavCount = 2;
+ NavGeometry0 = {
+ Frame = "{{0, 0}, {645, 321}}";
+ NavBarVisible = YES;
+ };
+ NavGeometry1 = {
+ Frame = "{{0, 330}, {645, 321}}";
+ NavBarVisible = YES;
+ };
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Debugger = {
+ Split0 = {
+ SplitCount = 2;
+ };
+ SplitCount = 1;
+ TabCount = 2;
+ };
+ LauncherConfigVersion = 7;
+ };
+ Tab1 = {
+ LauncherConfigVersion = 3;
+ Runner = {
+ };
+ };
+ TabCount = 4;
+ };
+ SplitCount = 1;
+ Tab1 = {
+ OptionsSetName = "Default Options";
+ };
+ TabCount = 5;
+ };
+ },
+ );
+ PBXWorkspaceGeometries = (
+ {
+ ContentSize = "{929, 674}";
+ LeftSlideOut = {
+ ActiveTab = 0;
+ Collapsed = NO;
+ Frame = "{{0, 23}, {929, 651}}";
+ Split0 = {
+ Collapsed = NO;
+ Frame = "{{284, 0}, {645, 651}}";
+ Split0 = {
+ Frame = "{{0, 0}, {645, 651}}";
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Debugger = {
+ Collapsed = NO;
+ Frame = "{{0, 0}, {681, 289}}";
+ Split0 = {
+ Frame = "{{0, 24}, {681, 265}}";
+ Split0 = {
+ Frame = "{{0, 0}, {333, 265}}";
+ };
+ Split1 = {
+ DebugVariablesTableConfiguration = (
+ Name,
+ 82.80298,
+ Value,
+ 104.074,
+ Summary,
+ 126.123,
+ );
+ Frame = "{{342, 0}, {339, 265}}";
+ };
+ SplitCount = 2;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ TabCount = 2;
+ TabsVisible = YES;
+ };
+ Frame = "{{0, 0}, {681, 289}}";
+ LauncherConfigVersion = 7;
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {681, 120}}";
+ LauncherConfigVersion = 3;
+ Runner = {
+ Frame = "{{0, 0}, {681, 120}}";
+ };
+ };
+ Tab2 = {
+ BuildMessageFrame = "{{0, 0}, {683, 127}}";
+ BuildTranscriptFrame = "{{0, 136}, {683, 100}}";
+ Frame = "{{0, 0}, {681, 234}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {681, 238}}";
+ };
+ TabCount = 4;
+ TabsVisible = NO;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {260, 651}}";
+ GroupTreeTableConfiguration = (
+ SCMStatusColumn,
+ 22,
+ TargetStatusColumn,
+ 18,
+ MainColumn,
+ 205,
+ );
+ };
+ Tab1 = {
+ ClassesFrame = "{{0, 0}, {250, 333}}";
+ ClassesTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXClassColumnIdentifier,
+ 207,
+ );
+ Frame = "{{0, 0}, {248, 554}}";
+ MembersFrame = "{{0, 342}, {250, 212}}";
+ MembersTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXMethodColumnIdentifier,
+ 206,
+ );
+ };
+ Tab2 = {
+ Frame = "{{0, 0}, {217, 554}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {239, 651}}";
+ TargetTableConfiguration = (
+ ActiveObject,
+ 16,
+ ObjectNames,
+ 206.296,
+ );
+ };
+ Tab4 = {
+ BreakpointsTreeTableConfiguration = (
+ breakpointColumn,
+ 197,
+ enabledColumn,
+ 31,
+ );
+ Frame = "{{0, 0}, {250, 554}}";
+ };
+ TabCount = 5;
+ TabsVisible = YES;
+ };
+ StatusViewVisible = YES;
+ Template = 64ABBB4501FA494900185B06;
+ ToolbarVisible = YES;
+ WindowLocation = "{165, 176}";
+ },
+ );
+ PBXWorkspaceStateSaveDate = 49921092;
+ };
+ perUserProjectItems = {
+ 005751A902FB00920AC916F0 = 005751A902FB00920AC916F0;
+ F55BC4B902B2E09101DC9062 = F55BC4B902B2E09101DC9062;
+ F55BC4BA02B2E09101DC9062 = F55BC4BA02B2E09101DC9062;
+ F55BC4BD02B2E09101DC9062 = F55BC4BD02B2E09101DC9062;
+ F55BC4BF02B2E09101DC9062 = F55BC4BF02B2E09101DC9062;
+ F55BC4C002B2E09101DC9062 = F55BC4C002B2E09101DC9062;
+ F55BC4C102B2E09101DC9062 = F55BC4C102B2E09101DC9062;
+ F55BC4C202B2E09101DC9062 = F55BC4C202B2E09101DC9062;
+ F55BC4C302B2E09101DC9062 = F55BC4C302B2E09101DC9062;
+ F55BC4C402B2E09101DC9062 = F55BC4C402B2E09101DC9062;
+ F55BC4C702B2E09101DC9062 = F55BC4C702B2E09101DC9062;
+ F5A439D1029B6B5501DC9064 = F5A439D1029B6B5501DC9064;
+ F5A439D2029B6B5501DC9064 = F5A439D2029B6B5501DC9064;
+ F5A439D3029B6B5501DC9064 = F5A439D3029B6B5501DC9064;
+ F5A439D4029B6B5501DC9064 = F5A439D4029B6B5501DC9064;
+ F5A439D5029B6B5501DC9064 = F5A439D5029B6B5501DC9064;
+ F5A439D6029B6B5501DC9064 = F5A439D6029B6B5501DC9064;
+ F5A439D7029B6B5501DC9064 = F5A439D7029B6B5501DC9064;
+ F5A439DA029B6B5501DC9064 = F5A439DA029B6B5501DC9064;
+ F5A439DB029B6B5501DC9064 = F5A439DB029B6B5501DC9064;
+ F5A439DE029B6B5501DC9064 = F5A439DE029B6B5501DC9064;
+ F5A439DF029B6B5501DC9064 = F5A439DF029B6B5501DC9064;
+ F5A439E0029B6B5501DC9064 = F5A439E0029B6B5501DC9064;
+ F5A439E1029B6B5501DC9064 = F5A439E1029B6B5501DC9064;
+ F5A439E2029B6B5501DC9064 = F5A439E2029B6B5501DC9064;
+ F5A439E3029B6B5501DC9064 = F5A439E3029B6B5501DC9064;
+ F5A439E4029B6B5501DC9064 = F5A439E4029B6B5501DC9064;
+ F5A439E5029B6B5501DC9064 = F5A439E5029B6B5501DC9064;
+ F5A439E6029B6B5501DC9064 = F5A439E6029B6B5501DC9064;
+ F5A439E7029B6B5501DC9064 = F5A439E7029B6B5501DC9064;
+ F5A439E8029B6B5501DC9064 = F5A439E8029B6B5501DC9064;
+ F5BE671E029B6FEE01DC9064 = F5BE671E029B6FEE01DC9064;
+ F5BE671F029B6FEE01DC9064 = F5BE671F029B6FEE01DC9064;
+ F5BFE59402F984FA01DC9062 = F5BFE59402F984FA01DC9062;
+ F5BFE59502F984FA01DC9062 = F5BFE59502F984FA01DC9062;
+ F5BFE59602F984FA01DC9062 = F5BFE59602F984FA01DC9062;
+ F5BFE59702F984FA01DC9062 = F5BFE59702F984FA01DC9062;
+ F5BFE59802F984FA01DC9062 = F5BFE59802F984FA01DC9062;
+ F5BFE59902F984FA01DC9062 = F5BFE59902F984FA01DC9062;
+ F5BFE59B02F984FA01DC9062 = F5BFE59B02F984FA01DC9062;
+ F5BFE59C02F984FA01DC9062 = F5BFE59C02F984FA01DC9062;
+ F5BFE59D02F984FA01DC9062 = F5BFE59D02F984FA01DC9062;
+ F5BFE59E02F984FA01DC9062 = F5BFE59E02F984FA01DC9062;
+ F5BFE59F02F984FA01DC9062 = F5BFE59F02F984FA01DC9062;
+ F5BFE5A002F984FA01DC9062 = F5BFE5A002F984FA01DC9062;
+ F5BFE5A102F984FA01DC9062 = F5BFE5A102F984FA01DC9062;
+ F5BFE5A202F984FA01DC9062 = F5BFE5A202F984FA01DC9062;
+ F5BFE5A402F984FA01DC9062 = F5BFE5A402F984FA01DC9062;
+ F5BFE5A502F984FA01DC9062 = F5BFE5A502F984FA01DC9062;
+ F5BFE5A602F984FA01DC9062 = F5BFE5A602F984FA01DC9062;
+ F5BFE5A702F984FA01DC9062 = F5BFE5A702F984FA01DC9062;
+ F5BFE5A802F984FA01DC9062 = F5BFE5A802F984FA01DC9062;
+ F5BFE5AA02F984FA01DC9062 = F5BFE5AA02F984FA01DC9062;
+ F5BFE5AB02F984FA01DC9062 = F5BFE5AB02F984FA01DC9062;
+ F5BFE5AC02F984FA01DC9062 = F5BFE5AC02F984FA01DC9062;
+ F5BFE5AD02F984FA01DC9062 = F5BFE5AD02F984FA01DC9062;
+ F5BFE5AE02F984FA01DC9062 = F5BFE5AE02F984FA01DC9062;
+ F5BFE5AF02F984FA01DC9062 = F5BFE5AF02F984FA01DC9062;
+ F5BFE5B002F984FA01DC9062 = F5BFE5B002F984FA01DC9062;
+ F5BFE5B202F984FA01DC9062 = F5BFE5B202F984FA01DC9062;
+ F5BFE5B302F984FA01DC9062 = F5BFE5B302F984FA01DC9062;
+ F5BFE5B402F984FA01DC9062 = F5BFE5B402F984FA01DC9062;
+ F5BFE5B502F984FA01DC9062 = F5BFE5B502F984FA01DC9062;
+ F5BFE5B702F984FA01DC9062 = F5BFE5B702F984FA01DC9062;
+ F5BFE5B802F984FA01DC9062 = F5BFE5B802F984FA01DC9062;
+ F5BFE5B902F984FA01DC9062 = F5BFE5B902F984FA01DC9062;
+ F5BFE5BB02F984FA01DC9062 = F5BFE5BB02F984FA01DC9062;
+ F5BFE5BC02F984FA01DC9062 = F5BFE5BC02F984FA01DC9062;
+ F5BFE5BD02F984FA01DC9062 = F5BFE5BD02F984FA01DC9062;
+ F5BFE5BE02F984FA01DC9062 = F5BFE5BE02F984FA01DC9062;
+ F5BFE5BF02F984FA01DC9062 = F5BFE5BF02F984FA01DC9062;
+ F5BFE5C002F984FA01DC9062 = F5BFE5C002F984FA01DC9062;
+ F5BFE5C102F984FA01DC9062 = F5BFE5C102F984FA01DC9062;
+ F5BFE5C402F984FA01DC9062 = F5BFE5C402F984FA01DC9062;
+ };
+ projectwideBuildSettings = {
+ OBJROOT = "/Volumes/TheCloset/jingham/tcl-tk/source/tcl-merge/Objects";
+ SYMROOT = "/Volumes/TheCloset/jingham/tcl-tk/source/tcl-merge/Products";
+ };
+ wantsIndex = 1;
+ wantsSCM = -1;
+ };
+ F53755DF016C38D201DC9062 = {
+ activeExec = 0;
+ };
+ F53756A0016C4DD401DC9062 = {
+ activeExec = 0;
+ executables = (
+ F53756AB016C4DD401DC9062,
+ );
+ };
+ F53756AB016C4DD401DC9062 = {
+ activeArgIndex = 2147483647;
+ argumentStrings = (
+ );
+ debuggerPlugin = GDBDebugging;
+ dylibVariantSuffix = "";
+ enableDebugStr = 1;
+ environmentEntries = (
+ );
+ isa = PBXExecutable;
+ name = "Wish Shell";
+ shlibInfoDictList = (
+ );
+ sourceDirectories = (
+ );
+ };
+ F55BC4B602B2DFB901DC9062 = {
+ fileReference = F5375580016C389901DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 201;
+ state = 2;
+ };
+ F55BC4B902B2E09101DC9062 = {
+ fRef = F5375553016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXEvent.c: 242";
+ rLen = 0;
+ rLoc = 6185;
+ rType = 0;
+ vrLen = 1438;
+ vrLoc = 5937;
+ };
+ F55BC4BA02B2E09101DC9062 = {
+ fRef = F55BC46A02B2D3F301DC9062;
+ isa = PBXTextBookmark;
+ name = "panedwindow.tcl: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1395;
+ vrLoc = 0;
+ };
+ F55BC4BD02B2E09101DC9062 = {
+ bstl = F537552C016C352C01DC9062;
+ isa = PBXBuildStyleBookmark;
+ };
+ F55BC4BF02B2E09101DC9062 = {
+ fRef = F5375553016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXEvent.c: 242";
+ rLen = 0;
+ rLoc = 6185;
+ rType = 0;
+ vrLen = 1438;
+ vrLoc = 5937;
+ };
+ F55BC4C002B2E09101DC9062 = {
+ isa = PBXTargetBookmark;
+ trg = F53755DF016C38D201DC9062;
+ };
+ F55BC4C102B2E09101DC9062 = {
+ fRef = F55BC46A02B2D3F301DC9062;
+ isa = PBXTextBookmark;
+ name = "panedwindow.tcl: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1395;
+ vrLoc = 0;
+ };
+ F55BC4C202B2E09101DC9062 = {
+ isa = PBXTargetBookmark;
+ trg = F53755DF016C38D201DC9062;
+ };
+ F55BC4C302B2E09101DC9062 = {
+ fRef = F55BC46A02B2D3F301DC9062;
+ isa = PBXTextBookmark;
+ name = "panedwindow.tcl: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1395;
+ vrLoc = 0;
+ };
+ F55BC4C402B2E09101DC9062 = {
+ isa = PBXTargetBookmark;
+ trg = F53755DF016C38D201DC9062;
+ };
+ F55BC4C702B2E09101DC9062 = {
+ bstl = F537552C016C352C01DC9062;
+ isa = PBXBuildStyleBookmark;
+ };
+ F566083B0197283B01DC9062 = {
+ fileReference = F5375548016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 214;
+ state = 2;
+ };
+ F566083C0197823801DC9062 = {
+ isa = PBXSymbolicBreakpoint;
+ state = 2;
+ symbolName = Tcl_CreateObjCommand;
+ };
+ F571FE470179562E01DC9062 = {
+ fileReference = F5375583016C389901DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 1711;
+ state = 2;
+ };
+ F571FE4A0179695001DC9062 = {
+ fileReference = F5375558016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 175;
+ state = 2;
+ };
+ F571FE4C01796B1101DC9062 = {
+ fileReference = F5375558016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 172;
+ state = 2;
+ };
+ F571FE4D01796CAF01DC9062 = {
+ fileReference = F5375558016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 229;
+ state = 2;
+ };
+ F571FE4E01796F9201DC9062 = {
+ fileReference = F53755C8016C389901DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 408;
+ state = 2;
+ };
+ F571FE4F0179702301DC9062 = {
+ fileReference = F537559A016C389901DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 444;
+ state = 2;
+ };
+ F571FE500179702301DC9062 = {
+ fileReference = F537559A016C389901DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 469;
+ state = 2;
+ };
+ F583DC0E018D092D01DC9062 = {
+ fileReference = F5375551016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 531;
+ state = 2;
+ };
+ F583DC0F018D0CB501DC9062 = {
+ fileReference = F5375551016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 547;
+ state = 2;
+ };
+ F583DC13018D2B4A01DC9062 = {
+ fileReference = F5375551016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 1478;
+ state = 2;
+ };
+ F58907BE018DCE8F01DC9062 = {
+ fileReference = F5375548016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 196;
+ state = 2;
+ };
+ F58907C5018DD1C301DC9062 = {
+ fileReference = F5375551016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 502;
+ state = 2;
+ };
+ F5978FD602B3190701DC9062 = {
+ fileReference = F5375580016C389901DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 224;
+ state = 2;
+ };
+ F5A439C0029B609C01DC9064 = {
+ fileReference = F5375548016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 74;
+ state = 1;
+ };
+ F5A439C2029B60ED01DC9064 = {
+ fileReference = F5375548016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 155;
+ state = 1;
+ };
+ F5A439CA029B620901DC9064 = {
+ fileReference = F5375548016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 306;
+ state = 1;
+ };
+ F5A439D1029B6B5501DC9064 = {
+ fRef = F5A439F3029B6B5601DC9064;
+ isa = PBXTextBookmark;
+ name = "CarbonEvents.h: 4483";
+ rLen = 19;
+ rLoc = 173576;
+ rType = 0;
+ vrLen = 804;
+ vrLoc = 173125;
+ };
+ F5A439D2029B6B5501DC9064 = {
+ fRef = F5375548016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXAppInit.c: Tcl_AppInit";
+ rLen = 0;
+ rLoc = 9908;
+ rType = 0;
+ vrLen = 1370;
+ vrLoc = 8362;
+ };
+ F5A439D3029B6B5501DC9064 = {
+ fRef = F5A439F4029B6B5601DC9064;
+ isa = PBXTextBookmark;
+ name = "MacWindows.h: 1410";
+ rLen = 105;
+ rLoc = 57285;
+ rType = 0;
+ vrLen = 1155;
+ vrLoc = 56795;
+ };
+ F5A439D4029B6B5501DC9064 = {
+ fRef = F5A439F5029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439D5029B6B5501DC9064 = {
+ fRef = F5A439F6029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439D6029B6B5501DC9064 = {
+ fRef = F5A439F7029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439D7029B6B5501DC9064 = {
+ fRef = F5A439F8029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439DA029B6B5501DC9064 = {
+ fRef = F5375553016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXEvent.c: TkMacOSXProcessEvent";
+ rLen = 25;
+ rLoc = 4656;
+ rType = 0;
+ vrLen = 1260;
+ vrLoc = 4407;
+ };
+ F5A439DB029B6B5501DC9064 = {
+ fRef = F537555C016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXMouseEvent.c: TkMacOSXProcessMouseEvent";
+ rLen = 0;
+ rLoc = 6037;
+ rType = 0;
+ vrLen = 1438;
+ vrLoc = 5075;
+ };
+ F5A439DE029B6B5501DC9064 = {
+ fRef = F5375553016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXEvent.c: ReceiveAndProcessEvent";
+ rLen = 0;
+ rLoc = 7098;
+ rType = 0;
+ vrLen = 1455;
+ vrLoc = 5920;
+ };
+ F5A439DF029B6B5501DC9064 = {
+ fRef = F5375548016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXAppInit.c: Tcl_AppInit";
+ rLen = 0;
+ rLoc = 9908;
+ rType = 0;
+ vrLen = 673;
+ vrLoc = 7806;
+ };
+ F5A439E0029B6B5501DC9064 = {
+ fRef = F5375567016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXWm.c: TkMacOSXMakeRealWindowExist";
+ rLen = 15;
+ rLoc = 148454;
+ rType = 0;
+ vrLen = 695;
+ vrLoc = 112860;
+ };
+ F5A439E1029B6B5501DC9064 = {
+ fRef = F5A439FB029B6B5601DC9064;
+ isa = PBXTextBookmark;
+ name = "MacWindows.h: 1410";
+ rLen = 0;
+ rLoc = 57304;
+ rType = 0;
+ vrLen = 659;
+ vrLoc = 56953;
+ };
+ F5A439E2029B6B5501DC9064 = {
+ fRef = F5375548016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXAppInit.c: Tcl_AppInit";
+ rLen = 0;
+ rLoc = 9908;
+ rType = 0;
+ vrLen = 1370;
+ vrLoc = 8362;
+ };
+ F5A439E3029B6B5501DC9064 = {
+ fRef = F5A439EF029B6B5601DC9064;
+ isa = PBXTextBookmark;
+ name = "MacWindows.h: 1410";
+ rLen = 105;
+ rLoc = 57285;
+ rType = 0;
+ vrLen = 1155;
+ vrLoc = 56795;
+ };
+ F5A439E4029B6B5501DC9064 = {
+ fRef = F5A439F1029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439E5029B6B5501DC9064 = {
+ fRef = F5A439FD029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439E6029B6B5501DC9064 = {
+ fRef = F5A439FE029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439E7029B6B5501DC9064 = {
+ fRef = F5A439EE029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439E8029B6B5501DC9064 = {
+ fRef = F5A439F2029B6B5601DC9064;
+ isa = PBXBookmark;
+ };
+ F5A439EE029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = Carbon.html;
+ path = /Developer/Documentation/Carbon/Carbon.html;
+ refType = 0;
+ };
+ F5A439EF029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = MacWindows.h;
+ path = /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/HIToolbox.framework/Versions/A/Headers/MacWindows.h;
+ refType = 0;
+ };
+ F5A439F1029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = Carbon.html;
+ path = /Developer/Documentation/Carbon/Carbon.html;
+ refType = 0;
+ };
+ F5A439F2029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = carboneventmanager.html;
+ path = /Developer/Documentation/Carbon/oss/CarbonEventManager/carboneventmanager.html;
+ refType = 0;
+ };
+ F5A439F3029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = CarbonEvents.h;
+ path = /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/HIToolbox.framework/Versions/A/Headers/CarbonEvents.h;
+ refType = 0;
+ };
+ F5A439F4029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = MacWindows.h;
+ path = /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/HIToolbox.framework/Versions/A/Headers/MacWindows.h;
+ refType = 0;
+ };
+ F5A439F5029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = windowmanager.html;
+ path = /Developer/Documentation/Carbon/HumanInterfaceToolbox/WindowManager/windowmanager.html;
+ refType = 0;
+ };
+ F5A439F6029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = index.html;
+ path = /Developer/Documentation/Carbon/HumanInterfaceToolbox/WindowManager/Window_Manager/index.html;
+ refType = 0;
+ };
+ F5A439F7029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = Carbon.html;
+ path = /Developer/Documentation/Carbon/Carbon.html;
+ refType = 0;
+ };
+ F5A439F8029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = carboneventmanager.html;
+ path = /Developer/Documentation/Carbon/oss/CarbonEventManager/carboneventmanager.html;
+ refType = 0;
+ };
+ F5A439FB029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = MacWindows.h;
+ path = /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/HIToolbox.framework/Versions/A/Headers/MacWindows.h;
+ refType = 0;
+ };
+ F5A439FD029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = windowmanager.html;
+ path = /Developer/Documentation/Carbon/HumanInterfaceToolbox/WindowManager/windowmanager.html;
+ refType = 0;
+ };
+ F5A439FE029B6B5601DC9064 = {
+ isa = PBXFileReference;
+ name = index.html;
+ path = /Developer/Documentation/Carbon/HumanInterfaceToolbox/WindowManager/Window_Manager/index.html;
+ refType = 0;
+ };
+ F5A5146F01D05DC201DC9062 = {
+ fileReference = F5375550016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 651;
+ state = 1;
+ };
+ F5A5147001D0758C01DC9062 = {
+ fileReference = F5375550016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 838;
+ state = 1;
+ };
+ F5A852D6020F6C6C01DC9062 = {
+ fileReference = F5375550016C376E01DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 277;
+ state = 1;
+ };
+ F5B2CDC10175829501DC9062 = {
+ fileReference = F5375583016C389901DC9062;
+ isa = PBXFileBreakpoint;
+ lineNumber = 2584;
+ state = 2;
+ };
+ F5BE671E029B6FEE01DC9064 = {
+ fRef = F5BE6723029B6FEE01DC9064;
+ isa = PBXBookmark;
+ };
+ F5BE671F029B6FEE01DC9064 = {
+ fRef = F5BE6722029B6FEE01DC9064;
+ isa = PBXBookmark;
+ };
+ F5BE6722029B6FEE01DC9064 = {
+ isa = PBXFileReference;
+ name = index.html;
+ path = /Developer/Documentation/Carbon/oss/CarbonEventManager/Carbon_Event_Manager_Ref/index.html;
+ refType = 0;
+ };
+ F5BE6723029B6FEE01DC9064 = {
+ isa = PBXFileReference;
+ name = index.html;
+ path = /Developer/Documentation/Carbon/oss/CarbonEventManager/Carbon_Event_Manager_Ref/index.html;
+ refType = 0;
+ };
+ F5BFE59402F984FA01DC9062 = {
+ isa = PBXTargetBookmark;
+ trg = F53755DF016C38D201DC9062;
+ };
+ F5BFE59502F984FA01DC9062 = {
+ fRef = F53755BC016C389901DC9062;
+ isa = PBXTextBookmark;
+ name = "tkTest.c: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1168;
+ vrLoc = 0;
+ };
+ F5BFE59602F984FA01DC9062 = {
+ fRef = F5BFE58C02F8C41501DC9062;
+ isa = PBXTextBookmark;
+ name = "tkUndo.c: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 723;
+ vrLoc = 0;
+ };
+ F5BFE59702F984FA01DC9062 = {
+ fRef = F5BFE58F02F8C45B01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkUndo.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1028;
+ vrLoc = 0;
+ };
+ F5BFE59802F984FA01DC9062 = {
+ fRef = F5375575016C37A601DC9062;
+ isa = PBXTextBookmark;
+ name = "tkIntDecls.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 959;
+ vrLoc = 52384;
+ };
+ F5BFE59902F984FA01DC9062 = {
+ fRef = F537556A016C37A601DC9062;
+ isa = PBXTextBookmark;
+ name = "ks_names.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 963;
+ vrLoc = 0;
+ };
+ F5BFE59B02F984FA01DC9062 = {
+ fRef = F537559F016C389901DC9062;
+ isa = PBXTextBookmark;
+ name = "tkGet.c: Tk_GetUid";
+ rLen = 50;
+ rLoc = 13445;
+ rType = 0;
+ vrLen = 1360;
+ vrLoc = 12671;
+ };
+ F5BFE59C02F984FA01DC9062 = {
+ fRef = F5375545016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXWm.h: 104";
+ rLen = 6;
+ rLoc = 4294;
+ rType = 0;
+ vrLen = 1558;
+ vrLoc = 8742;
+ };
+ F5BFE59D02F984FA01DC9062 = {
+ fRef = F537556B016C37A601DC9062;
+ isa = PBXTextBookmark;
+ name = "tk.h: 1606";
+ rLen = 0;
+ rLoc = 56812;
+ rType = 0;
+ vrLen = 897;
+ vrLoc = 55983;
+ };
+ F5BFE59E02F984FA01DC9062 = {
+ exec = F53756AB016C4DD401DC9062;
+ isa = PBXExecutableBookmark;
+ };
+ F5BFE59F02F984FA01DC9062 = {
+ fRef = F5BFE5E102F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5A002F984FA01DC9062 = {
+ fRef = F5BFE5DA02F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5A102F984FA01DC9062 = {
+ fRef = F5BFE5DC02F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5A202F984FA01DC9062 = {
+ fRef = F5BFE5DB02F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5A402F984FA01DC9062 = {
+ fRef = F5BFE5DD02F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5A502F984FA01DC9062 = {
+ fRef = F5375567016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXWm.c: TkUnsupported1Cmd";
+ rLen = 15;
+ rLoc = 148454;
+ rType = 0;
+ vrLen = 1386;
+ vrLoc = 112609;
+ };
+ F5BFE5A602F984FA01DC9062 = {
+ fRef = F5375568016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXXStubs.c: TkpCloseDisplay";
+ rLen = 0;
+ rLoc = 5311;
+ rType = 0;
+ vrLen = 437;
+ vrLoc = 4370;
+ };
+ F5BFE5A702F984FA01DC9062 = {
+ fRef = F53755C8016C389901DC9062;
+ isa = PBXTextBookmark;
+ name = "tkWindow.c: TkCloseDisplay";
+ rLen = 0;
+ rLoc = 9153;
+ rType = 0;
+ vrLen = 453;
+ vrLoc = 8833;
+ };
+ F5BFE5A802F984FA01DC9062 = {
+ fRef = F537555C016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXMouseEvent.c: TkMacOSXProcessMouseEvent";
+ rLen = 0;
+ rLoc = 6187;
+ rType = 0;
+ vrLen = 742;
+ vrLoc = 11312;
+ };
+ F5BFE5AA02F984FA01DC9062 = {
+ isa = PBXTargetBookmark;
+ trg = F53755DF016C38D201DC9062;
+ };
+ F5BFE5AB02F984FA01DC9062 = {
+ fRef = F53755BC016C389901DC9062;
+ isa = PBXTextBookmark;
+ name = "tkTest.c: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1168;
+ vrLoc = 0;
+ };
+ F5BFE5AC02F984FA01DC9062 = {
+ fRef = F5BFE58C02F8C41501DC9062;
+ isa = PBXTextBookmark;
+ name = "tkUndo.c: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 723;
+ vrLoc = 0;
+ };
+ F5BFE5AD02F984FA01DC9062 = {
+ fRef = F5BFE58F02F8C45B01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkUndo.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1028;
+ vrLoc = 0;
+ };
+ F5BFE5AE02F984FA01DC9062 = {
+ fRef = F5375575016C37A601DC9062;
+ isa = PBXTextBookmark;
+ name = "tkIntDecls.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 959;
+ vrLoc = 52384;
+ };
+ F5BFE5AF02F984FA01DC9062 = {
+ fRef = F537556A016C37A601DC9062;
+ isa = PBXTextBookmark;
+ name = "ks_names.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 963;
+ vrLoc = 0;
+ };
+ F5BFE5B002F984FA01DC9062 = {
+ fRef = F537556B016C37A601DC9062;
+ isa = PBXTextBookmark;
+ name = "tk.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 882;
+ vrLoc = 55769;
+ };
+ F5BFE5B202F984FA01DC9062 = {
+ fRef = F537559F016C389901DC9062;
+ isa = PBXTextBookmark;
+ name = "tkGet.c: Tk_GetUid";
+ rLen = 50;
+ rLoc = 13445;
+ rType = 0;
+ vrLen = 1360;
+ vrLoc = 12671;
+ };
+ F5BFE5B302F984FA01DC9062 = {
+ fRef = F5375545016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXWm.h: 104";
+ rLen = 6;
+ rLoc = 4294;
+ rType = 0;
+ vrLen = 1558;
+ vrLoc = 8742;
+ };
+ F5BFE5B402F984FA01DC9062 = {
+ fRef = F537556B016C37A601DC9062;
+ isa = PBXTextBookmark;
+ name = "tk.h: 1606";
+ rLen = 0;
+ rLoc = 56812;
+ rType = 0;
+ vrLen = 897;
+ vrLoc = 55983;
+ };
+ F5BFE5B502F984FA01DC9062 = {
+ exec = F53756AB016C4DD401DC9062;
+ isa = PBXExecutableBookmark;
+ };
+ F5BFE5B702F984FA01DC9062 = {
+ fRef = F5BFE5DF02F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5B802F984FA01DC9062 = {
+ fRef = F5BFE5D902F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5B902F984FA01DC9062 = {
+ fRef = F5BFE5E502F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5BB02F984FA01DC9062 = {
+ fRef = F5BFE5D802F984FA01DC9062;
+ isa = PBXBookmark;
+ };
+ F5BFE5BC02F984FA01DC9062 = {
+ fRef = F5375567016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXWm.c: TkUnsupported1Cmd";
+ rLen = 15;
+ rLoc = 148454;
+ rType = 0;
+ vrLen = 1386;
+ vrLoc = 112609;
+ };
+ F5BFE5BD02F984FA01DC9062 = {
+ fRef = F5375568016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXXStubs.c: 92";
+ rLen = 14;
+ rLoc = 2403;
+ rType = 0;
+ vrLen = 1501;
+ vrLoc = 2945;
+ };
+ F5BFE5BE02F984FA01DC9062 = {
+ fRef = F53755C8016C389901DC9062;
+ isa = PBXTextBookmark;
+ name = "tkWindow.c: DeleteWindowsExitProc";
+ rLen = 0;
+ rLoc = 79080;
+ rType = 0;
+ vrLen = 1549;
+ vrLoc = 78212;
+ };
+ F5BFE5BF02F984FA01DC9062 = {
+ fRef = F5375568016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXXStubs.c: TkpCloseDisplay";
+ rLen = 0;
+ rLoc = 5311;
+ rType = 0;
+ vrLen = 437;
+ vrLoc = 4370;
+ };
+ F5BFE5C002F984FA01DC9062 = {
+ fRef = F53755C8016C389901DC9062;
+ isa = PBXTextBookmark;
+ name = "tkWindow.c: TkCloseDisplay";
+ rLen = 0;
+ rLoc = 9153;
+ rType = 0;
+ vrLen = 453;
+ vrLoc = 8833;
+ };
+ F5BFE5C102F984FA01DC9062 = {
+ fRef = F537555C016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXMouseEvent.c: TkMacOSXProcessMouseEvent";
+ rLen = 0;
+ rLoc = 6187;
+ rType = 0;
+ vrLen = 742;
+ vrLoc = 11312;
+ };
+ F5BFE5C402F984FA01DC9062 = {
+ fRef = F5375568016C376E01DC9062;
+ isa = PBXTextBookmark;
+ name = "tkMacOSXXStubs.c: TkpCloseDisplay";
+ rLen = 0;
+ rLoc = 5311;
+ rType = 0;
+ vrLen = 500;
+ vrLoc = 4894;
+ };
+ F5BFE5D802F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = README.html;
+ path = /Developer/Documentation/Help/README/README.html;
+ refType = 0;
+ };
+ F5BFE5D902F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = index.html;
+ path = /Developer/Documentation/ReleaseNotes/index.html;
+ refType = 0;
+ };
+ F5BFE5DA02F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = devessentials.html;
+ path = /Developer/Documentation/Essentials/devessentials.html;
+ refType = 0;
+ };
+ F5BFE5DB02F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = index.html;
+ path = /Developer/Documentation/ReleaseNotes/index.html;
+ refType = 0;
+ };
+ F5BFE5DC02F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = MallocOptions.html;
+ path = /Developer/Documentation/ReleaseNotes/MallocOptions.html;
+ refType = 0;
+ };
+ F5BFE5DD02F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = README.html;
+ path = /Developer/Documentation/Help/README/README.html;
+ refType = 0;
+ };
+ F5BFE5DF02F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = devessentials.html;
+ path = /Developer/Documentation/Essentials/devessentials.html;
+ refType = 0;
+ };
+ F5BFE5E102F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = devtools.html;
+ path = /Developer/Documentation/DeveloperTools/devtools.html;
+ refType = 0;
+ };
+ F5BFE5E502F984FA01DC9062 = {
+ isa = PBXFileReference;
+ name = README.html;
+ path = /Developer/Documentation/Help/README/README.html;
+ refType = 0;
+ };
+}
diff --git a/tcl/macosx/Wish.pbproj/project.pbxproj b/tcl/macosx/Wish.pbproj/project.pbxproj
new file mode 100644
index 00000000000..035f7f003b8
--- /dev/null
+++ b/tcl/macosx/Wish.pbproj/project.pbxproj
@@ -0,0 +1,3619 @@
+// !$*UTF8*$!
+{
+ archiveVersion = 1;
+ classes = {
+ };
+ objectVersion = 38;
+ objects = {
+ F50D96120196176E01DC9062 = {
+ isa = PBXFrameworkReference;
+ name = ApplicationServices.framework;
+ path = /System/Library/Frameworks/ApplicationServices.framework;
+ refType = 0;
+ };
+ F50D96130196176E01DC9062 = {
+ fileRef = F50D96120196176E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F50D96140196176E01DC9062 = {
+ fileRef = F50D96120196176E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D903E0181474301DC9062 = {
+ fileRef = F5875C7B016FEF1D01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D903F018149BD01DC9062 = {
+ buildActionMask = 2147483647;
+ dstPath = "Versions/$(FRAMEWORK_VERSION)/Headers/X11";
+ dstSubfolderSpec = 1;
+ files = (
+ F51D9040018149FD01DC9062,
+ F51D9041018149FD01DC9062,
+ F51D9042018149FD01DC9062,
+ F51D9043018149FD01DC9062,
+ F51D9044018149FD01DC9062,
+ F51D9045018149FD01DC9062,
+ F51D9046018149FD01DC9062,
+ F51D9047018149FD01DC9062,
+ F51D9048018149FD01DC9062,
+ );
+ isa = PBXCopyFilesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F51D9040018149FD01DC9062 = {
+ fileRef = F53755CE016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9041018149FD01DC9062 = {
+ fileRef = F53755CF016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9042018149FD01DC9062 = {
+ fileRef = F53755D0016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9043018149FD01DC9062 = {
+ fileRef = F53755D1016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9044018149FD01DC9062 = {
+ fileRef = F53755D2016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9045018149FD01DC9062 = {
+ fileRef = F53755D3016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9046018149FD01DC9062 = {
+ fileRef = F53755D4016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9047018149FD01DC9062 = {
+ fileRef = F53755D5016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F51D9048018149FD01DC9062 = {
+ fileRef = F53755D6016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F52D38C5031F4259016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "if [ \"${BUILD_STYLE}\" = \"Development\" ]; then\n\t# keep copy of debug library around, so that\n\t# Deployment build can be installed on top\n\t# of Development build without overwriting it\n\tcd \"${TARGET_BUILD_DIR}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Versions/${FRAMEWORK_VERSION}\"\n\tcp -fp \"${PRODUCT_NAME}\" \"${PRODUCT_NAME}_debug\"\n\n\t# force Deployment build to be relinked next time\n\tif [ -f \"${OBJROOT}/Deployment.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\" ]; then\n\t touch -t `date -r \\`expr \\\\\\`date +\"%s\"\\\\\\` + 30\\` +\"%Y%m%d%H%M.%S\"` \"${OBJROOT}/Deployment.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\"\n\tfi\nelse\n\t# force Development build to be relinked next time\n\tif [ -f \"${OBJROOT}/Development.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\" ]; then\n\t touch -t `date -r \\`expr \\\\\\`date +\"%s\"\\\\\\` + 30\\` +\"%Y%m%d%H%M.%S\"` \"${OBJROOT}/Development.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\"\n\tfi\nfi";
+ };
+ F537552A016C352C01DC9062 = {
+ buildStyles = (
+ F537552C016C352C01DC9062,
+ F537552D016C352C01DC9062,
+ );
+ isa = PBXProject;
+ mainGroup = F537552B016C352C01DC9062;
+ productRefGroup = F53755DD016C38D201DC9062;
+ projectDirPath = "";
+ targets = (
+ F53756A0016C4DD401DC9062,
+ F53755DF016C38D201DC9062,
+ F548F8CE0313CEF0016F146B,
+ );
+ };
+ F537552B016C352C01DC9062 = {
+ children = (
+ F5C88659017D625C01DC9062,
+ F5DF07A7016CD03801DC9062,
+ F5375688016C3F1001DC9062,
+ F5375531016C376E01DC9062,
+ F537552E016C376E01DC9062,
+ F537553C016C376E01DC9062,
+ F53755C9016C389901DC9062,
+ F53755CC016C389901DC9062,
+ F537567C016C3ADB01DC9062,
+ F53755DD016C38D201DC9062,
+ );
+ isa = PBXGroup;
+ refType = 4;
+ };
+ F537552C016C352C01DC9062 = {
+ buildRules = (
+ );
+ buildSettings = {
+ TEMP_DIR = "${OBJROOT}/Development.build/$(PROJECT_NAME).build/$(TARGET_NAME).build";
+ UNSTRIPPED_PRODUCT = YES;
+ };
+ isa = PBXBuildStyle;
+ name = Development;
+ };
+ F537552D016C352C01DC9062 = {
+ buildRules = (
+ );
+ buildSettings = {
+ DEBUGGING_SYMBOLS = NO;
+ OPTIMIZATION_CFLAGS = "-Os";
+ TEMP_DIR = "${OBJROOT}/Deployment.build/$(PROJECT_NAME).build/$(TARGET_NAME).build";
+ };
+ isa = PBXBuildStyle;
+ name = Deployment;
+ };
+ F537552E016C376E01DC9062 = {
+ children = (
+ F537552F016C376E01DC9062,
+ F5375530016C376E01DC9062,
+ );
+ isa = PBXGroup;
+ name = Generic;
+ refType = 4;
+ };
+ F537552F016C376E01DC9062 = {
+ children = (
+ F5375569016C37A601DC9062,
+ F537556A016C37A601DC9062,
+ F537556B016C37A601DC9062,
+ F537556C016C37A601DC9062,
+ F537556D016C37A601DC9062,
+ F537556E016C37A601DC9062,
+ F537556F016C37A601DC9062,
+ F5375570016C37A601DC9062,
+ F5375571016C37A601DC9062,
+ F5375572016C37A601DC9062,
+ F5375573016C37A601DC9062,
+ F5375574016C37A601DC9062,
+ F5375575016C37A601DC9062,
+ F5375576016C37A601DC9062,
+ F5375577016C37A601DC9062,
+ F5375578016C37A601DC9062,
+ F5375579016C37A601DC9062,
+ F537557A016C37A601DC9062,
+ F537557B016C37A601DC9062,
+ F537557C016C37A601DC9062,
+ F537557D016C37A601DC9062,
+ F537557E016C37A601DC9062,
+ F537557F016C37A601DC9062,
+ F5BFE58F02F8C45B01DC9062,
+ );
+ isa = PBXGroup;
+ name = Headers;
+ refType = 4;
+ };
+ F5375530016C376E01DC9062 = {
+ children = (
+ F5375580016C389901DC9062,
+ F5375581016C389901DC9062,
+ F5375582016C389901DC9062,
+ F5375583016C389901DC9062,
+ F5375584016C389901DC9062,
+ F5375585016C389901DC9062,
+ F5375586016C389901DC9062,
+ F5375587016C389901DC9062,
+ F5375588016C389901DC9062,
+ F5375589016C389901DC9062,
+ F537558A016C389901DC9062,
+ F537558B016C389901DC9062,
+ F537558C016C389901DC9062,
+ F537558D016C389901DC9062,
+ F537558E016C389901DC9062,
+ F537558F016C389901DC9062,
+ F5375590016C389901DC9062,
+ F5375591016C389901DC9062,
+ F5375592016C389901DC9062,
+ F5375593016C389901DC9062,
+ F5375594016C389901DC9062,
+ F5375595016C389901DC9062,
+ F5375596016C389901DC9062,
+ F5375597016C389901DC9062,
+ F5375598016C389901DC9062,
+ F5375599016C389901DC9062,
+ F537559A016C389901DC9062,
+ F537559B016C389901DC9062,
+ F537559C016C389901DC9062,
+ F537559D016C389901DC9062,
+ F537559E016C389901DC9062,
+ F537559F016C389901DC9062,
+ F53755A0016C389901DC9062,
+ F53755A1016C389901DC9062,
+ F53755A2016C389901DC9062,
+ F53755A3016C389901DC9062,
+ F53755A4016C389901DC9062,
+ F53755A5016C389901DC9062,
+ F53755A6016C389901DC9062,
+ F53755A7016C389901DC9062,
+ F53755A8016C389901DC9062,
+ F53755A9016C389901DC9062,
+ F53755AA016C389901DC9062,
+ F53755AB016C389901DC9062,
+ F53755AC016C389901DC9062,
+ F53755AD016C389901DC9062,
+ F53755AE016C389901DC9062,
+ F53755AF016C389901DC9062,
+ F53755B0016C389901DC9062,
+ F53755B1016C389901DC9062,
+ F53755B2016C389901DC9062,
+ F55BC46802B2D38B01DC9062,
+ F53755B3016C389901DC9062,
+ F53755B4016C389901DC9062,
+ F53755B5016C389901DC9062,
+ F53755B6016C389901DC9062,
+ F53755B7016C389901DC9062,
+ F53755B8016C389901DC9062,
+ F53755B9016C389901DC9062,
+ F53755BA016C389901DC9062,
+ F53755BB016C389901DC9062,
+ F5BFE58B02F8C41501DC9062,
+ F53755BC016C389901DC9062,
+ F53755BD016C389901DC9062,
+ F53755BE016C389901DC9062,
+ F53755BF016C389901DC9062,
+ F53755C0016C389901DC9062,
+ F53755C1016C389901DC9062,
+ F53755C2016C389901DC9062,
+ F53755C3016C389901DC9062,
+ F53755C4016C389901DC9062,
+ F53755C5016C389901DC9062,
+ F5BFE58C02F8C41501DC9062,
+ F53755C6016C389901DC9062,
+ F53755C7016C389901DC9062,
+ F53755C8016C389901DC9062,
+ );
+ isa = PBXGroup;
+ name = Source;
+ refType = 4;
+ };
+ F5375531016C376E01DC9062 = {
+ children = (
+ F5375532016C376E01DC9062,
+ F537553B016C376E01DC9062,
+ );
+ isa = PBXGroup;
+ name = Resources;
+ refType = 4;
+ };
+ F5375532016C376E01DC9062 = {
+ children = (
+ F5375533016C376E01DC9062,
+ F5375534016C376E01DC9062,
+ F5375535016C376E01DC9062,
+ F5375536016C376E01DC9062,
+ F5375538016C376E01DC9062,
+ F5375539016C376E01DC9062,
+ F537553A016C376E01DC9062,
+ );
+ isa = PBXGroup;
+ name = "Resource Manager Resources";
+ refType = 4;
+ };
+ F5375533016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkAboutDlg.r;
+ refType = 4;
+ };
+ F5375534016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXApplication.r;
+ refType = 4;
+ };
+ F5375535016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXCursors.r;
+ refType = 4;
+ };
+ F5375536016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXLibrary.r;
+ refType = 4;
+ };
+ F5375538016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXMenu.r;
+ refType = 4;
+ };
+ F5375539016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXResource.r;
+ refType = 4;
+ };
+ F537553A016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXXCursors.r;
+ refType = 4;
+ };
+ F537553B016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = Wish.icns;
+ refType = 4;
+ };
+ F537553C016C376E01DC9062 = {
+ children = (
+ F537553D016C376E01DC9062,
+ F5375546016C376E01DC9062,
+ );
+ isa = PBXGroup;
+ name = "MacOS X";
+ refType = 4;
+ };
+ F537553D016C376E01DC9062 = {
+ children = (
+ F537553E016C376E01DC9062,
+ F537553F016C376E01DC9062,
+ F5375540016C376E01DC9062,
+ F5375541016C376E01DC9062,
+ F5375542016C376E01DC9062,
+ F5375543016C376E01DC9062,
+ F5375544016C376E01DC9062,
+ F5375545016C376E01DC9062,
+ );
+ isa = PBXGroup;
+ name = Headers;
+ refType = 4;
+ };
+ F537553E016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSX.h;
+ refType = 2;
+ };
+ F537553F016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXDebug.h;
+ refType = 2;
+ };
+ F5375540016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXDefault.h;
+ refType = 2;
+ };
+ F5375541016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXEvent.h;
+ refType = 2;
+ };
+ F5375542016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXInt.h;
+ refType = 2;
+ };
+ F5375543016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXPort.h;
+ refType = 2;
+ };
+ F5375544016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXUtil.h;
+ refType = 2;
+ };
+ F5375545016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXWm.h;
+ refType = 2;
+ };
+ F5375546016C376E01DC9062 = {
+ children = (
+ F5375548016C376E01DC9062,
+ F5375549016C376E01DC9062,
+ F537554A016C376E01DC9062,
+ F537554B016C376E01DC9062,
+ F537554C016C376E01DC9062,
+ F537554D016C376E01DC9062,
+ F537554E016C376E01DC9062,
+ F537554F016C376E01DC9062,
+ F5375550016C376E01DC9062,
+ F5375551016C376E01DC9062,
+ F5375552016C376E01DC9062,
+ F5375553016C376E01DC9062,
+ F5375554016C376E01DC9062,
+ F5375555016C376E01DC9062,
+ F5375556016C376E01DC9062,
+ F5375557016C376E01DC9062,
+ F5375558016C376E01DC9062,
+ F5375559016C376E01DC9062,
+ F537555A016C376E01DC9062,
+ F537555B016C376E01DC9062,
+ F537555C016C376E01DC9062,
+ F537555D016C376E01DC9062,
+ F537555E016C376E01DC9062,
+ F5375560016C376E01DC9062,
+ F5375561016C376E01DC9062,
+ F5375562016C376E01DC9062,
+ F5375563016C376E01DC9062,
+ F5375564016C376E01DC9062,
+ F5375565016C376E01DC9062,
+ F5375567016C376E01DC9062,
+ F5375568016C376E01DC9062,
+ );
+ isa = PBXGroup;
+ name = Source;
+ refType = 4;
+ };
+ F5375548016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXAppInit.c;
+ refType = 4;
+ };
+ F5375549016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXBitmap.c;
+ refType = 4;
+ };
+ F537554A016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXButton.c;
+ refType = 4;
+ };
+ F537554B016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXClipboard.c;
+ refType = 4;
+ };
+ F537554C016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXColor.c;
+ refType = 4;
+ };
+ F537554D016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXConfig.c;
+ refType = 4;
+ };
+ F537554E016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXCursor.c;
+ refType = 4;
+ };
+ F537554F016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXDebug.c;
+ refType = 4;
+ };
+ F5375550016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXDialog.c;
+ refType = 4;
+ };
+ F5375551016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXDraw.c;
+ refType = 4;
+ };
+ F5375552016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXEmbed.c;
+ refType = 4;
+ };
+ F5375553016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXEvent.c;
+ refType = 4;
+ };
+ F5375554016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXFont.c;
+ refType = 4;
+ };
+ F5375555016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXHLEvents.c;
+ refType = 4;
+ };
+ F5375556016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXInit.c;
+ refType = 4;
+ };
+ F5375557016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXKeyboard.c;
+ refType = 4;
+ };
+ F5375558016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXKeyEvent.c;
+ refType = 4;
+ };
+ F5375559016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXMenu.c;
+ refType = 4;
+ };
+ F537555A016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXMenubutton.c;
+ refType = 4;
+ };
+ F537555B016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXMenus.c;
+ refType = 4;
+ };
+ F537555C016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXMouseEvent.c;
+ refType = 4;
+ };
+ F537555D016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXNotify.c;
+ refType = 4;
+ };
+ F537555E016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXRegion.c;
+ refType = 4;
+ };
+ F5375560016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXScrlbr.c;
+ refType = 4;
+ };
+ F5375561016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXSend.c;
+ refType = 4;
+ };
+ F5375562016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXSubwindows.c;
+ refType = 4;
+ };
+ F5375563016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXTest.c;
+ refType = 4;
+ };
+ F5375564016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXUtil.c;
+ refType = 4;
+ };
+ F5375565016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXWindowEvent.c;
+ refType = 4;
+ };
+ F5375567016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXWm.c;
+ refType = 4;
+ };
+ F5375568016C376E01DC9062 = {
+ isa = PBXFileReference;
+ path = tkMacOSXXStubs.c;
+ refType = 4;
+ };
+ F5375569016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = default.h;
+ path = ../generic/default.h;
+ refType = 2;
+ };
+ F537556A016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = ks_names.h;
+ path = ../generic/ks_names.h;
+ refType = 2;
+ };
+ F537556B016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tk.h;
+ path = ../generic/tk.h;
+ refType = 2;
+ };
+ F537556C016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tk3d.h;
+ path = ../generic/tk3d.h;
+ refType = 2;
+ };
+ F537556D016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkButton.h;
+ path = ../generic/tkButton.h;
+ refType = 2;
+ };
+ F537556E016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvas.h;
+ path = ../generic/tkCanvas.h;
+ refType = 2;
+ };
+ F537556F016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkColor.h;
+ path = ../generic/tkColor.h;
+ refType = 2;
+ };
+ F5375570016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkDecls.h;
+ path = ../generic/tkDecls.h;
+ refType = 2;
+ };
+ F5375571016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkFileFilter.h;
+ path = ../generic/tkFileFilter.h;
+ refType = 2;
+ };
+ F5375572016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkFont.h;
+ path = ../generic/tkFont.h;
+ refType = 2;
+ };
+ F5375573016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkInitScript.h;
+ path = ../generic/tkInitScript.h;
+ refType = 2;
+ };
+ F5375574016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkInt.h;
+ path = ../generic/tkInt.h;
+ refType = 2;
+ };
+ F5375575016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkIntDecls.h;
+ path = ../generic/tkIntDecls.h;
+ refType = 2;
+ };
+ F5375576016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkIntPlatDecls.h;
+ path = ../generic/tkIntPlatDecls.h;
+ refType = 2;
+ };
+ F5375577016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkIntXlibDecls.h;
+ path = ../generic/tkIntXlibDecls.h;
+ refType = 2;
+ };
+ F5375578016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkMenu.h;
+ path = ../generic/tkMenu.h;
+ refType = 2;
+ };
+ F5375579016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkMenubutton.h;
+ path = ../generic/tkMenubutton.h;
+ refType = 2;
+ };
+ F537557A016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkPlatDecls.h;
+ path = ../generic/tkPlatDecls.h;
+ refType = 2;
+ };
+ F537557B016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkPort.h;
+ path = ../generic/tkPort.h;
+ refType = 2;
+ };
+ F537557C016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkScale.h;
+ path = ../generic/tkScale.h;
+ refType = 2;
+ };
+ F537557D016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkScrollbar.h;
+ path = ../generic/tkScrollbar.h;
+ refType = 2;
+ };
+ F537557E016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkSelect.h;
+ path = ../generic/tkSelect.h;
+ refType = 2;
+ };
+ F537557F016C37A601DC9062 = {
+ isa = PBXFileReference;
+ name = tkText.h;
+ path = ../generic/tkText.h;
+ refType = 2;
+ };
+ F5375580016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tk3d.c;
+ path = ../generic/tk3d.c;
+ refType = 2;
+ };
+ F5375581016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkArgv.c;
+ path = ../generic/tkArgv.c;
+ refType = 2;
+ };
+ F5375582016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkAtom.c;
+ path = ../generic/tkAtom.c;
+ refType = 2;
+ };
+ F5375583016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkBind.c;
+ path = ../generic/tkBind.c;
+ refType = 2;
+ };
+ F5375584016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkBitmap.c;
+ path = ../generic/tkBitmap.c;
+ refType = 2;
+ };
+ F5375585016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkButton.c;
+ path = ../generic/tkButton.c;
+ refType = 2;
+ };
+ F5375586016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvArc.c;
+ path = ../generic/tkCanvArc.c;
+ refType = 2;
+ };
+ F5375587016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvas.c;
+ path = ../generic/tkCanvas.c;
+ refType = 2;
+ };
+ F5375588016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvBmap.c;
+ path = ../generic/tkCanvBmap.c;
+ refType = 2;
+ };
+ F5375589016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvImg.c;
+ path = ../generic/tkCanvImg.c;
+ refType = 2;
+ };
+ F537558A016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvLine.c;
+ path = ../generic/tkCanvLine.c;
+ refType = 2;
+ };
+ F537558B016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvPoly.c;
+ path = ../generic/tkCanvPoly.c;
+ refType = 2;
+ };
+ F537558C016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvPs.c;
+ path = ../generic/tkCanvPs.c;
+ refType = 2;
+ };
+ F537558D016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvText.c;
+ path = ../generic/tkCanvText.c;
+ refType = 2;
+ };
+ F537558E016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvUtil.c;
+ path = ../generic/tkCanvUtil.c;
+ refType = 2;
+ };
+ F537558F016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCanvWind.c;
+ path = ../generic/tkCanvWind.c;
+ refType = 2;
+ };
+ F5375590016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkClipboard.c;
+ path = ../generic/tkClipboard.c;
+ refType = 2;
+ };
+ F5375591016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCmds.c;
+ path = ../generic/tkCmds.c;
+ refType = 2;
+ };
+ F5375592016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkColor.c;
+ path = ../generic/tkColor.c;
+ refType = 2;
+ };
+ F5375593016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkConfig.c;
+ path = ../generic/tkConfig.c;
+ refType = 2;
+ };
+ F5375594016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkConsole.c;
+ path = ../generic/tkConsole.c;
+ refType = 2;
+ };
+ F5375595016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkCursor.c;
+ path = ../generic/tkCursor.c;
+ refType = 2;
+ };
+ F5375596016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkEntry.c;
+ path = ../generic/tkEntry.c;
+ refType = 2;
+ };
+ F5375597016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkError.c;
+ path = ../generic/tkError.c;
+ refType = 2;
+ };
+ F5375598016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkEvent.c;
+ path = ../generic/tkEvent.c;
+ refType = 2;
+ };
+ F5375599016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkFileFilter.c;
+ path = ../generic/tkFileFilter.c;
+ refType = 2;
+ };
+ F537559A016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkFocus.c;
+ path = ../generic/tkFocus.c;
+ refType = 2;
+ };
+ F537559B016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkFont.c;
+ path = ../generic/tkFont.c;
+ refType = 2;
+ };
+ F537559C016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkFrame.c;
+ path = ../generic/tkFrame.c;
+ refType = 2;
+ };
+ F537559D016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkGC.c;
+ path = ../generic/tkGC.c;
+ refType = 2;
+ };
+ F537559E016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkGeometry.c;
+ path = ../generic/tkGeometry.c;
+ refType = 2;
+ };
+ F537559F016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkGet.c;
+ path = ../generic/tkGet.c;
+ refType = 2;
+ };
+ F53755A0016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkGrab.c;
+ path = ../generic/tkGrab.c;
+ refType = 2;
+ };
+ F53755A1016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkGrid.c;
+ path = ../generic/tkGrid.c;
+ refType = 2;
+ };
+ F53755A2016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkImage.c;
+ path = ../generic/tkImage.c;
+ refType = 2;
+ };
+ F53755A3016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkImgBmap.c;
+ path = ../generic/tkImgBmap.c;
+ refType = 2;
+ };
+ F53755A4016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkImgGIF.c;
+ path = ../generic/tkImgGIF.c;
+ refType = 2;
+ };
+ F53755A5016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkImgPhoto.c;
+ path = ../generic/tkImgPhoto.c;
+ refType = 2;
+ };
+ F53755A6016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkImgPPM.c;
+ path = ../generic/tkImgPPM.c;
+ refType = 2;
+ };
+ F53755A7016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkImgUtil.c;
+ path = ../generic/tkImgUtil.c;
+ refType = 2;
+ };
+ F53755A8016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkListbox.c;
+ path = ../generic/tkListbox.c;
+ refType = 2;
+ };
+ F53755A9016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkMacWinMenu.c;
+ path = ../generic/tkMacWinMenu.c;
+ refType = 2;
+ };
+ F53755AA016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkMain.c;
+ path = ../generic/tkMain.c;
+ refType = 2;
+ };
+ F53755AB016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkMenu.c;
+ path = ../generic/tkMenu.c;
+ refType = 2;
+ };
+ F53755AC016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkMenubutton.c;
+ path = ../generic/tkMenubutton.c;
+ refType = 2;
+ };
+ F53755AD016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkMenuDraw.c;
+ path = ../generic/tkMenuDraw.c;
+ refType = 2;
+ };
+ F53755AE016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkMessage.c;
+ path = ../generic/tkMessage.c;
+ refType = 2;
+ };
+ F53755AF016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkObj.c;
+ path = ../generic/tkObj.c;
+ refType = 2;
+ };
+ F53755B0016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkOldConfig.c;
+ path = ../generic/tkOldConfig.c;
+ refType = 2;
+ };
+ F53755B1016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkOption.c;
+ path = ../generic/tkOption.c;
+ refType = 2;
+ };
+ F53755B2016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkPack.c;
+ path = ../generic/tkPack.c;
+ refType = 2;
+ };
+ F53755B3016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkPlace.c;
+ path = ../generic/tkPlace.c;
+ refType = 2;
+ };
+ F53755B4016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkPointer.c;
+ path = ../generic/tkPointer.c;
+ refType = 2;
+ };
+ F53755B5016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkRectOval.c;
+ path = ../generic/tkRectOval.c;
+ refType = 2;
+ };
+ F53755B6016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkScale.c;
+ path = ../generic/tkScale.c;
+ refType = 2;
+ };
+ F53755B7016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkScrollbar.c;
+ path = ../generic/tkScrollbar.c;
+ refType = 2;
+ };
+ F53755B8016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkSelect.c;
+ path = ../generic/tkSelect.c;
+ refType = 2;
+ };
+ F53755B9016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkStubImg.c;
+ path = ../generic/tkStubImg.c;
+ refType = 2;
+ };
+ F53755BA016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkStubInit.c;
+ path = ../generic/tkStubInit.c;
+ refType = 2;
+ };
+ F53755BB016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkStubLib.c;
+ path = ../generic/tkStubLib.c;
+ refType = 2;
+ };
+ F53755BC016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTest.c;
+ path = ../generic/tkTest.c;
+ refType = 2;
+ };
+ F53755BD016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkText.c;
+ path = ../generic/tkText.c;
+ refType = 2;
+ };
+ F53755BE016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTextBTree.c;
+ path = ../generic/tkTextBTree.c;
+ refType = 2;
+ };
+ F53755BF016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTextDisp.c;
+ path = ../generic/tkTextDisp.c;
+ refType = 2;
+ };
+ F53755C0016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTextImage.c;
+ path = ../generic/tkTextImage.c;
+ refType = 2;
+ };
+ F53755C1016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTextIndex.c;
+ path = ../generic/tkTextIndex.c;
+ refType = 2;
+ };
+ F53755C2016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTextMark.c;
+ path = ../generic/tkTextMark.c;
+ refType = 2;
+ };
+ F53755C3016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTextTag.c;
+ path = ../generic/tkTextTag.c;
+ refType = 2;
+ };
+ F53755C4016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTextWind.c;
+ path = ../generic/tkTextWind.c;
+ refType = 2;
+ };
+ F53755C5016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkTrig.c;
+ path = ../generic/tkTrig.c;
+ refType = 2;
+ };
+ F53755C6016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkUtil.c;
+ path = ../generic/tkUtil.c;
+ refType = 2;
+ };
+ F53755C7016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkVisual.c;
+ path = ../generic/tkVisual.c;
+ refType = 2;
+ };
+ F53755C8016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkWindow.c;
+ path = ../generic/tkWindow.c;
+ refType = 2;
+ };
+ F53755C9016C389901DC9062 = {
+ children = (
+ F53755CA016C389901DC9062,
+ F53755CB016C389901DC9062,
+ );
+ isa = PBXGroup;
+ name = Unix;
+ refType = 4;
+ };
+ F53755CA016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkUnix3d.c;
+ path = ../unix/tkUnix3d.c;
+ refType = 2;
+ };
+ F53755CB016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = tkUnixScale.c;
+ path = ../unix/tkUnixScale.c;
+ refType = 2;
+ };
+ F53755CC016C389901DC9062 = {
+ children = (
+ F53755CD016C389901DC9062,
+ F53755D7016C389901DC9062,
+ );
+ isa = PBXGroup;
+ name = "X Emulation";
+ refType = 4;
+ };
+ F53755CD016C389901DC9062 = {
+ children = (
+ F53755CE016C389901DC9062,
+ F53755CF016C389901DC9062,
+ F53755D0016C389901DC9062,
+ F53755D1016C389901DC9062,
+ F53755D2016C389901DC9062,
+ F53755D3016C389901DC9062,
+ F53755D4016C389901DC9062,
+ F53755D5016C389901DC9062,
+ F53755D6016C389901DC9062,
+ );
+ isa = PBXGroup;
+ name = Headers;
+ refType = 4;
+ };
+ F53755CE016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = xbytes.h;
+ path = ../xlib/xbytes.h;
+ refType = 2;
+ };
+ F53755CF016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = cursorfont.h;
+ path = ../xlib/X11/cursorfont.h;
+ refType = 2;
+ };
+ F53755D0016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = keysym.h;
+ path = ../xlib/X11/keysym.h;
+ refType = 2;
+ };
+ F53755D1016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = keysymdef.h;
+ path = ../xlib/X11/keysymdef.h;
+ refType = 2;
+ };
+ F53755D2016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = X.h;
+ path = ../xlib/X11/X.h;
+ refType = 2;
+ };
+ F53755D3016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = Xatom.h;
+ path = ../xlib/X11/Xatom.h;
+ refType = 2;
+ };
+ F53755D4016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = Xfuncproto.h;
+ path = ../xlib/X11/Xfuncproto.h;
+ refType = 2;
+ };
+ F53755D5016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = Xlib.h;
+ path = ../xlib/X11/Xlib.h;
+ refType = 2;
+ };
+ F53755D6016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = Xutil.h;
+ path = ../xlib/X11/Xutil.h;
+ refType = 2;
+ };
+ F53755D7016C389901DC9062 = {
+ children = (
+ F53755D8016C389901DC9062,
+ F53755D9016C389901DC9062,
+ F53755DA016C389901DC9062,
+ F53755DB016C389901DC9062,
+ F53755DC016C389901DC9062,
+ );
+ isa = PBXGroup;
+ name = Source;
+ refType = 4;
+ };
+ F53755D8016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = xcolors.c;
+ path = ../xlib/xcolors.c;
+ refType = 2;
+ };
+ F53755D9016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = xdraw.c;
+ path = ../xlib/xdraw.c;
+ refType = 2;
+ };
+ F53755DA016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = xgc.c;
+ path = ../xlib/xgc.c;
+ refType = 2;
+ };
+ F53755DB016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = ximage.c;
+ path = ../xlib/ximage.c;
+ refType = 2;
+ };
+ F53755DC016C389901DC9062 = {
+ isa = PBXFileReference;
+ name = xutil.c;
+ path = ../xlib/xutil.c;
+ refType = 2;
+ };
+ F53755DD016C38D201DC9062 = {
+ children = (
+ F53755DE016C38D201DC9062,
+ F537569F016C4DD401DC9062,
+ F548F8CF0313CEF0016F146B,
+ );
+ isa = PBXGroup;
+ name = Products;
+ refType = 4;
+ };
+ F53755DE016C38D201DC9062 = {
+ isa = PBXFrameworkReference;
+ path = Tk.framework;
+ refType = 3;
+ };
+ F53755DF016C38D201DC9062 = {
+ buildPhases = (
+ F5877FB7031F97ED016F146B,
+ F53755E0016C38D201DC9062,
+ F53755E1016C38D301DC9062,
+ F53755E2016C38D301DC9062,
+ F53755E3016C38D301DC9062,
+ F53755E4016C38D301DC9062,
+ F5B1FC08016FFE3501DC9062,
+ F51D903F018149BD01DC9062,
+ F548F8C80313C9E0016F146B,
+ F52D38C5031F4259016F146B,
+ F5877FBC031FA968016F146B,
+ F5C1D51901B88F9A01DC9062,
+ );
+ buildSettings = {
+ DYLIB_COMPATIBILITY_VERSION = 8.4;
+ DYLIB_CURRENT_VERSION = 8.4;
+ DYLIB_INSTALL_PATH = /Library/Frameworks;
+ FRAMEWORK_SEARCH_PATHS = "\"$(SYMROOT)\"";
+ FRAMEWORK_VERSION = 8.4;
+ GLOBAL_CFLAGS = "`source \"${SYMROOT}/Tcl.framework/Resources/tclConfig.sh\"; echo $${}{TCL_EXTRA_CFLAGS} $${}{TCL_DEFS} | sed -e 's|\\\\\\\\\\\\\\\"|\\\"|g' | sed -e 's| -DTCL_WIDE_INT_TYPE=long. long||'` -U_REENTRANT";
+ HEADER_SEARCH_PATHS = "../../tcl/generic ../../tcl/unix ../bitmaps ../generic ../xlib";
+ INSTALL_PATH = "${DYLIB_INSTALL_PATH}";
+ LIBRARY_SEARCH_PATHS = "";
+ OPTIMIZATION_CFLAGS = "-O0";
+ OTHER_CFLAGS = "-DMAC_OSX_TK -DTCL_WIDE_INT_TYPE=\"long long\"";
+ OTHER_LDFLAGS = "-seg1addr 0xb000000";
+ OTHER_LIBTOOL_FLAGS = "";
+ OTHER_REZFLAGS = "-i \"../../tcl/generic\" -i \"../generic\"";
+ PRINCIPAL_CLASS = "";
+ PRODUCT_NAME = Tk;
+ SECTORDER_FLAGS = "";
+ TK_MAJOR_VERSION = 8;
+ TK_MINOR_VERSION = 4;
+ TK_PATCH_LEVEL = .0;
+ TK_VERSION = 8.4;
+ USE_GCC3_PFE_SUPPORT = NO;
+ WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas";
+ WRAPPER_EXTENSION = framework;
+ };
+ dependencies = (
+ F548F8D20313CF93016F146B,
+ );
+ isa = PBXFrameworkTarget;
+ name = TkLibrary;
+ productInstallPath = /Library/Frameworks;
+ productName = TkLibrary;
+ productReference = F53755DE016C38D201DC9062;
+ productSettingsXML = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+<!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">
+<plist version=\"1.0\">
+<dict>
+ <key>CFBundleDevelopmentRegion</key>
+ <string>English</string>
+ <key>CFBundleExecutable</key>
+ <string>Tk</string>
+ <key>CFBundleGetInfoString</key>
+ <string>Tk Library 8.4, Copyright © 2002 Tcl Core Team.
+MacOS X Port by Jim Ingham &lt;jingham@apple.com&gt; &amp; Ian Reid, Copyright © 2001-2002, Apple Computer, Inc.</string>
+ <key>CFBundleIconFile</key>
+ <string></string>
+ <key>CFBundleIdentifier</key>
+ <string>com.tcltk.tklibrary</string>
+ <key>CFBundleInfoDictionaryVersion</key>
+ <string>6.0</string>
+ <key>CFBundleName</key>
+ <string>Tk Library 8.4</string>
+ <key>CFBundlePackageType</key>
+ <string>FMWK</string>
+ <key>CFBundleShortVersionString</key>
+ <string>8.4.0</string>
+ <key>CFBundleSignature</key>
+ <string>WiSH</string>
+ <key>CFBundleVersion</key>
+ <string>8.4.0</string>
+</dict>
+</plist>
+";
+ shouldUseHeadermap = 0;
+ };
+ F53755E0016C38D201DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F53755E5016C390401DC9062,
+ F53755E6016C390401DC9062,
+ F53755E7016C390401DC9062,
+ F53755E8016C390401DC9062,
+ F53755E9016C390401DC9062,
+ F53755EA016C390401DC9062,
+ F53755EB016C390401DC9062,
+ F53755EC016C390401DC9062,
+ F53755ED016C390401DC9062,
+ F53755EE016C390401DC9062,
+ F53755EF016C390401DC9062,
+ F53755F0016C390401DC9062,
+ F53755F1016C390401DC9062,
+ F53755F2016C390401DC9062,
+ F53755F3016C390401DC9062,
+ F53755F4016C390401DC9062,
+ F53755F5016C390401DC9062,
+ F53755F6016C390401DC9062,
+ F53755F7016C390401DC9062,
+ F53755F8016C390401DC9062,
+ F53755F9016C390401DC9062,
+ F53755FA016C390401DC9062,
+ F53755FB016C390401DC9062,
+ F53755FC016C397D01DC9062,
+ F53755FD016C397D01DC9062,
+ F53755FE016C397D01DC9062,
+ F53755FF016C397D01DC9062,
+ F5375600016C397D01DC9062,
+ F5375601016C397D01DC9062,
+ F5375602016C397D01DC9062,
+ F5375603016C397D01DC9062,
+ F537566E016C3A1F01DC9062,
+ F537566F016C3A1F01DC9062,
+ F5375670016C3A1F01DC9062,
+ F5375671016C3A1F01DC9062,
+ F5375672016C3A1F01DC9062,
+ F5375673016C3A1F01DC9062,
+ F5375674016C3A1F01DC9062,
+ F5375675016C3A1F01DC9062,
+ F5375676016C3A1F01DC9062,
+ F5375693016C3F1001DC9062,
+ F5375694016C3F1001DC9062,
+ F5375695016C3F1001DC9062,
+ F5375696016C3F1001DC9062,
+ F5375697016C3F1001DC9062,
+ F5375698016C3F1001DC9062,
+ F5375699016C3F1001DC9062,
+ F537569A016C3F1001DC9062,
+ F537569B016C3F1001DC9062,
+ F537569C016C3F1001DC9062,
+ F5BFE59002F8C45B01DC9062,
+ );
+ isa = PBXHeadersBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53755E1016C38D301DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXResourcesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53755E2016C38D301DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F5375604016C397D01DC9062,
+ F5375605016C397D01DC9062,
+ F5375606016C397D01DC9062,
+ F5375607016C397D01DC9062,
+ F5375608016C397D01DC9062,
+ F5375609016C397D01DC9062,
+ F537560A016C397D01DC9062,
+ F537560B016C397D01DC9062,
+ F537560C016C397D01DC9062,
+ F537560D016C397D01DC9062,
+ F537560E016C397D01DC9062,
+ F537560F016C397D01DC9062,
+ F5375610016C397D01DC9062,
+ F5375611016C397D01DC9062,
+ F5375612016C397D01DC9062,
+ F5375613016C397D01DC9062,
+ F5375614016C397D01DC9062,
+ F5375615016C397D01DC9062,
+ F5375616016C397D01DC9062,
+ F5375617016C397D01DC9062,
+ F5375618016C397D01DC9062,
+ F5375619016C397D01DC9062,
+ F537561A016C397D01DC9062,
+ F537561B016C397D01DC9062,
+ F537561C016C397D01DC9062,
+ F537561D016C397D01DC9062,
+ F537561E016C397D01DC9062,
+ F537561F016C397D01DC9062,
+ F5375620016C397D01DC9062,
+ F5375621016C397D01DC9062,
+ F5375622016C397D01DC9062,
+ F5375623016C397D01DC9062,
+ F5375624016C397D01DC9062,
+ F5375625016C397D01DC9062,
+ F5375626016C397D01DC9062,
+ F5375627016C397D01DC9062,
+ F5375628016C397D01DC9062,
+ F5375629016C397D01DC9062,
+ F537562A016C397D01DC9062,
+ F537562B016C397D01DC9062,
+ F537562C016C397D01DC9062,
+ F537562D016C397D01DC9062,
+ F537562E016C397D01DC9062,
+ F537562F016C397D01DC9062,
+ F5375630016C397D01DC9062,
+ F5375631016C397D01DC9062,
+ F5375632016C397D01DC9062,
+ F5375633016C397D01DC9062,
+ F5375634016C397D01DC9062,
+ F5375635016C397D01DC9062,
+ F5375636016C397D01DC9062,
+ F5375637016C397D01DC9062,
+ F5375638016C397D01DC9062,
+ F5375639016C397D01DC9062,
+ F537563A016C397D01DC9062,
+ F537563B016C397D01DC9062,
+ F537563C016C397D01DC9062,
+ F537563D016C397D01DC9062,
+ F537563F016C397D01DC9062,
+ F5375640016C397D01DC9062,
+ F5375641016C397D01DC9062,
+ F5375642016C397D01DC9062,
+ F5375643016C397D01DC9062,
+ F5375644016C397D01DC9062,
+ F5375645016C397D01DC9062,
+ F5375646016C397D01DC9062,
+ F5375647016C397D01DC9062,
+ F5375648016C397D01DC9062,
+ F5375649016C397D01DC9062,
+ F537564A016C397D01DC9062,
+ F537564D016C39A101DC9062,
+ F537564E016C39A101DC9062,
+ F537564F016C39A101DC9062,
+ F5375650016C39A101DC9062,
+ F5375651016C39A101DC9062,
+ F5375652016C39A101DC9062,
+ F5375653016C39A101DC9062,
+ F5375654016C39A101DC9062,
+ F5375655016C39A101DC9062,
+ F5375656016C39A101DC9062,
+ F5375657016C39A101DC9062,
+ F5375658016C39A101DC9062,
+ F5375659016C39A101DC9062,
+ F537565A016C39A101DC9062,
+ F537565B016C39A101DC9062,
+ F537565C016C39A101DC9062,
+ F537565D016C39A101DC9062,
+ F537565E016C39A101DC9062,
+ F537565F016C39A101DC9062,
+ F5375660016C39A101DC9062,
+ F5375661016C39A101DC9062,
+ F5375662016C39A101DC9062,
+ F5375664016C39A101DC9062,
+ F5375665016C39A101DC9062,
+ F5375666016C39A101DC9062,
+ F5375667016C39A101DC9062,
+ F5375668016C39A101DC9062,
+ F537566A016C39A101DC9062,
+ F537566B016C39A101DC9062,
+ F537566C016C39F201DC9062,
+ F537566D016C39F201DC9062,
+ F5375677016C3A6D01DC9062,
+ F5375678016C3A6D01DC9062,
+ F5375679016C3A6D01DC9062,
+ F537567A016C3A6D01DC9062,
+ F537567B016C3A6D01DC9062,
+ F537569E016C49C301DC9062,
+ F55BC46902B2D38B01DC9062,
+ F5BFE58D02F8C41501DC9062,
+ F5BFE58E02F8C41501DC9062,
+ );
+ isa = PBXSourcesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53755E3016C38D301DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F51D903E0181474301DC9062,
+ F537567E016C3ADB01DC9062,
+ F50D96130196176E01DC9062,
+ );
+ isa = PBXFrameworksBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53755E4016C38D301DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F537567F016C3ADB01DC9062,
+ F5375680016C3ADB01DC9062,
+ F5375681016C3ADB01DC9062,
+ F5375682016C3ADB01DC9062,
+ );
+ isa = PBXRezBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53755E5016C390401DC9062 = {
+ fileRef = F5375569016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755E6016C390401DC9062 = {
+ fileRef = F537556A016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755E7016C390401DC9062 = {
+ fileRef = F537556B016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Public,
+ );
+ };
+ };
+ F53755E8016C390401DC9062 = {
+ fileRef = F537556C016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755E9016C390401DC9062 = {
+ fileRef = F537556D016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755EA016C390401DC9062 = {
+ fileRef = F537556E016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755EB016C390401DC9062 = {
+ fileRef = F537556F016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755EC016C390401DC9062 = {
+ fileRef = F5375570016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Public,
+ );
+ };
+ };
+ F53755ED016C390401DC9062 = {
+ fileRef = F5375571016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755EE016C390401DC9062 = {
+ fileRef = F5375572016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755EF016C390401DC9062 = {
+ fileRef = F5375573016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755F0016C390401DC9062 = {
+ fileRef = F5375574016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Private,
+ );
+ };
+ };
+ F53755F1016C390401DC9062 = {
+ fileRef = F5375575016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Private,
+ );
+ };
+ };
+ F53755F2016C390401DC9062 = {
+ fileRef = F5375576016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Private,
+ );
+ };
+ };
+ F53755F3016C390401DC9062 = {
+ fileRef = F5375577016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Private,
+ );
+ };
+ };
+ F53755F4016C390401DC9062 = {
+ fileRef = F5375578016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755F5016C390401DC9062 = {
+ fileRef = F5375579016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755F6016C390401DC9062 = {
+ fileRef = F537557A016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Public,
+ );
+ };
+ };
+ F53755F7016C390401DC9062 = {
+ fileRef = F537557B016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755F8016C390401DC9062 = {
+ fileRef = F537557C016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755F9016C390401DC9062 = {
+ fileRef = F537557D016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755FA016C390401DC9062 = {
+ fileRef = F537557E016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755FB016C390401DC9062 = {
+ fileRef = F537557F016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755FC016C397D01DC9062 = {
+ fileRef = F537553E016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Public,
+ );
+ };
+ };
+ F53755FD016C397D01DC9062 = {
+ fileRef = F537553F016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755FE016C397D01DC9062 = {
+ fileRef = F5375540016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53755FF016C397D01DC9062 = {
+ fileRef = F5375541016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375600016C397D01DC9062 = {
+ fileRef = F5375542016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ Private,
+ );
+ };
+ };
+ F5375601016C397D01DC9062 = {
+ fileRef = F5375543016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375602016C397D01DC9062 = {
+ fileRef = F5375544016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375603016C397D01DC9062 = {
+ fileRef = F5375545016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375604016C397D01DC9062 = {
+ fileRef = F5375580016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375605016C397D01DC9062 = {
+ fileRef = F5375581016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375606016C397D01DC9062 = {
+ fileRef = F5375582016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375607016C397D01DC9062 = {
+ fileRef = F5375583016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375608016C397D01DC9062 = {
+ fileRef = F5375584016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375609016C397D01DC9062 = {
+ fileRef = F5375585016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537560A016C397D01DC9062 = {
+ fileRef = F5375586016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537560B016C397D01DC9062 = {
+ fileRef = F5375587016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537560C016C397D01DC9062 = {
+ fileRef = F5375588016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537560D016C397D01DC9062 = {
+ fileRef = F5375589016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537560E016C397D01DC9062 = {
+ fileRef = F537558A016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537560F016C397D01DC9062 = {
+ fileRef = F537558B016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375610016C397D01DC9062 = {
+ fileRef = F537558C016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375611016C397D01DC9062 = {
+ fileRef = F537558D016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375612016C397D01DC9062 = {
+ fileRef = F537558E016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375613016C397D01DC9062 = {
+ fileRef = F537558F016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375614016C397D01DC9062 = {
+ fileRef = F5375590016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375615016C397D01DC9062 = {
+ fileRef = F5375591016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375616016C397D01DC9062 = {
+ fileRef = F5375592016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375617016C397D01DC9062 = {
+ fileRef = F5375593016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375618016C397D01DC9062 = {
+ fileRef = F5375594016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375619016C397D01DC9062 = {
+ fileRef = F5375595016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537561A016C397D01DC9062 = {
+ fileRef = F5375596016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537561B016C397D01DC9062 = {
+ fileRef = F5375597016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537561C016C397D01DC9062 = {
+ fileRef = F5375598016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537561D016C397D01DC9062 = {
+ fileRef = F5375599016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537561E016C397D01DC9062 = {
+ fileRef = F537559A016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537561F016C397D01DC9062 = {
+ fileRef = F537559B016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375620016C397D01DC9062 = {
+ fileRef = F537559C016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375621016C397D01DC9062 = {
+ fileRef = F537559D016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375622016C397D01DC9062 = {
+ fileRef = F537559E016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375623016C397D01DC9062 = {
+ fileRef = F537559F016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375624016C397D01DC9062 = {
+ fileRef = F53755A0016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375625016C397D01DC9062 = {
+ fileRef = F53755A1016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375626016C397D01DC9062 = {
+ fileRef = F53755A2016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375627016C397D01DC9062 = {
+ fileRef = F53755A3016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375628016C397D01DC9062 = {
+ fileRef = F53755A4016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375629016C397D01DC9062 = {
+ fileRef = F53755A5016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537562A016C397D01DC9062 = {
+ fileRef = F53755A6016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537562B016C397D01DC9062 = {
+ fileRef = F53755A7016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537562C016C397D01DC9062 = {
+ fileRef = F53755A8016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537562D016C397D01DC9062 = {
+ fileRef = F53755A9016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537562E016C397D01DC9062 = {
+ fileRef = F53755AA016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537562F016C397D01DC9062 = {
+ fileRef = F53755AB016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375630016C397D01DC9062 = {
+ fileRef = F53755AC016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375631016C397D01DC9062 = {
+ fileRef = F53755AD016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375632016C397D01DC9062 = {
+ fileRef = F53755AE016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375633016C397D01DC9062 = {
+ fileRef = F53755AF016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375634016C397D01DC9062 = {
+ fileRef = F53755B0016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375635016C397D01DC9062 = {
+ fileRef = F53755B1016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375636016C397D01DC9062 = {
+ fileRef = F53755B2016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375637016C397D01DC9062 = {
+ fileRef = F53755B3016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375638016C397D01DC9062 = {
+ fileRef = F53755B4016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375639016C397D01DC9062 = {
+ fileRef = F53755B5016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537563A016C397D01DC9062 = {
+ fileRef = F53755B6016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537563B016C397D01DC9062 = {
+ fileRef = F53755B7016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537563C016C397D01DC9062 = {
+ fileRef = F53755B8016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537563D016C397D01DC9062 = {
+ fileRef = F53755BA016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537563F016C397D01DC9062 = {
+ fileRef = F53755BD016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375640016C397D01DC9062 = {
+ fileRef = F53755BE016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375641016C397D01DC9062 = {
+ fileRef = F53755BF016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375642016C397D01DC9062 = {
+ fileRef = F53755C0016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375643016C397D01DC9062 = {
+ fileRef = F53755C1016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375644016C397D01DC9062 = {
+ fileRef = F53755C2016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375645016C397D01DC9062 = {
+ fileRef = F53755C3016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375646016C397D01DC9062 = {
+ fileRef = F53755C4016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375647016C397D01DC9062 = {
+ fileRef = F53755C5016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375648016C397D01DC9062 = {
+ fileRef = F53755C6016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375649016C397D01DC9062 = {
+ fileRef = F53755C7016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537564A016C397D01DC9062 = {
+ fileRef = F53755C8016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537564D016C39A101DC9062 = {
+ fileRef = F5375549016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537564E016C39A101DC9062 = {
+ fileRef = F537554A016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537564F016C39A101DC9062 = {
+ fileRef = F537554B016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375650016C39A101DC9062 = {
+ fileRef = F537554C016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375651016C39A101DC9062 = {
+ fileRef = F537554D016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375652016C39A101DC9062 = {
+ fileRef = F537554E016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375653016C39A101DC9062 = {
+ fileRef = F537554F016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375654016C39A101DC9062 = {
+ fileRef = F5375550016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375655016C39A101DC9062 = {
+ fileRef = F5375551016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375656016C39A101DC9062 = {
+ fileRef = F5375552016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375657016C39A101DC9062 = {
+ fileRef = F5375553016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375658016C39A101DC9062 = {
+ fileRef = F5375554016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375659016C39A101DC9062 = {
+ fileRef = F5375555016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537565A016C39A101DC9062 = {
+ fileRef = F5375556016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537565B016C39A101DC9062 = {
+ fileRef = F5375557016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537565C016C39A101DC9062 = {
+ fileRef = F5375558016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537565D016C39A101DC9062 = {
+ fileRef = F5375559016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537565E016C39A101DC9062 = {
+ fileRef = F537555A016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537565F016C39A101DC9062 = {
+ fileRef = F537555B016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375660016C39A101DC9062 = {
+ fileRef = F537555C016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375661016C39A101DC9062 = {
+ fileRef = F537555D016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375662016C39A101DC9062 = {
+ fileRef = F537555E016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375664016C39A101DC9062 = {
+ fileRef = F5375560016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375665016C39A101DC9062 = {
+ fileRef = F5375561016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375666016C39A101DC9062 = {
+ fileRef = F5375562016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375667016C39A101DC9062 = {
+ fileRef = F5375564016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375668016C39A101DC9062 = {
+ fileRef = F5375565016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537566A016C39A101DC9062 = {
+ fileRef = F5375567016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537566B016C39A101DC9062 = {
+ fileRef = F5375568016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537566C016C39F201DC9062 = {
+ fileRef = F53755CA016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537566D016C39F201DC9062 = {
+ fileRef = F53755CB016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537566E016C3A1F01DC9062 = {
+ fileRef = F53755CE016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ );
+ };
+ };
+ F537566F016C3A1F01DC9062 = {
+ fileRef = F53755CF016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ );
+ };
+ };
+ F5375670016C3A1F01DC9062 = {
+ fileRef = F53755D0016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ ATTRIBUTES = (
+ );
+ };
+ };
+ F5375671016C3A1F01DC9062 = {
+ fileRef = F53755D1016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375672016C3A1F01DC9062 = {
+ fileRef = F53755D2016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375673016C3A1F01DC9062 = {
+ fileRef = F53755D3016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375674016C3A1F01DC9062 = {
+ fileRef = F53755D4016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375675016C3A1F01DC9062 = {
+ fileRef = F53755D5016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375676016C3A1F01DC9062 = {
+ fileRef = F53755D6016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375677016C3A6D01DC9062 = {
+ fileRef = F53755D8016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375678016C3A6D01DC9062 = {
+ fileRef = F53755D9016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375679016C3A6D01DC9062 = {
+ fileRef = F53755DA016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537567A016C3A6D01DC9062 = {
+ fileRef = F53755DB016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537567B016C3A6D01DC9062 = {
+ fileRef = F53755DC016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537567C016C3ADB01DC9062 = {
+ children = (
+ F50D96120196176E01DC9062,
+ F5875C7B016FEF1D01DC9062,
+ F537567D016C3ADB01DC9062,
+ );
+ isa = PBXGroup;
+ name = "External Frameworks";
+ refType = 4;
+ };
+ F537567D016C3ADB01DC9062 = {
+ isa = PBXFrameworkReference;
+ name = Carbon.framework;
+ path = /System/Library/Frameworks/Carbon.framework;
+ refType = 0;
+ };
+ F537567E016C3ADB01DC9062 = {
+ fileRef = F537567D016C3ADB01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537567F016C3ADB01DC9062 = {
+ fileRef = F5375533016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375680016C3ADB01DC9062 = {
+ fileRef = F5375535016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375681016C3ADB01DC9062 = {
+ fileRef = F5375538016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375682016C3ADB01DC9062 = {
+ fileRef = F537553A016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375688016C3F1001DC9062 = {
+ children = (
+ F5375689016C3F1001DC9062,
+ F537568A016C3F1001DC9062,
+ F537568B016C3F1001DC9062,
+ F537568C016C3F1001DC9062,
+ F537568D016C3F1001DC9062,
+ F537568E016C3F1001DC9062,
+ F537568F016C3F1001DC9062,
+ F5375690016C3F1001DC9062,
+ F5375691016C3F1001DC9062,
+ F5375692016C3F1001DC9062,
+ );
+ isa = PBXGroup;
+ name = Bitmaps;
+ refType = 4;
+ };
+ F5375689016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = error.bmp;
+ path = ../bitmaps/error.bmp;
+ refType = 2;
+ };
+ F537568A016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = gray12.bmp;
+ path = ../bitmaps/gray12.bmp;
+ refType = 2;
+ };
+ F537568B016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = gray25.bmp;
+ path = ../bitmaps/gray25.bmp;
+ refType = 2;
+ };
+ F537568C016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = gray50.bmp;
+ path = ../bitmaps/gray50.bmp;
+ refType = 2;
+ };
+ F537568D016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = gray75.bmp;
+ path = ../bitmaps/gray75.bmp;
+ refType = 2;
+ };
+ F537568E016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = hourglass.bmp;
+ path = ../bitmaps/hourglass.bmp;
+ refType = 2;
+ };
+ F537568F016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = info.bmp;
+ path = ../bitmaps/info.bmp;
+ refType = 2;
+ };
+ F5375690016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = questhead.bmp;
+ path = ../bitmaps/questhead.bmp;
+ refType = 2;
+ };
+ F5375691016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = question.bmp;
+ path = ../bitmaps/question.bmp;
+ refType = 2;
+ };
+ F5375692016C3F1001DC9062 = {
+ isa = PBXFileReference;
+ name = warning.bmp;
+ path = ../bitmaps/warning.bmp;
+ refType = 2;
+ };
+ F5375693016C3F1001DC9062 = {
+ fileRef = F5375689016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375694016C3F1001DC9062 = {
+ fileRef = F537568A016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375695016C3F1001DC9062 = {
+ fileRef = F537568B016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375696016C3F1001DC9062 = {
+ fileRef = F537568C016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375697016C3F1001DC9062 = {
+ fileRef = F537568D016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375698016C3F1001DC9062 = {
+ fileRef = F537568E016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5375699016C3F1001DC9062 = {
+ fileRef = F537568F016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537569A016C3F1001DC9062 = {
+ fileRef = F5375690016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537569B016C3F1001DC9062 = {
+ fileRef = F5375691016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537569C016C3F1001DC9062 = {
+ fileRef = F5375692016C3F1001DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537569E016C49C301DC9062 = {
+ fileRef = F53755BB016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F537569F016C4DD401DC9062 = {
+ isa = PBXApplicationReference;
+ path = "Wish Shell.app";
+ refType = 3;
+ };
+ F53756A0016C4DD401DC9062 = {
+ buildPhases = (
+ F5877FB8031F982D016F146B,
+ F53756A1016C4DD401DC9062,
+ F53756A2016C4DD401DC9062,
+ F53756A4016C4DD401DC9062,
+ F53756A6016C4DD401DC9062,
+ F53756AA016C4DD401DC9062,
+ F5EEA7050324680B016F146B,
+ F55A164E032A11B1016F146B,
+ F5877FBD031FAC6A016F146B,
+ );
+ buildSettings = {
+ FRAMEWORK_SEARCH_PATHS = "\"$(SYMROOT)\"";
+ GLOBAL_CFLAGS = "`source \"${SYMROOT}/Tcl.framework/Resources/tclConfig.sh\"; echo $${}{TCL_EXTRA_CFLAGS} $${}{TCL_DEFS} | sed -e 's|\\\\\\\\\\\\\\\"|\\\"|g' | sed -e 's| -DTCL_WIDE_INT_TYPE=long. long||'` -U_REENTRANT";
+ HEADER_SEARCH_PATHS = "../../tcl/generic ../../tcl/unix ../generic ../xlib";
+ INSTALL_PATH = /Applications/Utilities;
+ LIBRARY_SEARCH_PATHS = "";
+ OPTIMIZATION_CFLAGS = "-O0";
+ OTHER_CFLAGS = "-DMAC_OSX_TK -DTCL_WIDE_INT_TYPE=\"long long\"";
+ OTHER_LDFLAGS = "-sectcreate __TEXT __info_plist \"$TEMP_DIR/Info.plist\"";
+ OTHER_REZFLAGS = "-i \"../../tcl/generic\" -i \"../generic\"";
+ PRODUCT_NAME = "Wish Shell";
+ SECTORDER_FLAGS = "";
+ USE_GCC3_PFE_SUPPORT = NO;
+ WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas";
+ WRAPPER_EXTENSION = app;
+ };
+ dependencies = (
+ F53756B2016C525F01DC9062,
+ );
+ isa = PBXApplicationTarget;
+ name = Wish;
+ productInstallPath = /Applications/Utilities;
+ productName = "Wish Shell";
+ productReference = F537569F016C4DD401DC9062;
+ productSettingsXML = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+<!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">
+<plist version=\"1.0\">
+<dict>
+ <key>CFBundleDevelopmentRegion</key>
+ <string>English</string>
+ <key>CFBundleExecutable</key>
+ <string>Wish Shell</string>
+ <key>CFBundleGetInfoString</key>
+ <string>Wish Shell 8.4, Copyright © 2002 Tcl Core Team.
+MacOS X Port by Jim Ingham &lt;jingham@apple.com&gt; &amp; Ian Reid, Copyright © 2001-2002, Apple Computer, Inc.</string>
+ <key>CFBundleIconFile</key>
+ <string>Wish.icns</string>
+ <key>CFBundleIdentifier</key>
+ <string>com.tcltk.wish</string>
+ <key>CFBundleInfoDictionaryVersion</key>
+ <string>6.0</string>
+ <key>CFBundleName</key>
+ <string>Wish</string>
+ <key>CFBundlePackageType</key>
+ <string>APPL</string>
+ <key>CFBundleShortVersionString</key>
+ <string>8.4.0</string>
+ <key>CFBundleSignature</key>
+ <string>WiSH</string>
+ <key>CFBundleVersion</key>
+ <string>8.4.0</string>
+</dict>
+</plist>
+";
+ shouldUseHeadermap = 0;
+ };
+ F53756A1016C4DD401DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F53756AC016C4E1D01DC9062,
+ F53756AD016C4E1D01DC9062,
+ F53756AE016C4E1D01DC9062,
+ );
+ isa = PBXHeadersBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53756A2016C4DD401DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F53756A3016C4DD401DC9062,
+ );
+ isa = PBXResourcesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53756A3016C4DD401DC9062 = {
+ fileRef = F537553B016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53756A4016C4DD401DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F53756A5016C4DD401DC9062,
+ );
+ isa = PBXSourcesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53756A5016C4DD401DC9062 = {
+ fileRef = F5375548016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53756A6016C4DD401DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ F53756A8016C4DD401DC9062,
+ F5875C7D016FEF1D01DC9062,
+ F53756A7016C4DD401DC9062,
+ F50D96140196176E01DC9062,
+ F5877FB9031F9F49016F146B,
+ );
+ isa = PBXFrameworksBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53756A7016C4DD401DC9062 = {
+ fileRef = F53755DE016C38D201DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53756A8016C4DD401DC9062 = {
+ fileRef = F537567D016C3ADB01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53756AA016C4DD401DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXRezBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53756AC016C4E1D01DC9062 = {
+ fileRef = F537556B016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53756AD016C4E1D01DC9062 = {
+ fileRef = F5375570016C37A601DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53756AE016C4E1D01DC9062 = {
+ fileRef = F537553E016C376E01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F53756B2016C525F01DC9062 = {
+ isa = PBXTargetDependency;
+ target = F53755DF016C38D201DC9062;
+ };
+ F548F8C80313C9E0016F146B = {
+ buildActionMask = 2147483647;
+ dstPath = "Versions/$(FRAMEWORK_VERSION)";
+ dstSubfolderSpec = 1;
+ files = (
+ F5877FBA031F9F4B016F146B,
+ );
+ isa = PBXCopyFilesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F548F8CA0313CEF0016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXHeadersBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F548F8CB0313CEF0016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ F548F8D10313CF14016F146B,
+ F548F8D00313CF11016F146B,
+ );
+ isa = PBXSourcesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F548F8CC0313CEF0016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXFrameworksBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F548F8CD0313CEF0016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXRezBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F548F8CE0313CEF0016F146B = {
+ buildPhases = (
+ F548F8CA0313CEF0016F146B,
+ F548F8CB0313CEF0016F146B,
+ F548F8CC0313CEF0016F146B,
+ F548F8CD0313CEF0016F146B,
+ );
+ buildSettings = {
+ GLOBAL_CFLAGS = "`source \"${SYMROOT}/Tcl.framework/Resources/tclConfig.sh\"; echo $${}{TCL_EXTRA_CFLAGS} $${}{TCL_DEFS} | sed -e 's|\\\\\\\\\\\\\\\"|\\\"|g' | sed -e 's| -DTCL_WIDE_INT_TYPE=long. long||'` -U_REENTRANT";
+ HEADER_SEARCH_PATHS = "../../tcl/generic ../../tcl/unix ../generic ../xlib";
+ LIBRARY_STYLE = STATIC;
+ OPTIMIZATION_CFLAGS = "-O0";
+ OTHER_CFLAGS = "-DMAC_OSX_TK -DTCL_WIDE_INT_TYPE=\"long long\"";
+ OTHER_LDFLAGS = "";
+ OTHER_LIBTOOL_FLAGS = "";
+ PRODUCT_NAME = libtkstub8.4.a;
+ REZ_EXECUTABLE = YES;
+ SECTORDER_FLAGS = "";
+ WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas";
+ };
+ dependencies = (
+ );
+ isa = PBXLibraryTarget;
+ name = TkStubLibrary;
+ productInstallPath = /usr/local/lib;
+ productName = TkStub;
+ productReference = F548F8CF0313CEF0016F146B;
+ shouldUseHeadermap = 0;
+ };
+ F548F8CF0313CEF0016F146B = {
+ isa = PBXLibraryReference;
+ path = libtkstub8.4.a;
+ refType = 3;
+ };
+ F548F8D00313CF11016F146B = {
+ fileRef = F53755B9016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F548F8D10313CF14016F146B = {
+ fileRef = F53755BB016C389901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F548F8D20313CF93016F146B = {
+ isa = PBXTargetDependency;
+ target = F548F8CE0313CEF0016F146B;
+ };
+ F55A164E032A11B1016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "# if we are embedding frameworks, copy them into the app\nif [ `echo \"${DYLIB_INSTALL_PATH:-}\" | grep -c \"@executable_path\"` -gt 0 ]; then\nrm -rf \"${TARGET_BUILD_DIR}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Contents/Frameworks\"\nmkdir -p \"${TARGET_BUILD_DIR}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Contents/Frameworks\"\nif [ \"${DEPLOYMENT_LOCATION:-}\" = \"YES\" ]; then\n FWKDIR=\"${INSTALL_ROOT}/Library/Frameworks\"\nelse\n FWKDIR=\"${TARGET_BUILD_DIR}\"\nfi\ncp -fRP \"${FWKDIR}/Tcl.framework\" \"${TARGET_BUILD_DIR}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Contents/Frameworks\"\ncp -fRP \"${FWKDIR}/Tk.framework\" \"${TARGET_BUILD_DIR}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Contents/Frameworks\"\nfi";
+ };
+ F55BC46802B2D38B01DC9062 = {
+ isa = PBXFileReference;
+ name = tkPanedWindow.c;
+ path = ../generic/tkPanedWindow.c;
+ refType = 2;
+ };
+ F55BC46902B2D38B01DC9062 = {
+ fileRef = F55BC46802B2D38B01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F55BC46A02B2D3F301DC9062 = {
+ isa = PBXFileReference;
+ name = panedwindow.tcl;
+ path = ../library/panedwindow.tcl;
+ refType = 2;
+ };
+ F55BC46B02B2D3F301DC9062 = {
+ fileRef = F55BC46A02B2D3F301DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5875C7B016FEF1D01DC9062 = {
+ isa = PBXFrameworkReference;
+ path = Tcl.framework;
+ refType = 3;
+ };
+ F5875C7D016FEF1D01DC9062 = {
+ fileRef = F5875C7B016FEF1D01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5877FB7031F97ED016F146B = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "# ensure we can overwrite a previous install\nif [ -d \"${INSTALL_ROOT}/${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\" ]; then\n chmod -RH u+w \"${INSTALL_ROOT}/${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\"\nfi\n\n# if we are embedding frameworks, fix things so that install works with the embedding INSTALL_PATH\nif [ `echo \"${DYLIB_INSTALL_PATH:-}\" | grep -c \"@executable_path\"` -gt 0 ]; then\n cd \"${INSTALL_ROOT}\"\n if [ ! -d \"Library/Frameworks/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\" ]; then\n mkdir -p Library/Frameworks\n mv \"Frameworks/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\" Library/Frameworks\n fi\n rm -r Frameworks\n ln -fs Library/Frameworks\nfi";
+ };
+ F5877FB8031F982D016F146B = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "# ensure we can overwrite a previous install\nif [ -d \"${INSTALL_ROOT}${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\" ]; then\n chmod -RH u+w \"${INSTALL_ROOT}${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\"\nfi";
+ };
+ F5877FB9031F9F49016F146B = {
+ fileRef = F548F8CF0313CEF0016F146B;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5877FBA031F9F4B016F146B = {
+ fileRef = F548F8CF0313CEF0016F146B;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5877FBC031FA968016F146B = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "# redo prebinding\ncd \"${INSTALL_ROOT}\"\nif [ ! -d usr/lib ]; then mkdir -p usr; ln -fs /usr/lib usr/; RM_USRLIB=1; fi\nif [ ! -d System ]; then ln -fs /System .; RM_SYSTEM=1; fi\nredo_prebinding -r . \"./${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Versions/${FRAMEWORK_VERSION}/${PRODUCT_NAME}\"\nif [ -n \"${RM_USRLIB:-}\" ]; then rm -f usr/lib; rmdir -p usr; fi\nif [ -n \"${RM_SYSTEM:-}\" ]; then rm -f System; fi";
+ };
+ F5877FBD031FAC6A016F146B = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "# redo prebinding\ncd \"${INSTALL_ROOT}\"\nif [ ! -d usr/lib ]; then mkdir -p usr; ln -fs /usr/lib usr/; RM_USRLIB=1; fi\nif [ ! -d System ]; then ln -fs /System .; RM_SYSTEM=1; fi\nredo_prebinding -r . \"./${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Contents/MacOS/${PRODUCT_NAME}\"\nif [ -n \"${RM_USRLIB:-}\" ]; then rm -f usr/lib; rmdir -p usr; fi\nif [ -n \"${RM_SYSTEM:-}\" ]; then rm -f System; fi";
+ };
+ F5B1FC08016FFE3501DC9062 = {
+ buildActionMask = 2147483647;
+ dstPath = "Versions/$(FRAMEWORK_VERSION)/Resources/Scripts";
+ dstSubfolderSpec = 1;
+ files = (
+ F5B1FC09016FFE3501DC9062,
+ F5B1FC0A016FFE3501DC9062,
+ F5B1FC0B016FFE3501DC9062,
+ F5B1FC0C016FFE3501DC9062,
+ F5B1FC0D016FFE3501DC9062,
+ F5B1FC0E016FFE3501DC9062,
+ F5B1FC0F016FFE3501DC9062,
+ F5B1FC10016FFE3501DC9062,
+ F5B1FC11016FFE3501DC9062,
+ F5B1FC12016FFE3501DC9062,
+ F5B1FC13016FFE3501DC9062,
+ F5B1FC14016FFE3501DC9062,
+ F5B1FC15016FFE3501DC9062,
+ F5B1FC16016FFE3501DC9062,
+ F5B1FC17016FFE3501DC9062,
+ F5B1FC18016FFE3501DC9062,
+ F5B1FC19016FFE3501DC9062,
+ F5B1FC1A016FFE3501DC9062,
+ F55BC46B02B2D3F301DC9062,
+ F5B1FC1B016FFE3501DC9062,
+ F5B1FC1C016FFE3501DC9062,
+ F5B1FC1D016FFE3501DC9062,
+ F5B1FC1E016FFE3501DC9062,
+ F5B1FC1F016FFE3501DC9062,
+ F5B1FC20016FFE3501DC9062,
+ F5B1FC21016FFE3501DC9062,
+ F5B1FC22016FFE3501DC9062,
+ F5B1FC23016FFE3501DC9062,
+ F5B1FC24016FFE3501DC9062,
+ F5B1FC25016FFE3501DC9062,
+ F5B1FC26016FFE3501DC9062,
+ );
+ isa = PBXCopyFilesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F5B1FC09016FFE3501DC9062 = {
+ fileRef = F5DF0928016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC0A016FFE3501DC9062 = {
+ fileRef = F5DF0929016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC0B016FFE3501DC9062 = {
+ fileRef = F5DF092A016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC0C016FFE3501DC9062 = {
+ fileRef = F5DF092B016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC0D016FFE3501DC9062 = {
+ fileRef = F5DF092C016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC0E016FFE3501DC9062 = {
+ fileRef = F5DF092D016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC0F016FFE3501DC9062 = {
+ fileRef = F5DF092E016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC10016FFE3501DC9062 = {
+ fileRef = F5DF092F016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC11016FFE3501DC9062 = {
+ fileRef = F5DF0930016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC12016FFE3501DC9062 = {
+ fileRef = F5DF0931016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC13016FFE3501DC9062 = {
+ fileRef = F5DF0932016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC14016FFE3501DC9062 = {
+ fileRef = F5DF0933016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC15016FFE3501DC9062 = {
+ fileRef = F5DF0934016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC16016FFE3501DC9062 = {
+ fileRef = F5DF0935016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC17016FFE3501DC9062 = {
+ fileRef = F5DF0936016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC18016FFE3501DC9062 = {
+ fileRef = F5DF0937016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC19016FFE3501DC9062 = {
+ fileRef = F5DF0938016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC1A016FFE3501DC9062 = {
+ fileRef = F5DF0939016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC1B016FFE3501DC9062 = {
+ fileRef = F5DF093A016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC1C016FFE3501DC9062 = {
+ fileRef = F5DF093B016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC1D016FFE3501DC9062 = {
+ fileRef = F5DF093C016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC1E016FFE3501DC9062 = {
+ fileRef = F5DF093D016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC1F016FFE3501DC9062 = {
+ fileRef = F5DF093E016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC20016FFE3501DC9062 = {
+ fileRef = F5DF093F016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC21016FFE3501DC9062 = {
+ fileRef = F5DF0940016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC22016FFE3501DC9062 = {
+ fileRef = F5DF0941016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC23016FFE3501DC9062 = {
+ fileRef = F5DF0942016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC24016FFE3501DC9062 = {
+ fileRef = F5DF0943016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC25016FFE3501DC9062 = {
+ fileRef = F5DF0944016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5B1FC26016FFE3501DC9062 = {
+ fileRef = F5DF0945016CD3F901DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5BFE58B02F8C41501DC9062 = {
+ isa = PBXFileReference;
+ name = tkStyle.c;
+ path = ../generic/tkStyle.c;
+ refType = 2;
+ };
+ F5BFE58C02F8C41501DC9062 = {
+ isa = PBXFileReference;
+ name = tkUndo.c;
+ path = ../generic/tkUndo.c;
+ refType = 2;
+ };
+ F5BFE58D02F8C41501DC9062 = {
+ fileRef = F5BFE58B02F8C41501DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5BFE58E02F8C41501DC9062 = {
+ fileRef = F5BFE58C02F8C41501DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5BFE58F02F8C45B01DC9062 = {
+ isa = PBXFileReference;
+ name = tkUndo.h;
+ path = ../generic/tkUndo.h;
+ refType = 2;
+ };
+ F5BFE59002F8C45B01DC9062 = {
+ fileRef = F5BFE58F02F8C45B01DC9062;
+ isa = PBXBuildFile;
+ settings = {
+ };
+ };
+ F5C1D51901B88F9A01DC9062 = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "#source buildConfig";
+ };
+ F5C88659017D625C01DC9062 = {
+ children = (
+ F5C8865A017D625C01DC9062,
+ F5C8865B017D625C01DC9062,
+ );
+ isa = PBXGroup;
+ name = "Header Tools";
+ refType = 4;
+ };
+ F5C8865A017D625C01DC9062 = {
+ isa = PBXFileReference;
+ name = tk.decls;
+ path = ../generic/tk.decls;
+ refType = 2;
+ };
+ F5C8865B017D625C01DC9062 = {
+ isa = PBXFileReference;
+ name = tkInt.decls;
+ path = ../generic/tkInt.decls;
+ refType = 2;
+ };
+ F5DF07A7016CD03801DC9062 = {
+ children = (
+ F5DF0928016CD3F901DC9062,
+ F5DF0929016CD3F901DC9062,
+ F5DF092A016CD3F901DC9062,
+ F5DF092B016CD3F901DC9062,
+ F5DF092C016CD3F901DC9062,
+ F5DF092D016CD3F901DC9062,
+ F5DF092E016CD3F901DC9062,
+ F5DF092F016CD3F901DC9062,
+ F5DF0930016CD3F901DC9062,
+ F5DF0931016CD3F901DC9062,
+ F5DF0932016CD3F901DC9062,
+ F5DF0933016CD3F901DC9062,
+ F5DF0934016CD3F901DC9062,
+ F5DF0935016CD3F901DC9062,
+ F5DF0936016CD3F901DC9062,
+ F5DF0937016CD3F901DC9062,
+ F5DF0938016CD3F901DC9062,
+ F5DF0939016CD3F901DC9062,
+ F55BC46A02B2D3F301DC9062,
+ F5DF093A016CD3F901DC9062,
+ F5DF093B016CD3F901DC9062,
+ F5DF093C016CD3F901DC9062,
+ F5DF093D016CD3F901DC9062,
+ F5DF093E016CD3F901DC9062,
+ F5DF093F016CD3F901DC9062,
+ F5DF0940016CD3F901DC9062,
+ F5DF0941016CD3F901DC9062,
+ F5DF0942016CD3F901DC9062,
+ F5DF0943016CD3F901DC9062,
+ F5DF0944016CD3F901DC9062,
+ F5DF0945016CD3F901DC9062,
+ );
+ isa = PBXGroup;
+ name = Scripts;
+ refType = 4;
+ };
+ F5DF0928016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = bgerror.tcl;
+ path = ../library/bgerror.tcl;
+ refType = 2;
+ };
+ F5DF0929016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = button.tcl;
+ path = ../library/button.tcl;
+ refType = 2;
+ };
+ F5DF092A016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = choosedir.tcl;
+ path = ../library/choosedir.tcl;
+ refType = 2;
+ };
+ F5DF092B016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = clrpick.tcl;
+ path = ../library/clrpick.tcl;
+ refType = 2;
+ };
+ F5DF092C016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = comdlg.tcl;
+ path = ../library/comdlg.tcl;
+ refType = 2;
+ };
+ F5DF092D016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = console.tcl;
+ path = ../library/console.tcl;
+ refType = 2;
+ };
+ F5DF092E016CD3F901DC9062 = {
+ includeInIndex = 0;
+ isa = PBXFolderReference;
+ name = demos;
+ path = ../library/demos;
+ refType = 2;
+ };
+ F5DF092F016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = dialog.tcl;
+ path = ../library/dialog.tcl;
+ refType = 2;
+ };
+ F5DF0930016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = entry.tcl;
+ path = ../library/entry.tcl;
+ refType = 2;
+ };
+ F5DF0931016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = focus.tcl;
+ path = ../library/focus.tcl;
+ refType = 2;
+ };
+ F5DF0932016CD3F901DC9062 = {
+ includeInIndex = 0;
+ isa = PBXFolderReference;
+ name = images;
+ path = ../library/images;
+ refType = 2;
+ };
+ F5DF0933016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = listbox.tcl;
+ path = ../library/listbox.tcl;
+ refType = 2;
+ };
+ F5DF0934016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = menu.tcl;
+ path = ../library/menu.tcl;
+ refType = 2;
+ };
+ F5DF0935016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = msgbox.tcl;
+ path = ../library/msgbox.tcl;
+ refType = 2;
+ };
+ F5DF0936016CD3F901DC9062 = {
+ includeInIndex = 0;
+ isa = PBXFolderReference;
+ name = msgs;
+ path = ../library/msgs;
+ refType = 2;
+ };
+ F5DF0937016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = obsolete.tcl;
+ path = ../library/obsolete.tcl;
+ refType = 2;
+ };
+ F5DF0938016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = optMenu.tcl;
+ path = ../library/optMenu.tcl;
+ refType = 2;
+ };
+ F5DF0939016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = palette.tcl;
+ path = ../library/palette.tcl;
+ refType = 2;
+ };
+ F5DF093A016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = prolog.ps;
+ path = ../library/prolog.ps;
+ refType = 2;
+ };
+ F5DF093B016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = safetk.tcl;
+ path = ../library/safetk.tcl;
+ refType = 2;
+ };
+ F5DF093C016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = scale.tcl;
+ path = ../library/scale.tcl;
+ refType = 2;
+ };
+ F5DF093D016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = scrlbar.tcl;
+ path = ../library/scrlbar.tcl;
+ refType = 2;
+ };
+ F5DF093E016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = spinbox.tcl;
+ path = ../library/spinbox.tcl;
+ refType = 2;
+ };
+ F5DF093F016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = tclIndex;
+ path = ../library/tclIndex;
+ refType = 2;
+ };
+ F5DF0940016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = tearoff.tcl;
+ path = ../library/tearoff.tcl;
+ refType = 2;
+ };
+ F5DF0941016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = text.tcl;
+ path = ../library/text.tcl;
+ refType = 2;
+ };
+ F5DF0942016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = tk.tcl;
+ path = ../library/tk.tcl;
+ refType = 2;
+ };
+ F5DF0943016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = tkfbox.tcl;
+ path = ../library/tkfbox.tcl;
+ refType = 2;
+ };
+ F5DF0944016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = unsupported.tcl;
+ path = ../library/unsupported.tcl;
+ refType = 2;
+ };
+ F5DF0945016CD3F901DC9062 = {
+ isa = PBXFileReference;
+ name = xmfbox.tcl;
+ path = ../library/xmfbox.tcl;
+ refType = 2;
+ };
+ F5EEA7050324680B016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "if [ \"${BUILD_STYLE}\" = \"Development\" ]; then\n\t# force Deployment build to be relinked next time\n\tif [ -f \"${OBJROOT}/Deployment.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\" ]; then\n\t touch -t `date -r \\`expr \\\\\\`date +\"%s\"\\\\\\` + 30\\` +\"%Y%m%d%H%M.%S\"` \"${OBJROOT}/Deployment.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\"\n\tfi\nelse\n\t# force Development build to be relinked next time\n\tif [ -f \"${OBJROOT}/Development.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\" ]; then\n\t touch -t `date -r \\`expr \\\\\\`date +\"%s\"\\\\\\` + 30\\` +\"%Y%m%d%H%M.%S\"` \"${OBJROOT}/Development.build/${PROJECT_NAME}.build/${TARGET_NAME}.build/Objects-normal/LinkFileList\"\n\tfi\nfi";
+ };
+ };
+ rootObject = F537552A016C352C01DC9062;
+}
diff --git a/tcl/macosx/tclets.r b/tcl/macosx/tclets.r
new file mode 100644
index 00000000000..ce68db49657
--- /dev/null
+++ b/tcl/macosx/tclets.r
@@ -0,0 +1,172 @@
+/*
+ * tclets.r --
+ *
+ */
+
+/*
+ * 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>
+
+/*
+ * We now load the Tclets code into the resource fork
+ */
+
+#define TK_LIBRARY_RESOURCES 3000
+
+read 'TEXT' (TK_LIBRARY_RESOURCES+114, "tclshrc", purgeable)
+ "::mac:tclets.tcl";
+
+data 'icns' (-16455) {
+ $"6963 6E73 0000 08F8 6963 7323 0000 0048" /* icns...øics#...H */
+ $"0100 02EE 05CE 09EE 13DE 23FF 47CE 86C6" /* ...î.ÎÆî.Þ#ÿG렮 */
+ $"4681 22C2 12C4 0888 0410 0220 0140 0080" /* F"Â.Ä.ˆ... .@.€ */
+ $"0100 03EE 07CE 0FEE 1FFE 3FFF 7FFE FFFE" /* ...î.Î.î.þ?ÿ.þÿþ */
+ $"7FFF 3FFE 1FFC 0FF8 07F0 03E0 01C0 0080" /* .ÿ?þ.ü.ø.ð.à.À.€ */
+ $"6963 7334 0000 0088 0000 000F 0000 0000" /* ics4...ˆ........ */
+ $"0000 00FC F6D0 FFF0 0000 0FC5 DD00 F6F0" /* ...üöÐÿð...ÅÝ.öð */
+ $"0000 FCCD 66F0 F6F0 000F CC6E 66CE F6F0" /* ..üÍfðöð..ÌnfÎöð */
+ $"00FC CC6E 67EF F6FF 0FCC CD66 66CC F6F0" /* .üÌngïöÿ.ÌÍffÌöð */
+ $"FCCC CDDC 66CC CFA0 0FCC CD6C EDCC CC0F" /* üÌÍÜfÌÏ .ÌÍlíÌÌ. */
+ $"00FC CC6C E6CC CCF0 000F CC6C 66CC CF00" /* .üÌlæÌÌð..ÌlfÌÏ. */
+ $"0000 FCCC 6CCC F000 0000 0FCC DCCF 0000" /* ..üÌlÌð....ÌÜÏ.. */
+ $"0000 00FD DCF0 0000 0000 000F CF00 0000" /* ...ýÜð......Ï... */
+ $"0000 0000 F000 0000 6963 7338 0000 0108" /* ....ð...ics8.... */
+ $"0000 0000 0000 00FF 0000 0000 0000 0000" /* .......ÿ........ */
+ $"0000 0000 0000 FF2B FFEC 7F00 FFFF FF00" /* ......ÿ+ÿì..ÿÿÿ. */
+ $"0000 0000 00FF 2BB0 7F7F 0000 FFEC FF00" /* .....ÿ+°....ÿìÿ. */
+ $"0000 0000 FF2B 2B7F ECEC FF00 FFEC FF00" /* ....ÿ++.ììÿ.ÿìÿ. */
+ $"0000 00FF 2B2B ECFC ECEC 2BFB FFEC FF00" /* ...ÿ++ìüìì+ûÿìÿ. */
+ $"0000 FF2B 2B2B ECFC ECC0 FBFF FFEC FFFF" /* ..ÿ+++ìüìÀûÿÿìÿÿ */
+ $"00FF 2B2B 2B7F ECEC ECEC 2B2B FFEC FF00" /* .ÿ+++.ìììì++ÿìÿ. */
+ $"FF2B 2B2B 2B7F 7FF6 ECEC 2B2B 2BFF FD00" /* ÿ++++..öìì+++ÿý. */
+ $"00FF 2B2B 2B7F ECF6 FCF9 2B2B 2B2B 00FF" /* .ÿ+++.ìöüù++++.ÿ */
+ $"0000 FF2B 2B2B ECF6 FCEC 2B2B 2B2B FF00" /* ..ÿ+++ìöüì++++ÿ. */
+ $"0000 00FF 2B2B ECF6 ECEC 2B2B 2BFF 0000" /* ...ÿ++ìöìì+++ÿ.. */
+ $"0000 0000 FF2B 2BF6 EC2B 2B2B FF00 0000" /* ....ÿ++öì+++ÿ... */
+ $"0000 0000 00FF 2BF6 F92B 2BFF 0000 0000" /* .....ÿ+öù++ÿ.... */
+ $"0000 0000 0000 FFF9 F92B FF00 0000 0000" /* ......ÿùù+ÿ..... */
+ $"0000 0000 0000 00FF 2BFF 0000 0000 0000" /* .......ÿ+ÿ...... */
+ $"0000 0000 0000 0000 FF00 0000 0000 0000" /* ........ÿ....... */
+ $"4943 4E23 0000 0108 0001 0000 0002 8000" /* ICN#..........€. */
+ $"0004 78F8 0008 70F8 0010 F0F8 0021 E8F8" /* ..xø..pø..ðø.!èø */
+ $"0043 C4F8 0081 FAF8 0107 F1F8 0207 F0F8" /* .CÄø.úø..ñø..ðø */
+ $"0407 F7FF 0807 E3FE 1007 E1FC 200E E0F8" /* ..÷ÿ..ãþ..áü .àø */
+ $"4002 E074 800E E022 400E E001 200E C002" /* @.àt€.à"@.à. .À. */
+ $"1006 E004 0806 C008 0406 E010 0202 C020" /* ..à...À...à...À */
+ $"0102 C040 0080 8080 0040 0100 0020 0200" /* ..À@.€€€.@... .. */
+ $"0010 0400 0008 0800 0004 1000 0002 2000" /* .............. . */
+ $"0001 4000 0000 8000 0001 0000 0003 8000" /* ..@...€.......€. */
+ $"0007 F8F8 000F F0F8 001F F0F8 003F F8F8" /* ..øø..ðø..ðø.?øø */
+ $"007F FCF8 00FF FEF8 01FF FFF8 03FF FFF8" /* ..üø.ÿþø.ÿÿø.ÿÿø */
+ $"07FF FFFF 0FFF FFFE 1FFF FFFC 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 6963 6C34 0000 0208" /* ..À...€.icl4.... */
+ $"0000 0000 0000 000F 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 00FC F000 0000 0000 0000" /* .......üð....... */
+ $"0000 0000 0000 0FCC CFD6 D000 FFFF F000" /* .......ÌÏÖÐ.ÿÿð. */
+ $"0000 0000 0000 FCCC C556 0000 F767 F000" /* ......üÌÅV..÷gð. */
+ $"0000 0000 000F CCCC 566F 0000 F676 F000" /* ......ÌÌVo..övð. */
+ $"0000 0000 00FC CCC5 6F5C F000 F767 F000" /* .....üÌÅo\ð.÷gð. */
+ $"0000 0000 0FCC CC66 66CC 0F00 F676 F000" /* .....ÌÌffÌ..övð. */
+ $"0000 0000 FCCC CCD5 5666 FCF0 F767 F000" /* ....üÌÌÕVfüð÷gð. */
+ $"0000 000F CCCC C656 5667 CCCF F676 F000" /* ....ÌÌÆVVgÌÏövð. */
+ $"0000 00FC CCCC C6E5 5566 CCCC F767 F000" /* ...üÌÌÆåUfÌÌ÷gð. */
+ $"0000 0FCC CCCC C656 5657 CFFF F676 FFFF" /* ...ÌÌÌÆVVWÏÿövÿÿ */
+ $"0000 FCCC CCCC C6E5 565C CCF7 6767 67F0" /* ..üÌÌÌÆåV\Ì÷gggð */
+ $"000F CCCC CCCC C655 565C CCCF 7676 7F00" /* ..ÌÌÌÌÆUV\ÌÏvv.. */
+ $"00FC CCCC CCCC 7660 556C CCCC F767 F000" /* .üÌÌÌÌv`UlÌÌ÷gð. */
+ $"0FCC CCCC CCCC CD5D 567C CCCC CF7F CF00" /* .ÌÌÌÌÌÍ]V|ÌÌÏ.Ï. */
+ $"FCCC CCCC CCCC 6660 556C CCCC CCFC CCF0" /* üÌÌÌÌÌf`UlÌÌÌüÌð */
+ $"0FCC CCCC CCCC 665C 565C CCCC CCCC CCCF" /* .ÌÌÌÌÌf\V\ÌÌÌÌÌÏ */
+ $"00FC CCCC CCCC 6660 E6DC CCCC CCCC CCF0" /* .üÌÌÌÌf`æÜÌÌÌÌÌð */
+ $"000F CCCC CCCC C650 656C CCCC CCCC CF00" /* ..ÌÌÌÌÆPelÌÌÌÌÏ. */
+ $"0000 FCCC CCCC C6EC 5ECC CCCC CCCC F000" /* ..üÌÌÌÆì^ÌÌÌÌÌð. */
+ $"0000 0FCC CCCC C650 566C CCCC CCCF 0000" /* ...ÌÌÌÆPVlÌÌÌÏ.. */
+ $"0000 00FC CCCC CC50 D5CC CCCC CCF0 0000" /* ...üÌÌÌPÕÌÌÌÌð.. */
+ $"0000 000F CCCC CC50 56CC CCCC CF00 0000" /* ....ÌÌÌPVÌÌÌÏ... */
+ $"0000 0000 FCCC CCD0 5CCC CCCC F000 0000" /* ....üÌÌÐ\ÌÌÌð... */
+ $"0000 0000 0FCC CCD0 DCCC CCCF 0000 0000" /* .....ÌÌÐÜÌÌÏ.... */
+ $"0000 0000 00FC CCD0 DCCC CCF0 0000 0000" /* .....üÌÐÜÌÌð.... */
+ $"0000 0000 000F CCD0 DCCC CF00 0000 0000" /* ......ÌÐÜÌÏ..... */
+ $"0000 0000 0000 FCC0 CCCC F000 0000 0000" /* ......üÀÌÌð..... */
+ $"0000 0000 0000 0FCD 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" /* ........ð....... */
+ $"6963 6C38 0000 0408 0000 0000 0000 0000" /* icl8............ */
+ $"0000 0000 0000 00FF 0000 0000 0000 0000" /* .......ÿ........ */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 FF2B FF00 0000 0000 0000" /* ......ÿ+ÿ....... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 00FF 2B2B 2BFF 7FEC 7F00 0000" /* .....ÿ+++ÿ.ì.... */
+ $"FFFF FFFF FF00 0000 0000 0000 0000 0000" /* ÿÿÿÿÿ........... */
+ $"0000 0000 FF2B 2B2B 2BB0 B0EC 0000 0000" /* ....ÿ++++°°ì.... */
+ $"FFC0 ECC0 FF00 0000 0000 0000 0000 0000" /* ÿÀìÀÿ........... */
+ $"0000 00FF 2B2B 2B2B B0EC ECFF 0000 0000" /* ...ÿ++++°ììÿ.... */
+ $"FFEC C0EC FF00 0000 0000 0000 0000 0000" /* ÿìÀìÿ........... */
+ $"0000 FF2B 2B2B 2BB0 ECFF B02B FF00 0000" /* ..ÿ++++°ìÿ°+ÿ... */
+ $"FFC0 ECC0 FF00 0000 0000 0000 0000 0000" /* ÿÀìÀÿ........... */
+ $"00FF 2B2B 2B2B ECEC ECEC 2B2B 00FF 0000" /* .ÿ++++ìììì++.ÿ.. */
+ $"FFEC C0EC FF00 0000 0000 0000 0000 0000" /* ÿìÀìÿ........... */
+ $"FF2B 2B2B 2B2B F9B0 B0EC ECEC FF2B FF00" /* ÿ+++++ù°°ìììÿ+ÿ. */
+ $"FFC0 ECC0 FF00 0000 0000 0000 0000 00FF" /* ÿÀìÀÿ..........ÿ */
+ $"2B2B 2B2B 2BEC B0EC B0EC ECC0 2B2B 2BFF" /* +++++ì°ì°ììÀ+++ÿ */
+ $"FFEC C0EC FF00 0000 0000 0000 0000 FF2B" /* ÿìÀìÿ.........ÿ+ */
+ $"2B2B 2B2B 2BEC FCB0 B0B0 ECEC 2B2B 2B2B" /* +++++ìü°°°ìì++++ */
+ $"FFC0 ECC0 FF00 0000 0000 0000 00FF 2B2B" /* ÿÀìÀÿ........ÿ++ */
+ $"2B2B 2B2B 2BEC B0EC B0EC B0C0 2BFF FFFF" /* +++++ì°ì°ì°À+ÿÿÿ */
+ $"FFEC C0EC FFFF FFFF 0000 0000 FF2B 2B2B" /* ÿìÀìÿÿÿÿ....ÿ+++ */
+ $"2B2B 2B2B 2BEC FCB0 B0EC B02B 2B2B FFC0" /* +++++ìü°°ì°+++ÿÀ */
+ $"ECC0 ECC0 ECC0 FF00 0000 00FF 2B2B 2B2B" /* ìÀìÀìÀÿ....ÿ++++ */
+ $"2B2B 2B2B 2BEC B0B0 B0EC B02B 2B2B 2BFF" /* +++++ì°°°ì°++++ÿ */
+ $"C0EC C0EC C0FF 0000 0000 FF2B 2B2B 2B2B" /* ÀìÀìÀÿ....ÿ+++++ */
+ $"2B2B 2B2B C0EC EC00 B0B0 EC2B 2B2B 2B2B" /* ++++Àìì.°°ì+++++ */
+ $"FFC0 ECC0 FF00 0000 00FF 2B2B 2B2B 2B2B" /* ÿÀìÀÿ....ÿ++++++ */
+ $"2B2B 2B2B 2BF9 B0F9 B0EC C02B 2B2B 2B2B" /* +++++ù°ù°ìÀ+++++ */
+ $"2BFF C0FF 2BFF 0000 FF2B 2B2B 2B2B 2B2B" /* +ÿÀÿ+ÿ..ÿ+++++++ */
+ $"2B2B 2B2B ECEC EC00 B0B0 EC2B 2B2B 2B2B" /* ++++ììì.°°ì+++++ */
+ $"2B2B FF2B 2B2B FF00 00FF 2B2B 2B2B 2B2B" /* ++ÿ+++ÿ..ÿ++++++ */
+ $"2B2B 2B2B ECEC B02B B0EC B02B 2B2B 2B2B" /* ++++ìì°+°ì°+++++ */
+ $"2B2B 2B2B 2B2B 2BFF 0000 FF2B 2B2B 2B2B" /* +++++++ÿ..ÿ+++++ */
+ $"2B2B 2B2B ECEC EC00 FCEC F92B 2B2B 2B2B" /* ++++ììì.üìù+++++ */
+ $"2B2B 2B2B 2B2B FF00 0000 00FF 2B2B 2B2B" /* ++++++ÿ....ÿ++++ */
+ $"2B2B 2B2B 2BEC B000 ECB0 EC2B 2B2B 2B2B" /* +++++ì°.ì°ì+++++ */
+ $"2B2B 2B2B 2BFF 0000 0000 0000 FF2B 2B2B" /* +++++ÿ......ÿ+++ */
+ $"2B2B 2B2B 2BEC FC2B B0FC 2B2B 2B2B 2B2B" /* +++++ìü+°ü++++++ */
+ $"2B2B 2B2B FF00 0000 0000 0000 00FF 2B2B" /* ++++ÿ........ÿ++ */
+ $"2B2B 2B2B 2BEC B000 B0EC EC2B 2B2B 2B2B" /* +++++ì°.°ìì+++++ */
+ $"2B2B 2BFF 0000 0000 0000 0000 0000 FF2B" /* +++ÿ..........ÿ+ */
+ $"2B2B 2B2B 2B2B B000 7FB0 2B2B 2B2B 2B2B" /* ++++++°..°++++++ */
+ $"2B2B FF00 0000 0000 0000 0000 0000 00FF" /* ++ÿ............ÿ */
+ $"2B2B 2B2B 2B2B B000 B0EC 2B2B 2B2B 2B2B" /* ++++++°.°ì++++++ */
+ $"2BFF 0000 0000 0000 0000 0000 0000 0000" /* +ÿ.............. */
+ $"FF2B 2B2B 2B2B F900 B02B 2B2B 2B2B 2B2B" /* ÿ+++++ù.°+++++++ */
+ $"FF00 0000 0000 0000 0000 0000 0000 0000" /* ÿ............... */
+ $"00FF 2B2B 2B2B F900 F92B 2B2B 2B2B 2BFF" /* .ÿ++++ù.ù++++++ÿ */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 FF2B 2B2B F900 F92B 2B2B 2B2B FF00" /* ..ÿ+++ù.ù+++++ÿ. */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 00FF 2B2B F900 F92B 2B2B 2BFF 0000" /* ...ÿ++ù.ù++++ÿ.. */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 FF2B 2B00 2B2B 2B2B FF00 0000" /* ....ÿ++.++++ÿ... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 00FF 2BF9 2B2B 2BFF 0000 0000" /* .....ÿ+ù+++ÿ.... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 FF2B 2B2B FF00 0000 0000" /* ......ÿ+++ÿ..... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 00FF 2BFF 0000 0000 0000" /* .......ÿ+ÿ...... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 0000 FF00 0000 0000 0000" /* ........ÿ....... */
+ $"0000 0000 0000 0000" /* ........ */
+};
diff --git a/tcl/macosx/tkAboutDlg.r b/tcl/macosx/tkAboutDlg.r
new file mode 100644
index 00000000000..ae04ecdf655
--- /dev/null
+++ b/tcl/macosx/tkAboutDlg.r
@@ -0,0 +1,393 @@
+/*
+ * tkAboutDlg.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
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include <Carbon.r>
+#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
+
+/*
+ * 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" "Jim Ingham & Ray Johnson"
+ "Scriptics Inc." "\n" "jingham@cygnus.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"
+};
diff --git a/tcl/macosx/tkMacOSX.h b/tcl/macosx/tkMacOSX.h
new file mode 100644
index 00000000000..581bf304b4b
--- /dev/null
+++ b/tcl/macosx/tkMacOSX.h
@@ -0,0 +1,34 @@
+/*
+ * tkMacOSXInt.h --
+ *
+ * Declarations of Macintosh specific exported variables and procedures.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 <Carbon/Carbon.h>
+#include "tkInt.h"
+
+/*
+ * Structures and function types for handling Netscape-type in process
+ * embedding where Tk does not control the top-level
+ */
+
+typedef int (Tk_MacOSXEmbedRegisterWinProc) (int winID, Tk_Window window);
+typedef GWorldPtr (Tk_MacOSXEmbedGetGrafPortProc) (Tk_Window window);
+typedef int (Tk_MacOSXEmbedMakeContainerExistProc) (Tk_Window window);
+typedef void (Tk_MacOSXEmbedGetClipProc) (Tk_Window window, RgnHandle rgn);
+typedef void (Tk_MacOSXEmbedGetOffsetInParentProc) (Tk_Window window, Point *ulCorner);
+
+#include "tkPlatDecls.h"
+
+#endif /* _TKMAC */
diff --git a/tcl/macosx/tkMacOSXAppInit.c b/tcl/macosx/tkMacOSXAppInit.c
new file mode 100644
index 00000000000..b088faace24
--- /dev/null
+++ b/tcl/macosx/tkMacOSXAppInit.c
@@ -0,0 +1,241 @@
+/*
+ * tkAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in wish and similar Tk-based applications.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 <pthread.h>
+#include "tk.h"
+#include "tclInt.h"
+#include "locale.h"
+
+#include <Carbon/Carbon.h>
+#include "tkMacOSX.h"
+#include "tkMacOSXEvent.h"
+
+#ifndef MAX_PATH_LEN
+ #define MAX_PATH_LEN 1024
+#endif
+
+/*
+ * If the App is in an App package, then we want to add the Scripts
+ * directory to the auto_path. But we have to wait till after the
+ * Tcl_Init is run, or it gets blown away. This stores what we
+ * figured out in main.
+ */
+
+char scriptPath[MAX_PATH_LEN + 1];
+
+extern Tcl_Interp *gStdoutInterp;
+
+#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. */
+{
+ int textEncoding; /*
+ * Variable used to take care of
+ * lazy font initialization
+ */
+ CFBundleRef bundleRef;
+
+ /*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TK_LOCAL_APPINIT
+#define TK_LOCAL_APPINIT Tcl_AppInit
+#endif
+ extern int TK_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+ scriptPath[0] = '\0';
+
+ /*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tk_Main(). Note, if you use this
+ * hook, then I won't do the CFBundle lookup, since if you are messing
+ * around at this level, you probably don't want me to do this for you...
+ */
+
+#ifdef TK_LOCAL_MAIN_HOOK
+ extern int TK_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+ TK_LOCAL_MAIN_HOOK(&argc, &argv);
+#else
+
+ /*
+ * On MacOS X, we look for a file in the Resources/Scripts directory
+ * called AppMain.tcl and if found, we set argv[1] to that, so that
+ * the rest of the code will find it, and add the Scripts folder to
+ * the auto_path. If we don't find the startup script, we just bag
+ * it, assuming the user is starting up some other way.
+ */
+
+ bundleRef = CFBundleGetMainBundle();
+
+ if (bundleRef != NULL) {
+ CFURLRef appMainURL;
+ appMainURL = CFBundleCopyResourceURL(bundleRef,
+ CFSTR("AppMain"),
+ CFSTR("tcl"),
+ CFSTR("Scripts"));
+
+ if (appMainURL != NULL) {
+ CFURLRef scriptFldrURL;
+ char *startupScript = malloc(MAX_PATH_LEN + 1);
+
+ if (CFURLGetFileSystemRepresentation (appMainURL, true,
+ startupScript, MAX_PATH_LEN)) {
+ TclSetStartupScriptFileName(startupScript);
+ scriptFldrURL = CFBundleCopyResourceURL(bundleRef,
+ CFSTR("Scripts"),
+ NULL,
+ NULL);
+ CFURLGetFileSystemRepresentation(scriptFldrURL,
+ true, scriptPath, MAX_PATH_LEN);
+ CFRelease(scriptFldrURL);
+ } else {
+ free(startupScript);
+ }
+ CFRelease(appMainURL);
+ }
+ }
+
+#endif
+ textEncoding=GetApplicationTextEncoding();
+
+ /*
+ * Now add the scripts folder to the auto_path.
+ */
+
+ Tk_Main(argc,argv,TK_LOCAL_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 the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Tk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+
+ if (scriptPath[0] != '\0') {
+ Tcl_SetVar(interp, "auto_path", scriptPath,
+ TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
+ }
+
+#ifdef TK_TEST
+ if (Tktest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
+ (Tcl_PackageInitProc *) NULL);
+#endif /* TK_TEST */
+
+ /*
+ * If we don't have a TTY, then use the Tk based console
+ * interpreter instead.
+ */
+
+ if (ttyname(0) == NULL) {
+ Tk_InitConsoleChannels(interp);
+ Tcl_RegisterChannel(interp, Tcl_GetStdChannel(TCL_STDIN));
+ Tcl_RegisterChannel(interp, Tcl_GetStdChannel(TCL_STDOUT));
+ Tcl_RegisterChannel(interp, Tcl_GetStdChannel(TCL_STDERR));
+ if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
+ goto error;
+ }
+ /* Only show the console if we don't have a startup script */
+ if (TclGetStartupScriptPath() == NULL) {
+ Tcl_Eval(interp, "console show");
+ }
+ }
+
+ /*
+ * 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;
+
+ error:
+ return TCL_ERROR;
+}
diff --git a/tcl/macosx/tkMacOSXApplication.r b/tcl/macosx/tkMacOSXApplication.r
new file mode 100644
index 00000000000..150ede963aa
--- /dev/null
+++ b/tcl/macosx/tkMacOSXApplication.r
@@ -0,0 +1,276 @@
+/*
+ * tkMacOSXApplication.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 <Carbon/Carbon.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 Jim Ingham & Ian Reid" "\n" "© 2001 Apple Computer, Inc" "\n" "1998-2000 Scriptics Inc." "\n" "1996-1997 Sun Microsystems Inc."
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ "Wish " TK_PATCH_LEVEL " © 1993-1999"
+};
+
+#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"
+ }
+};
+
+#define kIconHelpString 256
+
+resource 'hfdr' (-5696, purgeable) {
+ HelpMgrVersion, hmDefaultOptions, 0, 0,
+ {HMSTRResItem {kIconHelpString}}
+};
+resource 'STR ' (kIconHelpString, purgeable) {
+ "This is the interpreter for Tcl & Tk scripts"
+ " running on Macintosh computers."
+};
+
+/*
+ * 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/tcl/macosx/tkMacOSXBitmap.c b/tcl/macosx/tkMacOSXBitmap.c
new file mode 100644
index 00000000000..723c7d970b5
--- /dev/null
+++ b/tcl/macosx/tkMacOSXBitmap.c
@@ -0,0 +1,283 @@
+/*
+ * tkMacOSXBitmap.c --
+ *
+ * This file handles the implementation of native bitmaps.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+
+#include <Carbon/Carbon.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 the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDefineNativeBitmaps()
+{
+ int new;
+ Tcl_HashEntry *predefHashPtr;
+ TkPredefBitmap *predefPtr;
+ CONST char * name;
+ BuiltInIcon *builtInPtr;
+ NativeIcon *nativeIconPtr;
+ Tcl_HashTable *tablePtr;
+
+ for (builtInPtr = builtInIcons; builtInPtr->name != NULL; builtInPtr++) {
+ name = Tk_GetUid(builtInPtr->name);
+ tablePtr = TkGetBitmapPredefTable();
+ predefHashPtr = Tcl_CreateHashEntry(tablePtr, name, &new);
+ if (!new) {
+ continue;
+ }
+ predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
+ nativeIconPtr = (NativeIcon *) ckalloc(sizeof(NativeIcon));
+ nativeIconPtr->id = builtInPtr->id;
+ nativeIconPtr->type = builtInPtr->type;
+ 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 the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+TkpCreateNativeBitmap(
+ Display *display,
+ CONST 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 = TkMacOSXGetDrawablePort(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 the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+TkpGetNativeAppBitmap(
+ Display *display, /* The display. */
+ CONST 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 = -1, destWrote;
+ Str255 nativeName;
+
+ /*
+ * macRoman is the encoding that the resource fork uses.
+ */
+
+ Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), name,
+ strlen(name), 0, NULL,
+ (char *) &nativeName[1],
+ 255, NULL, &destWrote, NULL); /* Internalize native */
+ nativeName[0] = destWrote;
+
+ resource = GetNamedResource('cicn', nativeName);
+ if (resource != NULL) {
+ type = TYPE3;
+ } else {
+ resource = GetNamedResource('ICON', nativeName);
+ if (resource != NULL) {
+ type = TYPE2;
+ }
+ }
+
+ if (resource == NULL) {
+ return NULL;
+ }
+
+ pix = Tk_GetPixmap(display, None, 32, 32, 0);
+ destPort = TkMacOSXGetDrawablePort(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/tcl/macosx/tkMacOSXButton.c b/tcl/macosx/tkMacOSXButton.c
new file mode 100644
index 00000000000..a1ec7b7ab66
--- /dev/null
+++ b/tcl/macosx/tkMacOSXButton.c
@@ -0,0 +1,1580 @@
+/*
+ * tkMacOSXButton.c --
+ *
+ * This file implements the Macintosh specific portion of the
+ * button widgets.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+#include "tkMacOSXDebug.h"
+
+#define DEFAULT_USE_TK_TEXT 0
+
+/*
+ * Default insets for controls
+ */
+#define DEF_INSET_LEFT 2
+#define DEF_INSET_RIGHT 2
+#define DEF_INSET_TOP 2
+#define DEF_INSET_BOTTOM 4
+
+#include <Carbon/Carbon.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
+
+/*
+ * Declaration of Mac specific button structure.
+ */
+
+typedef struct {
+ SInt16 initialValue;
+ SInt16 minValue;
+ SInt16 maxValue;
+ SInt16 procID;
+ int isBevel;
+} MacControlParams;
+
+typedef struct {
+ int drawType;
+ Tk_3DBorder border;
+ int relief;
+ 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. */
+ GC gc;
+ int hasImageOrBitmap;
+} DrawParams;
+
+
+typedef struct {
+ TkButton info; /* generic button info */
+ int id;
+ int usingControl;
+ int useTkText;
+ int flags; /* initialisation status */
+ MacControlParams params;
+ WindowRef windowRef;
+ RGBColor userPaneBackground;
+ ControlRef userPane; /* Carbon control */
+ ControlRef control; /* Carbon control */
+ Str255 controlTitle;
+ ControlFontStyleRec fontStyle;
+ /*
+ * the following are used to store the image content for
+ * beveled buttons - i.e. buttons with images.
+ */
+ CCTabHandle tabHandle;
+ ControlButtonContentInfo bevelButtonContent;
+ OpenCPicParams picParams;
+ Pixmap picPixmap;
+} MacButton;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+
+static OSErr SetUserPaneDrawProc(ControlRef control,
+ ControlUserPaneDrawProcPtr upp);
+static OSErr SetUserPaneSetUpSpecialBackgroundProc(ControlRef control,
+ ControlUserPaneBackgroundProcPtr upp);
+static void UserPaneDraw(ControlRef control, ControlPartCode cpc);
+static void UserPaneBackgroundProc(ControlHandle,
+ ControlBackgroundPtr info);
+
+static void ButtonEventProc _ANSI_ARGS_(( ClientData clientData, XEvent *eventPtr));
+static int UpdateControlColors _ANSI_ARGS_((MacButton *mbPtr ));
+static void TkMacOSXComputeControlParams _ANSI_ARGS_((TkButton * butPtr, MacControlParams * paramsPtr));
+static int TkMacOSXComputeDrawParams _ANSI_ARGS_((TkButton * butPtr, DrawParams * dpPtr));
+static void TkMacOSXDrawControl _ANSI_ARGS_((MacButton *butPtr,
+ GWorldPtr destPort, GC gc, Pixmap pixmap));
+static void SetupBevelButton _ANSI_ARGS_((MacButton *butPtr,
+ ControlRef controlHandle,
+ GWorldPtr destPort, GC gc, Pixmap pixmap));
+
+extern int TkFontGetFirstTextLayout(Tk_TextLayout layout, Tk_Font * font, char * dst);
+extern void TkMacOSXInitControlFontStyle(Tk_Font tkfont,ControlFontStylePtr fsPtr);
+
+/*
+ * The class procedure table for the button widgets.
+ */
+
+Tk_ClassProcs tkpButtonProcs = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkButtonWorldChanged, /* worldChangedProc */
+};
+
+static int bCount;
+
+int tkPictureIsOpen;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+{
+ MacButton *macButtonPtr;
+ macButtonPtr = (MacButton *) ckalloc(sizeof(MacButton));
+ Tk_CreateEventHandler(tkwin, ActivateMask,
+ ButtonEventProc, (ClientData) macButtonPtr);
+ macButtonPtr->id=bCount++;
+ macButtonPtr->usingControl=0;
+ macButtonPtr->flags=0;
+ macButtonPtr->userPaneBackground.red=0;
+ macButtonPtr->userPaneBackground.green=0;
+ macButtonPtr->userPaneBackground.blue=~0;
+ macButtonPtr->userPane=NULL;
+ macButtonPtr->control=NULL;
+ macButtonPtr->controlTitle[0]=
+ macButtonPtr->controlTitle[1]=0;
+ macButtonPtr->picParams.version = -2;
+ macButtonPtr->picParams.hRes = 0x00480000;
+ macButtonPtr->picParams.vRes = 0x00480000;
+ macButtonPtr->picParams.srcRect.top = 0;
+ macButtonPtr->picParams.srcRect.left = 0;
+ macButtonPtr->picParams.reserved1 = 0;
+ macButtonPtr->picParams.reserved2 = 0;
+ macButtonPtr->bevelButtonContent.contentType = kControlContentPictHandle;
+ bzero(&macButtonPtr->params, sizeof(macButtonPtr->params));
+ bzero(&macButtonPtr->fontStyle,sizeof(macButtonPtr->fontStyle));
+ return (TkButton *)macButtonPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ MacButton *macButtonPtr = (MacButton *)clientData;
+ TkButton *butPtr = (TkButton *) clientData;
+ Tk_Window tkwin = butPtr->tkwin;
+ int x = 0; /* Initialization only needed to stop
+ * compiler warning. */
+ int y;
+ int width, height, fullWidth, fullHeight;
+ int imageXOffset, imageYOffset, textXOffset, textYOffset;
+ int haveImage = 0, haveText = 0;
+ GWorldPtr destPort;
+ int borderWidth;
+ Pixmap pixmap;
+ int wasUsingControl;
+ DrawParams drawParams, * dpPtr = &drawParams;
+
+ butPtr->flags &= ~REDRAW_PENDING;
+ if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ pixmap = (Pixmap) Tk_WindowId(tkwin);
+ wasUsingControl = macButtonPtr->usingControl;
+
+ if (TkMacOSXComputeDrawParams(butPtr, &drawParams) ) {
+ macButtonPtr->usingControl=1;
+ macButtonPtr->useTkText=DEFAULT_USE_TK_TEXT;
+ } else {
+ macButtonPtr->usingControl=0;
+ macButtonPtr->useTkText=1;
+ }
+
+ /*
+ * set up clipping region
+ */
+
+ TkMacOSXSetUpClippingRgn(pixmap);
+
+ /*
+ * See the comment in UpdateControlColors as to why we use the
+ * highlightbackground for the border of Macintosh buttons.
+ */
+
+ if (macButtonPtr->useTkText) {
+ 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);
+ }
+ }
+
+ /*
+ * 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 (macButtonPtr->usingControl) {
+ borderWidth = 0;
+ /*
+ * This part uses Macintosh rather than Tk calls to draw
+ * to the screen. Make sure the ports etc. are set correctly.
+ */
+
+ destPort = TkMacOSXGetDrawablePort(pixmap);
+ SetGWorld(destPort, NULL);
+ TkMacOSXDrawControl(macButtonPtr, destPort, dpPtr->gc, pixmap);
+ } else {
+ if (wasUsingControl && macButtonPtr->userPane) {
+ DisposeControl(macButtonPtr->userPane);
+ macButtonPtr->userPane = NULL;
+ macButtonPtr->control = NULL;
+ macButtonPtr->flags = 0;
+ }
+ }
+
+ if ((dpPtr->drawType == DRAW_CUSTOM) || (dpPtr->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 (dpPtr->drawType == DRAW_BEVEL) {
+ /* Empty Body */
+ } else {
+ if (butPtr->image != None) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+ haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ imageXOffset = 0;
+ imageYOffset = 0;
+ textXOffset = 0;
+ textYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (butPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + butPtr->padY;
+ } else {
+ imageYOffset = butPtr->textHeight + butPtr->padY;
+ }
+ fullHeight = height + butPtr->textHeight + butPtr->padY;
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /*
+ * Image is left or right of text
+ */
+
+ if (butPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + butPtr->padX;
+ } else {
+ imageXOffset = butPtr->textWidth + butPtr->padX;
+ }
+ fullWidth = butPtr->textWidth + butPtr->padX + width;
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /*
+ * Image and text are superimposed
+ */
+
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + fullWidth, fullHeight, &x, &y);
+
+ x += butPtr->indicatorSpace;
+
+ x += dpPtr->offset;
+ y += dpPtr->offset;
+ if (dpPtr->relief == TK_RELIEF_RAISED) {
+ x -= dpPtr->offset;
+ y -= dpPtr->offset;
+ } else if (dpPtr->relief == TK_RELIEF_SUNKEN) {
+ x += dpPtr->offset;
+ y += dpPtr->offset;
+ }
+
+ if (butPtr->image != NULL) {
+ if ((butPtr->selectImage != NULL) &&
+ (butPtr->flags & SELECTED)) {
+ Tk_RedrawImage(butPtr->selectImage, 0, 0,
+ width, height, pixmap, x + imageXOffset,
+ y + imageYOffset);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width,
+ height, pixmap, x + imageXOffset,
+ y + imageYOffset);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, dpPtr->gc, x + imageXOffset,
+ y + imageYOffset);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, dpPtr->gc,
+ 0, 0, (unsigned int) width,
+ (unsigned int) height, x + imageXOffset,
+ y + imageYOffset, 1);
+ XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0);
+ }
+
+ if (macButtonPtr->useTkText ) {
+ Tk_DrawTextLayout(butPtr->display, pixmap,
+ dpPtr->gc, butPtr->textLayout,
+ x + textXOffset, y + textYOffset, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, dpPtr->gc,
+ butPtr->textLayout,
+ x + textXOffset, y + textYOffset,
+ butPtr->underline);
+ }
+ y += fullHeight/2;
+ } else {
+ if (haveImage) {
+ TkComputeAnchor(butPtr->anchor, tkwin, 0, 0,
+ butPtr->indicatorSpace + width, height, &x, &y);
+ x += butPtr->indicatorSpace;
+
+ x += dpPtr->offset;
+ y += dpPtr->offset;
+ if (dpPtr->relief == TK_RELIEF_RAISED) {
+ x -= dpPtr->offset;
+ y -= dpPtr->offset;
+ } else if (dpPtr->relief == TK_RELIEF_SUNKEN) {
+ x += dpPtr->offset;
+ y += dpPtr->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, dpPtr->gc, x, y);
+ XCopyPlane(butPtr->display, butPtr->bitmap,
+ pixmap, dpPtr->gc,
+ 0, 0, (unsigned int) width,
+ (unsigned int) height, x, y, 1);
+ XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0);
+ }
+ y += height/2;
+ } else {
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX,
+ butPtr->padY,
+ butPtr->indicatorSpace + butPtr->textWidth,
+ butPtr->textHeight, &x, &y);
+
+ x += butPtr->indicatorSpace;
+
+ if (macButtonPtr->useTkText) {
+ Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->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 (macButtonPtr->useTkText) {
+ if ((butPtr->state == STATE_DISABLED)
+ && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->selectBorder)->pixel);
+ }
+ XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
+ 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 (dpPtr->relief != TK_RELIEF_FLAT) {
+ int inset = butPtr->highlightWidth;
+ Tk_Draw3DRectangle(tkwin, pixmap, dpPtr->border, inset, inset,
+ Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
+ butPtr->borderWidth, dpPtr->relief);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, haveImage = 0, haveText = 0;
+ int xInset, yInset;
+ int txtWidth, txtHeight;
+ Tk_FontMetrics fm;
+ DrawParams drawParams;
+
+ /*
+ * First figure out the size of the contents of the button.
+ */
+
+ width = 0;
+ height = 0;
+ txtWidth = 0;
+ txtHeight = 0;
+ avgWidth = 0;
+
+
+ butPtr->indicatorSpace = 0;
+ if (butPtr->image != NULL) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+
+ if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) {
+ Tk_FreeTextLayout(butPtr->textLayout);
+ butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
+
+ txtWidth = butPtr->textWidth;
+ txtHeight = butPtr->textHeight;
+ avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
+ Tk_GetFontMetrics(butPtr->tkfont, &fm);
+ haveText = (txtWidth != 0 && txtHeight != 0);
+ }
+
+ /*
+ * If the button is compound (ie, it shows both an image and text),
+ * the new geometry is a combination of the image and text geometry.
+ * We only honor the compound bit if the button has both text and an
+ * image, because otherwise it is not really a compound button.
+ */
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /*
+ * Image is above or below text
+ */
+
+ height += txtHeight + butPtr->padY;
+ width = (width > txtWidth ? width : txtWidth);
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /*
+ * Image is left or right of text
+ */
+
+ width += txtWidth + butPtr->padX;
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /*
+ * Image and text are superimposed
+ */
+
+ width = (width > txtWidth ? width : txtWidth);
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ 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;
+ }
+ }
+
+ width += 2 * butPtr->padX;
+ height += 2 * butPtr->padY;
+
+ } else {
+ if (haveImage) {
+ 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 {
+ width = txtWidth;
+ height = txtHeight;
+ 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 != STATE_DISABLED) {
+ butPtr->inset += butPtr->highlightWidth;
+ }
+ } else {
+ butPtr->inset = 0;
+ width += (2 * butPtr->borderWidth + 4);
+ height += (2 * butPtr->borderWidth + 4);
+ }
+ } 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)) {
+ 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;
+ }
+
+ if (TkMacOSXComputeDrawParams(butPtr,&drawParams)) {
+ xInset = butPtr->indicatorSpace + DEF_INSET_LEFT + DEF_INSET_RIGHT;
+ yInset = DEF_INSET_TOP + DEF_INSET_BOTTOM;
+ } else {
+ xInset = butPtr->indicatorSpace+butPtr->inset*2;
+ yInset = butPtr->inset*2;
+ }
+ Tk_GeometryRequest(butPtr->tkwin, width + xInset, height + yInset);
+ 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)
+{
+ MacButton *mbPtr = ( MacButton *) butPtr; /* Mac button. */
+ if (mbPtr->userPane) {
+ DisposeControl(mbPtr->userPane);
+ mbPtr->userPane = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXInitControl --
+ *
+ * This procedure initialises a Carbon control
+ *
+ * Results:
+ * 0 on success, 1 on failure.
+ *
+ * Side effects:
+ * A background pane control and the control itself is created
+ * The contol is embedded in the background control
+ * The background control is embedded in the root control
+ * of the containing window
+ * The creation parameters for the control are also computed
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXInitControl (
+ MacButton *mbPtr, /* Mac button. */
+ GWorldPtr destPort,
+ GC gc,
+ Pixmap pixmap,
+ Rect *paneRect,
+ Rect *cntrRect
+)
+{
+ OSErr status;
+ TkButton * butPtr = ( TkButton * )mbPtr;
+ ControlRef rootControl;
+ SInt16 procID;
+ Boolean initiallyVisible;
+ SInt16 initialValue;
+ SInt16 minValue;
+ SInt16 maxValue;
+ SInt32 controlReference;
+
+ rootControl = TkMacOSXGetRootControl(Tk_WindowId(butPtr->tkwin));
+ mbPtr->windowRef
+ = GetWindowFromPort(TkMacOSXGetDrawablePort(Tk_WindowId(butPtr->tkwin)));
+
+ /*
+ * Set up the user pane
+ */
+
+ initiallyVisible=false;
+ initialValue=kControlSupportsEmbedding|
+ kControlHasSpecialBackground;
+ minValue=0;
+ maxValue=1;
+ procID=kControlUserPaneProc;
+ controlReference=(SInt32)mbPtr;
+ mbPtr->userPane=NewControl(mbPtr->windowRef,
+ paneRect, "\p",
+ initiallyVisible,
+ initialValue,
+ minValue,
+ maxValue,
+ procID,
+ controlReference );
+
+ if (!mbPtr->userPane) {
+ fprintf(stderr,"Failed to create user pane control\n");
+ return 1;
+ }
+
+ if ((status=EmbedControl(mbPtr->userPane,rootControl))!=noErr) {
+ fprintf(stderr,"Failed to embed user pane control %d\n", status);
+ return 1;
+ }
+
+ SetUserPaneSetUpSpecialBackgroundProc(mbPtr->userPane,
+ UserPaneBackgroundProc);
+ SetUserPaneDrawProc(mbPtr->userPane,UserPaneDraw);
+ initiallyVisible=false;
+ TkMacOSXComputeControlParams(butPtr,&mbPtr->params);
+ mbPtr->control=NewControl(mbPtr->windowRef,
+ cntrRect, "\p",
+ initiallyVisible,
+ mbPtr->params.initialValue,
+ mbPtr->params.minValue,
+ mbPtr->params.maxValue,
+ mbPtr->params.procID,
+ controlReference );
+
+ if (!mbPtr->control) {
+ fprintf(stderr,"failed to create control of type %d\n",procID);
+ return 1;
+ }
+
+ if (EmbedControl(mbPtr->control,mbPtr->userPane) != noErr ) {
+ fprintf(stderr,"failed to embed control of type %d\n",procID);
+ return 1;
+ }
+
+ mbPtr->flags|=(1 + 2);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMacOSXDrawControl --
+ *
+ * This function draws the tk button using Mac controls
+ * In addition, this code may apply custom colors passed
+ * in the TkButton.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The control is created, or reinitialised as needed
+ *
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TkMacOSXDrawControl(
+ MacButton *mbPtr, /* Mac 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 */
+
+{
+ TkButton * butPtr = ( TkButton *)mbPtr;
+ int err;
+ TkWindow * winPtr;
+ Rect paneRect;
+ Rect cntrRect;
+ int hilitePart = -1;
+
+
+ winPtr=(TkWindow *)butPtr->tkwin;
+
+ paneRect.left = winPtr->privatePtr->xOff;
+ paneRect.top = winPtr->privatePtr->yOff;
+ paneRect.right = paneRect.left + Tk_Width(butPtr->tkwin);
+ paneRect.bottom = paneRect.top + Tk_Height(butPtr->tkwin);
+
+ cntrRect=paneRect;
+
+/*
+ cntrRect.left+=butPtr->inset;
+ cntrRect.top+=butPtr->inset;
+ cntrRect.right-=butPtr->inset;
+ cntrRect.bottom-=butPtr->inset;
+*/
+ cntrRect.left+=DEF_INSET_LEFT;
+ cntrRect.top+=DEF_INSET_TOP;
+ cntrRect.right-=DEF_INSET_RIGHT;
+ cntrRect.bottom-=DEF_INSET_BOTTOM;
+
+ /*
+ * The control has been previously initialised
+ * It may need to be re-initialised
+ */
+
+ if (mbPtr->flags) {
+ MacControlParams params;
+ TkMacOSXComputeControlParams(butPtr, &params);
+ if (bcmp(&params, &mbPtr->params, sizeof(params))) {
+ /*
+ * the type of control has changed
+ * Clean it up and clear the flag
+ */
+
+ if (mbPtr->userPane) {
+ DisposeControl(mbPtr->userPane);
+ mbPtr->userPane = NULL;
+ mbPtr->control = NULL;
+ }
+ mbPtr->flags = 0;
+ }
+ }
+ if (!(mbPtr->flags & 1)) {
+ if (TkMacOSXInitControl(mbPtr, destPort, gc,
+ pixmap, &paneRect, &cntrRect) ) {
+ return;
+ }
+ }
+ SetControlBounds(mbPtr->userPane, &paneRect);
+ SetControlBounds(mbPtr->control, &cntrRect);
+
+ if (!mbPtr->useTkText) {
+ Str255 controlTitle;
+ ControlFontStyleRec fontStyle;
+ Tk_Font font;
+ int len;
+
+ len = TkFontGetFirstTextLayout(butPtr->textLayout,
+ &font, controlTitle);
+ controlTitle[len] = 0;
+ if (bcmp(mbPtr->controlTitle, controlTitle, len+1)) {
+ CFStringRef cf;
+ cf = CFStringCreateWithCString(NULL,
+ controlTitle, kCFStringEncodingUTF8);
+ if (cf != NULL) {
+ SetControlTitleWithCFString(mbPtr->control, cf);
+ CFRelease(cf);
+ }
+ bcopy(controlTitle, mbPtr->controlTitle, len+1);
+ }
+ if (len) {
+ TkMacOSXInitControlFontStyle(font, &fontStyle);
+ if (bcmp(&mbPtr->fontStyle, &fontStyle, sizeof(fontStyle)) ) {
+ if (SetControlFontStyle(mbPtr->control, &fontStyle) != noErr) {
+ fprintf(stderr,"SetControlFontStyle failed\n");
+ }
+ bcopy(&fontStyle, &mbPtr->fontStyle,
+ sizeof(fontStyle));
+ }
+ }
+ }
+ if (mbPtr->params.isBevel) {
+ /* Initialiase the image/button parameters */
+ SetupBevelButton(mbPtr, mbPtr->control, destPort,
+ gc, pixmap);
+ }
+
+ if (butPtr->flags & SELECTED) {
+ SetControlValue(mbPtr->control, 1);
+ } else {
+ SetControlValue(mbPtr->control, 0);
+ }
+
+ if (!Tk_MacOSXIsAppInFront() || butPtr->state == STATE_DISABLED) {
+ HiliteControl(mbPtr->control, kControlInactivePart);
+ } else if (butPtr->state == STATE_ACTIVE) {
+ if (mbPtr->params.isBevel) {
+ HiliteControl(mbPtr->control, kControlButtonPart);
+ } else {
+ switch (butPtr->type) {
+ case TYPE_BUTTON:
+ HiliteControl(mbPtr->control, kControlButtonPart);
+ break;
+ case TYPE_RADIO_BUTTON:
+ HiliteControl(mbPtr->control, kControlRadioButtonPart);
+ break;
+ case TYPE_CHECK_BUTTON:
+ HiliteControl(mbPtr->control, kControlCheckBoxPart);
+ break;
+ }
+ }
+ } else {
+ HiliteControl(mbPtr->control, kControlNoPart);
+ }
+ UpdateControlColors(mbPtr);
+
+ if ((butPtr->type == TYPE_BUTTON) ) {
+ Boolean isDefault;
+
+ if (butPtr->defaultState == STATE_ACTIVE) {
+ isDefault = true;
+ } else {
+ isDefault = false;
+ }
+ if ((err=SetControlData(mbPtr->control, kControlNoPart,
+ kControlPushButtonDefaultTag,
+ sizeof(isDefault), (Ptr) &isDefault)) != noErr ) {
+ }
+ }
+
+ if (mbPtr->flags&2) {
+ ShowControl(mbPtr->control);
+ ShowControl(mbPtr->userPane);
+ mbPtr->flags ^= 2;
+ } else {
+ Draw1Control(mbPtr->userPane);
+ SetControlVisibility(mbPtr->control, true, true);
+ }
+
+ if (mbPtr->params.isBevel) {
+ KillPicture(mbPtr->bevelButtonContent.u.picture);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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(
+ MacButton *mbPtr, /* Mac 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 err;
+ TkButton *butPtr = ( TkButton *)mbPtr;
+ int height, width;
+ ControlButtonGraphicAlignment theAlignment;
+
+ SetPort(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;
+ }
+
+ mbPtr->picParams.srcRect.right = width;
+ mbPtr->picParams.srcRect.bottom = height;
+
+ /*
+ * Set the flag to circumvent clipping and bounds problems with OS 10.0.4
+ */
+
+ if (!(mbPtr->bevelButtonContent.u.picture
+ = OpenCPicture(&mbPtr->picParams)) ) {
+ fprintf(stderr,"OpenCPicture failed\n");
+ }
+ tkPictureIsOpen = 1;
+
+ /*
+ * 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();
+ tkPictureIsOpen = 0;
+
+ if ( (err=SetControlData(controlHandle, kControlButtonPart,
+ kControlBevelButtonContentTag,
+ sizeof(ControlButtonContentInfo),
+ (char *) &mbPtr->bevelButtonContent)) != noErr ) {
+ fprintf(stderr,
+ "SetControlData BevelButtonContent failed, %d\n", err );
+ }
+
+ 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;
+ }
+
+ if ((err=SetControlData(controlHandle, kControlButtonPart,
+ kControlBevelButtonGraphicAlignTag,
+ sizeof(ControlButtonGraphicAlignment),
+ (char *) &theAlignment)) != noErr ) {
+ fprintf(stderr,
+ "SetControlData BevelButtonGraphicAlign failed, %d\n", err );
+ }
+
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+OSErr SetUserPaneDrawProc (
+ ControlRef control,
+ ControlUserPaneDrawProcPtr upp)
+{
+ ControlUserPaneDrawUPP myControlUserPaneDrawUPP;
+ myControlUserPaneDrawUPP = NewControlUserPaneDrawUPP(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.
+ *
+ *--------------------------------------------------------------
+ */
+OSErr
+SetUserPaneSetUpSpecialBackgroundProc(
+ ControlRef control,
+ ControlUserPaneBackgroundProcPtr upp)
+{
+ ControlUserPaneBackgroundUPP myControlUserPaneBackgroundUPP;
+ myControlUserPaneBackgroundUPP = NewControlUserPaneBackgroundUPP(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.
+ *
+ *--------------------------------------------------------------
+ */
+void
+UserPaneDraw(
+ ControlRef control,
+ ControlPartCode cpc)
+{
+ Rect contrlRect;
+ MacButton * mbPtr;
+ mbPtr = ( MacButton *)GetControlReference(control);
+ GetControlBounds(control,&contrlRect);
+ RGBBackColor (&mbPtr->userPaneBackground);
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+UserPaneBackgroundProc(
+ ControlHandle control,
+ ControlBackgroundPtr info)
+{
+ MacButton * mbPtr;
+ mbPtr = ( MacButton *)GetControlReference(control);
+ if (info->colorDevice) {
+ RGBBackColor (&mbPtr->userPaneBackground);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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(MacButton * mbPtr)
+{
+ XColor *xcolor;
+ TkButton * butPtr = ( TkButton * )mbPtr;
+
+ /*
+ * 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 (butPtr->type == TYPE_BUTTON) {
+ xcolor = Tk_3DBorderColor(butPtr->highlightBorder);
+ } else {
+ xcolor = Tk_3DBorderColor(butPtr->normalBorder);
+ }
+ TkSetMacColor(xcolor->pixel, &mbPtr->userPaneBackground);
+
+ return false;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ButtonEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkButton *buttonPtr = (TkButton *) clientData;
+ if (eventPtr->type == ActivateNotify
+ || eventPtr->type == DeactivateNotify) {
+ if ((buttonPtr->tkwin == NULL)
+ || (!Tk_IsMapped(buttonPtr->tkwin))) {
+ return;
+ }
+ if ((buttonPtr->flags & REDRAW_PENDING) == 0) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) buttonPtr);
+ buttonPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXComputeControlParams --
+ *
+ * This procedure computes the various parameters used
+ * when creating a Carbon control (NewControl)
+ * These are determined by the various tk button parameters
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the control initialisation parameters
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TkMacOSXComputeControlParams(TkButton * butPtr, MacControlParams * paramsPtr )
+{
+ paramsPtr->isBevel = 0;
+
+ /*
+ * Determine ProcID based on button type and dimensions
+ */
+
+ switch (butPtr->type) {
+ case TYPE_BUTTON:
+ if ((butPtr->image == None) && (butPtr->bitmap == None)) {
+ paramsPtr->initialValue = 1;
+ paramsPtr->minValue = 0;
+ paramsPtr->maxValue = 1;
+ paramsPtr->procID = kControlPushButtonProc;
+ } else {
+ paramsPtr->initialValue = 0;
+ paramsPtr->minValue = kControlBehaviorOffsetContents
+ | kControlContentPictHandle;
+ paramsPtr->maxValue = 1;
+ if (butPtr->borderWidth <= 2) {
+ paramsPtr->procID = kControlBevelButtonSmallBevelProc;
+ } else if (butPtr->borderWidth == 3) {
+ paramsPtr->procID = kControlBevelButtonNormalBevelProc;
+ } else {
+ paramsPtr->procID = kControlBevelButtonLargeBevelProc;
+ }
+ paramsPtr->isBevel = 1;
+ }
+ break;
+ case TYPE_RADIO_BUTTON:
+ if (((butPtr->image == None) && (butPtr->bitmap == None))
+ || (butPtr->indicatorOn)) {
+ paramsPtr->initialValue = 1;
+ paramsPtr->minValue = 0;
+ paramsPtr->maxValue = 1;
+ paramsPtr->procID = kControlRadioButtonProc;
+ } else {
+ paramsPtr->initialValue = 0;
+ paramsPtr->minValue = kControlBehaviorOffsetContents|
+ kControlBehaviorSticky|
+ kControlContentPictHandle;
+ paramsPtr->maxValue = 1;
+ if (butPtr->borderWidth <= 2) {
+ paramsPtr->procID = kControlBevelButtonSmallBevelProc;
+ } else if (butPtr->borderWidth == 3) {
+ paramsPtr->procID = kControlBevelButtonNormalBevelProc;
+ } else {
+ paramsPtr->procID = kControlBevelButtonLargeBevelProc;
+ }
+ paramsPtr->isBevel = 1;
+ }
+ break;
+ case TYPE_CHECK_BUTTON:
+ if (((butPtr->image == None)
+ && (butPtr->bitmap == None))
+ || (butPtr->indicatorOn)) {
+ paramsPtr->initialValue = 1;
+ paramsPtr->minValue = 0;
+ paramsPtr->maxValue = 1;
+ paramsPtr->procID = kControlCheckBoxProc;
+ } else {
+ paramsPtr->initialValue = 0;
+ paramsPtr->minValue = kControlBehaviorOffsetContents
+ | kControlBehaviorSticky
+ | kControlContentPictHandle;
+ paramsPtr->maxValue = 1;
+ if (butPtr->borderWidth <= 2) {
+ paramsPtr->procID = kControlBevelButtonSmallBevelProc;
+ } else if (butPtr->borderWidth == 3) {
+ paramsPtr->procID = kControlBevelButtonNormalBevelProc;
+ } else {
+ paramsPtr->procID = kControlBevelButtonLargeBevelProc;
+ }
+ paramsPtr->isBevel = 1;
+ }
+ break;
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXComputeDrawParams --
+ *
+ * This procedure computes the various parameters used
+ * when drawing a button
+ * These are determined by the various tk button parameters
+ *
+ * Results:
+ * 1 if control will be used, 0 otherwise.
+ *
+ * Side effects:
+ * Sets the button draw parameters
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TkMacOSXComputeDrawParams(TkButton * butPtr, DrawParams * dpPtr)
+{
+ dpPtr->hasImageOrBitmap = ((butPtr->image != NULL)
+ || (butPtr->bitmap != None));
+ dpPtr->offset = (butPtr->type == TYPE_BUTTON)
+ && dpPtr->hasImageOrBitmap;
+ dpPtr->border = butPtr->normalBorder;
+ if ((butPtr->state == STATE_DISABLED)
+ && (butPtr->disabledFg != NULL)) {
+ dpPtr->gc = butPtr->disabledGC;
+ } else if ((butPtr->type == TYPE_BUTTON)
+ && (butPtr->state == STATE_ACTIVE)) {
+ dpPtr->gc = butPtr->activeTextGC;
+ dpPtr->border = butPtr->activeBorder;
+ } else {
+ dpPtr->gc = butPtr->normalTextGC;
+ }
+
+ if ((butPtr->flags & SELECTED)
+ && (butPtr->state != STATE_ACTIVE)
+ && (butPtr->selectBorder != NULL)
+ && !butPtr->indicatorOn) {
+ dpPtr->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.
+ */
+
+ dpPtr->relief = butPtr->relief;
+
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
+ if (!dpPtr->hasImageOrBitmap) {
+ dpPtr->relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN
+ : TK_RELIEF_RAISED;
+ }
+ }
+
+ /*
+ * Determine the draw type
+ */
+ if (butPtr->type == TYPE_LABEL) {
+ dpPtr->drawType = DRAW_LABEL;
+ } else if (butPtr->type == TYPE_BUTTON) {
+ if (!dpPtr->hasImageOrBitmap) {
+ dpPtr->drawType = DRAW_CONTROL;
+ } else if (butPtr->image != None) {
+ dpPtr->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 (dpPtr->gc->clip_mask == 0) {
+ dpPtr->drawType = DRAW_BEVEL;
+ } else {
+ TkpClipMask *clipPtr = (TkpClipMask*) dpPtr->gc->clip_mask;
+ if ((clipPtr->type == TKP_CLIP_PIXMAP) &&
+ (clipPtr->value.pixmap != butPtr->bitmap)) {
+ dpPtr->drawType = DRAW_CUSTOM;
+ } else {
+ dpPtr->drawType = DRAW_BEVEL;
+ }
+ }
+ }
+ } else {
+ if (butPtr->indicatorOn) {
+ dpPtr->drawType = DRAW_CONTROL;
+ } else if (dpPtr->hasImageOrBitmap) {
+ if (dpPtr->gc->clip_mask == 0) {
+ dpPtr->drawType = DRAW_BEVEL;
+ } else {
+ TkpClipMask *clipPtr = (TkpClipMask*) dpPtr->gc->clip_mask;
+ if ((clipPtr->type == TKP_CLIP_PIXMAP) &&
+ (clipPtr->value.pixmap != butPtr->bitmap)) {
+ dpPtr->drawType = DRAW_CUSTOM;
+ } else {
+ dpPtr->drawType = DRAW_BEVEL;
+ }
+ }
+ } else {
+ dpPtr->drawType = DRAW_CUSTOM;
+ }
+ }
+
+ if ((dpPtr->drawType == DRAW_CONTROL) || (dpPtr->drawType == DRAW_BEVEL)) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
diff --git a/tcl/macosx/tkMacOSXClipboard.c b/tcl/macosx/tkMacOSXClipboard.c
new file mode 100644
index 00000000000..833422d1caf
--- /dev/null
+++ b/tcl/macosx/tkMacOSXClipboard.c
@@ -0,0 +1,321 @@
+/*
+ * tkMacOSXClipboard.c --
+ *
+ * This file manages the clipboard for the Tk toolkit.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+#include "tkSelect.h"
+
+#include <Carbon/Carbon.h>
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelGetSelection --
+ *
+ * Retrieve the specified selection from another process. For
+ * now, only fetching XA_STRING from CLIPBOARD is supported.
+ * Eventually other types should be allowed.
+ *
+ * Results:
+ * The return value is a standard Tcl return value.
+ * If an error occurs (such as no selection exists)
+ * then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ int err;
+ long length;
+ ScrapRef scrapRef;
+ char * buf;
+
+ if ((selection == Tk_InternAtom(tkwin, "CLIPBOARD"))
+ && (target == XA_STRING)) {
+ /*
+ * Get the scrap from the Macintosh global clipboard.
+ */
+
+ err=GetCurrentScrap(&scrapRef);
+ if (err != noErr) {
+ Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
+ " GetCurrentScrap failed.", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ err=GetScrapFlavorSize(scrapRef,'TEXT',&length);
+ if (err != noErr) {
+ Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
+ " GetScrapFlavorSize failed.", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (length > 0) {
+ Tcl_DString encodedText;
+
+ buf = (char *)ckalloc(length+1);
+ buf[length] = 0;
+ err = GetScrapFlavorData(scrapRef, 'TEXT', &length, buf);
+ if (err != noErr) {
+ Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
+ " GetScrapFlavorData failed.", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_ExternalToUtfDString(TkMacOSXCarbonEncoding, buf, length,
+ &encodedText);
+ result = (*proc)(clientData, interp,
+ Tcl_DStringValue(&encodedText));
+ Tcl_DStringFree(&encodedText);
+
+ ckfree(buf);
+ return result;
+ }
+ }
+
+ 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) TkGetMainInfoList()->winPtr;
+
+ if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {
+
+ /*
+ * Only claim and empty the clipboard if we aren't already the
+ * owner of the clipboard.
+ */
+
+ dispPtr = TkGetMainInfoList()->winPtr->dispPtr;
+ if (dispPtr->clipboardActive) {
+ return;
+ }
+ ClearCurrentScrap();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ScrapRef scrapRef;
+
+ dispPtr = TkGetDisplayList();
+ if ((dispPtr == NULL) || !dispPtr->clipboardActive) {
+ return;
+ }
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = targetPtr->nextPtr) {
+ if (targetPtr->type == XA_STRING)
+ break;
+ }
+ if (targetPtr != NULL) {
+ Tcl_DString encodedText;
+
+ 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;
+ }
+ }
+ }
+
+ ClearCurrentScrap();
+ GetCurrentScrap(&scrapRef);
+ Tcl_UtfToExternalDString(TkMacOSXCarbonEncoding, buffer, length, &encodedText);
+ PutScrapFlavor(scrapRef, 'TEXT', 0, Tcl_DStringLength(&encodedText), Tcl_DStringValue(&encodedText) );
+ Tcl_DStringFree(&encodedText);
+ 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 (TkGetMainInfoList() != NULL) {
+ Tk_ClearSelection((Tk_Window) TkGetMainInfoList()->winPtr,
+ Tk_InternAtom((Tk_Window) TkGetMainInfoList()->winPtr,
+ "CLIPBOARD"));
+ }
+
+ return;
+}
diff --git a/tcl/macosx/tkMacOSXColor.c b/tcl/macosx/tkMacOSXColor.c
new file mode 100644
index 00000000000..f5ab4abe044
--- /dev/null
+++ b/tcl/macosx/tkMacOSXColor.c
@@ -0,0 +1,448 @@
+/*
+ * tkMacOSXColor.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.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+#include <Carbon/Carbon.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.
+ */
+/*
+ * Stubbed out for OS X
+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 = 0xFFFF;
+ } 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:
+ return GetMenuPartColor((pixel >> 24), macColor);
+ 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 = 0;
+
+ 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 = 0xFFFF;
+ } 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. */
+{
+/* Stubbed out for OS X
+ 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;
+
+ if (part == wContentColor) {
+ GetThemeBrushAsColor(kThemeBrushDocumentWindowBackground,
+ 0xFFFF, true, macColor);
+ return true;
+ } else {
+ 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 */
+{
+
+ /* Under Appearance, we don't want to set any menu colors when we
+ are asked for the standard menu colors. So we return false (which
+ means don't use this color... */
+
+ macColor->red = 0xFFFF;
+ macColor->green = 0;
+ macColor->blue = 0;
+ return false;
+}
diff --git a/tcl/macosx/tkMacOSXConfig.c b/tcl/macosx/tkMacOSXConfig.c
new file mode 100644
index 00000000000..5b2ecc4873c
--- /dev/null
+++ b/tcl/macosx/tkMacOSXConfig.c
@@ -0,0 +1,46 @@
+/*
+ * tkMacOSXConfig.c --
+ *
+ * This module implements the Macintosh system defaults for
+ * the configuration package.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetSystemDefault --
+ *
+ * Given a dbName and className for a configuration option,
+ * return a string representation of the option.
+ *
+ * Results:
+ * Returns a Tk_Uid that is the string identifier that identifies
+ * this option. Returns NULL if there are no system defaults
+ * that match this pair.
+ *
+ * Side effects:
+ * None, once the package is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkpGetSystemDefault(
+ Tk_Window tkwin, /* A window to use. */
+ CONST char *dbName, /* The option database name. */
+ CONST char *className) /* The name of the option class. */
+{
+ return NULL;
+}
diff --git a/tcl/macosx/tkMacOSXCursor.c b/tcl/macosx/tkMacOSXCursor.c
new file mode 100644
index 00000000000..6243a422f14
--- /dev/null
+++ b/tcl/macosx/tkMacOSXCursor.c
@@ -0,0 +1,406 @@
+/*
+ * tkMacOSXCursor.c --
+ *
+ * This file contains Macintosh specific cursor related routines.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+
+#include <Carbon/Carbon.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 */
+} TkMacOSXCursor;
+
+/*
+ * 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 TkMacOSXCursor * 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_ ((TkMacOSXCursor *macCursorPtr,
+ CONST 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(
+ TkMacOSXCursor *macCursorPtr,
+ CONST char *string)
+{
+ Handle resource;
+ Str255 curName;
+ int destWrote, inCurLen;
+
+ inCurLen = strlen(string);
+ if (inCurLen > 255) {
+ return;
+ }
+
+ /*
+ * macRoman is the encoding that the resource fork uses.
+ */
+
+ Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), string,
+ inCurLen, 0, NULL,
+ (char *) &curName[1],
+ 255, NULL, &destWrote, NULL); /* Internalize native */
+ curName[0] = destWrote;
+
+ resource = GetNamedResource('crsr', curName);
+
+ if (resource != NULL) {
+ short id;
+ Str255 theName;
+ ResType theType;
+
+ 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;
+ TkMacOSXCursor *macCursorPtr;
+
+ macCursorPtr = (TkMacOSXCursor *) ckalloc(sizeof(TkMacOSXCursor));
+ 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) {
+ CONST 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. */
+ CONST char *source, /* Bitmap data for cursor shape. */
+ CONST 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeCursor --
+ *
+ * This procedure is called to release a cursor allocated by
+ * TkGetCursorByName.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor data structure is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeCursor(
+ TkCursor *cursorPtr)
+{
+ TkMacOSXCursor *macCursorPtr = (TkMacOSXCursor *) cursorPtr;
+
+ switch (macCursorPtr->type) {
+ case COLOR:
+ DisposeCCursor((CCrsrHandle) macCursorPtr->macCursor);
+ break;
+ case NORMAL:
+ ReleaseResource(macCursorPtr->macCursor);
+ break;
+ }
+
+ if (macCursorPtr == gCurrentCursor) {
+ gCurrentCursor = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXInstallCursor --
+ *
+ * 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
+TkMacOSXInstallCursor(
+ int resizeOverride)
+{
+ TkMacOSXCursor *macCursorPtr = gCurrentCursor;
+ CCrsrHandle ccursor;
+ CursHandle cursor;
+
+ gResizeOverride = resizeOverride;
+
+ if (resizeOverride) {
+ cursor = (CursHandle) GetNamedResource('CURS', "\presize");
+ if (cursor) {
+ SetCursor(*cursor);
+ } else {
+ /*
+ fprintf(stderr,"Resize cursor failed, %d\n", ResError());
+ */
+ }
+ } else if (macCursorPtr == NULL || macCursorPtr->type == ARROW) {
+ SetThemeCursor(kThemeArrowCursor);
+ } 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 = (TkMacOSXCursor *) cursor;
+ }
+
+ if (Tk_MacOSXIsAppInFront()) {
+ TkMacOSXInstallCursor(gResizeOverride);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MacOSXTkOwnsCursor --
+ *
+ * Sets whether Tk has the right to adjust the cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May keep Tk from changing the cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MacOSXTkOwnsCursor(
+ int tkOwnsIt)
+{
+ gTkOwnsCursor = tkOwnsIt;
+}
diff --git a/tcl/macosx/tkMacOSXCursors.r b/tcl/macosx/tkMacOSXCursors.r
new file mode 100644
index 00000000000..b20423994b6
--- /dev/null
+++ b/tcl/macosx/tkMacOSXCursors.r
@@ -0,0 +1,130 @@
+/*
+ * tkMacOSXCursors.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/tcl/macosx/tkMacOSXDebug.c b/tcl/macosx/tkMacOSXDebug.c
new file mode 100644
index 00000000000..53997e8fd5e
--- /dev/null
+++ b/tcl/macosx/tkMacOSXDebug.c
@@ -0,0 +1,439 @@
+/*
+ * tkMacOSXDebug.c --
+ *
+ * Implementation of Macintosh specific functions for debugging MacOS events,
+ * regions, etc...
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#include "tkMacOSXDebug.h"
+
+typedef struct {
+ EventKind kind;
+ char * name;
+} MyEventName;
+
+typedef struct {
+ EventClass c;
+ MyEventName * names;
+} MyEventNameList;
+
+static MyEventName windowEventNames [] = {
+ { kEventWindowUpdate,"Update"},
+ { kEventWindowDrawContent,"DrawContent"},
+ { kEventWindowActivated,"Activated"},
+ { kEventWindowDeactivated,"Deactivated"},
+ { kEventWindowGetClickActivation,"GetClickActivation"},
+ { kEventWindowShowing,"Showing"},
+ { kEventWindowHiding,"Hiding"},
+ { kEventWindowShown,"Shown"},
+ { kEventWindowHidden,"Hidden"},
+ { kEventWindowBoundsChanging,"BoundsChanging"},
+ { kEventWindowBoundsChanged,"BoundsChanged"},
+ { kEventWindowResizeStarted,"ResizeStarted"},
+ { kEventWindowResizeCompleted,"ResizeCompleted"},
+ { kEventWindowDragStarted,"DragStarted"},
+ { kEventWindowDragCompleted,"DragCompleted"},
+ { kEventWindowClickDragRgn,"ClickDragRgn"},
+ { kEventWindowClickResizeRgn,"ClickResizeRgn"},
+ { kEventWindowClickCollapseRgn,"ClickCollapseRgn"},
+ { kEventWindowClickCloseRgn,"ClickCloseRgn"},
+ { kEventWindowClickZoomRgn,"ClickZoomRgn"},
+ { kEventWindowClickContentRgn,"ClickContentRgn"},
+ { kEventWindowClickProxyIconRgn,"ClickProxyIconRgn"},
+ { kEventWindowCursorChange,"CursorChange" },
+ { kEventWindowCollapse,"Collapse"},
+ { kEventWindowCollapsed,"Collapsed"},
+ { kEventWindowCollapseAll,"CollapseAll"},
+ { kEventWindowExpand,"Expand"},
+ { kEventWindowExpanded,"Expanded"},
+ { kEventWindowExpandAll,"ExpandAll"},
+ { kEventWindowCollapse,"Collapse"},
+ { kEventWindowClose,"Close"},
+ { kEventWindowClosed,"Closed"},
+ { kEventWindowCloseAll,"CloseAll"},
+ { kEventWindowZoom,"Zoom"},
+ { kEventWindowZoomed,"Zoomed"},
+ { kEventWindowZoomAll,"ZoomAll"},
+ { kEventWindowContextualMenuSelect,"ContextualMenuSelect"},
+ { kEventWindowPathSelect,"PathSelect"},
+ { kEventWindowGetIdealSize,"GetIdealSize"},
+ { kEventWindowGetMinimumSize,"GetMinimumSize"},
+ { kEventWindowGetMaximumSize,"GetMaximumSize"},
+ { kEventWindowConstrain,"Constrain"},
+ { kEventWindowHandleContentClick,"HandleContentClick"},
+ { kEventWindowProxyBeginDrag,"ProxyBeginDra}"},
+ { kEventWindowProxyEndDrag,"ProxyEndDrag"},
+ { kEventWindowFocusAcquired,"FocusAcquired"},
+ { kEventWindowFocusRelinquish,"FocusRelinquish"},
+ { kEventWindowDrawFrame,"DrawFrame"},
+ { kEventWindowDrawPart,"DrawPart"},
+ { kEventWindowGetRegion,"GetRegion"},
+ { kEventWindowHitTest,"HitTest"},
+ { kEventWindowInit,"Init"},
+ { kEventWindowDispose,"Dispose"},
+ { kEventWindowDragHilite,"DragHilite"},
+ { kEventWindowModified,"Modified"},
+ { kEventWindowSetupProxyDragImage,"SetupProxyDragImage"},
+ { kEventWindowStateChanged,"StateChanged"},
+ { kEventWindowMeasureTitle,"MeasureTitle"},
+ { kEventWindowDrawGrowBox,"DrawGrowBox"},
+ { kEventWindowGetGrowImageRegion,"GetGrowImageRegion"},
+ { kEventWindowPaint,"Paint"},
+ { 0, NULL },
+};
+
+static MyEventName mouseEventNames [] = {
+ { kEventMouseMoved, "Moved"},
+ { kEventMouseUp, "Up"},
+ { kEventMouseDown, "Down"},
+ { kEventMouseDragged, "Dragged"},
+ { kEventMouseWheelMoved, "WheelMoved"},
+ { 0, NULL}
+};
+
+static MyEventName keyboardEventNames [] = {
+ { kEventRawKeyDown, "Down"},
+ { kEventRawKeyRepeat, "Repeat"},
+ { kEventRawKeyUp, "Up"},
+ { kEventRawKeyModifiersChanged, "ModifiersChanged"},
+ { kEventHotKeyPressed, "HotKeyPressed"},
+ { kEventHotKeyReleased, "HotKeyReleased"},
+ { 0, NULL}
+};
+
+static MyEventName appEventNames [] = {
+ { kEventAppActivated, "Activated"},
+ { kEventAppDeactivated, "Deactivated"},
+ { kEventAppQuit, "Quit"},
+ { kEventAppLaunchNotification, "LaunchNotification"},
+ { kEventAppLaunched, "Launched"},
+ { kEventAppTerminated, "Terminated"},
+ { kEventAppFrontSwitched, "FrontSwitched"},
+ { 0, NULL}
+};
+
+static MyEventName menuEventNames [] = {
+ { kEventMenuBeginTracking, "BeginTracking"},
+ { kEventMenuEndTracking, "EndTracking"},
+ { kEventMenuChangeTrackingMode, "ChangeTrackingMode"},
+ { kEventMenuOpening, "Opening"},
+ { kEventMenuClosed, "Closed"},
+ { kEventMenuTargetItem, "TargetItem"},
+ { kEventMenuMatchKey, "MatchKey"},
+ { kEventMenuEnableItems, "EnableItems"},
+ { kEventMenuDispose, "Dispose"},
+ { 0, NULL }
+};
+
+static MyEventName controlEventNames [] = {
+ { kEventControlInitialize, "Initialize" },
+ { kEventControlDispose, "Dispose" },
+ { kEventControlGetOptimalBounds, "GetOptimalBounds" },
+ { kEventControlHit, "Hit" },
+ { kEventControlSimulateHit, "SimulateHit" },
+ { kEventControlHitTest, "HitTest" },
+ { kEventControlDraw, "Draw" },
+ { kEventControlApplyBackground, "ApplyBackground" },
+ { kEventControlApplyTextColor, "ApplyTextColor" },
+ { kEventControlSetFocusPart, "SetFocusPart" },
+ { kEventControlGetFocusPart, "GetFocusPart" },
+ { kEventControlActivate, "Activate" },
+ { kEventControlDeactivate, "Deactivate" },
+ { kEventControlSetCursor, "SetCursor" },
+ { kEventControlContextualMenuClick, "ContextualMenuClick" },
+ { kEventControlClick, "Click" },
+ { kEventControlTrack, "Track" },
+ { kEventControlGetScrollToHereStartPoint, "GetScrollToHereStartPoint" },
+ { kEventControlGetIndicatorDragConstraint, "GetIndicatorDragConstraint" },
+ { kEventControlIndicatorMoved, "IndicatorMoved" },
+ { kEventControlGhostingFinished, "GhostingFinished" },
+ { kEventControlGetActionProcPart, "GetActionProcPart" },
+ { kEventControlGetPartRegion, "GetPartRegion" },
+ { kEventControlGetPartBounds, "GetPartBounds" },
+ { kEventControlSetData, "SetData" },
+ { kEventControlGetData, "GetData" },
+ { kEventControlValueFieldChanged, "ValueFieldChanged" },
+ { kEventControlAddedSubControl, "AddedSubControl" },
+ { kEventControlRemovingSubControl, "RemovingSubControl" },
+ { kEventControlBoundsChanged, "BoundsChanged" },
+ { kEventControlOwningWindowChanged, "OwningWindowChanged" },
+ { kEventControlArbitraryMessage, "ArbitraryMessage" },
+ { 0, NULL }
+};
+
+
+static MyEventName commandEventNames [] = {
+ { kEventCommandProcess, "Process" },
+ { kEventCommandUpdateStatus, "UpdateStatus" },
+ { 0, NULL }
+};
+
+static MyEventNameList eventNameList [] = {
+ { kEventClassWindow, windowEventNames },
+ { kEventClassMouse, mouseEventNames },
+ { kEventClassKeyboard, keyboardEventNames },
+ { kEventClassApplication, appEventNames },
+ { kEventClassMenu, menuEventNames },
+ { kEventClassControl, controlEventNames },
+ { kEventClassCommand, commandEventNames },
+ { 0, NULL}
+};
+
+
+MyEventName classicEventNames [] = {
+ { nullEvent,"nullEvent" },
+ { mouseDown,"mouseDown" },
+ { mouseUp,"mouseUp" },
+ { keyDown,"keyDown" },
+ { keyUp,"keyUp" },
+ { autoKey,"autoKey" },
+ { updateEvt,"updateEvt" },
+ { diskEvt,"diskEvt" },
+ { activateEvt,"activateEvt" },
+ { osEvt,"osEvt" },
+ { kHighLevelEvent,"kHighLevelEvent" },
+ { 0, NULL }
+};
+
+char *
+CarbonEventToAscii(EventRef eventRef, char * buf)
+{
+ EventClass eventClass;
+ EventKind eventKind;
+ MyEventNameList * list = eventNameList;
+ MyEventName * names = NULL;
+ int * iPtr = ( int * )buf;
+ char * iBuf = buf;
+ int found = 0;
+
+ eventClass = GetEventClass(eventRef);
+ eventKind = GetEventKind(eventRef);
+
+ *iPtr = eventClass;
+ buf [ 4 ] = 0;
+ strcat(buf, " ");
+ buf += strlen(buf);
+ while (list->names && (!names) ) {
+ if (eventClass==list->c) {
+ names = list -> names;
+ } else {
+ list++;
+ }
+ }
+ if (names) {
+ found = 0;
+ while (names->name && !found) {
+ if (eventKind==names->kind) {
+ sprintf(buf, "%-20s", names->name);
+ found=1;
+ } else {
+ names++;
+ }
+ }
+ if (!found) {
+ sprintf(buf, "%-20d", eventKind );
+ }
+ } else {
+ sprintf(buf, "%-20d", eventKind );
+ }
+ return iBuf;
+}
+
+char * CarbonEventKindToAscii(EventRef eventRef, char * buf )
+{
+ EventClass eventClass;
+ EventKind eventKind;
+ MyEventNameList * list = eventNameList;
+ MyEventName * names = NULL;
+ int found = 0;
+ eventClass = GetEventClass(eventRef);
+ eventKind = GetEventKind(eventRef);
+ while (list->names && (!names) ) {
+ if (eventClass == list -> c) {
+ names = list -> names;
+ } else {
+ list++;
+ }
+ }
+ if (names) {
+ found=0;
+ while ( names->name && !found ) {
+ if (eventKind==names->kind) {
+ sprintf(buf,"%s",names->name);
+ found=1;
+ } else {
+ names++;
+ }
+ }
+ }
+ if (!found) {
+ sprintf ( buf,"%d", eventKind );
+ } else {
+ sprintf ( buf,"%d", eventKind );
+ }
+ return buf;
+}
+
+char * ClassicEventToAscii(EventRecord * eventPtr, char * buf )
+{
+ MyEventName * names = NULL;
+ int found = 0;
+ names = classicEventNames;
+ while ( names -> name && !found )
+ if (eventPtr->what==names->kind) {
+ int * iPtr;
+ char cBuf[8];
+ iPtr=( int *)&cBuf;
+ *iPtr = eventPtr->message;
+ cBuf[4] = 0;
+ sprintf(buf, "%-16s %08x %04x %s", names->name,
+ (int) eventPtr->message,
+ eventPtr->modifiers,
+ cBuf);
+ found=1;
+ } else {
+ names++;
+ }
+ if (!found) {
+ sprintf(buf,"%-16d %08x %08x, %s",
+ eventPtr->what, (int) eventPtr->message,
+ eventPtr->modifiers, buf);
+ }
+ return buf;
+
+}
+
+void printPoint(char * tag, Point * p )
+{
+ fprintf(stderr,"%s %4d %4d\n",
+ tag,p->h,p->v );
+}
+
+void printRect(char * tag, Rect * r )
+{
+ fprintf(stderr,"%s %4d %4d %4d %4d (%dx%d)\n",
+ tag,r->left,r->top,r->right,r->bottom,
+ r->right-r->left+1,r->bottom-r->top+1 );
+}
+
+void printRegion(char * tag, RgnHandle rgn )
+{
+ Rect r;
+ GetRegionBounds(rgn,&r);
+ printRect(tag,&r);
+}
+
+void printWindowTitle(char * tag, WindowRef window )
+{
+ Str255 title;
+ GetWTitle(window,title);
+ title [ title[0] + 1 ] = 0;
+ fprintf(stderr, "%s %s\n", tag, title +1 );
+}
+
+typedef struct {
+ int msg;
+ char * name;
+} MsgName;
+
+MsgName msgNames [] = {
+ { kMenuDrawMsg, "Draw"},
+ { kMenuSizeMsg, "Size"},
+ { kMenuPopUpMsg, "PopUp"},
+ { kMenuCalcItemMsg, "CalcItem" },
+ { kMenuThemeSavvyMsg, "ThemeSavvy"},
+ { kMenuInitMsg, "Init" },
+ { kMenuDisposeMsg, "Dispose" },
+ { kMenuFindItemMsg, "FindItem" },
+ { kMenuHiliteItemMsg, "HiliteItem" },
+ { kMenuDrawItemsMsg, "DrawItems" },
+ { -1, NULL }
+};
+
+
+char *
+TkMacOSXMenuMessageToAscii(int msg, char * s)
+{
+ MsgName * msgNamePtr;
+ for (msgNamePtr = msgNames;msgNamePtr->name;) {
+ if (msgNamePtr->msg==msg) {
+ strcpy(s,msgNamePtr->name);
+ return s;
+ } else {
+ msgNamePtr++;
+ }
+ }
+ sprintf(s,"unknown : %d", msg );
+ return s;
+}
+
+
+char * MouseTrackingResultToAscii(MouseTrackingResult r, char * buf)
+{
+ MsgName trackingNames [] = {
+ { kMouseTrackingMousePressed , "MousePressed " },
+ { kMouseTrackingMouseReleased , "MouseReleased " },
+ { kMouseTrackingMouseExited , "MouseExited " },
+ { kMouseTrackingMouseEntered , "MouseEntered " },
+ { kMouseTrackingMouseMoved , "MouseMoved " },
+ { kMouseTrackingKeyModifiersChanged, "KeyModifiersChanged" },
+ { kMouseTrackingUserCancelled , "UserCancelled " },
+ { kMouseTrackingTimedOut , "TimedOut " },
+ { -1, NULL }
+ };
+ MsgName * namePtr;
+ for (namePtr=trackingNames;namePtr->name;namePtr++) {
+ if (namePtr->msg==r) {
+ strcpy(buf,namePtr->name);
+ return buf;
+ }
+ }
+ sprintf(buf, "Unknown mouse tracking result : %d", r);
+ return buf;
+}
diff --git a/tcl/macosx/tkMacOSXDebug.h b/tcl/macosx/tkMacOSXDebug.h
new file mode 100644
index 00000000000..0b3185dd01a
--- /dev/null
+++ b/tcl/macosx/tkMacOSXDebug.h
@@ -0,0 +1,69 @@
+/*
+ * tkMacOSXDebug.h --
+ *
+ * Declarations of Macintosh specific functions for debugging MacOS events,
+ * regions, etc...
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#ifndef _TKMACDEBUG
+#define _TKMACDEBUG
+#include <Carbon/Carbon.h>
+
+char * CarbonEventToAscii(EventRef eventRef, char * buf );
+char * ClassicEventToAscii(EventRecord * eventPtr, char * buf );
+
+void printRect(char * tag, Rect * r );
+void printPoint(char * tag, Point * p );
+
+void printRegion(char * tag, RgnHandle rgn );
+void printWindowTitle(char * tag, WindowRef window );
+char * TkMacOSXMenuMessageToAscii(int msg, char * s);
+
+char * MouseTrackingResultToAscii(MouseTrackingResult r, char * buf );
+#endif
diff --git a/tcl/macosx/tkMacOSXDefault.h b/tcl/macosx/tkMacOSXDefault.h
new file mode 100644
index 00000000000..e4a0ce4a2a6
--- /dev/null
+++ b/tcl/macosx/tkMacOSXDefault.h
@@ -0,0 +1,531 @@
+/*
+ * tkMacOSXDefault.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.
+ * Copyright 2001, Apple Computer, 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
+//IGR#define DEF_BUTTON_BG_COLOR "systemButtonFace"
+#define DEF_BUTTON_BG_COLOR WHITE
+#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_COMPOUND "none"
+#define DEF_BUTTON_DEFAULT "disabled"
+#define DEF_BUTTON_DISABLED_FG_COLOR DISABLED
+#define DEF_BUTTON_DISABLED_FG_MONO ""
+//IGR#define DEF_BUTTON_FG "systemButtonText"
+#define DEF_BUTTON_FG BLACK
+#define DEF_CHKRAD_FG DEF_BUTTON_FG
+#define DEF_BUTTON_FONT "system"
+#define DEF_BUTTON_HEIGHT "0"
+#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR
+#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO
+#define DEF_BUTTON_HIGHLIGHT "systemButtonFrame"
+#define DEF_LABEL_HIGHLIGHT_WIDTH "0"
+#define DEF_BUTTON_HIGHLIGHT_WIDTH "4"
+#define DEF_BUTTON_IMAGE (char *) NULL
+#define DEF_BUTTON_INDICATOR "1"
+#define DEF_BUTTON_JUSTIFY "center"
+#define DEF_BUTTON_OFF_VALUE "0"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_OVER_RELIEF ""
+#define DEF_BUTTON_PADX "12"
+#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_REPEAT_DELAY "0"
+#define DEF_BUTTON_REPEAT_INTERVAL "0"
+#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_DISABLED_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_DISABLED_BG_MONO WHITE
+#define DEF_ENTRY_DISABLED_FG DISABLED
+#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_READONLY_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_READONLY_BG_MONO WHITE
+/* #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_PADX "0"
+#define DEF_FRAME_PADY "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for labelframes:
+ */
+
+#define DEF_LABELFRAME_BORDER_WIDTH "2"
+#define DEF_LABELFRAME_CLASS "Labelframe"
+#define DEF_LABELFRAME_RELIEF "groove"
+#define DEF_LABELFRAME_FG "systemButtonText"
+#define DEF_LABELFRAME_FONT "system"
+#define DEF_LABELFRAME_TEXT ""
+#define DEF_LABELFRAME_LABELANCHOR "nw"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_ACTIVE_STYLE "underline"
+#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_DISABLED_FG DISABLED
+#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_LIST_VARIABLE ""
+#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_STATE "normal"
+#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_COMPOUND "none"
+#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_COLOR DEF_MENUBUTTON_BG_COLOR
+#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO
+#define DEF_MENUBUTTON_HIGHLIGHT BLACK
+#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0"
+#define DEF_MENUBUTTON_IMAGE (char *) NULL
+#define DEF_MENUBUTTON_INDICATOR "0"
+/* #define DEF_MENUBUTTON_JUSTIFY "center" */
+#define DEF_MENUBUTTON_JUSTIFY "left"
+#define DEF_MENUBUTTON_MENU ""
+#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 panedwindows
+ */
+
+#define DEF_PANEDWINDOW_BG_COLOR NORMAL_BG
+#define DEF_PANEDWINDOW_BG_MONO WHITE
+#define DEF_PANEDWINDOW_BORDERWIDTH "2"
+#define DEF_PANEDWINDOW_CURSOR ""
+#define DEF_PANEDWINDOW_HANDLEPAD "8"
+#define DEF_PANEDWINDOW_HANDLESIZE "8"
+#define DEF_PANEDWINDOW_HEIGHT ""
+#define DEF_PANEDWINDOW_OPAQUERESIZE "0"
+#define DEF_PANEDWINDOW_ORIENT "horizontal"
+#define DEF_PANEDWINDOW_RELIEF "flat"
+#define DEF_PANEDWINDOW_SASHCURSOR ""
+#define DEF_PANEDWINDOW_SASHPAD "2"
+#define DEF_PANEDWINDOW_SASHRELIEF "raised"
+#define DEF_PANEDWINDOW_SASHWIDTH "2"
+#define DEF_PANEDWINDOW_SHOWHANDLE "1"
+#define DEF_PANEDWINDOW_WIDTH ""
+
+/*
+ * Defaults for panedwindow panes
+ */
+
+#define DEF_PANEDWINDOW_PANE_AFTER ""
+#define DEF_PANEDWINDOW_PANE_BEFORE ""
+#define DEF_PANEDWINDOW_PANE_HEIGHT ""
+#define DEF_PANEDWINDOW_PANE_MINSIZE "0"
+#define DEF_PANEDWINDOW_PANE_PADX "0"
+#define DEF_PANEDWINDOW_PANE_PADY "0"
+#define DEF_PANEDWINDOW_PANE_STICKY "nsew"
+#define DEF_PANEDWINDOW_PANE_WIDTH ""
+
+/*
+ * 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_COLOR DEF_SCALE_BG_COLOR
+#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO
+#define DEF_SCALE_HIGHLIGHT BLACK
+#define DEF_SCALE_HIGHLIGHT_WIDTH "0"
+#define DEF_SCALE_LABEL ""
+#define DEF_SCALE_LENGTH "100"
+#define DEF_SCALE_ORIENT "vertical"
+#define DEF_SCALE_RELIEF "flat"
+#define DEF_SCALE_REPEAT_DELAY "300"
+#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_AUTO_SEPARATORS "1"
+#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_MAX_UNDO "0"
+#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_UNDO "0"
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+
+/*
+ * 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 ""
+#define DEF_TOPLEVEL_USE ""
+
+#endif /* _TKMACDEFAULT */
diff --git a/tcl/macosx/tkMacOSXDialog.c b/tcl/macosx/tkMacOSXDialog.c
new file mode 100644
index 00000000000..281461ee737
--- /dev/null
+++ b/tcl/macosx/tkMacOSXDialog.c
@@ -0,0 +1,1229 @@
+/*
+ * tkMacOSXDialog.c --
+ *
+ * Contains the Mac implementation of the common dialog boxes.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 <Carbon/Carbon.h>
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkMacOSXUtil.h"
+#include "tkMacOSXInt.h"
+#include "tkFileFilter.h"
+
+#ifndef StrLength
+#define StrLength(s) (*((unsigned char *) (s)))
+#endif
+#ifndef StrBody
+#define StrBody(s) ((char *) (s) + 1)
+#endif
+
+/*
+ * The following are ID's for resources that are defined in tkMacOSXResource.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 CHOOSE_FOLDER 2
+
+#define MATCHED 0
+#define UNMATCHED 1
+
+#define TK_DEFAULT_ABOUT 128
+
+/*
+ * The following structure is used in the GetFileName() function. It stored
+ * information about the file dialog and the file filters.
+ */
+typedef struct _OpenFileData {
+ FileFilterList fl; /* List of file filters. */
+ SInt16 curType; /* The filetype currently being
+ * listed. */
+ short popupItem; /* Item number of the popup in the
+ * dialog. */
+ int usePopup; /* True if we show the popup menu (this
+ * is an open operation and the
+ * -filetypes option is set). */
+} OpenFileData;
+
+
+static Boolean MatchOneType _ANSI_ARGS_((StringPtr fileNamePtr, OSType fileType,
+ OpenFileData *myofdPtr, FileFilter *filterPtr));
+static pascal Boolean OpenFileFilterProc(AEDesc* theItem, void* info,
+ NavCallBackUserData callBackUD,
+ NavFilterModes filterMode );
+pascal void OpenEventProc(NavEventCallbackMessage callBackSelector,
+ NavCBRecPtr callBackParms,
+ NavCallBackUserData callBackUD );
+static void InitFileDialogs();
+static int NavServicesGetFile(Tcl_Interp *interp, OpenFileData *ofd,
+ AEDesc *initialDescPtr,
+ unsigned char *initialFile, AEDescList *selectDescPtr,
+ StringPtr title, StringPtr message, int multiple, int isOpen);
+static int HandleInitialDirectory (Tcl_Interp *interp,
+ char *initialFile, char *initialDir,
+ FSRef *dirRef,
+ AEDescList *selectDescPtr,
+ AEDesc *dirDescPtr);
+
+/*
+ * Have we initialized the file dialog subsystem
+ */
+
+static int fileDlgInited = 0;
+
+/*
+ * Filter and hook functions used by the tk_getOpenFile and tk_getSaveFile
+ * commands.
+ */
+
+NavObjectFilterUPP openFileFilterUPP;
+NavEventUPP openFileEventUPP;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseColorObjCmd --
+ *
+ * This procedure implements the color dialog box for the Mac
+ * platform. See the user documentation for details on what it
+ * does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseColorObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
+{
+ Tk_Window parent;
+ char *title;
+ int i, picked, srcRead, dstWrote;
+ ColorPickerInfo cpinfo;
+ static int inited = 0;
+ static RGBColor in;
+ static CONST char *optionStrings[] = {
+ "-initialcolor", "-parent", "-title", NULL
+ };
+ enum options {
+ COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
+ };
+
+ if (inited == 0) {
+ /*
+ * 'in' stores the last color picked. The next time the color dialog
+ * pops up, the last color will remain in the dialog.
+ */
+
+ in.red = 0xffff;
+ in.green = 0xffff;
+ in.blue = 0xffff;
+ inited = 1;
+ }
+
+ parent = (Tk_Window) clientData;
+ title = "Choose a color:";
+ picked = 0;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *option, *value;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ option = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", option, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ value = Tcl_GetStringFromObj(objv[i + 1], NULL);
+
+ switch ((enum options) index) {
+ case COLOR_INITIAL: {
+ XColor *colorPtr;
+
+ colorPtr = Tk_GetColor(interp, parent, value);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ in.red = colorPtr->red;
+ in.green = colorPtr->green;
+ in.blue = colorPtr->blue;
+ Tk_FreeColor(colorPtr);
+ break;
+ }
+ case COLOR_PARENT: {
+ parent = Tk_NameToWindow(interp, value, parent);
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case COLOR_TITLE: {
+ title = value;
+ break;
+ }
+ }
+ }
+
+
+ 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 = kColorPickerCanModifyPalette
+ | kColorPickerCanAnimatePalette;
+ cpinfo.placeWhere = kDeepestColorScreen;
+ cpinfo.pickerType = 0L;
+ cpinfo.eventProc = NULL;
+ cpinfo.colorProc = NULL;
+ cpinfo.colorProcData = NULL;
+
+ /* This doesn't seem to actually set the title! */
+ Tcl_UtfToExternal(NULL, NULL, title, -1, 0, NULL,
+ StrBody(cpinfo.prompt), 255, &srcRead, &dstWrote, NULL);
+ StrLength(cpinfo.prompt) = (unsigned char) dstWrote;
+
+ if ((PickColor(&cpinfo) == noErr) && (cpinfo.newColorChosen != 0)) {
+ in.red = cpinfo.theColor.color.rgb.red;
+ in.green = cpinfo.theColor.color.rgb.green;
+ in.blue = cpinfo.theColor.color.rgb.blue;
+ picked = 1;
+ }
+
+ if (picked != 0) {
+ char result[32];
+
+ sprintf(result, "#%02x%02x%02x", in.red >> 8, in.green >> 8,
+ in.blue >> 8);
+ Tcl_AppendResult(interp, result, NULL);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOpenFileObjCmd --
+ *
+ * This procedure implements the "open file" dialog box for the
+ * Mac platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See user documentation.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetOpenFileObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
+{
+ int i, result, multiple;
+ OpenFileData ofd;
+ Tk_Window parent;
+ Str255 message, title;
+ AEDesc initialDesc = {typeNull, NULL};
+ FSRef dirRef;
+ AEDesc *initialPtr = NULL;
+ AEDescList selectDesc = {typeNull, NULL};
+ char *initialFile = NULL, *initialDir = NULL;
+ static CONST char *openOptionStrings[] = {
+ "-defaultextension", "-filetypes",
+ "-initialdir", "-initialfile",
+ "-message", "-multiple",
+ "-parent", "-title", NULL
+ };
+ enum openOptions {
+ OPEN_DEFAULT, OPEN_FILETYPES,
+ OPEN_INITDIR, OPEN_INITFILE,
+ OPEN_MESSAGE, OPEN_MULTIPLE,
+ OPEN_PARENT, OPEN_TITLE
+ };
+
+ if (!fileDlgInited) {
+ InitFileDialogs();
+ }
+
+ result = TCL_ERROR;
+ parent = (Tk_Window) clientData;
+ multiple = false;
+ title[0] = 0;
+ message[0] = 0;
+
+ TkInitFileFilters(&ofd.fl);
+
+ ofd.curType = 0;
+ ofd.popupItem = OPEN_POPUP_ITEM;
+ ofd.usePopup = 1;
+
+ for (i = 1; i < objc; i += 2) {
+ char *choice;
+ int index, choiceLen;
+ char *string;
+ int srcRead, dstWrote;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], openOptionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto end;
+ }
+
+ switch (index) {
+ case OPEN_DEFAULT:
+ break;
+ case OPEN_FILETYPES:
+ choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ if (TkGetFileFilters(interp, &ofd.fl, choice, 0)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case OPEN_INITDIR:
+ initialDir = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ break;
+ case OPEN_INITFILE:
+ initialFile = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ break;
+ case OPEN_MESSAGE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, choice, choiceLen,
+ 0, NULL, StrBody(message), 255,
+ &srcRead, &dstWrote, NULL);
+ message[0] = dstWrote;
+ break;
+ case OPEN_MULTIPLE:
+ if (Tcl_GetBooleanFromObj(interp, objv[i + 1], &multiple)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case OPEN_PARENT:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ parent = Tk_NameToWindow(interp, choice, parent);
+ if (parent == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case OPEN_TITLE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, choice, choiceLen,
+ 0, NULL, StrBody(title), 255,
+ &srcRead, &dstWrote, NULL);
+ title[0] = dstWrote;
+ break;
+ }
+ }
+
+ if (HandleInitialDirectory(interp, initialFile, initialDir, &dirRef,
+ &selectDesc, &initialDesc) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+
+ if (initialDesc.descriptorType == typeFSRef) {
+ initialPtr = &initialDesc;
+ }
+ result = NavServicesGetFile(interp, &ofd, initialPtr,
+ NULL, &selectDesc,
+ title, message, multiple, OPEN_FILE);
+
+ end:
+ TkFreeFileFilters(&ofd.fl);
+ AEDisposeDesc(&initialDesc);
+ AEDisposeDesc(&selectDesc);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetSaveFileObjCmd --
+ *
+ * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
+ * instead
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See user documentation.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetSaveFileObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
+{
+ int i, result;
+ Str255 initialFile;
+ Tk_Window parent;
+ AEDesc initialDesc = {typeNull, NULL};
+ AEDesc *initialPtr = NULL;
+ FSRef dirRef;
+ Str255 title, message;
+ OpenFileData ofd;
+ static CONST char *saveOptionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-message", "-parent", "-title", NULL
+ };
+ enum saveOptions {
+ SAVE_DEFAULT, SAVE_FILETYPES, SAVE_INITDIR, SAVE_INITFILE,
+ SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE
+ };
+
+ if (!fileDlgInited) {
+ InitFileDialogs();
+ }
+
+ result = TCL_ERROR;
+ parent = (Tk_Window) clientData;
+ StrLength(initialFile) = 0;
+ title[0] = 0;
+ message[0] = 0;
+
+ for (i = 1; i < objc; i += 2) {
+ char *choice;
+ int index, choiceLen;
+ char *string;
+ Tcl_DString ds;
+ int srcRead, dstWrote;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], saveOptionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case SAVE_DEFAULT:
+ break;
+ case SAVE_FILETYPES:
+ /* Currently unimplemented - what would we do here anyway? */
+ break;
+ case SAVE_INITDIR:
+ choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ if (HandleInitialDirectory(interp, NULL, choice, &dirRef,
+ NULL, &initialDesc) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case SAVE_INITFILE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ if (Tcl_TranslateFileName(interp, choice, &ds) == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL,
+ StrBody(initialFile), 255, &srcRead, &dstWrote, NULL);
+ StrLength(initialFile) = (unsigned char) dstWrote;
+ Tcl_DStringFree(&ds);
+ break;
+ case SAVE_MESSAGE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, choice, choiceLen,
+ 0, NULL, StrBody(message), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(message) = (unsigned char) dstWrote;
+ break;
+ case SAVE_PARENT:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ parent = Tk_NameToWindow(interp, choice, parent);
+ if (parent == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case SAVE_TITLE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, choice, choiceLen,
+ 0, NULL, StrBody(title), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(title) = (unsigned char) dstWrote;
+ break;
+ }
+ }
+
+ TkInitFileFilters(&ofd.fl);
+ ofd.usePopup = 0;
+
+ if (initialDesc.descriptorType == typeFSRef) {
+ initialPtr = &initialDesc;
+ }
+ result = NavServicesGetFile(interp, &ofd, initialPtr, initialFile, NULL,
+ title, message, false, SAVE_FILE);
+
+ end:
+
+ AEDisposeDesc(&initialDesc);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseDirectoryObjCmd --
+ *
+ * This procedure implements the "tk_chooseDirectory" dialog box
+ * for the Windows platform. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A modal dialog window is created. Tcl_SetServiceMode() is
+ * called to allow background events to be processed
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int i, result;
+ Tk_Window parent;
+ AEDesc initialDesc = {typeNull, NULL};
+ AEDesc *initialPtr = NULL;
+ FSRef dirRef;
+ Str255 message, title;
+ int srcRead, dstWrote;
+ OpenFileData ofd;
+ static CONST char *chooseOptionStrings[] = {
+ "-initialdir", "-message", "-mustexist", "-parent", "-title", NULL
+ };
+ enum chooseOptions {
+ CHOOSE_INITDIR, CHOOSE_MESSAGE, CHOOSE_MUSTEXIST,
+ CHOOSE_PARENT, CHOOSE_TITLE
+ };
+
+
+ if (!NavServicesAvailable()) {
+ return TCL_ERROR;
+ }
+
+ if (!fileDlgInited) {
+ InitFileDialogs();
+ }
+ result = TCL_ERROR;
+ parent = (Tk_Window) clientData;
+ title[0] = 0;
+ message[0] = 0;
+
+ for (i = 1; i < objc; i += 2) {
+ char *choice;
+ int index, choiceLen;
+ char *string;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], chooseOptionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case CHOOSE_INITDIR:
+ choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
+ if (HandleInitialDirectory(interp, NULL, choice, &dirRef,
+ NULL, &initialDesc) != TCL_OK) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case CHOOSE_MESSAGE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, choice, choiceLen,
+ 0, NULL, StrBody(message), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(message) = (unsigned char) dstWrote;
+ break;
+ case CHOOSE_PARENT:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ parent = Tk_NameToWindow(interp, choice, parent);
+ if (parent == NULL) {
+ result = TCL_ERROR;
+ goto end;
+ }
+ break;
+ case CHOOSE_TITLE:
+ choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, choice, choiceLen,
+ 0, NULL, StrBody(title), 255,
+ &srcRead, &dstWrote, NULL);
+ StrLength(title) = (unsigned char) dstWrote;
+ break;
+ }
+ }
+
+ TkInitFileFilters(&ofd.fl);
+ ofd.usePopup = 0;
+
+
+ if (initialDesc.descriptorType == typeFSRef) {
+ initialPtr = &initialDesc;
+ }
+ result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, NULL,
+ title, message, false, CHOOSE_FOLDER);
+
+ end:
+ AEDisposeDesc(&initialDesc);
+
+ return result;
+}
+
+int
+HandleInitialDirectory (
+ Tcl_Interp *interp,
+ char *initialFile,
+ char *initialDir,
+ FSRef *dirRef,
+ AEDescList *selectDescPtr,
+ AEDesc *dirDescPtr)
+{
+ Tcl_DString ds;
+ OSErr err;
+ Boolean isDirectory;
+ char *dirName = NULL;
+ int result = TCL_OK;
+
+ if (initialDir != NULL) {
+ dirName = Tcl_TranslateFileName(interp, initialDir, &ds);
+ if (dirName == NULL) {
+ return TCL_ERROR;
+ }
+
+ err = FSPathMakeRef(dirName,
+ dirRef, &isDirectory);
+
+ if (err != noErr) {
+ Tcl_AppendResult(interp, "bad directory \"",
+ initialDir, "\"", NULL);
+ result = TCL_ERROR;
+ goto end;
+ }
+ if (!isDirectory) {
+ Tcl_AppendResult(interp, "-intialdir \"",
+ initialDir, " is a file, not a directory.\"", NULL);
+ result = TCL_ERROR;
+ goto end;
+ }
+
+ AECreateDesc(typeFSRef, dirRef, sizeof(*dirRef), dirDescPtr);
+ }
+
+ if (initialFile != NULL && selectDescPtr != NULL) {
+ FSRef fileRef;
+ AEDesc fileDesc;
+ char *namePtr;
+
+ if (initialDir != NULL) {
+ Tcl_DStringAppend(&ds, "/", 1);
+ Tcl_DStringAppend(&ds, initialFile, -1);
+ namePtr = Tcl_DStringValue(&ds);
+ } else {
+ namePtr = initialFile;
+ }
+
+ AECreateList(NULL, 0, false, selectDescPtr);
+
+ err = FSPathMakeRef(namePtr, &fileRef, &isDirectory);
+ if (err != noErr) {
+ Tcl_AppendResult(interp, "bad initialfile \"", initialFile,
+ "\" file does not exist.", NULL);
+ return TCL_ERROR;
+ }
+ AECreateDesc(typeFSRef, &fileRef, sizeof(fileRef), &fileDesc);
+ AEPutDesc(selectDescPtr, 1, &fileDesc);
+ AEDisposeDesc(&fileDesc);
+ }
+
+end:
+ if (dirName != NULL) {
+ Tcl_DStringFree(&ds);
+ }
+ return result;
+}
+
+static void
+InitFileDialogs()
+{
+ fileDlgInited = 1;
+ openFileFilterUPP = NewNavObjectFilterUPP(OpenFileFilterProc);
+ openFileEventUPP = NewNavEventUPP(OpenEventProc);
+}
+
+static int
+NavServicesGetFile(
+ Tcl_Interp *interp,
+ OpenFileData *ofdPtr,
+ AEDesc *initialDescPtr,
+ unsigned char *initialFile,
+ AEDescList *selectDescPtr,
+ StringPtr title,
+ StringPtr message,
+ int multiple,
+ int isOpen)
+{
+ NavReplyRecord theReply;
+ NavDialogCreationOptions diagOptions;
+ NavDialogRef dialogRef = NULL;
+ CFStringRef * menuItemNames = NULL;
+ OSErr err;
+ Tcl_Obj *theResult = NULL;
+ int result;
+ TextEncoding encoding;
+
+ encoding = GetApplicationTextEncoding();
+ err = NavGetDefaultDialogCreationOptions(&diagOptions);
+ if (err!=noErr) {
+ return TCL_ERROR;
+ }
+ diagOptions.location.h = -1;
+ diagOptions.location.v = -1;
+ diagOptions.optionFlags = kNavDontAutoTranslate
+ + kNavDontAddTranslateItems;
+
+ if (multiple) {
+ diagOptions.optionFlags += kNavAllowMultipleFiles;
+ }
+
+ if (ofdPtr != NULL && ofdPtr->usePopup) {
+ FileFilter *filterPtr;
+
+ filterPtr = ofdPtr->fl.filters;
+ if (filterPtr == NULL) {
+ ofdPtr->usePopup = 0;
+ }
+ }
+
+ if (ofdPtr != NULL && ofdPtr->usePopup) {
+ FileFilter *filterPtr;
+ int index = 0;
+ ofdPtr->curType = 0;
+
+ menuItemNames = (CFStringRef *)ckalloc(ofdPtr->fl.numFilters
+ * sizeof(CFStringRef));
+
+ for (filterPtr = ofdPtr->fl.filters; filterPtr != NULL;
+ filterPtr = filterPtr->next, index++) {
+ menuItemNames[index] = CFStringCreateWithCString(NULL,
+ filterPtr->name, encoding);
+ }
+ diagOptions.popupExtension = CFArrayCreate(NULL,
+ (const void **)menuItemNames, ofdPtr->fl.numFilters, NULL);;
+ } else {
+ diagOptions.optionFlags += kNavNoTypePopup;
+ diagOptions.popupExtension = NULL;
+ }
+
+ /*
+ * This is required to allow App packages to be selectable in the
+ * file dialogs...
+ */
+
+ diagOptions.optionFlags += kNavSupportPackages;
+
+ diagOptions.clientName = CFStringCreateWithCString(NULL, "Wish", encoding);
+ if (message == NULL) {
+ diagOptions.message = NULL;
+ } else {
+ diagOptions.message = CFStringCreateWithPascalString(NULL, message, encoding);
+ }
+ if ((initialFile != NULL) && (initialFile[0] != 0)) {
+ diagOptions.saveFileName = CFStringCreateWithPascalString(NULL,
+ initialFile, encoding);
+ } else {
+ diagOptions.saveFileName = NULL;
+ }
+ if (title == NULL) {
+ diagOptions.windowTitle = NULL;
+ } else {
+ diagOptions.windowTitle = CFStringCreateWithPascalString(NULL, title, encoding);
+ }
+
+ diagOptions.actionButtonLabel = NULL;
+ diagOptions.cancelButtonLabel = NULL;
+ diagOptions.preferenceKey = 0;
+
+ /*
+ * Now process the selection list. We have to use the popupExtension
+ * to fill the menu.
+ */
+
+ if (isOpen == OPEN_FILE) {
+ err = NavCreateGetFileDialog(&diagOptions,
+ NULL,
+ openFileEventUPP,
+ NULL,
+ openFileFilterUPP,
+ ofdPtr,
+ &dialogRef);
+ if (err!=noErr){
+ fprintf(stderr,"NavCreateGetFileDialog failed, %d\n", err );
+ dialogRef = NULL;
+ }
+ } else if (isOpen == SAVE_FILE) {
+ err = NavCreatePutFileDialog(&diagOptions, 'TEXT', 'WIsH',
+ openFileEventUPP, NULL, &dialogRef);
+ if (err!=noErr){
+ fprintf(stderr,"NavCreatePutFileDialog failed, %d\n", err );
+ dialogRef = NULL;
+ }
+ } else if (isOpen == CHOOSE_FOLDER) {
+ err = NavCreateChooseFolderDialog(&diagOptions, openFileEventUPP,
+ openFileFilterUPP, NULL, &dialogRef);
+ if (err!=noErr){
+ fprintf(stderr,"NavCreateChooseFolderDialog failed, %d\n", err );
+ dialogRef = NULL;
+ }
+ }
+
+ if (dialogRef) {
+ if (initialDescPtr != NULL) {
+ NavCustomControl (dialogRef, kNavCtlSetLocation, initialDescPtr);
+ }
+ if ((selectDescPtr != NULL)
+ && (selectDescPtr->descriptorType != typeNull)) {
+ NavCustomControl(dialogRef, kNavCtlSetSelection, &selectDescPtr);
+ }
+
+ if ((err = NavDialogRun(dialogRef)) != noErr ){
+ fprintf(stderr,"NavDialogRun failed, %d\n", err );
+ } else {
+ if ((err = NavDialogGetReply(dialogRef, &theReply)) != noErr) {
+ fprintf(stderr,"NavGetReply failed, %d\n", err );
+ }
+ }
+ }
+
+ /*
+ * Most commands assume that the file dialogs return a single
+ * item, not a list. So only build a list if multiple is true...
+ */
+ if (err==noErr) {
+ if (multiple) {
+ theResult = Tcl_NewListObj(0, NULL);
+ } else {
+ theResult = Tcl_NewObj();
+ }
+ if (!theResult) {
+ err = memFullErr;
+ }
+ }
+ if (theReply.validRecord && err==noErr) {
+ AEDesc resultDesc;
+ long count;
+ Tcl_DString fileName;
+ FSRef fsRef;
+ char pathPtr[1024];
+ int pathValid = 0;
+ err = AECountItems(&theReply.selection, &count);
+ if (err == noErr) {
+ long i;
+ for (i = 1; i <= count; i++ ) {
+ err = AEGetNthDesc(&theReply.selection,
+ i, typeFSRef, NULL, &resultDesc);
+ pathValid = 0;
+ if (err == noErr) {
+ if ((err = AEGetDescData(&resultDesc, &fsRef, sizeof(fsRef)))
+ != noErr ) {
+ fprintf(stderr,"AEGetDescData failed %d\n", err );
+ } else {
+ if (err = FSRefMakePath(&fsRef, pathPtr, 1024) ) {
+ fprintf(stderr,"FSRefMakePath failed, %d\n", err );
+ } else {
+ if (isOpen == SAVE_FILE) {
+ CFStringRef saveNameRef;
+ char saveName [1024];
+ if (saveNameRef = NavDialogGetSaveFileName(dialogRef)) {
+ if (CFStringGetCString(saveNameRef, saveName,
+ 1024, encoding)) {
+ strcat(pathPtr, "/");
+ strcat(pathPtr, saveName);
+ pathValid = 1;
+ } else {
+ fprintf(stderr, "CFStringGetCString failed\n");
+ }
+ } else {
+ fprintf(stderr, "NavDialogGetSaveFileName failed\n");
+ }
+ } else {
+ pathValid = 1;
+ }
+ if (pathValid) {
+ /*
+ * Tested this and NULL=utf-8 encoding is
+ * good here
+ */
+ Tcl_ExternalToUtfDString(NULL, pathPtr, -1,
+ &fileName);
+ if (multiple) {
+ Tcl_ListObjAppendElement(interp, theResult,
+ Tcl_NewStringObj(Tcl_DStringValue(&fileName),
+ Tcl_DStringLength(&fileName)));
+ } else {
+ Tcl_SetStringObj(theResult, Tcl_DStringValue(&fileName),
+ Tcl_DStringLength(&fileName));
+ }
+ Tcl_DStringFree(&fileName);
+ }
+ }
+ }
+ AEDisposeDesc(&resultDesc);
+ }
+ }
+ }
+ err = NavDisposeReply(&theReply);
+ Tcl_SetObjResult(interp, theResult);
+ result = TCL_OK;
+ } else if (err == userCanceledErr) {
+ result = TCL_OK;
+ } else {
+ result = TCL_ERROR;
+ }
+
+ /*
+ * Clean up any allocated strings
+ * dispose of things in reverse order of creation
+ */
+
+ if (diagOptions.windowTitle) {
+ CFRelease(diagOptions.windowTitle);
+ }
+ if (diagOptions.saveFileName) {
+ CFRelease(diagOptions.saveFileName);
+ }
+ if (diagOptions.message) {
+ CFRelease(diagOptions.message);
+ }
+ if (diagOptions.clientName) {
+ CFRelease(diagOptions.clientName);
+ }
+ /*
+ * dispose of the CFArray diagOptions.popupExtension
+ */
+
+ if (menuItemNames) {
+ int i;
+ for (i=0;i < ofdPtr->fl.numFilters;i++) {
+ CFRelease(menuItemNames[i]);
+ }
+ ckfree((void *)menuItemNames);
+ }
+ if (diagOptions.popupExtension != NULL) {
+ CFRelease(diagOptions.popupExtension);
+ }
+
+ return result;
+}
+
+static pascal Boolean
+OpenFileFilterProc(
+ AEDesc* theItem, void* info,
+ NavCallBackUserData callBackUD,
+ NavFilterModes filterMode )
+{
+ OpenFileData *ofdPtr = (OpenFileData *) callBackUD;
+ if (!ofdPtr || !ofdPtr->usePopup) {
+ return true;
+ } else {
+ if (ofdPtr->fl.numFilters == 0) {
+ return true;
+ } else {
+
+ if ( theItem->descriptorType == typeFSS ) {
+ NavFileOrFolderInfo* theInfo = (NavFileOrFolderInfo*)info;
+ int result;
+
+ if ( !theInfo->isFolder ) {
+ OSType fileType;
+ StringPtr fileNamePtr;
+ int i;
+ FileFilter *filterPtr;
+
+ fileType = theInfo->fileAndFolder.fileInfo.finderInfo.fdType;
+ HLock((Handle)theItem->dataHandle);
+ fileNamePtr = (((FSSpec *) *theItem->dataHandle)->name);
+
+ if (ofdPtr->usePopup) {
+ i = ofdPtr->curType;
+ for (filterPtr = ofdPtr->fl.filters; filterPtr && i > 0; i--) {
+ filterPtr = filterPtr->next;
+ }
+ if (filterPtr) {
+ result = MatchOneType(fileNamePtr, fileType,
+ ofdPtr, filterPtr);
+ } else {
+ result = false;
+ }
+ } else {
+ /*
+ * We are not using the popup menu. In this case, the file is
+ * considered matched if it matches any of the file filters.
+ */
+ result = UNMATCHED;
+ for (filterPtr = ofdPtr->fl.filters; filterPtr;
+ filterPtr = filterPtr->next) {
+ if (MatchOneType(fileNamePtr, fileType,
+ ofdPtr, filterPtr) == MATCHED) {
+ result = MATCHED;
+ break;
+ }
+ }
+ }
+
+ HUnlock((Handle)theItem->dataHandle);
+ return (result == MATCHED);
+ } else {
+ return true;
+ }
+ }
+ }
+
+ return true;
+ }
+}
+
+pascal void
+OpenEventProc(
+ NavEventCallbackMessage callBackSelector,
+ NavCBRecPtr callBackParams,
+ NavCallBackUserData callBackUD )
+{
+ NavMenuItemSpec *chosenItem;
+ OpenFileData *ofd = (OpenFileData *) callBackUD;
+ static SInt32 otherEvent = ~(kNavCBCustomize|kNavCBStart|kNavCBTerminate
+ |kNavCBNewLocation|kNavCBShowDesktop|kNavCBSelectEntry|kNavCBAccept
+ |kNavCBCancel|kNavCBAdjustPreview);
+
+ if (callBackSelector == kNavCBPopupMenuSelect) {
+ chosenItem = (NavMenuItemSpec *) callBackParams->eventData.eventDataParms.param;
+ ofd->curType = chosenItem->menuType;
+ } else if (callBackSelector == kNavCBAdjustRect
+ || callBackSelector & otherEvent != 0) {
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS
+ | TCL_DONT_WAIT
+ | TCL_WINDOW_EVENTS)) {
+ /* Empty Body */
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ StringPtr fileNamePtr, /* Name of the file */
+ OSType fileType, /* Type of the file */
+ OpenFileData * ofdPtr, /* Information about this file dialog */
+ FileFilter * filterPtr) /* Match the file described by pb against
+ * this filter */
+{
+ FileFilterClause * clausePtr;
+
+ /*
+ * A file matches with a file type if it matches with at least one
+ * 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 (fileNamePtr == NULL) {
+ continue;
+ }
+ p = (char*)(fileNamePtr);
+ 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 (fileType == mfPtr->type) {
+ macMatched = 1;
+ break;
+ }
+ }
+
+ if (globMatched && macMatched) {
+ return MATCHED;
+ }
+ }
+
+ return UNMATCHED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ WindowRef windowRef;
+ short itemHit = -9;
+
+ aboutDlog = GetNewDialog(128, NULL, (void *) (-1));
+
+ if (!aboutDlog) {
+ return;
+ }
+
+ windowRef=GetDialogWindow(aboutDlog);
+ SelectWindow(windowRef);
+
+ while (itemHit != 1) {
+ ModalDialog( NULL, &itemHit);
+ }
+ DisposeDialog(aboutDlog);
+ aboutDlog = NULL;
+
+ SelectWindow(FrontNonFloatingWindow());
+
+ return;
+}
diff --git a/tcl/macosx/tkMacOSXDraw.c b/tcl/macosx/tkMacOSXDraw.c
new file mode 100644
index 00000000000..41f90e35036
--- /dev/null
+++ b/tcl/macosx/tkMacOSXDraw.c
@@ -0,0 +1,1714 @@
+/*
+ * tkMacOSXDraw.c --
+ *
+ * This file contains functions that perform drawing to
+ * Xlib windows. Most of the functions simple emulate
+ * Xlib functions.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "X11/X.h"
+#include "X11/Xlib.h"
+#include <stdio.h>
+
+#include <Carbon/Carbon.h>
+#include "tkMacOSXInt.h"
+#include "tkPort.h"
+#include "tkMacOSXDebug.h"
+
+#ifndef PI
+# define PI 3.14159265358979323846
+#endif
+#define RGBFLOATRED( c ) (float)((float)(c.red) / 65535.0)
+#define RGBFLOATGREEN( c ) (float)((float)(c.green) / 65535.0)
+#define RGBFLOATBLUE( c ) (float)((float)(c.blue) / 65535.0)
+
+/*
+ * Temporary regions that can be reused.
+ */
+
+static RgnHandle tmpRgn = NULL;
+static RgnHandle tmpRgn2 = NULL;
+
+static PixPatHandle gPenPat = NULL;
+
+static int useCGDrawing = 0;
+
+/*
+ * Prototypes for functions used only in this file.
+ */
+static unsigned char InvertByte _ANSI_ARGS_((unsigned char data));
+
+void TkMacOSXSetUpCGContext(MacDrawable *macWin,
+ CGrafPtr destPort, GC gc, CGContextRef *contextPtr);
+void TkMacOSXReleaseCGContext(MacDrawable *macWin, CGrafPtr destPort,
+ CGContextRef *context);
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 dst, /* 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, dstRect;
+ Rect * srcPtr, * dstPtr;
+ const BitMap * srcBit;
+ const BitMap * dstBit;
+ MacDrawable *srcDraw = (MacDrawable *) src;
+ MacDrawable *dstDraw = (MacDrawable *) dst;
+ CGrafPtr srcPort, dstPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ short tmode;
+ RGBColor origForeColor, origBackColor, whiteColor, blackColor;
+ Rect clpRect;
+
+ dstPort = TkMacOSXGetDrawablePort(dst);
+ srcPort = TkMacOSXGetDrawablePort(src);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(dstPort, 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);
+
+ if (tmpRgn2 == NULL) {
+ tmpRgn2 = NewRgn();
+ }
+ srcPtr = &srcRect;
+ SetRect(&srcRect, (short) (srcDraw->xOff + src_x),
+ (short) (srcDraw->yOff + src_y),
+ (short) (srcDraw->xOff + src_x + width ),
+ (short) (srcDraw->yOff + src_y + height));
+ if (tkPictureIsOpen ) {
+ dstPtr = &srcRect;
+ } else {
+ dstPtr = &dstRect;
+ SetRect(&dstRect, (short) (dstDraw->xOff + dest_x),
+ (short) (dstDraw->yOff + dest_y),
+ (short) (dstDraw->xOff + dest_x + width ),
+ (short) (dstDraw->yOff + dest_y + height));
+ }
+ TkMacOSXSetUpClippingRgn(dst);
+ /*
+ * We will change the clip rgn in this routine, so we need to
+ * be able to restore it when we exit.
+ */
+
+ GetClip(tmpRgn2);
+ if (tkPictureIsOpen) {
+ /*
+ * When rendering into a picture, after a call to "OpenCPicture"
+ * the clipping is seriously WRONG and also INCONSISTENT with the
+ * clipping for single plane bitmaps.
+ * To circumvent this problem, we clip to the whole window
+ * In this case, would have also clipped to the srcRect
+ * ClipRect(&srcRect);
+ */
+ GetPortBounds(dstPort,&clpRect);
+ dstPtr = &srcRect;
+ ClipRect(&clpRect);
+ }
+ if (!gc->clip_mask ) {
+ } else 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();
+ }
+ if (!tkPictureIsOpen) {
+ xOffset = dstDraw->xOff + gc->clip_x_origin;
+ yOffset = dstDraw->yOff + gc->clip_y_origin;
+ OffsetRgn(clipRgn, xOffset, yOffset);
+ }
+ GetClip(tmpRgn);
+ SectRgn(tmpRgn, clipRgn, tmpRgn);
+ SetClip(tmpRgn);
+ if (!tkPictureIsOpen) {
+ OffsetRgn(clipRgn, -xOffset, -yOffset);
+ }
+ }
+ srcBit = GetPortBitMapForCopyBits( srcPort );
+ dstBit = GetPortBitMapForCopyBits( dstPort );
+ tmode = srcCopy;
+
+ CopyBits(srcBit, dstBit, srcPtr, dstPtr, 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 dst, /* 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, dstRect;
+ Rect * srcPtr, * dstPtr;
+ const BitMap * srcBit;
+ const BitMap * dstBit;
+ const BitMap * mskBit;
+ MacDrawable *srcDraw = (MacDrawable *) src;
+ MacDrawable *dstDraw = (MacDrawable *) dst;
+ GWorldPtr srcPort, dstPort, mskPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ RGBColor macColor;
+ TkpClipMask *clipPtr = (TkpClipMask*)gc->clip_mask;
+ short tmode;
+
+ srcPort = TkMacOSXGetDrawablePort(src);
+ dstPort = TkMacOSXGetDrawablePort(dst);
+
+ if (tmpRgn == NULL) {
+ tmpRgn = NewRgn();
+ }
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(dstPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(dst);
+
+
+ srcBit = GetPortBitMapForCopyBits ( srcPort );
+ dstBit = GetPortBitMapForCopyBits ( dstPort );
+ SetRect(&srcRect, (short) (srcDraw->xOff + src_x),
+ (short) (srcDraw->yOff + src_y),
+ (short) (srcDraw->xOff + src_x + width),
+ (short) (srcDraw->yOff + src_y + height));
+ srcPtr = &srcRect;
+ if (tkPictureIsOpen) {
+ /*
+ * When rendering into a picture, after a call to "OpenCPicture"
+ * the clipping is seriously WRONG and also INCONSISTENT with the
+ * clipping for color bitmaps.
+ * To circumvent this problem, we clip to the whole window
+ */
+ Rect clpRect;
+ GetPortBounds(dstPort,&clpRect);
+ ClipRect(&clpRect);
+ dstPtr = &srcRect;
+ } else {
+ dstPtr = &dstRect;
+ SetRect(&dstRect, (short) (dstDraw->xOff + dest_x),
+ (short) (dstDraw->yOff + dest_y),
+ (short) (dstDraw->xOff + dest_x + width),
+ (short) (dstDraw->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, dstBit, srcPtr, dstPtr, tmode, NULL);
+ } else if (clipPtr->type == TKP_CLIP_PIXMAP) {
+ if (clipPtr->value.pixmap == src) {
+ PixMapHandle pm;
+ /*
+ * Case 2: transparent bitmaps. If it's color we ignore
+ * the forecolor.
+ */
+ pm=GetPortPixMap(srcPort);
+ if (GetPixDepth(pm)== 1) {
+ tmode = srcOr;
+ } else {
+ tmode = transparent;
+ }
+ CopyBits(srcBit, dstBit, srcPtr, dstPtr, tmode, NULL);
+ } else {
+ /*
+ * Case 3: two arbitrary bitmaps.
+ */
+ tmode = srcCopy;
+ mskPort = TkMacOSXGetDrawablePort(clipPtr->value.pixmap);
+ mskBit = GetPortBitMapForCopyBits ( mskPort );
+ CopyDeepMask(srcBit, mskBit, dstBit,
+ srcPtr, srcPtr, dstPtr, 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. */
+{
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ const BitMap * destBits;
+ int i, j;
+ BitMap bitmap;
+ char *newData = NULL;
+ Rect destRect, srcRect;
+
+ destPort = TkMacOSXGetDrawablePort(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);
+
+ TkMacOSXSetUpClippingRgn(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;
+ }
+ destBits = GetPortBitMapForCopyBits ( destPort );
+ CopyBits(&bitmap, destBits,
+ &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.pixelFormat = 0;
+ pixmap.pmTable = NULL;
+ pixmap.pmExt = 0;
+ pixmap.baseAddr = image->data;
+ pixmap.rowBytes = image->bytes_per_line | 0x8000;
+
+ CopyBits((BitMap *) &pixmap, GetPortBitMapForCopyBits ( destPort ),
+ &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 = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ 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 = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ if (npoints < 2) {
+ return; /* TODO: generate BadValue error. */
+ }
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ if (useCGDrawing) {
+ CGContextRef outContext;
+
+ TkMacOSXSetUpCGContext(macWin, destPort, gc, &outContext);
+
+ CGContextBeginPath(outContext);
+ CGContextMoveToPoint(outContext, (float) points[0].x,
+ (float) points[0].y);
+ if (mode == CoordModeOrigin) {
+ for (i = 1; i < npoints; i++) {
+ CGContextAddLineToPoint(outContext,
+ (float) points[i].x,
+ (float) points[i].y);
+ }
+ }
+
+ CGContextStrokePath(outContext);
+ TkMacOSXReleaseCGContext(macWin, destPort, &outContext);
+ } else {
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ 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));
+ }
+ }
+ HidePen();
+
+ }
+ 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 = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ if (useCGDrawing) {
+ CGContextRef outContext;
+
+ TkMacOSXSetUpCGContext(macWin, destPort, gc, &outContext);
+
+ CGContextBeginPath(outContext);
+ for (i = 0; i < nsegments; i++) {
+ CGContextMoveToPoint(outContext,
+ (float) segments[i].x1,
+ (float) segments[i].y1);
+ CGContextAddLineToPoint (outContext,
+ (float) segments[i].x2,
+ (float) segments[i].y2);
+ }
+ CGContextStrokePath(outContext);
+ TkMacOSXReleaseCGContext(macWin, destPort, &outContext);
+ } else {
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ 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));
+ }
+ HidePen();
+ }
+
+ 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 = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ if (useCGDrawing) {
+ CGContextRef outContext;
+
+ TkMacOSXSetUpCGContext(macWin, destPort, gc, &outContext);
+
+ CGContextBeginPath(outContext);
+ CGContextMoveToPoint(outContext, (float) (points[0].x),
+ (float) (points[0].y));
+ for (i = 1; i < npoints; i++) {
+
+ if (mode == CoordModePrevious) {
+ CGContextAddLineToPoint(outContext, (float) points[i].x,
+ (float) points[i].y);
+ } else {
+ }
+ }
+ //CGContextStrokePath(outContext);
+ CGContextFillPath(outContext);
+ TkMacOSXReleaseCGContext(macWin, destPort, &outContext);
+ } else {
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ 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 = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ 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);
+ HidePen();
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawRectangles --
+ *
+ * Draws the outlines of the specified rectangles as if a
+ * five-point PolyLine protocol request were specified for each
+ * rectangle:
+ *
+ * [x,y] [x+width,y] [x+width,y+height] [x,y+height]
+ * [x,y]
+ *
+ * For the specified rectangles, these functions do not draw a
+ * pixel more than once. XDrawRectangles draws the rectangles in
+ * the order listed in the array. If rectangles intersect, the
+ * intersecting pixels are drawn multiple times. Draws a
+ * rectangle.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws rectangles on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+XDrawRectangles(
+ Display *display,
+ Drawable drawable,
+ GC gc,
+ XRectangle *rectArr,
+ int nRects)
+{
+ MacDrawable *macWin = (MacDrawable *) drawable;
+ Rect rect;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ XRectangle * rectPtr;
+ int i;
+
+ destPort = TkMacOSXGetDrawablePort(drawable);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(drawable);
+
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+
+ ShowPen();
+ PenPixPat(gPenPat);
+
+ for (i = 0, rectPtr = rectArr; i < nRects;i++, rectPtr++ ) {
+ rect.left = (short) (macWin->xOff + rectPtr->x);
+ rect.top = (short) (macWin->yOff + rectPtr->y);
+ rect.right = (short) (rect.left + rectPtr->width);
+ rect.bottom = (short) (rect.top + rectPtr->height);
+ FrameRect(&rect);
+ }
+ HidePen();
+
+ 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;
+ float fX = (float) x,
+ fY = (float) y,
+ fWidth = (float) width,
+ fHeight = (float) height;
+
+ if (width == 0 || height == 0) {
+ return;
+ }
+
+ destPort = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ if (useCGDrawing) {
+ CGContextRef outContext;
+ CGAffineTransform transform;
+ int clockwise = angle1 ? 0 : 1;
+
+ TkMacOSXSetUpCGContext(macWin, destPort, gc, &outContext);
+
+ CGContextBeginPath(outContext);
+
+ /*
+ * If we are drawing an oval, we have to squash the coordinate
+ * system before drawing, since CGContextAddArcToPoint only draws
+ * circles.
+ */
+
+ CGContextSaveGState(outContext);
+ transform = CGAffineTransformMakeTranslation((float) (x + width/2),
+ (float) (y + height/2));
+ transform = CGAffineTransformScale(transform, 1.0, fHeight/fWidth);
+ CGContextConcatCTM(outContext, transform);
+
+ CGContextAddArc(outContext, 0.0, 0.0,
+ (float) width/2,
+ (float) angle1, (float) angle2, clockwise);
+
+ CGContextRestoreGState(outContext);
+
+ CGContextStrokePath(outContext);
+ TkMacOSXReleaseCGContext(macWin, destPort, &outContext);
+ } else {
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+
+ 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);
+ HidePen();
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawArcs --
+ *
+ * Draws multiple circular or elliptical arcs. Each arc is
+ * specified by a rectangle and two angles. The center of the
+ * circle or ellipse is the center of the rect- angle, and the
+ * major and minor axes are specified by the width and height.
+ * Positive angles indicate counterclock- wise motion, and
+ * negative angles indicate clockwise motion. If the magnitude
+ * of angle2 is greater than 360 degrees, XDrawArcs truncates it
+ * to 360 degrees.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws an arc for each array element on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+XDrawArcs(
+ Display *display,
+ Drawable d,
+ GC gc,
+ XArc *arcArr,
+ int nArcs)
+{
+
+ MacDrawable *macWin = (MacDrawable *) d;
+ Rect rect;
+ short start, extent;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ XArc * arcPtr;
+ int i;
+
+ destPort = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+
+ ShowPen();
+ PenPixPat(gPenPat);
+ for (i = 0, arcPtr = arcArr;i < nArcs;i++, arcPtr++ ) {
+ rect.left = (short) (macWin->xOff + arcPtr->x);
+ rect.top = (short) (macWin->yOff + arcPtr->y);
+ rect.right = (short) (rect.left + arcPtr->width);
+ rect.bottom = (short) (rect.top + arcPtr->height);
+ start = (short) (90 - (arcPtr->angle1 / 64));
+ extent = (short) (-(arcPtr->angle2 / 64));
+ FrameArc(&rect, start, extent);
+ }
+ HidePen();
+
+ 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 = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ 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);
+ HidePen();
+
+ KillPoly(polygon);
+ } else {
+ ShowPen();
+ FillCArc(&theRect, start, extent, gPenPat);
+ HidePen();
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillArcs --
+ *
+ * Draw a filled arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a filled arc for each array element on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+XFillArcs(
+ Display *display,
+ Drawable d,
+ GC gc,
+ XArc *arcArr,
+ int nArcs)
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ Rect rect;
+ 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;
+ int i;
+ XArc * arcPtr;
+
+ destPort = TkMacOSXGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(d);
+
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ for (i = 0, arcPtr = arcArr;i<nArcs;i++, arcPtr++ ) {
+ rect.left = (short) (macWin->xOff + arcPtr->x);
+ rect.top = (short) (macWin->yOff + arcPtr->y);
+ rect.right = (short) (rect.left + arcPtr->width);
+ rect.bottom = (short) (rect.top + arcPtr->height);
+ start = (short) (90 - (arcPtr->angle1 / 64));
+ extent = (short) (- (arcPtr->angle2 / 64));
+
+ if (gc->arc_mode == ArcChord) {
+ boxWidth = rect.right - rect.left;
+ boxHeight = rect.bottom - rect.top;
+ angle = -(arcPtr->angle1/64.0)*PI/180.0;
+ sin1 = sin(angle);
+ cos1 = cos(angle);
+ angle -= (arcPtr->angle2/64.0)*PI/180.0;
+ sin2 = sin(angle);
+ cos2 = cos(angle);
+ vertex[0] = (rect.left + rect.right)/2.0;
+ vertex[1] = (rect.top + rect.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) ((rect.left + rect.right)/2),
+ (short) ((rect.top + rect.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(&rect, start, extent, gPenPat);
+ FillCPoly(polygon, gPenPat);
+ HidePen();
+
+ KillPoly(polygon);
+ } else {
+ ShowPen();
+ FillCArc(&rect, start, extent, gPenPat);
+ HidePen();
+ }
+ }
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XMaxRequestSize --
+ *
+ *----------------------------------------------------------------------
+ */
+long
+XMaxRequestSize(Display *display)
+{
+ return (SHRT_MAX / 4);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ RgnHandle visRgn, clipRgn;
+
+ destPort = TkMacOSXGetDrawablePort(Tk_WindowId(tkwin));
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(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.
+ */
+ visRgn = NewRgn();
+ clipRgn = NewRgn();
+ RectRgn(rgn, &srcRect);
+ GetPortVisibleRegion(destPort,visRgn);
+ DiffRgn(rgn, visRgn, rgn);
+ OffsetRgn(rgn, dx, dy);
+ GetPortClipRegion(destPort, clipRgn);
+ DiffRgn(clipRgn, rgn, clipRgn);
+ SetPortClipRegion(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(clipRgn, rgn, clipRgn);
+ SetPortClipRegion(destPort, clipRgn);
+ SetEmptyRgn(rgn);
+ macDraw->toplevel->flags |= TK_DRAWN_UNDER_MENU;
+ }
+
+ ScrollRect(&scrollRect, dx, dy, rgn);
+
+ SetGWorld(saveWorld, saveDevice);
+
+ DisposeRgn(clipRgn);
+ DisposeRgn(visRgn);
+ /*
+ * 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXSetUpGraphicsPort --
+ *
+ * Set up the graphics port from the given GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current port is adjusted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXSetUpGraphicsPort(
+ GC gc,
+ GWorldPtr destPort) /* 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);
+ }
+ if (gc->line_style != LineSolid) {
+ unsigned char *p = (unsigned char *) &(gc->dashes);
+ /*
+ * Here the dash pattern should be set in the drawing,
+ * environment, but I don't know how to do that for the Mac.
+ *
+ * p[] is an array of unsigned chars containing the dash list.
+ * A '\0' indicates the end of this list.
+ *
+ * Someone knows how to implement this? If you have a more
+ * complete implementation of SetUpGraphicsPort() for
+ * the Mac (or for Windows), please let me know.
+ *
+ * Jan Nijtmans
+ * CMG Arnhem, B.V.
+ * email: j.nijtmans@chello.nl (private)
+ * jan.nijtmans@cmg.nl (work)
+ * url: http://purl.oclc.org/net/nijtmans/
+ *
+ * FIXME:
+ * This is not possible with QuickDraw line drawing, we either
+ * have to convert all line drawings to regions, or, on Mac OS X
+ * we can use CG to draw our lines instead of QuickDraw.
+ */
+ }
+}
+ /*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXSetUpGraphicsPort --
+ *
+ * Set up the graphics port from the given GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current port is adjusted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXSetUpCGContext(
+ MacDrawable *macWin,
+ CGrafPtr destPort,
+ GC gc,
+ CGContextRef *contextPtr) /* GC to apply to current port. */
+{
+ RGBColor macColor;
+ CGContextRef outContext;
+ OSStatus err;
+ Rect boundsRect;
+ CGAffineTransform coordsTransform;
+
+ err = QDBeginCGContext(destPort, contextPtr);
+ outContext = *contextPtr;
+
+ CGContextSaveGState(outContext);
+
+ GetPortBounds(destPort, &boundsRect);
+
+ CGContextResetCTM(outContext);
+ coordsTransform = CGAffineTransformMake(1.0, 0.0, 0.0, -1.0, 0,
+ (float)(boundsRect.bottom - boundsRect.top));
+ CGContextConcatCTM(outContext, coordsTransform);
+
+ if (macWin->clipRgn != NULL) {
+ ClipCGContextToRegion(outContext, &boundsRect, macWin->clipRgn);
+ } else {
+ RgnHandle clipRgn = NewRgn();
+ GetPortClipRegion(destPort, clipRgn);
+ ClipCGContextToRegion(outContext, &boundsRect,
+ clipRgn);
+ DisposeRgn(clipRgn);
+ }
+
+ /* Now offset the CTM to the subwindow offset */
+
+ CGContextTranslateCTM(outContext, macWin->xOff, macWin->yOff);
+
+ if (TkSetMacColor(gc->foreground, &macColor) == true) {
+ CGContextSetRGBStrokeColor(outContext, RGBFLOATRED(macColor),
+ RGBFLOATGREEN(macColor),
+ RGBFLOATBLUE(macColor), 1.0);
+ }
+ if (TkSetMacColor(gc->background, &macColor) == true) {
+ CGContextSetRGBFillColor(outContext, RGBFLOATRED(macColor),
+ RGBFLOATGREEN(macColor),
+ RGBFLOATBLUE(macColor), 1.0);
+ }
+
+ if(gc->function == GXxor) {
+ }
+
+ CGContextSetLineWidth(outContext, (float) gc->line_width);
+
+ if (gc->line_style != LineSolid) {
+ unsigned char *p = (unsigned char *) &(gc->dashes);
+ /*
+ * Here the dash pattern should be set in the drawing,
+ * environment, but I don't know how to do that for the Mac.
+ *
+ * p[] is an array of unsigned chars containing the dash list.
+ * A '\0' indicates the end of this list.
+ *
+ * Someone knows how to implement this? If you have a more
+ * complete implementation of SetUpGraphicsPort() for
+ * the Mac (or for Windows), please let me know.
+ *
+ * Jan Nijtmans
+ * CMG Arnhem, B.V.
+ * email: j.nijtmans@chello.nl (private)
+ * jan.nijtmans@cmg.nl (work)
+ * url: http://purl.oclc.org/net/nijtmans/
+ *
+ * FIXME:
+ * This is not possible with QuickDraw line drawing, we either
+ * have to convert all line drawings to regions, or, on Mac OS X
+ * we can use CG to draw our lines instead of QuickDraw.
+ */
+ }
+}
+
+void
+TkMacOSXReleaseCGContext(
+ MacDrawable *macWin,
+ CGrafPtr destPort,
+ CGContextRef *outContext)
+{
+ CGContextResetCTM(*outContext);
+ CGContextRestoreGState(*outContext);
+ QDEndCGContext(destPort, outContext);
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXSetUpClippingRgn --
+ *
+ * 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
+TkMacOSXSetUpClippingRgn(
+ Drawable drawable) /* Drawable to update. */
+{
+ MacDrawable *macDraw = (MacDrawable *) drawable;
+
+ if (macDraw->winPtr != NULL) {
+ if (macDraw->flags & TK_CLIP_INVALID) {
+ TkMacOSXUpdateClipRgn(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(TkMacOSXGetDrawablePort(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);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXMakeStippleMap --
+ *
+ * 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
+TkMacOSXMakeStippleMap(
+ Drawable drawable, /* Window to apply stipple. */
+ Drawable stipple) /* The stipple pattern. */
+{
+ GWorldPtr destPort;
+ BitMapPtr bitmapPtr;
+ Rect portRect;
+ int width, height, stippleHeight, stippleWidth;
+ int i, j;
+ char * data;
+ Rect bounds;
+
+ destPort = TkMacOSXGetDrawablePort(drawable);
+
+ GetPortBounds ( destPort, &portRect );
+ width = portRect.right - portRect.left;
+ height = portRect.bottom - 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 = TkMacOSXGetDrawablePort(stipple);
+ stippleWidth = portRect.right - portRect.left;
+ stippleHeight = portRect.bottom - 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(GetPortBitMapForCopyBits ( destPort ), bitmapPtr,
+ &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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawpHighlightBorder --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus.
+ *
+ * On the Macintosh, this puts a 1 pixel border in the bgGC color
+ * between the widget and the focus ring, except in the case where
+ * highlightWidth is 1, in which case the border is left out.
+ *
+ * For proper Mac L&F, use highlightWidth of 3.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawHighlightBorder (
+ Tk_Window tkwin,
+ GC fgGC,
+ GC bgGC,
+ int highlightWidth,
+ Drawable drawable)
+{
+ if (highlightWidth == 1) {
+ TkDrawInsetFocusHighlight (tkwin, fgGC, highlightWidth, drawable, 0);
+ } else {
+ TkDrawInsetFocusHighlight (tkwin, bgGC, highlightWidth, drawable, 0);
+ if (fgGC != bgGC) {
+ TkDrawInsetFocusHighlight (tkwin, fgGC, highlightWidth - 1, drawable, 0);
+ }
+ }
+}
diff --git a/tcl/macosx/tkMacOSXEmbed.c b/tcl/macosx/tkMacOSXEmbed.c
new file mode 100644
index 00000000000..9ec4e3aae44
--- /dev/null
+++ b/tcl/macosx/tkMacOSXEmbed.c
@@ -0,0 +1,1193 @@
+/*
+ * tkMacOSXEmbed.c --
+ *
+ * This file contains platform-specific procedures for theMac to provide
+ * basic operations needed for application embedding (where one
+ * application can use as its main window an internal window from
+ * some other application).
+ * Currently only Toplevel embedding within the same Tk application is
+ * allowed on the Macintosh.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "X11/X.h"
+#include "X11/Xlib.h"
+#include <stdio.h>
+
+#include <Carbon/Carbon.h>
+#include "tkMacOSXInt.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
+ */
+
+TkMacOSXEmbedHandler *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_MacOSXSetEmbedHandler --
+ *
+ * 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_MacOSXSetEmbedHandler(
+ Tk_MacOSXEmbedRegisterWinProc *registerWinProc,
+ Tk_MacOSXEmbedGetGrafPortProc *getPortProc,
+ Tk_MacOSXEmbedMakeContainerExistProc *containerExistProc,
+ Tk_MacOSXEmbedGetClipProc *getClipProc,
+ Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc)
+{
+ if (gMacEmbedHandler == NULL) {
+ gMacEmbedHandler = (TkMacOSXEmbedHandler *) ckalloc(sizeof(TkMacOSXEmbedHandler));
+ }
+ 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->grafPtr = NULL;
+ macWin->toplevel = macWin;
+ macWin->xOff = 0;
+ macWin->yOff = 0;
+ } else {
+ macWin->grafPtr = 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 the interp's 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. */
+ CONST 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 grafPtr 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 TkMacOSXGetDrawablePort
+ * to get the portPtr. It will correctly find the container's port.
+ */
+
+ macWin->grafPtr = 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);
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXContainerId --
+ *
+ * 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 *
+TkMacOSXContainerId(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("TkMacOSXContainerId couldn't find window");
+ return None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetHostToplevel --
+ *
+ * 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 *
+TkMacOSXGetHostToplevel(
+ 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 TkMacOSXGetHostToplevel(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. */
+ CONST 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/tcl/macosx/tkMacOSXEvent.c b/tcl/macosx/tkMacOSXEvent.c
new file mode 100644
index 00000000000..d8a3279fe76
--- /dev/null
+++ b/tcl/macosx/tkMacOSXEvent.c
@@ -0,0 +1,276 @@
+/*
+ * tkMacOSXEvent.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.
+ * Copyright 2001, Apple Computer, 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 <stdlib.h>
+#include <string.h>
+#include <pthread.h>
+#include <sys/types.h>
+#include <sys/ioctl.h>
+
+#include "tkMacOSXInt.h"
+#include "tkMacOSXEvent.h"
+#include "tkMacOSXDebug.h"
+
+#define TK_MAC_DEBUG 1
+
+/*
+ * The following are undocumented event classes
+ *
+ */
+enum {
+ kEventClassUser = 'user',
+ kEventClassCgs = 'cgs ',
+};
+
+/*
+ * The following are undocumented event kinds
+ *
+ */
+enum {
+ kEventMouse8 = 8,
+ kEventMouse9 = 9,
+ kEventApp103 = 103
+};
+
+EventRef TkMacOSXCreateFakeEvent ();
+
+/*
+ * Forward declarations of procedures used in this file.
+ */
+static int ReceiveAndProcessEvent _ANSI_ARGS_(());
+
+static EventTargetRef targetRef;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tkMacOSXFlushWindows --
+ *
+ * This routine flushes all the Carbon windows of the application
+ * It is called by the setup procedure for the Tcl/Carbon event source
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Flushes all Carbon windows
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+tkMacOSXFlushWindows ()
+{
+ WindowRef wRef = GetWindowList();
+
+ while (wRef) {
+ CGrafPtr portPtr = GetWindowPort(wRef);
+ if (QDIsPortBuffered(portPtr)) {
+ QDFlushPortBuffer(portPtr, NULL);
+ }
+ wRef=GetNextWindow(wRef);
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXCountAndProcessMacEvents --
+ *
+ * This routine receives any Carbon events that aare in the
+ * queue and converts them to tk events
+ * It is called by the event set-up and check routines
+ * Results:
+ * The number of events in the queue.
+ *
+ * Side effects:
+ * Tells the Window Manager to deliver events to the event
+ * queue of the current thread.
+ * Receives any Carbon events on the queue and converts them to tk events
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXCountAndProcessMacEvents()
+{
+ EventQueueRef qPtr;
+ int eventCount;
+ qPtr = GetMainEventQueue();
+ eventCount = GetNumEventsInQueue(qPtr);
+ if (eventCount) {
+ int n, err;
+ for (n = 0, err = 0;n<eventCount && !err;n++) {
+ err = ReceiveAndProcessEvent();
+ }
+ }
+ return eventCount;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXProcessAppleEvent --
+ *
+ * This processes Apple events
+ *
+ * Results:
+ * 0 on success
+ * -1 on failure
+ *
+ * Side effects:
+ * Calls the Tk high-level event handler
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TkMacOSXProcessAppleEvent(TkMacOSXEvent * eventPtr, MacEventStatus * statusPtr)
+{
+ int err;
+ EventRecord eventRecord;
+ if (ConvertEventRefToEventRecord(eventPtr->eventRef,
+ &eventRecord )) {
+ err=TkMacOSXDoHLEvent(&eventRecord);
+ if (err!=noErr) {
+ char buf1 [ 256 ];
+ char buf2 [ 256 ];
+ fprintf(stderr,
+ "TkMacOSXDoHLEvent failed : %s,%s,%d\n",
+ CarbonEventToAscii(eventPtr->eventRef, buf1),
+ ClassicEventToAscii(&eventRecord,buf2), err);
+ statusPtr->err = 1;
+ } else {
+ statusPtr->handledByTk = 1;
+ }
+ } else {
+ statusPtr->err = 1;
+ fprintf(stderr,"ConvertEventRefToEventRecord failed\n");
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXProcessEvent --
+ *
+ * This dispatches a filtered Carbon event to the appropriate handler
+ *
+ * Results:
+ * 0 on success
+ * -1 on failure
+ *
+ * Side effects:
+ * Converts a Carbon event to a Tk event
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TkMacOSXProcessEvent(TkMacOSXEvent * eventPtr, MacEventStatus * statusPtr)
+{
+ switch (eventPtr->eClass) {
+ case kEventClassMouse:
+ TkMacOSXProcessMouseEvent(eventPtr, statusPtr);
+ break;
+ case kEventClassWindow:
+ TkMacOSXProcessWindowEvent(eventPtr, statusPtr);
+ break;
+ case kEventClassKeyboard:
+ TkMacOSXProcessKeyboardEvent(eventPtr, statusPtr);
+ break;
+ case kEventClassApplication:
+ TkMacOSXProcessApplicationEvent(eventPtr, statusPtr);
+ break;
+ case kEventClassAppleEvent:
+ TkMacOSXProcessAppleEvent(eventPtr, statusPtr);
+ break;
+ case kEventClassCgs:
+ case kEventClassUser:
+ case kEventClassWish:
+ statusPtr->handledByTk = 1;
+ break;
+ default:
+#ifdef TK_MAC_DEBUG
+ if (0)
+ {
+ char buf [ 256 ];
+ fprintf(stderr,
+ "Unrecognised event : %s\n",
+ CarbonEventToAscii(eventPtr->eventRef, buf));
+ }
+#endif
+ break;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReceiveAndProcessEvent --
+ *
+ * This receives a carbon event and converts it to a tk event
+ *
+ * Results:
+ * 0 on success
+ * Mac OS error number on failure
+ *
+ * Side effects:
+ * This receives the next Carbon event
+ * and converts it to the appropriate tk event
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReceiveAndProcessEvent()
+{
+ TkMacOSXEvent macEvent;
+ MacEventStatus eventStatus;
+ int err;
+ char buf [ 256 ];
+
+ /*
+ * This is a poll, since we have already counted the events coming
+ * into this routine, and are guaranteed to have one waiting.
+ */
+
+ err=ReceiveNextEvent(0, NULL, kEventDurationNoWait,
+ true, &macEvent.eventRef);
+ if (err != noErr) {
+ return err;
+ } else {
+ macEvent.eClass = GetEventClass(macEvent.eventRef);
+ macEvent.eKind = GetEventKind(macEvent.eventRef);
+ bzero(&eventStatus, sizeof(eventStatus));
+ TkMacOSXProcessEvent(&macEvent,&eventStatus);
+ if (!eventStatus.handledByTk) {
+ if (!targetRef) {
+ targetRef=GetEventDispatcherTarget();
+ }
+
+ err= SendEventToEventTarget(macEvent.eventRef,targetRef);
+ if (err != noErr /* && err != eventNotHandledErr */) {
+ fprintf(stderr,
+ "RCNE SendEventToEventTarget (%s) failed, %d\n",
+ CarbonEventToAscii(macEvent.eventRef,buf ),err);
+ }
+ }
+ ReleaseEvent(macEvent.eventRef);
+ return 0;
+ }
+}
diff --git a/tcl/macosx/tkMacOSXEvent.h b/tcl/macosx/tkMacOSXEvent.h
new file mode 100644
index 00000000000..2ce339b0155
--- /dev/null
+++ b/tcl/macosx/tkMacOSXEvent.h
@@ -0,0 +1,86 @@
+/*
+ * tkMacOSXEvent.h --
+ *
+ * Declarations of Macintosh specific functions for implementing the
+ * Mac OS X Notifier.
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#ifndef _TKMACEVENT
+#define _TKMACEVENT
+
+#include <Carbon/Carbon.h>
+#include <tcl.h>
+
+enum {
+ kEventClassWish = 'WiSH'
+};
+
+typedef struct {
+ int handledByTk;
+ int err;
+ char errMsg[1024];
+} MacEventStatus;
+
+/*
+ * The event information in passed in the following structures
+ */
+typedef struct {
+ EventRef eventRef;
+ UInt32 eClass; /* Defines the class of event : see CarbonEvents.h */
+ UInt32 eKind; /* Defines the kind of the event : see CarbonEvents.h */
+} TkMacOSXEvent;
+
+int TkMacOSXCountAndProcessMacEvents _ANSI_ARGS_(());
+void tkMacOSXFlushWindows _ANSI_ARGS_(());
+int TkMacOSXProcessMouseEvent(TkMacOSXEvent * e, MacEventStatus * statusPtr);
+int TkMacOSXProcessWindowEvent(TkMacOSXEvent * e, MacEventStatus * statusPtr);
+int TkMacOSXProcessKeyboardEvent(TkMacOSXEvent * e, MacEventStatus * statusPtr);
+int TkMacOSXProcessApplicationEvent(TkMacOSXEvent * e, MacEventStatus * statusPtr);
+
+#endif
diff --git a/tcl/macosx/tkMacOSXFont.c b/tcl/macosx/tkMacOSXFont.c
new file mode 100644
index 00000000000..5f90652ae21
--- /dev/null
+++ b/tcl/macosx/tkMacOSXFont.c
@@ -0,0 +1,2191 @@
+/*
+ * tkMacOSXFont.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.
+ * Copyright 2001, Apple Computer, 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 <Carbon/Carbon.h>
+
+#include "tkMacOSXInt.h"
+#include "tkFont.h"
+
+/*
+ * For doing things with Mac strings and Fixed numbers. This probably should move
+ * the mac header file.
+ */
+
+#ifndef StrLength
+#define StrLength(s) (*((unsigned char *) (s)))
+#endif
+#ifndef StrBody
+#define StrBody(s) ((char *) (s) + 1)
+#endif
+#define pstrcmp(s1, s2) RelString((s1), (s2), 1, 1)
+#define pstrcasecmp(s1, s2) RelString((s1), (s2), 0, 1)
+
+#ifndef Fixed2Int
+#define Fixed2Int(f) ((f) >> 16)
+#define Int2Fixed(i) ((i) << 16)
+#endif
+
+/*
+ * The preferred font encodings.
+ */
+
+static CONST char *encodingList[] = {
+ "macRoman", "macJapan", NULL
+};
+
+/*
+ * The following structures are used to map the script/language codes of a
+ * font to the name that should be passed to Tcl_GetTextEncoding() to obtain
+ * the encoding for that font. The set of numeric constants is fixed and
+ * defined by Apple.
+ */
+
+static TkStateMap scriptMap[] = {
+ {smRoman, "macRoman"},
+ {smJapanese, "macJapan"},
+ {smTradChinese, "macChinese"},
+ {smKorean, "macKorean"},
+ {smArabic, "macArabic"},
+ {smHebrew, "macHebrew"},
+ {smGreek, "macGreek"},
+ {smCyrillic, "macCyrillic"},
+ {smRSymbol, "macRSymbol"},
+ {smDevanagari, "macDevanagari"},
+ {smGurmukhi, "macGurmukhi"},
+ {smGujarati, "macGujarati"},
+ {smOriya, "macOriya"},
+ {smBengali, "macBengali"},
+ {smTamil, "macTamil"},
+ {smTelugu, "macTelugu"},
+ {smKannada, "macKannada"},
+ {smMalayalam, "macMalayalam"},
+ {smSinhalese, "macSinhalese"},
+ {smBurmese, "macBurmese"},
+ {smKhmer, "macKhmer"},
+ {smThai, "macThailand"},
+ {smLaotian, "macLaos"},
+ {smGeorgian, "macGeorgia"},
+ {smArmenian, "macArmenia"},
+ {smSimpChinese, "macSimpChinese"},
+ {smTibetan, "macTIbet"},
+ {smMongolian, "macMongolia"},
+ {smGeez, "macEthiopia"},
+ {smEastEurRoman, "macCentEuro"},
+ {smVietnamese, "macVietnam"},
+ {smExtArabic, "macSindhi"},
+ {NULL, NULL}
+};
+
+static TkStateMap romanMap[] = {
+ {langCroatian, "macCroatian"},
+ {langSlovenian, "macCroatian"},
+ {langIcelandic, "macIceland"},
+ {langRomanian, "macRomania"},
+ {langTurkish, "macTurkish"},
+ {langGreek, "macGreek"},
+ {NULL, NULL}
+};
+
+static TkStateMap cyrillicMap[] = {
+ {langUkrainian, "macUkraine"},
+ {langBulgarian, "macBulgaria"},
+ {NULL, NULL}
+};
+
+/*
+ * The following structure represents a font family. It is assumed that
+ * all screen fonts constructed from the same "font family" share certain
+ * properties; all screen fonts with the same "font family" point to a
+ * shared instance of this structure. The most important shared property
+ * is the character existence metrics, used to determine if a screen font
+ * can display a given Unicode character.
+ *
+ * Under Macintosh, a "font family" is uniquely identified by its face number.
+ */
+
+
+#define FONTMAP_SHIFT 10
+
+#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar) * 8 - FONTMAP_SHIFT))
+#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT)
+
+typedef struct FontFamily {
+ struct FontFamily *nextPtr; /* Next in list of all known font families. */
+ int refCount; /* How many SubFonts are referring to this
+ * FontFamily. When the refCount drops to
+ * zero, this FontFamily may be freed. */
+ /*
+ * Key.
+ */
+
+ FMFontFamily faceNum; /* Unique face number key for this FontFamily. */
+
+ /*
+ * Derived properties.
+ */
+
+ Tcl_Encoding encoding; /* Encoding for this font family. */
+ int isSymbolFont; /* Non-zero if this is a symbol family. */
+ int isMultiByteFont; /* Non-zero if this is a multi-byte family. */
+ char typeTable[256]; /* Table that identfies all lead bytes for a
+ * multi-byte family, used when measuring chars.
+ * If a byte is a lead byte, the value at the
+ * corresponding position in the typeTable is 1,
+ * otherwise 0. If this is a single-byte font,
+ * all entries are 0. */
+ char *fontMap[FONTMAP_PAGES];
+ /* Two-level sparse table used to determine
+ * quickly if the specified character exists.
+ * As characters are encountered, more pages
+ * in this table are dynamically added. The
+ * contents of each page is a bitmask
+ * consisting of FONTMAP_BITSPERPAGE bits,
+ * representing whether this font can be used
+ * to display the given character at the
+ * corresponding bit position. The high bits
+ * of the character are used to pick which
+ * page of the table is used. */
+} FontFamily;
+
+/*
+ * The following structure encapsulates an individual screen font. A font
+ * object is made up of however many SubFonts are necessary to display a
+ * stream of multilingual characters.
+ */
+
+typedef struct SubFont {
+ char **fontMap; /* Pointer to font map from the FontFamily,
+ * cached here to save a dereference. */
+ FontFamily *familyPtr; /* The FontFamily for this SubFont. */
+} SubFont;
+
+/*
+ * The following structure represents Macintosh's implementation of a font
+ * object.
+ */
+
+#define SUBFONT_SPACE 3
+
+typedef struct MacFont {
+ TkFont font; /* Stuff used by generic font package. Must
+ * be first in structure. */
+ SubFont staticSubFonts[SUBFONT_SPACE];
+ /* Builtin space for a limited number of
+ * SubFonts. */
+ int numSubFonts; /* Length of following array. */
+ SubFont *subFontArray; /* Array of SubFonts that have been loaded
+ * in order to draw/measure all the characters
+ * encountered by this font so far. All fonts
+ * start off with one SubFont initialized by
+ * AllocFont() from the original set of font
+ * attributes. Usually points to
+ * staticSubFonts, but may point to malloced
+ * space if there are lots of SubFonts. */
+
+ short size; /* Font size in pixels, constructed from
+ * font attributes. */
+ short style; /* Style bits, constructed from font
+ * attributes. */
+} MacFont;
+
+/*
+ * The following structure is used to map between the UTF-8 name for a font and
+ * the name that the Macintosh uses to refer to the font, in order to determine
+ * if a font exists. The Macintosh names for fonts are stored in the encoding
+ * of the font itself.
+ */
+
+typedef struct FontNameMap {
+ Tk_Uid utfName; /* The name of the font in UTF-8. */
+ StringPtr nativeName; /* The name of the font in the font's encoding. */
+ FMFontFamily faceNum; /* Unique face number for this font. */
+} FontNameMap;
+
+/*
+ * The list of font families that are currently loaded. As screen fonts
+ * are loaded, this list grows to hold information about what characters
+ * exist in each font family.
+ */
+
+static FontFamily *fontFamilyList = NULL;
+
+/*
+ * Information cached about the system at startup time.
+ */
+
+static FontNameMap *gFontNameMap = NULL;
+static GWorldPtr gWorld = NULL;
+
+/*
+ * Procedures used only in this file.
+ */
+
+static FontFamily * AllocFontFamily(CONST MacFont *fontPtr, int family);
+static SubFont * CanUseFallback(MacFont *fontPtr, CONST char *fallbackName, int ch);
+static SubFont * CanUseFallbackWithAliases(MacFont *fontPtr, CONST char *faceName, int ch, Tcl_DString *nameTriedPtr);
+static SubFont * FindSubFontForChar(MacFont *fontPtr, int ch);
+static void FontMapInsert(SubFont *subFontPtr, int ch);
+static void FontMapLoadPage(SubFont *subFontPtr, int row);
+static int FontMapLookup(SubFont *subFontPtr, int ch);
+static void FreeFontFamily(FontFamily *familyPtr);
+static void InitFont(Tk_Window tkwin, int family, int size, int style, MacFont *fontPtr);
+static void InitSubFont(CONST MacFont *fontPtr, int family, SubFont *subFontPtr);
+static void MultiFontDrawText(MacFont *fontPtr, CONST char *source, int numBytes, int x, int y);
+static void ReleaseFont(MacFont *fontPtr);
+static void ReleaseSubFont(SubFont *subFontPtr);
+static int SeenName(CONST char *name, Tcl_DString *dsPtr);
+
+static CONST char * BreakLine(FontFamily *familyPtr, int flags, CONST char *source, int numBytes, int *widthPtr);
+static int GetFamilyNum(CONST char *faceName, short *familyPtr);
+static int GetFamilyOrAliasNum(CONST char *faceName, short *familyPtr);
+static Tcl_Encoding GetFontEncoding(int faceNum, int allowSymbol, int *isSymbolPtr);
+static Tk_Uid GetUtfFaceName(StringPtr faceNameStr);
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependant code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * See comments below.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ FMFontFamilyIterator fontFamilyIterator;
+ FMFontFamily fontFamily;
+ FontNameMap *tmpFontNameMap, *newFontNameMap, *mapPtr;
+ int i, j, numFonts, fontMapOffset, isSymbol;
+ Str255 nativeName;
+ Tcl_DString ds;
+ Tcl_Encoding encoding;
+ Tcl_Encoding *encodings;
+
+ if (gWorld == NULL) {
+ Rect rect = {0, 0, 1, 1};
+ SetFractEnable(0);
+ /*
+ * Used for saving and restoring state while drawing and measuring.
+ */
+ if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {
+ panic("TkpFontPkgInit: NewGWorld failed");
+ }
+ /*
+ * The name of each font is stored in the encoding of that font.
+ * How would we translate a name from UTF-8 into the native encoding
+ * of the font unless we knew the encoding of that font? We can't.
+ * So, precompute the UTF-8 and native names of all fonts on the
+ * system. The when the user asks for font by its UTF-8 name, we
+ * lookup the name in that table and really ask for the font by its
+ * native name. Any unknown UTF-8 names will be mapped to the system
+ * font.
+ */
+ FMCreateFontFamilyIterator (NULL, NULL, kFMDefaultOptions, &fontFamilyIterator);
+ numFonts = 0;
+ while (FMGetNextFontFamily(&fontFamilyIterator, &fontFamily) != kFMIterationCompleted) {
+ numFonts++;
+ }
+ tmpFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * numFonts);
+ encodings = (Tcl_Encoding *) ckalloc(sizeof(Tcl_Encoding) * numFonts);
+ mapPtr = tmpFontNameMap;
+ FMResetFontFamilyIterator(NULL, NULL, kFMDefaultOptions, &fontFamilyIterator);
+ i = 0;
+ while (FMGetNextFontFamily(&fontFamilyIterator, &fontFamily) != kFMIterationCompleted) {
+ mapPtr->faceNum = fontFamily;
+ encodings[i] = GetFontEncoding(mapPtr->faceNum, 0, &isSymbol);
+ FMGetFontFamilyName(fontFamily, nativeName );
+ Tcl_ExternalToUtfDString(encodings[i], StrBody(nativeName), StrLength(nativeName), &ds);
+ mapPtr->utfName = Tk_GetUid(Tcl_DStringValue(&ds));
+ mapPtr->nativeName = (StringPtr) ckalloc(StrLength(nativeName) + 1);
+ memcpy(mapPtr->nativeName, nativeName, StrLength(nativeName) + 1);
+ Tcl_DStringFree(&ds);
+ mapPtr++;
+ i++;
+ }
+ FMDisposeFontFamilyIterator (&fontFamilyIterator);
+
+ /*
+ * Reorder FontNameMap so fonts with the preferred encodings are at
+ * the front of the list. The relative order of fonts that all have
+ * the same encoding is preserved. Fonts with unknown encodings get
+ * stuck at the end.
+ */
+ newFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * (numFonts + 1));
+ fontMapOffset = 0;
+ for (i = 0; encodingList[i] != NULL; i++) {
+ encoding = Tcl_GetEncoding(NULL, encodingList[i]);
+ if (encoding == NULL) {
+ continue;
+ }
+ for (j = 0; j < numFonts; j++) {
+ if (encodings[j] == encoding) {
+ newFontNameMap[fontMapOffset] = tmpFontNameMap[j];
+ fontMapOffset++;
+ Tcl_FreeEncoding(encodings[j]);
+ tmpFontNameMap[j].utfName = NULL;
+ }
+ }
+ Tcl_FreeEncoding(encoding);
+ }
+ for (i = 0; i < numFonts; i++) {
+ if (tmpFontNameMap[i].utfName != NULL) {
+ newFontNameMap[fontMapOffset] = tmpFontNameMap[i];
+ fontMapOffset++;
+ Tcl_FreeEncoding(encodings[i]);
+ }
+ }
+ if (fontMapOffset != numFonts) {
+ panic("TkpFontPkgInit: unexpected number of fonts");
+ }
+
+ mapPtr = &newFontNameMap[numFonts];
+ mapPtr->utfName = NULL;
+ mapPtr->nativeName = NULL;
+ mapPtr->faceNum = 0;
+
+ ckfree((char *) tmpFontNameMap);
+ ckfree((char *) encodings);
+
+ gFontNameMap = newFontNameMap;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetNativeFont --
+ *
+ * Map a platform-specific native font name to a TkFont.
+ *
+ * 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. */
+{
+ SInt16 family;
+ MacFont *fontPtr;
+
+ if (strcmp(name, "system") == 0) {
+ family = GetSysFont();
+ } else if (strcmp(name, "application") == 0) {
+ family = GetAppFont();
+ } else {
+ return NULL;
+ }
+
+ fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
+ InitFont(tkwin, family, 0, 0, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFromAttributes --
+ *
+ * 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. */
+{
+ short faceNum, style;
+ int i, j;
+ CONST char *faceName, *fallback;
+ char ***fallbacks;
+ MacFont *fontPtr;
+
+ /*
+ * Algorithm to get the closest font to the one requested.
+ *
+ * try fontname
+ * try all aliases for fontname
+ * foreach fallback for fontname
+ * try the fallback
+ * try all aliases for the fallback
+ */
+
+ faceNum = 0;
+ faceName = faPtr->family;
+ if (faceName != NULL) {
+ if (GetFamilyOrAliasNum(faceName, &faceNum) != 0) {
+ goto found;
+ }
+ fallbacks = TkFontGetFallbacks();
+ for (i = 0; fallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(faceName, fallback) == 0) {
+ for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) {
+ if (GetFamilyOrAliasNum(fallback, &faceNum)) {
+ goto found;
+ }
+ }
+ }
+ break;
+ }
+ }
+ }
+
+ found:
+ style = 0;
+ if (faPtr->weight != TK_FW_NORMAL) {
+ style |= bold;
+ }
+ if (faPtr->slant != TK_FS_ROMAN) {
+ style |= italic;
+ }
+ if (faPtr->underline) {
+ style |= underline;
+ }
+ if (tkFontPtr == NULL) {
+ fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
+ } else {
+ fontPtr = (MacFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+ }
+ InitFont(tkwin, faceNum, faPtr->size, style, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpDeleteFont --
+ *
+ * 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. */
+{
+ MacFont *fontPtr;
+
+ fontPtr = (MacFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFamilies --
+ *
+ * Return information about the font families that are available
+ * on the display of the given window.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list of all the available
+ * font families.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkpGetFontFamilies(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ Tk_Window tkwin) /* For display to query. */
+{
+ FontNameMap *mapPtr;
+ Tcl_Obj *resultPtr, *strPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ strPtr = Tcl_NewStringObj(mapPtr->utfName, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpGetSubFonts --
+ *
+ * A function used by the testing package for querying the actual
+ * screen fonts that make up a font object.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list containing the
+ * names of the screen fonts that make up the given font object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpGetSubFonts(interp, tkfont)
+ Tcl_Interp *interp; /* Interp to hold result. */
+ Tk_Font tkfont; /* Font object to query. */
+{
+ int i;
+ Tcl_Obj *resultPtr, *strPtr;
+ MacFont *fontPtr;
+ FontFamily *familyPtr;
+ Str255 nativeName;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ fontPtr = (MacFont *) tkfont;
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ familyPtr = fontPtr->subFontArray[i].familyPtr;
+ GetFontName(familyPtr->faceNum, nativeName);
+ strPtr = Tcl_NewStringObj(GetUtfFaceName(nativeName), -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_MeasureChars --
+ *
+ * Determine the number of characters from the string that will fit
+ * in the given horizontal span. The measurement is done under the
+ * assumption that Tk_DrawChars() will be used to actually display
+ * the characters.
+ *
+ * Results:
+ * The return value is the number of bytes from source that
+ * fit into the span that extends from 0 to maxLength. *lengthPtr is
+ * filled with the x-coordinate of the right edge of the last
+ * character that did fit.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_MeasureChars(
+ Tk_Font tkfont, /* Font in which characters will be drawn. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes, /* Maximum number of bytes to consider
+ * from source string. */
+ int maxLength, /* If >= 0, maxLength specifies the longest
+ * permissible line length; don't consider any
+ * character that would cross this
+ * x-position. If < 0, then line length is
+ * unbounded and the flags argument is
+ * ignored. */
+ int flags, /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ int *lengthPtr) /* Filled with x-location just after the
+ * terminating character. */
+{
+ MacFont *fontPtr;
+ FontFamily *lastFamilyPtr;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ int curX, curByte;
+
+ /*
+ * According to "Inside Macintosh: Text", the Macintosh may
+ * automatically substitute
+ * ligatures or context-sensitive presentation forms when
+ * measuring/displaying text within a font run. We cannot safely
+ * measure individual characters and add up the widths w/o errors.
+ * However, if we convert a range of text from UTF-8 to, say,
+ * Shift-JIS, and get the offset into the Shift-JIS string as to
+ * where a word or line break would occur, then can we map that
+ * number back to UTF-8?
+ */
+
+ fontPtr = (MacFont *) tkfont;
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(gWorld, NULL);
+
+ TextSize(fontPtr->size);
+ TextFace(fontPtr->style);
+
+ lastFamilyPtr = fontPtr->subFontArray[0].familyPtr;
+
+ if (numBytes == 0) {
+ curX = 0;
+ curByte = 0;
+ } else if (maxLength < 0) {
+ CONST char *p, *end, *next;
+ Tcl_UniChar ch;
+ FontFamily *thisFamilyPtr;
+ Tcl_DString runString;
+
+ /*
+ * A three step process:
+ * 1. Find a contiguous range of characters that can all be
+ * represented by a single screen font.
+ * 2. Convert those chars to the encoding of that font.
+ * 3. Measure converted chars.
+ */
+
+ curX = 0;
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
+ if (thisFamilyPtr != lastFamilyPtr) {
+ TextFont(lastFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source,
+ p - source, &runString);
+ curX += TextWidth(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ lastFamilyPtr = thisFamilyPtr;
+ source = p;
+ }
+ p = next;
+ }
+ TextFont(lastFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, p - source,
+ &runString);
+ curX += TextWidth(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ curByte = numBytes;
+ } else {
+ CONST char *p, *end, *next, *sourceOrig;
+ int widthLeft;
+ FontFamily *thisFamilyPtr;
+ Tcl_UniChar ch;
+ CONST char *rest = NULL;
+
+ /*
+ * How many chars will fit in the space allotted?
+ */
+
+ if (maxLength > 32767) {
+ maxLength = 32767;
+ }
+
+ widthLeft = maxLength;
+ sourceOrig = source;
+ end = source + numBytes;
+ for (p = source; p < end; p = next) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
+ if (thisFamilyPtr != lastFamilyPtr) {
+ if (p > source) {
+ rest = BreakLine(lastFamilyPtr, flags, source,
+ p - source, &widthLeft);
+ flags &= ~TK_AT_LEAST_ONE;
+ if (rest != NULL) {
+ p = source;
+ break;
+ }
+ }
+ lastFamilyPtr = thisFamilyPtr;
+ source = p;
+ }
+ }
+
+ if (p > source) {
+ rest = BreakLine(lastFamilyPtr, flags, source, p - source,
+ &widthLeft);
+ }
+
+ if (rest == NULL) {
+ curByte = numBytes;
+ } else {
+ curByte = rest - sourceOrig;
+ }
+ curX = maxLength - widthLeft;
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+
+ *lengthPtr = curX;
+ return curByte;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * BreakLine --
+ *
+ * Determine where the given line of text should be broken so that it
+ * fits in the specified range. Before calling this function, the
+ * font values and graphics port must be set.
+ *
+ * Results:
+ * The return value is NULL if the specified range is larger that the
+ * space the text needs, and *widthLeftPtr is filled with how much
+ * space is left in the range after measuring the whole text buffer.
+ * Otherwise, the return value is a pointer into the text buffer that
+ * indicates where the line should be broken (up to, but not including
+ * that character), and *widthLeftPtr is filled with how much space is
+ * left in the range after measuring up to that character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static CONST char *
+BreakLine(
+ FontFamily *familyPtr, /* FontFamily that describes the font values
+ * that are already selected into the graphics
+ * port. */
+ int flags, /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes, /* Maximum number of bytes to consider
+ * from source string. */
+ int *widthLeftPtr) /* On input, specifies size of range into
+ * which characters from source buffer should
+ * be fit. On output, filled with how much
+ * space is left after fitting as many
+ * characters as possible into the range.
+ * Result may be negative if TK_AT_LEAST_ONE
+ * was specified in the flags argument. */
+{
+ Fixed pixelWidth, widthLeft;
+ StyledLineBreakCode breakCode;
+ Tcl_DString runString;
+ long textOffset;
+ Boolean leadingEdge;
+ Point point;
+ int charOffset, thisCharWasDoubleByte;
+ char *p, *end, *typeTable;
+
+ TextFont(familyPtr->faceNum);
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, numBytes,
+ &runString);
+ pixelWidth = Int2Fixed(*widthLeftPtr) + 1;
+ if (flags & TK_WHOLE_WORDS) {
+ textOffset = (flags & TK_AT_LEAST_ONE);
+ widthLeft = pixelWidth;
+ breakCode = StyledLineBreak(Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString), 0, Tcl_DStringLength(&runString),
+ 0, &widthLeft, &textOffset);
+ if (breakCode != smBreakOverflow) {
+ /*
+ * StyledLineBreak includes all the space characters at the end of
+ * line that we want to suppress.
+ */
+
+ textOffset = VisibleLength(Tcl_DStringValue(&runString), textOffset);
+ goto getoffset;
+ }
+ } else {
+ point.v = 1;
+ point.h = 1;
+ textOffset = PixelToChar(Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString), 0, pixelWidth, &leadingEdge,
+ &widthLeft, smOnlyStyleRun, point, point);
+ if (Fixed2Int(widthLeft) < 0) {
+ goto getoffset;
+ }
+ }
+ *widthLeftPtr = Fixed2Int(widthLeft);
+ Tcl_DStringFree(&runString);
+ return NULL;
+
+ /*
+ * The conversion routine that converts UTF-8 to the target encoding
+ * must map one UTF-8 character to exactly one encoding-specific
+ * character, so that the following algorithm works:
+ *
+ * 1. Get byte offset of where line should be broken.
+ * 2. Get char offset corresponding to that byte offset.
+ * 3. Map that char offset to byte offset in UTF-8 string.
+ */
+
+ getoffset:
+ thisCharWasDoubleByte = 0;
+ if (familyPtr->isMultiByteFont == 0) {
+ charOffset = textOffset;
+ } else {
+ charOffset = 0;
+ typeTable = familyPtr->typeTable;
+
+ p = Tcl_DStringValue(&runString);
+ end = p + textOffset;
+ thisCharWasDoubleByte = typeTable[*((unsigned char *) p)];
+ for ( ; p < end; p++) {
+ thisCharWasDoubleByte = typeTable[*((unsigned char *) p)];
+ p += thisCharWasDoubleByte;
+ charOffset++;
+ }
+ }
+
+ if ((flags & TK_WHOLE_WORDS) == 0) {
+ if ((flags & TK_PARTIAL_OK) && (leadingEdge != 0)) {
+ textOffset += thisCharWasDoubleByte;
+ textOffset++;
+ charOffset++;
+ } else if (((flags & TK_PARTIAL_OK) == 0) && (leadingEdge == 0)) {
+ textOffset -= thisCharWasDoubleByte;
+ textOffset--;
+ charOffset--;
+ }
+ }
+ if ((textOffset == 0) && (Tcl_DStringLength(&runString) > 0)
+ && (flags & TK_AT_LEAST_ONE)) {
+ p = Tcl_DStringValue(&runString);
+ textOffset += familyPtr->typeTable[*((unsigned char *) p)];
+ textOffset++;
+ charOffset++;
+ }
+ *widthLeftPtr = Fixed2Int(pixelWidth)
+ - TextWidth(Tcl_DStringValue(&runString), 0, textOffset);
+ Tcl_DStringFree(&runString);
+ return Tcl_UtfAtIndex(source, charOffset);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawChars --
+ *
+ * Draw a string of characters on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawChars(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for drawing characters. */
+ Tk_Font tkfont, /* Font in which characters will be drawn;
+ * must be the same as font used in GC. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. All Tk meta-characters
+ * (tabs, control characters, and newlines)
+ * should be stripped out of the string that
+ * is passed to this function. If they are
+ * not stripped out, they will be displayed as
+ * regular printing characters. */
+ int numBytes, /* Number of bytes in string. */
+ int x, int y) /* Coordinates at which to place origin of
+ * string when drawing. */
+{
+ MacFont *fontPtr;
+ MacDrawable *macWin;
+ RGBColor macColor, origColor;
+ GWorldPtr destPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ short txFont, txFace, txSize;
+ BitMapPtr stippleMap;
+ Rect portRect;
+
+ fontPtr = (MacFont *) tkfont;
+ macWin = (MacDrawable *) drawable;
+
+ destPort = TkMacOSXGetDrawablePort(drawable);
+ GetPortBounds(destPort, &portRect);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacOSXSetUpClippingRgn(drawable);
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ txFont = GetPortTextFont(destPort);
+ txFace = GetPortTextFace(destPort);
+ txSize = GetPortTextSize(destPort);
+ GetForeColor(&origColor);
+
+ if ((gc->fill_style == FillStippled
+ || gc->fill_style == FillOpaqueStippled)
+ && gc->stipple != None) {
+ Pixmap pixmap;
+ GWorldPtr bufferPort;
+ Pattern white;
+
+ stippleMap = TkMacOSXMakeStippleMap(drawable, gc->stipple);
+
+ pixmap = Tk_GetPixmap(display, drawable,
+ stippleMap->bounds.right, stippleMap->bounds.bottom, 0);
+
+ bufferPort = TkMacOSXGetDrawablePort(pixmap);
+ SetGWorld(bufferPort, NULL);
+
+ if (TkSetMacColor(gc->foreground, &macColor) == true) {
+ RGBForeColor(&macColor);
+ }
+ GetQDGlobalsWhite(&white);
+ ShowPen();
+ FillRect(&stippleMap->bounds, &white);
+ MultiFontDrawText(fontPtr, source, numBytes, 0, 0);
+ HidePen();
+
+ SetGWorld(destPort, NULL);
+ CopyDeepMask(GetPortBitMapForCopyBits(bufferPort), stippleMap,
+ GetPortBitMapForCopyBits(destPort), &stippleMap->bounds,
+ &stippleMap->bounds, &portRect,
+ srcOr, NULL);
+
+ /* TODO: this doesn't work quite right - it does a blend. you can't
+ * draw white text when you have a stipple.
+ */
+
+ Tk_FreePixmap(display, pixmap);
+ ckfree(stippleMap->baseAddr);
+ ckfree((char *)stippleMap);
+ } else {
+ if (TkSetMacColor(gc->foreground, &macColor) == true) {
+ RGBForeColor(&macColor);
+ }
+ ShowPen();
+ MultiFontDrawText(fontPtr, source, numBytes, macWin->xOff + x,
+ macWin->yOff + y);
+ HidePen();
+ }
+
+ TextFont(txFont);
+ TextSize(txSize);
+ TextFace(txFace);
+ RGBForeColor(&origColor);
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * MultiFontDrawText --
+ *
+ * Helper function for Tk_DrawChars. Draws characters, using the
+ * various screen fonts in fontPtr to draw multilingual characters.
+ * Note: No bidirectional support.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ * Contents of fontPtr may be modified if more subfonts were loaded
+ * in order to draw all the multilingual characters in the given
+ * string.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+MultiFontDrawText(
+ MacFont *fontPtr, /* Contains set of fonts to use when drawing
+ * following string. */
+ CONST char *source, /* Potentially multilingual UTF-8 string. */
+ int numBytes, /* Length of string in bytes. */
+ int x, int y) /* Coordinates at which to place origin *
+ * of string when drawing. */
+{
+ FontFamily *lastFamilyPtr, *thisFamilyPtr = NULL;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ Tcl_UniChar ch;
+
+ TextSize(fontPtr->size);
+ TextFace(fontPtr->style);
+
+ lastFamilyPtr = fontPtr->subFontArray[0].familyPtr;
+
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
+ if (thisFamilyPtr != lastFamilyPtr) {
+ if (p > source) {
+ TextFont(lastFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source,
+ p - source, &runString);
+ MoveTo((short) x, (short) y);
+ DrawText(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ x += TextWidth(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ source = p;
+ }
+ lastFamilyPtr = thisFamilyPtr;
+ }
+ p = next;
+ }
+ if (p > source) {
+ TextFont(thisFamilyPtr->faceNum);
+ Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source,
+ p - source, &runString);
+ MoveTo((short) x, (short) y);
+ DrawText(Tcl_DStringValue(&runString), 0,
+ Tcl_DStringLength(&runString));
+ Tcl_DStringFree(&runString);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkMacOSXIsCharacterMissing --
+ *
+ * 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
+TkMacOSXIsCharacterMissing(
+ Tk_Font tkfont, /* The font we are looking in. */
+ unsigned int searchChar) /* The character we are looking for. */
+{
+/*
+ * For some reason, FMSwapFont always returns a NULL font handle under OS X
+ * Until we figure this one out, return 0;
+ */
+#ifdef MAC_OSX_TK
+ return 0;
+#else
+ MacFont *fontPtr = (MacFont *) tkfont;
+ FMInput fm;
+ FontRec **fontRecHandle;
+ FMOutPtr fmOutPtr;
+
+
+ fm.family = fontPtr->subFontArray[0].familyPtr->faceNum;
+ fm.size = fontPtr->size;
+ fm.face = fontPtr->style;
+ fm.needBits = 0;
+ fm.device = 0;
+ fm.numer.h = fm.numer.v = fm.denom.h = fm.denom.v = 1;
+
+ fmOutPtr=FMSwapFont(&fm);
+ fprintf(stderr,"fmOut %08x, handle %08x\n", (int)fmOutPtr, fmOutPtr->fontHandle);
+
+#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;
+#endif
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Initializes the memory for a MacFont that wraps the platform-specific
+ * data.
+ *
+ * The caller is responsible for initializing the fields of the
+ * TkFont that are used exclusively by the generic TkFont code, and
+ * for releasing those fields before calling TkpDeleteFont().
+ *
+ * Results:
+ * Fills the MacFont structure.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitFont(
+ Tk_Window tkwin, /* For display where font will be used. */
+ int faceNum, /* Macintosh font number. */
+ int size, /* Point size for Macintosh font. */
+ int style, /* Macintosh style bits. */
+ MacFont *fontPtr) /* Filled with information constructed from
+ * the above arguments. */
+{
+ Str255 nativeName;
+ FontInfo fi;
+ TkFontAttributes *faPtr;
+ TkFontMetrics *fmPtr;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ short pixels;
+
+ if (size == 0) {
+ size = -GetDefFontSize();
+ }
+ pixels = (short) TkFontGetPixels(tkwin, size);
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(gWorld, NULL);
+ TextFont(faceNum);
+
+
+ TextSize(pixels);
+ TextFace(style);
+
+ GetFontInfo(&fi);
+ GetFontName(faceNum, nativeName);
+ fontPtr->font.fid = (Font) fontPtr;
+
+ faPtr = &fontPtr->font.fa;
+ faPtr->family = GetUtfFaceName(nativeName);
+ faPtr->size = TkFontGetPoints(tkwin, size);
+ faPtr->weight = (style & bold) ? TK_FW_BOLD : TK_FW_NORMAL;
+ faPtr->slant = (style & italic) ? TK_FS_ITALIC : TK_FS_ROMAN;
+ faPtr->underline = ((style & underline) != 0);
+ faPtr->overstrike = 0;
+
+ fmPtr = &fontPtr->font.fm;
+ fmPtr->ascent = fi.ascent;
+ fmPtr->descent = fi.descent;
+ fmPtr->maxWidth = fi.widMax;
+ fmPtr->fixed = (CharWidth('i') == CharWidth('w'));
+
+ fontPtr->size = pixels;
+ fontPtr->style = (short) style;
+
+ fontPtr->numSubFonts = 1;
+ fontPtr->subFontArray = fontPtr->staticSubFonts;
+ InitSubFont(fontPtr, faceNum, &fontPtr->subFontArray[0]);
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseFont --
+ *
+ * Called to release the Macintosh-specific contents of a TkFont.
+ * The caller is responsible for freeing the memory used by the
+ * font itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseFont(
+ MacFont *fontPtr) /* The font to delete. */
+{
+ int i;
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ ReleaseSubFont(&fontPtr->subFontArray[i]);
+ }
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * InitSubFont --
+ *
+ * Wrap a screen font and load the FontFamily that represents
+ * it. Used to prepare a SubFont so that characters can be mapped
+ * from UTF-8 to the charset of the font.
+ *
+ * Results:
+ * The subFontPtr is filled with information about the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+InitSubFont(
+ CONST MacFont *fontPtr, /* Font object in which the SubFont will be
+ * used. */
+ int faceNum, /* The font number. */
+ SubFont *subFontPtr) /* Filled with SubFont constructed from
+ * above attributes. */
+{
+ subFontPtr->familyPtr = AllocFontFamily(fontPtr, faceNum);
+ subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseSubFont --
+ *
+ * Called to release the contents of a SubFont. The caller is
+ * responsible for freeing the memory used by the SubFont itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseSubFont(
+ SubFont *subFontPtr) /* The SubFont to delete. */
+{
+ FreeFontFamily(subFontPtr->familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * AllocFontFamily --
+ *
+ * Find the FontFamily structure associated with the given font
+ * family. The information should be stored by the caller in a
+ * SubFont and used when determining if that SubFont supports a
+ * character.
+ *
+ * Results:
+ * A pointer to a FontFamily. The reference count in the FontFamily
+ * is automatically incremented. When the SubFont is released, the
+ * reference count is decremented. When no SubFont is using this
+ * FontFamily, it may be deleted.
+ *
+ * Side effects:
+ * A new FontFamily structure will be allocated if this font family
+ * has not been seen.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static FontFamily *
+AllocFontFamily(
+ CONST MacFont *fontPtr, /* Font object in which the FontFamily will
+ * be used. */
+ int faceNum) /* The font number. */
+{
+ FontFamily *familyPtr;
+ int i;
+
+ familyPtr = fontFamilyList;
+ for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if (familyPtr->faceNum == faceNum) {
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
+
+ familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ memset(familyPtr, 0, sizeof(FontFamily));
+ familyPtr->nextPtr = fontFamilyList;
+ fontFamilyList = familyPtr;
+
+ /*
+ * Set key for this FontFamily.
+ */
+
+ familyPtr->faceNum = faceNum;
+
+ /*
+ * An initial refCount of 2 means that FontFamily information will
+ * persist even when the SubFont that loaded the FontFamily is released.
+ * Change it to 1 to cause FontFamilies to be unloaded when not in use.
+ */
+
+ familyPtr->refCount = 2;
+ familyPtr->encoding = GetFontEncoding(faceNum, 1, &familyPtr->isSymbolFont);
+ familyPtr->isMultiByteFont = 0;
+ FillParseTable(familyPtr->typeTable, FontToScript(faceNum));
+ for (i = 0; i < 256; i++) {
+ if (familyPtr->typeTable[i] != 0) {
+ familyPtr->isMultiByteFont = 1;
+ break;
+ }
+ }
+ return familyPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FreeFontFamily --
+ *
+ * Called to free a FontFamily when the SubFont is finished using it.
+ * Frees the contents of the FontFamily and the memory used by the
+ * FontFamily itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FreeFontFamily(
+ FontFamily *familyPtr) /* The FontFamily to delete. */
+{
+ FontFamily **familyPtrPtr;
+ int i;
+
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ Tcl_FreeEncoding(familyPtr->encoding);
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree((char *) familyPtr->fontMap[i]);
+ }
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which physical screen font is necessary to use to
+ * display the given character. If the font object does not have
+ * a screen font that can display the character, another screen font
+ * may be loaded into the font object, following a set of preferred
+ * fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+FindSubFontForChar(
+ MacFont *fontPtr, /* The font object with which the character
+ * will be displayed. */
+ int ch) /* The Unicode character to be displayed. */
+{
+ int i, j, k;
+ CONST char *fallbackName;
+ char **aliases;
+ SubFont *subFontPtr;
+ FontNameMap *mapPtr;
+ Tcl_DString faceNames;
+ char ***fontFallbacks;
+ char **anyFallbacks;
+
+ if (FontMapLookup(&fontPtr->subFontArray[0], ch)) {
+ return &fontPtr->subFontArray[0];
+ }
+
+ for (i = 1; i < fontPtr->numSubFonts; i++) {
+ if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
+ return &fontPtr->subFontArray[i];
+ }
+ }
+
+ /*
+ * Keep track of all face names that we check, so we don't check some
+ * name multiple times if it can be reached by multiple paths.
+ */
+
+ Tcl_DStringInit(&faceNames);
+
+ aliases = TkFontGetAliasList(fontPtr->font.fa.family);
+
+ subFontPtr = NULL;
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) {
+ /*
+ * If the base font has a fallback...
+ */
+
+ goto tryfallbacks;
+ } else if (aliases != NULL) {
+ /*
+ * Or if an alias for the base font has a fallback...
+ */
+
+ for (k = 0; aliases[k] != NULL; k++) {
+ if (strcasecmp(aliases[k], fallbackName) == 0) {
+ goto tryfallbacks;
+ }
+ }
+ }
+ }
+ continue;
+
+ /*
+ * ...then see if we can use one of the fallbacks, or an
+ * alias for one of the fallbacks.
+ */
+
+ tryfallbacks:
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName,
+ ch, &faceNames);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ /*
+ * See if we can use something from the global fallback list.
+ */
+
+ anyFallbacks = TkFontGetGlobalClass();
+ for (i = 0; anyFallbacks[i] != NULL; i++) {
+ fallbackName = anyFallbacks[i];
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName, ch,
+ &faceNames);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * Try all face names available in the whole system until we
+ * find one that can be used.
+ */
+
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ fallbackName = mapPtr->utfName;
+ if (SeenName(fallbackName, &faceNames) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, fallbackName, ch);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ end:
+ Tcl_DStringFree(&faceNames);
+
+ if (subFontPtr == NULL) {
+ /*
+ * No font can display this character. We will use the base font
+ * and have it display the "unknown" character.
+ */
+
+ subFontPtr = &fontPtr->subFontArray[0];
+ FontMapInsert(subFontPtr, ch);
+ }
+ return subFontPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLookup --
+ *
+ * See if the screen font can display the given character.
+ *
+ * Results:
+ * The return value is 0 if the screen font cannot display the
+ * character, non-zero otherwise.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FontMapLookup(
+ SubFont *subFontPtr, /* Contains font mapping cache to be queried
+ * and possibly updated. */
+ int ch) /* Character to be tested. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapInsert --
+ *
+ * Tell the font mapping cache that the given screen font should be
+ * used to display the specified character. This is called when no
+ * font on the system can be be found that can display that
+ * character; we lie to the font and tell it that it can display
+ * the character, otherwise we would end up re-searching the entire
+ * fallback hierarchy every time that character was seen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontMapInsert(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int ch) /* Character to be added to cache. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated HFONT can (1) or cannot (0) display the
+ * characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int row) /* Index of the page to be loaded into
+ * the cache. */
+{
+ FMInput fm;
+ FMOutPtr fmOut;
+ int i, end, bitOffset, isMultiByteFont;
+ char src[TCL_UTF_MAX];
+ unsigned char buf[16];
+ int srcRead, dstWrote;
+ Tcl_Encoding encoding;
+ Handle fHandle = NULL;
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ encoding = subFontPtr->familyPtr->encoding;
+
+ fm.family = subFontPtr->familyPtr->faceNum;
+ fm.size = 12;
+ fm.face = 0;
+ fm.needBits = 0;
+ fm.device = 0;
+ fm.numer.h = 1;
+ fm.numer.v = 1;
+ fm.denom.h = 1;
+ fm.denom.v = 1;
+ /*
+#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
+ fHandle = FMSwapFont(&fm)->fontHandle;
+#else
+ fHandle = FMSwapFont(&fm)->fontHandle;
+#endif
+*/
+/*
+ * For some reason, FMSwapFont alywas returns a structure where the returned font handle
+ * is NULL. Until we figure this one out, assume all characters are allowed
+ */
+ fmOut=FMSwapFont(&fm);
+ fHandle=fmOut->fontHandle;
+ isMultiByteFont=subFontPtr->familyPtr->isMultiByteFont;
+#ifndef MAC_OSX_TK
+ GetResInfo(fHandle, &theID, &theType, theName);
+ fprintf ( stderr, "ResError() %d, %x\n", ResError (), fHandle );
+ if (theType=='sfnt') {
+#endif
+ /*
+ * Found an outline font which has very complex font record.
+ * Let's just assume *ALL* the characters are allowed.
+ */
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i,
+ src),
+ TCL_ENCODING_STOPONERROR, NULL, (char *) buf,
+ sizeof(buf),
+ &srcRead, &dstWrote, NULL) == TCL_OK) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1
+ << (bitOffset & 7);
+ }
+ }
+#ifndef MAC_OSX_TK
+ } else {
+ /*
+ * Found an old bitmap font which has a well-defined record.
+ * We can check the width table to see which characters exist.
+ */
+
+ fontRecPtr = *((FontRec **) fHandle );
+ widths = (short *) ((long) &fontRecPtr->owTLoc
+ + ((long) (fontRecPtr->owTLoc - fontRecPtr->firstChar)
+ * sizeof(short)));
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ if (Tcl_UtfToExternal(NULL, encoding, src,
+ Tcl_UniCharToUtf(i, src),
+ TCL_ENCODING_STOPONERROR, NULL, (char *) buf, sizeof(buf),
+ &srcRead, &dstWrote, NULL) == TCL_OK) {
+
+ if (((isMultiByteFont != 0) && (buf[0] > 31))
+ || (widths[buf[0]] != -1)) {
+ if ((buf[0] == 0x11) && (widths[0x12] == -1)) {
+ continue;
+ }
+
+ /*
+ * Mac's char existence metrics are only for one-byte
+ * characters. If we have a double-byte char, just
+ * assume that the font supports that char if the font's
+ * encoding supports that char.
+ */
+
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1
+ << (bitOffset & 7);
+ }
+ }
+ }
+ }
+#endif
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(
+ MacFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ CONST char *faceName, /* Desired face name for new screen font. */
+ int ch, /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr) /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ SubFont *subFontPtr;
+ char **aliases;
+ int i;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SeenName(
+ CONST char *name, /* The name to check. */
+ Tcl_DString *dsPtr) /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified physical screen font has not already been loaded
+ * into the font object, determine if the specified physical screen
+ * font can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont, owned
+ * by the font object. This SubFont can be used to display the given
+ * character. The SubFont represents the screen font with the base set
+ * of font attributes from the font object, but using the specified
+ * font name. NULL is returned if the font object already holds
+ * a reference to the specified physical font or if the specified
+ * physical font cannot display the given character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(
+ MacFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ CONST char *faceName, /* Desired face name for new screen font. */
+ int ch) /* The Unicode character that the new
+ * screen font must be able to display. */
+{
+ int i;
+ SubFont subFont;
+ short faceNum;
+
+ if (GetFamilyNum(faceName, &faceNum) == 0) {
+ return NULL;
+ }
+
+ /*
+ * Skip all fonts we've already used.
+ */
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ if (faceNum == fontPtr->subFontArray[i].familyPtr->faceNum) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Load this font and see if it has the desired character.
+ */
+
+ InitSubFont(fontPtr, faceNum, &subFont);
+ if (((ch < 256) && (subFont.familyPtr->isSymbolFont))
+ || (FontMapLookup(&subFont, ch) == 0)) {
+ ReleaseSubFont(&subFont);
+ return NULL;
+ }
+
+ if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
+ SubFont *newPtr;
+ newPtr = (SubFont *) ckalloc(sizeof(SubFont)
+ * (fontPtr->numSubFonts + 1));
+ memcpy((char *) newPtr, fontPtr->subFontArray,
+ fontPtr->numSubFonts * sizeof(SubFont));
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+ fontPtr->subFontArray = newPtr;
+ }
+ fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
+ fontPtr->numSubFonts++;
+ return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetFamilyNum --
+ *
+ * Determines if any physical screen font exists on the system with
+ * the given family name. If the family exists, then it should be
+ * possible to construct some physical screen font with that family
+ * name.
+ *
+ * Results:
+ * The return value is 0 if the specified font family does not exist,
+ * non-zero otherwise. *faceNumPtr is filled with the unique face
+ * number that identifies the screen font, or 0 if the font family
+ * did not exist.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+GetFamilyNum(
+ CONST char *faceName, /* UTF-8 name of font family to query. */
+ short *faceNumPtr) /* Filled with font number for above family. */
+{
+ FontNameMap *mapPtr;
+
+ if (faceName != NULL) {
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ if (strcasecmp(faceName, mapPtr->utfName) == 0) {
+ *faceNumPtr = mapPtr->faceNum;
+ return 1;
+ }
+ }
+ }
+ *faceNumPtr = 0;
+ return 0;
+}
+
+static int
+GetFamilyOrAliasNum(
+ CONST char *faceName, /* UTF-8 name of font family to query. */
+ short *faceNumPtr) /* Filled with font number for above family. */
+{
+ char **aliases;
+ int i;
+
+ if (GetFamilyNum(faceName, faceNumPtr) != 0) {
+ return 1;
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (GetFamilyNum(aliases[i], faceNumPtr) != 0) {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetUtfFaceName --
+ *
+ * Given the native name for a Macintosh font (in which the name of
+ * the font is in the encoding of the font itself), return the UTF-8
+ * name that corresponds to that font. The specified font name must
+ * refer to a font that actually exists on the machine.
+ *
+ * This function is used to obtain the UTF-8 name when querying the
+ * properties of a Macintosh font object.
+ *
+ * Results:
+ * The return value is a pointer to the UTF-8 of the specified font.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static Tk_Uid
+GetUtfFaceName(
+ StringPtr nativeName) /* Pascal name for font in native encoding. */
+{
+ FontNameMap *mapPtr;
+
+ for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
+ if (pstrcmp(nativeName, mapPtr->nativeName) == 0) {
+ return mapPtr->utfName;
+ }
+ }
+ panic("GetUtfFaceName: unexpected nativeName");
+ return NULL;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * GetFontEncoding --
+ *
+ * Return a string that can be passed to Tcl_GetTextEncoding() and
+ * used to convert bytes from UTF-8 into the encoding of the
+ * specified font.
+ *
+ * The desired encoding to use to convert the name of a symbolic
+ * font into UTF-8 is macRoman, while the desired encoding to use
+ * to convert bytes in a symbolic font to UTF-8 is the corresponding
+ * symbolic encoding. Due to this dual interpretatation of symbolic
+ * fonts, the caller can specify what type of encoding to return
+ * should the specified font be symbolic.
+ *
+ * Results:
+ * The return value is a string that specifies the font's encoding.
+ * If the font's encoding could not be identified, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static Tcl_Encoding
+GetFontEncoding(
+ int faceNum, /* Macintosh font number. */
+ int allowSymbol, /* If non-zero, then the encoding string
+ * for symbol fonts will be the corresponding
+ * symbol encoding. Otherwise, the encoding
+ * string for symbol fonts will be
+ * "macRoman". */
+ int *isSymbolPtr) /* Filled with non-zero if this font is a
+ * symbol font, 0 otherwise. */
+{
+ Str255 faceName;
+ int script, lang;
+ char *name;
+
+ if (allowSymbol != 0) {
+ GetFontName(faceNum, faceName);
+ if (pstrcasecmp(faceName, "\psymbol") == 0) {
+ *isSymbolPtr = 1;
+ return Tcl_GetEncoding(NULL, "symbol");
+ }
+ if (pstrcasecmp(faceName, "\pzapf dingbats") == 0) {
+ *isSymbolPtr = 1;
+ return Tcl_GetEncoding(NULL, "macDingbats");
+ }
+ }
+ *isSymbolPtr = 0;
+ script = FontToScript(faceNum);
+ lang = GetScriptVariable(script, smScriptLang);
+ name = NULL;
+ if (script == smRoman) {
+ name = TkFindStateString(romanMap, lang);
+ } else if (script == smCyrillic) {
+ name = TkFindStateString(cyrillicMap, lang);
+ }
+ if (name == NULL) {
+ name = TkFindStateString(scriptMap, script);
+ }
+ return Tcl_GetEncoding(NULL, name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXInitControlFontStyle --
+ *
+ * This procedure sets up the appropriate ControlFontStyleRec
+ * for a Mac control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXInitControlFontStyle(Tk_Font tkfont, ControlFontStylePtr fsPtr)
+{
+ MacFont *fontPtr;
+ FontFamily *lastFamilyPtr;
+ fontPtr = (MacFont *) tkfont;
+ lastFamilyPtr = fontPtr->subFontArray[0].familyPtr;
+ fsPtr->flags =
+ kControlUseFontMask|
+ kControlUseSizeMask|
+ kControlUseFaceMask|
+ kControlUseJustMask;
+ fsPtr->font = lastFamilyPtr->faceNum;
+ fsPtr->size = fontPtr->size;
+ fsPtr->style = fontPtr->style;
+ fsPtr->just = teCenter;
+}
diff --git a/tcl/macosx/tkMacOSXHLEvents.c b/tcl/macosx/tkMacOSXHLEvents.c
new file mode 100644
index 00000000000..5c04014358d
--- /dev/null
+++ b/tcl/macosx/tkMacOSXHLEvents.c
@@ -0,0 +1,447 @@
+/*
+ * tkMacOSXHLEvents.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.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXUtil.h"
+#include "tkMacOSXInt.h"
+
+#include <Carbon/Carbon.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 OSErr QuitHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon);
+static OSErr OappHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon);
+static OSErr OdocHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon);
+static OSErr PrintHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon);
+static OSErr ScriptHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon);
+static OSErr PrefsHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon);
+
+static int MissedAnyParameters _ANSI_ARGS_((const AppleEvent *theEvent));
+static int ReallyKillMe _ANSI_ARGS_((Tcl_Event *eventPtr, int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXInitAppleEvents --
+ *
+ * Initilize the Apple Events on the Macintosh. This registers the
+ * core event handlers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXInitAppleEvents(
+ Tcl_Interp *interp) /* Interp to handle basic events. */
+{
+ OSErr err;
+ AEEventHandlerUPP OappHandlerUPP, OdocHandlerUPP,
+ PrintHandlerUPP, QuitHandlerUPP, ScriptHandlerUPP,
+ PrefsHandlerUPP;
+
+ /*
+ * Install event handlers for the core apple events.
+ */
+ QuitHandlerUPP = NewAEEventHandlerUPP(QuitHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEQuitApplication,
+ QuitHandlerUPP, (long) interp, false);
+
+ OappHandlerUPP = NewAEEventHandlerUPP(OappHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEOpenApplication,
+ OappHandlerUPP, (long) interp, false);
+
+ OdocHandlerUPP = NewAEEventHandlerUPP(OdocHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments,
+ OdocHandlerUPP, (long) interp, false);
+
+ PrintHandlerUPP = NewAEEventHandlerUPP(PrintHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments,
+ PrintHandlerUPP, (long) interp, false);
+
+ PrefsHandlerUPP = NewAEEventHandlerUPP(PrefsHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEShowPreferences,
+ PrefsHandlerUPP, (long) interp, false);
+
+ if (interp != NULL) {
+ ScriptHandlerUPP = NewAEEventHandlerUPP(ScriptHandler);
+ err = AEInstallEventHandler('misc', 'dosc',
+ ScriptHandlerUPP, (long) interp, false);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXDoHLEvent --
+ *
+ * Dispatch incomming highlevel events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the incoming event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXDoHLEvent(EventRecord *theEvent)
+{
+ return AEProcessAppleEvent(theEvent);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QuitHandler, OappHandler, etc. --
+ *
+ * These are the core Apple event handlers. Only the Quit event does
+ * anything interesting.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+OSErr QuitHandler (const AppleEvent * event, 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 OSErr
+OappHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon)
+{
+ return noErr;
+}
+
+/* Called when the user selects 'Preferences...' in MacOS X */
+static OSErr
+PrefsHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon)
+{
+ Tcl_CmdInfo dummy;
+ Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
+ /*
+ * Don't bother if we don't have an interp or
+ * the show preferences procedure doesn't exist.
+ */
+
+ if ((interp == NULL) ||
+ (Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)) == 0) {
+ return noErr;
+ }
+ Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences");
+ return noErr;
+}
+
+static OSErr
+OdocHandler (const AppleEvent * event, 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, "::tk::mac::OpenDocument", &dummy)) == 0) {
+ return noErr;
+ }
+
+ /*
+ * If we get any errors wil retrieving our parameters
+ * we just return with no error.
+ */
+
+ err = AEGetParamDesc(event, keyDirectObject,
+ typeAEList, &fileSpecList);
+ if (err != noErr) {
+ return noErr;
+ }
+
+ err = MissedAnyParameters(event);
+ if (err != noErr) {
+ return noErr;
+ }
+
+ err = AECountItems(&fileSpecList, &count);
+ if (err != noErr) {
+ return noErr;
+ }
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, "::tk::mac::OpenDocument", -1);
+ for (index = 1; index <= count; index++) {
+ int length;
+ Handle fullPath;
+
+ err = AEGetNthPtr(&fileSpecList, index, typeFSS,
+ &keyword, &type, (Ptr) &file, sizeof(FSSpec), &actual);
+ if ( err != noErr ) {
+ continue;
+ }
+
+ err = FSpPathFromLocation(&file, &length, &fullPath);
+ HLock(fullPath);
+ Tcl_ExternalToUtfDString(NULL, *fullPath, length, &pathName);
+ HUnlock(fullPath);
+ DisposeHandle(fullPath);
+
+ Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
+ Tcl_DStringFree(&pathName);
+ }
+
+ Tcl_GlobalEval(interp, Tcl_DStringValue(&command));
+
+ Tcl_DStringFree(&command);
+ return noErr;
+}
+
+static OSErr
+PrintHandler (const AppleEvent * event, AppleEvent * reply, long handlerRefcon)
+{
+ return noErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScriptHandler --
+ *
+ * This handler process the script event.
+ *
+ * Results:
+ * Schedules the given event to be processed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OSErr
+ScriptHandler (const AppleEvent * event, 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(event, keyDirectObject, typeWildCard,
+ &theDesc);
+ if (theErr != noErr) {
+ sprintf(errString, "AEDoScriptHandler: GetParamDesc error %d", theErr);
+ theErr = AEPutParamPtr(reply, keyErrorString, typeChar, errString,
+ strlen(errString));
+ } else if (MissedAnyParameters(event)) {
+ sprintf(errString, "AEDoScriptHandler: extra parameters");
+ AEPutParamPtr(reply, keyErrorString, typeChar, errString,
+ strlen(errString));
+ theErr = -1771;
+ } else {
+ if (theDesc.descriptorType == (DescType)'TEXT') {
+ Tcl_DString encodedText;
+ short i;
+ Size size;
+ char * data;
+
+ size = AEGetDescDataSize(&theDesc);
+
+ data = (char *)ckalloc(size + 1);
+ if ( !data ) {
+ theErr = -1771;
+ }
+ else {
+ AEGetDescData(&theDesc,data,size);
+ data [ size ] = 0;
+ for (i=0; i<size; i++)
+ if (data[i] == '\r')
+ data[i] = '\n';
+ AEReplaceDescData(theDesc.descriptorType,data,size+1,&theDesc);
+ }
+ Tcl_ExternalToUtfDString(NULL, data, size,
+ &encodedText);
+ tclErr = Tcl_GlobalEval(interp, Tcl_DStringValue(&encodedText));
+ Tcl_DStringFree(&encodedText);
+ } else if (theDesc.descriptorType == (DescType)'alis') {
+ Boolean dummy;
+ FSSpec theFSS;
+ Handle fullPath;
+ int length;
+ AliasHandle aliasHandle;
+
+ AEGetDescData (&theDesc,&aliasHandle,sizeof(aliasHandle ) );
+
+ theErr = ResolveAlias(NULL, aliasHandle,
+ &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'",
+ (char *)(&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,
+ Tcl_GetStringResult(interp),
+ strlen(Tcl_GetStringResult(interp)));
+ } else {
+ AEPutParamPtr(reply, keyErrorString, typeChar,
+ Tcl_GetStringResult(interp),
+ strlen(Tcl_GetStringResult(interp)));
+ AEPutParamPtr(reply, keyErrorNumber, typeInteger,
+ (Ptr) &tclErr, sizeof(int));
+ }
+ }
+
+ AEDisposeDesc(&theDesc);
+
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static 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(
+ const AppleEvent *theEvent)
+{
+ DescType returnedType;
+ Size actualSize;
+ OSErr err;
+
+ err = AEGetAttributePtr(theEvent, keyMissedKeywordAttr, typeWildCard,
+ &returnedType, NULL, 0, &actualSize);
+
+ return (err != errAEDescNotFound);
+}
diff --git a/tcl/macosx/tkMacOSXInit.c b/tcl/macosx/tkMacOSXInit.c
new file mode 100644
index 00000000000..a6c4bef728c
--- /dev/null
+++ b/tcl/macosx/tkMacOSXInit.c
@@ -0,0 +1,221 @@
+/*
+ * tkUnixInit.c --
+ *
+ * This file contains Unix-specific interpreter initialization
+ * functions.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+
+/*
+ * The Init script (common to Windows and Unix platforms) is
+ * defined in tkInitScript.h
+ */
+#include "tkInitScript.h"
+
+/*
+ * The following structures are used to map the script/language codes of a
+ * font to the name that should be passed to Tcl_GetEncoding() to obtain
+ * the encoding for that font. The set of numeric constants is fixed and
+ * defined by Apple.
+ */
+
+typedef struct Map {
+ int numKey;
+ char *strKey;
+} Map;
+
+static Map scriptMap[] = {
+ {smRoman, "macRoman"},
+ {smJapanese, "macJapan"},
+ {smTradChinese, "macChinese"},
+ {smKorean, "macKorean"},
+ {smArabic, "macArabic"},
+ {smHebrew, "macHebrew"},
+ {smGreek, "macGreek"},
+ {smCyrillic, "macCyrillic"},
+ {smRSymbol, "macRSymbol"},
+ {smDevanagari, "macDevanagari"},
+ {smGurmukhi, "macGurmukhi"},
+ {smGujarati, "macGujarati"},
+ {smOriya, "macOriya"},
+ {smBengali, "macBengali"},
+ {smTamil, "macTamil"},
+ {smTelugu, "macTelugu"},
+ {smKannada, "macKannada"},
+ {smMalayalam, "macMalayalam"},
+ {smSinhalese, "macSinhalese"},
+ {smBurmese, "macBurmese"},
+ {smKhmer, "macKhmer"},
+ {smThai, "macThailand"},
+ {smLaotian, "macLaos"},
+ {smGeorgian, "macGeorgia"},
+ {smArmenian, "macArmenia"},
+ {smSimpChinese, "macSimpChinese"},
+ {smTibetan, "macTIbet"},
+ {smMongolian, "macMongolia"},
+ {smGeez, "macEthiopia"},
+ {smEastEurRoman, "macCentEuro"},
+ {smVietnamese, "macVietnam"},
+ {smExtArabic, "macSindhi"},
+ {NULL, NULL}
+};
+
+Tcl_Encoding TkMacOSXCarbonEncoding = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpInit --
+ *
+ * Performs Mac-specific interpreter initialization related to the
+ * tk_library variable.
+ *
+ * Results:
+ * Returns a standard Tcl result. Leaves an error message or result
+ * in the interp's result.
+ *
+ * Side effects:
+ * Sets "tk_library" Tcl variable, runs "tk.tcl" script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(interp)
+ Tcl_Interp *interp;
+{
+ char tkLibPath[1024];
+ int result;
+ static int menusInitialized = false;
+ static int carbonEncodingInitialized = false;
+
+ /*
+ * Since it is possible for TkInit to be called multiple times
+ * and we don't want to do the menu initialization multiple times
+ * we protect against doing it more than once.
+ */
+
+ if (menusInitialized == false) {
+ menusInitialized = true;
+ Tk_MacOSXSetupTkNotifier();
+ TkMacOSXInitAppleEvents(interp);
+ TkMacOSXInitMenus(interp);
+ }
+
+ if (carbonEncodingInitialized == false) {
+ CFStringEncoding encoding;
+ char *encodingStr = NULL;
+ int i;
+
+ encoding = CFStringGetSystemEncoding();
+
+ for (i = 0; scriptMap[i].strKey != NULL; i++) {
+ if (scriptMap[i].numKey == encoding) {
+ encodingStr = scriptMap[i].strKey;
+ break;
+ }
+ }
+ if (encodingStr == NULL) {
+ encodingStr = "macRoman";
+ }
+
+ TkMacOSXCarbonEncoding = Tcl_GetEncoding (NULL, encodingStr);
+ if (TkMacOSXCarbonEncoding == NULL) {
+ TkMacOSXCarbonEncoding = Tcl_GetEncoding (NULL, NULL);
+ }
+ }
+
+ /*
+ * When Tk is in a framework, force tcl_findLibrary to look in the
+ * framework scripts directory.
+ * FIXME: Should we come up with a more generic way of doing this?
+ */
+
+ result = Tcl_MacOSXOpenBundleResources(interp, "com.tcltk.tklibrary",
+ 1, 1024, tkLibPath);
+
+ if (result != TCL_ERROR) {
+ Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY);
+ }
+
+ 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. */
+{
+ CONST 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)
+ CONST char *msg; /* Message to be displayed. */
+ CONST char *title; /* Title of warning. */
+{
+ Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ if (errChannel) {
+ Tcl_WriteChars(errChannel, title, -1);
+ Tcl_WriteChars(errChannel, ": ", 2);
+ Tcl_WriteChars(errChannel, msg, -1);
+ Tcl_WriteChars(errChannel, "\n", 1);
+ }
+}
diff --git a/tcl/macosx/tkMacOSXInt.h b/tcl/macosx/tkMacOSXInt.h
new file mode 100644
index 00000000000..91450430dcd
--- /dev/null
+++ b/tcl/macosx/tkMacOSXInt.h
@@ -0,0 +1,155 @@
+/*
+ * tkMacOSXInt.h --
+ *
+ * Declarations of Macintosh specific shared variables and procedures.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Include platform specific public interfaces.
+ */
+
+#ifndef _TKMAC
+#include "tkMacOSX.h"
+#endif
+
+#ifndef _TKPORT
+#include "tkPort.h"
+#endif
+
+#include <Carbon/Carbon.h>
+
+struct TkWindowPrivate {
+ TkWindow *winPtr; /* Ptr to tk window or NULL if Pixmap */
+ CGrafPtr grafPtr;
+ ControlRef rootControl;
+ 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 TkMacOSXWindowList {
+ struct TkMacOSXWindowList *nextPtr; /* The next window in the list. */
+ TkWindow *winPtr; /* This window */
+} TkMacOSXWindowList;
+
+/*
+ * 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
+ * TkMacOSXGetDrawablePort. The definitions of the function types
+ * are in tclMac.h.
+ */
+
+typedef struct {
+ Tk_MacOSXEmbedRegisterWinProc *registerWinProc;
+ Tk_MacOSXEmbedGetGrafPortProc *getPortProc;
+ Tk_MacOSXEmbedMakeContainerExistProc *containerExistProc;
+ Tk_MacOSXEmbedGetClipProc *getClipProc;
+ Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc;
+} TkMacOSXEmbedHandler;
+
+extern TkMacOSXEmbedHandler *gMacEmbedHandler;
+
+/*
+ * Defines used for TkMacOSXInvalidateWindow
+ */
+
+#define TK_WINDOW_ONLY 0
+#define TK_PARENT_WINDOW 1
+
+/*
+ * Accessor for the privatePtr flags field for the TK_HOST_EXISTS field
+ */
+
+#define TkMacOSXHostToplevelExists(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.
+ */
+
+/*
+ * 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 int tkPictureIsOpen; /* If this is 1, we are drawing to a picture
+ * The clipping should then be done relative
+ * to the bounds of the picture rather than the window
+ * As of OS X.0.4, something is seriously wrong:
+ * The clipping bounds only seem to work if the
+ * top,left values are 0,0
+ * The destination rectangle for CopyBits
+ * should also have top,left values of 0,0
+ */
+extern TkMacOSXWindowList *tkMacOSXWindowListPtr;
+ /* The list of toplevels */
+
+extern Tcl_Encoding TkMacOSXCarbonEncoding;
+
+#include "tkIntPlatDecls.h"
+
+#endif /* _TKMACINT */
diff --git a/tcl/macosx/tkMacOSXKeyEvent.c b/tcl/macosx/tkMacOSXKeyEvent.c
new file mode 100644
index 00000000000..a8d27119156
--- /dev/null
+++ b/tcl/macosx/tkMacOSXKeyEvent.c
@@ -0,0 +1,501 @@
+/*
+ * tkMacOSXKeyEvent.c --
+ *
+ * This file implements functions that decode & handle keyboard events
+ * on MacOS X.
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#include "tkMacOSXInt.h"
+#include "tkPort.h"
+#include "tkMacOSXEvent.h"
+
+typedef struct {
+ WindowRef whichWindow;
+ Point global;
+ Point local;
+ int state;
+ char ch;
+ UInt32 keyCode;
+ UInt32 keyModifiers;
+ UInt32 message;
+} KeyEventData;
+
+static Tk_Window gGrabWinPtr = NULL; /* Current grab window, NULL if no grab. */
+static Tk_Window gKeyboardWinPtr = NULL; /* Current keyboard grab window. */
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static int GenerateKeyEvent _ANSI_ARGS_(( EventKind eKind,
+ KeyEventData * e,
+ Window window,
+ UInt32 savedKeyCode,
+ UInt32 savedModifiers));
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXProcessKeyboardEvent --
+ *
+ * This routine processes the event in eventPtr, and
+ * generates the appropriate Tk events from it.
+ *
+ * Results:
+ * True if event(s) are generated - false otherwise.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int TkMacOSXProcessKeyboardEvent(
+ TkMacOSXEvent * eventPtr,
+ MacEventStatus * statusPtr)
+{
+ static UInt32 savedKeyCode = 0;
+ static UInt32 savedModifiers = 0;
+ OSStatus status;
+ KeyEventData keyEventData;
+ Window window;
+ MenuRef menuRef;
+ MenuItemIndex menuItemIndex;
+ int eventGenerated;
+
+ statusPtr->handledByTk = 1;
+ keyEventData.whichWindow = FrontNonFloatingWindow();
+ if (keyEventData.whichWindow == NULL) {
+ return 0;
+ }
+ GetMouse(&keyEventData.local);
+ keyEventData.global = keyEventData.local;
+ LocalToGlobal(&keyEventData.global);
+ keyEventData.state = TkMacOSXButtonKeyState();
+#if 0
+ /*
+ * This block of code seems like a good idea, to trap
+ * key-bindings which point directly to menus, but it
+ * has a number of problems:
+ * (1) when grabs are present we definitely don't want
+ * to do this.
+ * (2) Tk's semantics define accelerator keystrings in
+ * menus as a purely visual adornment, and require that
+ * the developer create separate bindings to trigger
+ * them. This breaks those semantics. (i.e. Tk will
+ * behave differently on Aqua to the behaviour on Unix/Win).
+ * (3) Tk's bindings depend on the current window's bindtags,
+ * which may be completely different to what happens to be
+ * in some global menu (agreed, it shouldn't be that different,
+ * but it often is).
+ *
+ * While a better middleground might be possible, the best, most
+ * compatible, approach at present is to disable this block.
+ */
+ if (IsMenuKeyEvent(NULL, eventPtr->eventRef,
+ kNilOptions, &menuRef, &menuItemIndex)) {
+ int oldMode;
+ MenuID menuID;
+ KeyMap theKeys;
+ int selection;
+
+ menuID = GetMenuID(menuRef);
+ selection = (menuID << 16 ) | menuItemIndex;
+
+ GetKeys(theKeys);
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ TkMacOSXClearMenubarActive();
+
+ /*
+ * Handle -postcommand
+ */
+
+ TkMacOSXPreprocessMenu();
+ TkMacOSXHandleMenuSelect(selection, theKeys[1] & 4);
+ Tcl_SetServiceMode(oldMode);
+ return 0; /* TODO: may not be on event on queue. */
+ }
+#endif
+
+ status = GetEventParameter(eventPtr->eventRef,
+ kEventParamKeyMacCharCodes,
+ typeChar, NULL,
+ sizeof(keyEventData.ch), NULL,
+ &keyEventData.ch);
+ if (status != noErr) {
+ fprintf(stderr, "Failed to retrieve KeyMacCharCodes\n" );
+ statusPtr->err = 1;
+ return 1;
+ }
+ status = GetEventParameter(eventPtr->eventRef,
+ kEventParamKeyCode,
+ typeUInt32, NULL,
+ sizeof(keyEventData.keyCode), NULL,
+ &keyEventData.keyCode);
+ if (status != noErr) {
+ fprintf(stderr, "Failed to retrieve KeyCode\n" );
+ statusPtr->err = 1;
+ return 1;
+ }
+ status = GetEventParameter(eventPtr->eventRef,
+ kEventParamKeyModifiers,
+ typeUInt32, NULL,
+ sizeof(keyEventData.keyModifiers), NULL,
+ &keyEventData.keyModifiers);
+ if (status != noErr) {
+ fprintf(stderr, "Failed to retrieve KeyModifiers\n" );
+ statusPtr->err = 1;
+ return 1;
+ }
+ keyEventData.message = keyEventData.ch|(keyEventData.keyCode << 8);
+
+ window = TkMacOSXGetXWindow(keyEventData.whichWindow);
+
+ eventGenerated = GenerateKeyEvent(eventPtr->eKind, &keyEventData,
+ window, savedKeyCode, savedModifiers);
+ savedModifiers = keyEventData.keyModifiers;
+
+ if (eventGenerated == 0) {
+ savedKeyCode = keyEventData.message;
+ return false;
+ } else if (eventGenerated == -1) {
+ savedKeyCode = 0;
+ return false;
+ } else {
+ savedKeyCode = 0;
+ 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:
+ * 1 if an event was generated, 0 if we are waiting for another
+ * byte of a multi-byte sequence, and -1 for any other error.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+GenerateKeyEvent( EventKind eKind,
+ KeyEventData * e,
+ Window window,
+ UInt32 savedKeyCode,
+ UInt32 savedModifiers )
+{
+ Tk_Window tkwin;
+ XEvent event;
+ unsigned char byte;
+ char buf[16];
+ TkDisplay *dispPtr;
+
+ /*
+ * The focus must be in the FrontWindow on the Macintosh.
+ * We then query Tk to determine the exact Tk window
+ * that owns the focus.
+ */
+
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+
+ if (tkwin == NULL) {
+ fprintf(stderr,"tkwin == NULL, %d\n", __LINE__);
+ return -1;
+ }
+
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
+ if (tkwin == NULL) {
+ fprintf(stderr,"tkwin == NULL, %d\n", __LINE__);
+ return -1;
+ }
+ byte = (e->message&charCodeMask);
+ if (byte == 0) {
+ /*
+ * Either we have a pure-modifier change, or perhaps
+ * a dead-key (e.g. opt-e) was pressed. In the former case we do
+ * want to generate an event, in the latter I'm not sure
+ * what to do.
+ */
+ if (eKind == kEventRawKeyModifiersChanged) {
+ /* Drop through to the event code below */
+ } else {
+ /*
+ * What shall we do here? We certainly aren't dealing
+ * with deadkeys at present. Is this where they come?
+ */
+ return 0;
+ }
+ } else if ((savedKeyCode == 0) &&
+ (Tcl_ExternalToUtf(NULL, TkMacOSXCarbonEncoding,
+ (char *) &byte, 1, 0, NULL,
+ buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK)) {
+ /*
+ * This event specifies a lead byte. Wait for the second byte
+ * to come in before sending the XEvent.
+ */
+ fprintf(stderr,"Failed %02x\n", byte);
+ return 0;
+ }
+
+ event.xany.send_event = False;
+ event.xkey.same_screen = true;
+ event.xkey.subwindow = None;
+ event.xkey.time = TkpGetMS();
+
+ event.xkey.x_root = e->global.h;
+ event.xkey.y_root = e->global.v;
+ Tk_TopCoordsToWindow(tkwin, e->local.h, e->local.v,
+ &event.xkey.x, &event.xkey.y);
+
+ /*
+ * Now, we may have a problem here. How do we handle 'Option-char'
+ * keypresses? The problem is that we might want to bind to some of
+ * these (e.g. Cmd-Opt-d is 'uncomment' in Alpha), but Option-d
+ * generates a 'delta' symbol with some keycode unrelated to 'd', and so
+ * the binding never triggers. In any case, the delta that is produced
+ * is never mapped to an 'XK_Greek_DELTA' keysym so bindings on that
+ * won't work either (a general KeyPress binding will of course trigger,
+ * but a specific binding on XK_Greek_DELTA will not).
+ *
+ * I think what we want is for the event to contain information on
+ * both the 'Opt-d' side of things and the 'delta'. Then a binding
+ * on Opt-d will trigger, but the ascii/string representation of the
+ * event will be a delta.
+ *
+ * A different way to look at this is that 'Opt-d' is delta, but that
+ * Command-Opt-d is nothing to do with delta, but I'm not sure that is
+ * helpful.
+ *
+ * Also some keypresses (Opt-e) are dead-keys to add accents to
+ * letters. We don't handle them yet.
+ *
+ * Help needed!
+ */
+ event.xkey.keycode = byte |
+ ((savedKeyCode & charCodeMask) << 8) |
+ ((e->message&keyCodeMask) << 8);
+
+ event.xany.serial = Tk_Display(tkwin)->request;
+ event.xkey.window = Tk_WindowId(tkwin);
+ event.xkey.display = Tk_Display(tkwin);
+ event.xkey.root = XRootWindow(Tk_Display(tkwin), 0);
+ event.xkey.state = e->state;
+
+ switch(eKind) {
+ case kEventRawKeyDown:
+ event.xany.type = KeyPress;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ break;
+ case kEventRawKeyUp:
+ event.xany.type = KeyRelease;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ break;
+ case kEventRawKeyRepeat:
+ event.xany.type = KeyRelease;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ event.xany.type = KeyPress;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ break;
+ case kEventRawKeyModifiersChanged:
+ if (savedModifiers > e->keyModifiers) {
+ event.xany.type = KeyRelease;
+ } else {
+ event.xany.type = KeyPress;
+ }
+ /*
+ * Use special '-1' to signify a special keycode to
+ * our platform specific code in tkMacOSXKeyboard.c.
+ * This is rather like what happens on Windows.
+ */
+ event.xany.send_event = -1;
+ /* Set keycode (which was zero) to the changed modifier */
+ event.xkey.keycode = (e->keyModifiers ^ savedModifiers);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ break;
+ default:
+ break;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetCapture --
+ *
+ * Results:
+ * Returns the current grab window
+ * Side effects:
+ * None.
+ *
+ */
+Tk_Window
+TkMacOSXGetCapture()
+{
+ return gGrabWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetCaretPos --
+ *
+ * This enables correct placement of the XIM caret. This is called
+ * by widgets to indicate their cursor placement, and the caret
+ * location is used by TkpGetString to place the XIM caret.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetCaretPos(tkwin, x, y, height)
+ Tk_Window tkwin;
+ int x;
+ int y;
+ int height;
+{
+}
diff --git a/tcl/macosx/tkMacOSXKeyboard.c b/tcl/macosx/tkMacOSXKeyboard.c
new file mode 100644
index 00000000000..85bd0084711
--- /dev/null
+++ b/tcl/macosx/tkMacOSXKeyboard.c
@@ -0,0 +1,682 @@
+/*
+ * tkMacOSXKeyboard.c --
+ *
+ * Routines to support keyboard events on the Macintosh.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "X11/Xlib.h"
+#include "X11/keysym.h"
+#include <Carbon/Carbon.h>
+#include "tkMacOSXInt.h"
+
+typedef struct {
+ int 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()
+{
+ Tcl_HashEntry *hPtr;
+ 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);
+ if (!KCHRPtr){
+ fprintf(stderr,"GetScriptManagerVariable failed\n");
+ }
+ 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;
+ int c;
+ int virtualKey;
+ int newKeycode;
+ unsigned long dummy, newChar;
+
+ if (!initialized) {
+ InitKeyMaps();
+ }
+ if (keycode == 0) {
+ /*
+ * This means we had a pure modifier keypress or
+ * something similar which is a TO DO.
+ */
+ return NoSymbol;
+ }
+
+ virtualKey = (char) (keycode >> 16);
+ c = (keycode) & 0xffff;
+ if (c > 255) {
+ return NoSymbol;
+ }
+
+ /*
+ * When determining what keysym to produce we first 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetString --
+ *
+ * Retrieve the string equivalent for the given keyboard event.
+ *
+ * Results:
+ * Returns the UTF string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkpGetString(
+ TkWindow *winPtr, /* Window where event occurred: needed to
+ * get input context. */
+ XEvent *eventPtr, /* X keyboard event. */
+ Tcl_DString *dsPtr) /* Uninitialized or empty string to hold
+ * result. */
+{
+ register Tcl_HashEntry *hPtr;
+ char string[3];
+ int virtualKey;
+ int c, len;
+
+ if (!initialized) {
+ InitKeyMaps();
+ }
+
+ Tcl_DStringInit(dsPtr);
+
+ virtualKey = (char) (eventPtr->xkey.keycode >> 16);
+ c = (eventPtr->xkey.keycode) & 0xffff;
+
+ if (c < 256) {
+ string[0] = (char) c;
+ len = 1;
+ } else {
+ string[0] = (char) (c >> 8);
+ string[1] = (char) c;
+ len = 2;
+ }
+ /*
+ * Just return NULL if the character is a function key or another
+ * non-printing key.
+ */
+ if (c == 0x10 || (eventPtr->xany.send_event == -1)) {
+ len = 0;
+ } else {
+ hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
+ if (hPtr != NULL) {
+ len = 0;
+ }
+ }
+ return Tcl_ExternalToUtfDString(TkMacOSXCarbonEncoding, string,
+ len, dsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ * FIXME - This is no longer true. This function is now used in
+ * "event generate" so we really should make it work.
+ *
+ * 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 <<16);
+ }
+
+ return keycode;
+}
+
+/*
+ * 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.
+ */
+
+void
+TkpSetKeycodeAndState(tkwin, keySym, eventPtr)
+ Tk_Window tkwin;
+ KeySym keySym;
+ XEvent *eventPtr;
+{
+ Display *display;
+ int state;
+ KeyCode keycode;
+
+ display = Tk_Display(tkwin);
+
+ if (keySym == NoSymbol) {
+ keycode = 0;
+ } else {
+ keycode = XKeysymToKeycode(display, keySym);
+ }
+ if (keycode != 0) {
+ for (state = 0; state < 4; state++) {
+ if (XKeycodeToKeysym(display, keycode, state) == keySym) {
+ if (state & 1) {
+ eventPtr->xkey.state |= ShiftMask;
+ }
+ if (state & 2) {
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ eventPtr->xkey.state |= dispPtr->modeModMask;
+ }
+ break;
+ }
+ }
+ }
+ eventPtr->xkey.keycode = keycode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetKeySym --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkpGetKeySym(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) {
+ TkpInitKeymapInfo(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;
+ }
+ if (eventPtr->xany.send_event == -1) {
+ /* We use -1 as a special signal for a pure modifier */
+ int modifier = eventPtr->xkey.keycode;
+ if (modifier == cmdKey) {
+ return XK_Alt_L;
+ } else if (modifier == shiftKey) {
+ return XK_Shift_L;
+ } else if (modifier == alphaLock) {
+ return XK_Caps_Lock;
+ } else if (modifier == optionKey) {
+ return XK_Meta_L;
+ } else if (modifier == controlKey) {
+ return XK_Control_L;
+ } else if (modifier == rightShiftKey) {
+ return XK_Shift_R;
+ } else if (modifier == rightOptionKey) {
+ return XK_Meta_R;
+ } else if (modifier == rightControlKey) {
+ return XK_Control_R;
+ } else {
+ /* If we get here, we probably need to implement something new */
+ return NoSymbol;
+ }
+ }
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitKeymapInfo --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitKeymapInfo(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);
+}
diff --git a/tcl/macosx/tkMacOSXLibrary.r b/tcl/macosx/tkMacOSXLibrary.r
new file mode 100644
index 00000000000..1662aafbef5
--- /dev/null
+++ b/tcl/macosx/tkMacOSXLibrary.r
@@ -0,0 +1,510 @@
+/*
+ * tkMacOSXLibrary.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 & Jim Ingham" "\n" "© 1993-1997 Sun Microsystems" "\n" "1998-2000 Scriptics Inc."
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ "Tk Library " TK_PATCH_LEVEL " © 1993-1999"
+};
+
+#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" "Jim Ingham & Ray Johnson"
+ "Scriptics Inc." "\n" "jingham@cygnus.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/tcl/macosx/tkMacOSXMenu.c b/tcl/macosx/tkMacOSXMenu.c
new file mode 100644
index 00000000000..f0611222980
--- /dev/null
+++ b/tcl/macosx/tkMacOSXMenu.c
@@ -0,0 +1,4691 @@
+/*
+ * tkMacOSXMenu.c --
+ *
+ * This module implements the Mac-platform specific features of menus.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+#include "tkMenuButton.h"
+#include "tkMenu.h"
+#include "tkColor.h"
+#include "tkMacOSXInt.h"
+#undef Status
+
+#define USE_TK_MDEF
+//#define USE_ATSU
+
+#include <Carbon/Carbon.h>
+#include "tkMacOSXDebug.h"
+#include <CoreFoundation/CFString.h>
+
+typedef struct MacMenu {
+ MenuRef 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
+#define SCREEN_MARGIN 5
+
+static int gNoTkMenus = 0; /* This is used by Tk_MacOSXTurnOffMenus 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 char elipsisString[TCL_UTF_MAX + 1];
+ /* The UTF representation of the elipsis (...)
+ * character. */
+static int helpItemCount; /* The number of items in the help menu.
+ * -1 means that the help menu is
+ * unavailable. This does not include
+ * the automatically generated separator. */
+static int inPostMenu; /* We cannot be re-entrant like X
+ * windows. */
+static short lastMenuID; /* To pass to NewMenu; need to figure out
+ * a good way to do this. */
+static short lastCascadeID;
+ /* Cascades have to have ids that are
+ * less than 256. */
+static MacDrawable macMDEFDrawable;
+ /* Drawable for use by MDEF code */
+static int 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 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 Tcl_Obj *useMDEFVar;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+int TkMacOSXGetNewMenuID _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuInstPtr,
+ int cascade,
+ short *menuIDPtr));
+void TkMacOSXFreeMenuID _ANSI_ARGS_((short menuID));
+
+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 void GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Tcl_DString *dStringPtr));
+static void GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *modWidthPtr,
+ int *textWidthPtr, int *heightPtr));
+static void GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+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 char FindMarkCharacter _ANSI_ARGS_((TkMenuEntry *mePtr));
+static void InvalidateMDEFRgns _ANSI_ARGS_((void));
+
+static void MenuDefProc _ANSI_ARGS_((short message,
+ MenuHandle menu, Rect *menuRectPtr,
+ Point hitPt, short *whichItem ));
+static void HandleMenuHiliteMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr);
+static void HandleMenuDrawMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr);
+static void HandleMenuFindItemsMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr);
+static void HandleMenuPopUpMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr);
+static void HandleMenuCalcItemMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr);
+
+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 mySetMenuTitle _ANSI_ARGS_((MenuHandle menuHdl,
+ Tcl_Obj *titlePtr));
+static void AppearanceEntryDrawWrapper _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Rect * menuRectPtr, MenuTrackingData *mtdPtr,
+ 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));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXUseID --
+ *
+ * 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 TkMacOSXGetNewMenuID 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
+TkMacOSXUseMenuID(
+ short macID) /* The id to take out of the table */
+{
+ Tcl_HashEntry *commandEntryPtr;
+ int newEntry;
+ int iMacID = macID; /* Do this to remove compiler warning */
+
+ TkMenuInit();
+ commandEntryPtr = Tcl_CreateHashEntry(&commandTable, (char *) iMacID,
+ &newEntry);
+ if (newEntry == 1) {
+ Tcl_SetHashValue(commandEntryPtr, NULL);
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetNewMenuID --
+ *
+ * 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.
+ *
+ * Carbon allows a much larger number of menus than the old APIs.
+ * I believe this is 32768, but am not sure. This code just uses
+ * 2000 as the upper limit. Unfortunately tk leaks menus when
+ * cloning, under some circumstances (see bug on sourceforge).
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+ TkMacOSXGetNewMenuID(
+ 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 = NULL;
+ 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) {
+ int iCurID = curID;
+ commandEntryPtr = Tcl_CreateHashEntry(&commandTable,
+ (char *) iCurID, &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.
+ */
+
+ short curID = lastCascadeID + 1;
+ if (curID == 2000) {
+ curID = 0;
+ }
+
+ while (curID != lastCascadeID) {
+ int iCurID = curID;
+ commandEntryPtr = Tcl_CreateHashEntry(&commandTable,
+ (char *) iCurID, &newEntry);
+ if (newEntry == 1) {
+ found = 1;
+ lastCascadeID = returnID = curID;
+ break;
+ }
+ curID++;
+ if (curID == 2000) {
+ curID = 0;
+ }
+ }
+ }
+
+ if (found) {
+ Tcl_SetHashValue(commandEntryPtr, (char *) menuPtr);
+ *menuIDPtr = returnID;
+ return TCL_OK;
+ } else {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "No more menus can be allocated.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXFreeMenuID --
+ *
+ * Marks the id as free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The hash table entry for the ID is cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXFreeMenuID(
+ short menuID) /* The id to free */
+{
+ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&commandTable,
+ (char *) ((int)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;
+ MenuRef macMenuHdl;
+ MenuDefSpec menuDefSpec;
+ Tcl_Obj *useMDEFObjPtr;
+ int useMDEF;
+ int error = TCL_OK;
+ int err;
+
+
+ error = TkMacOSXGetNewMenuID(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);
+
+ /*
+ * Check whether we want to use the custom mdef or not. For now
+ * the default is to use it unless the variable is explicitly
+ * set to no.
+ */
+
+ useMDEFObjPtr = Tcl_ObjGetVar2(menuPtr->interp, useMDEFVar, NULL, TCL_GLOBAL_ONLY);
+ if (useMDEFObjPtr == NULL
+ || Tcl_GetBooleanFromObj(NULL, useMDEFObjPtr, &useMDEF) == TCL_ERROR
+ || useMDEF) {
+ menuDefSpec.defType = kMenuDefProcPtr;
+ menuDefSpec.u.defProc = MenuDefProc;
+ if ((err = SetMenuDefinition(macMenuHdl, &menuDefSpec)) != noErr) {
+ fprintf(stderr, "SetMenuDefinition failed %d\n", err );
+ }
+ }
+ 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 */
+{
+ MenuRef macMenuHdl = ((MacMenu *) menuPtr->platformData)->menuHdl;
+
+ if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
+ Tcl_CancelIdleCall(ReconfigureMacintoshMenu, (ClientData) menuPtr);
+ menuPtr->menuFlags &= ~MENU_RECONFIGURE_PENDING;
+ }
+ if (GetMenuID(macMenuHdl) == currentHelpMenuID) {
+ MenuRef helpMenuHdl;
+ MenuItemIndex helpIndex;
+
+ if ((HMGetHelpMenu(&helpMenuHdl,&helpIndex) == noErr)
+ && (helpMenuHdl != NULL)) {
+ int i, count = CountMenuItems(helpMenuHdl);
+
+ for (i = helpItemCount; i <= count; i++) {
+ DeleteMenuItem(helpMenuHdl, helpItemCount);
+ }
+ }
+ currentHelpMenuID = 0;
+ }
+ if (menuPtr->platformData != NULL) {
+ MenuID menuID;
+ menuID = GetMenuID(macMenuHdl);
+ DeleteMenu(menuID);
+ TkMacOSXFreeMenuID(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;
+ MenuID newMenuID, menuID = GetMenuID(macMenuHdl);
+ int error = TCL_OK;
+ if (menuID >= 256) {
+ error = TkMacOSXGetNewMenuID(menuPtr->interp, menuPtr, 1, &newMenuID);
+ if (error == TCL_OK) {
+ TkMacOSXFreeMenuID(menuID);
+ SetMenuID (macMenuHdl,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. This is primarily used to do a substitution
+ * between "..." and the ellipsis character which looks nicer.
+ *
+ * Results:
+ * itemText points to the new text for the item.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetEntryText(
+ TkMenuEntry *mePtr, /* A pointer to the menu entry. */
+ Tcl_DString *dStringPtr) /* The DString to put the text into. This
+ * will be initialized by this routine. */
+{
+ Tcl_DStringInit(dStringPtr);
+ if (mePtr->type == TEAROFF_ENTRY) {
+ Tcl_DStringAppend(dStringPtr, "(Tear-off)", -1);
+ } else if (mePtr->imagePtr != NULL) {
+ Tcl_DStringAppend(dStringPtr, "(Image)", -1);
+ } else if (mePtr->bitmapPtr != NULL) {
+ Tcl_DStringAppend(dStringPtr, "(Pixmap)", -1);
+ } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) {
+ /*
+ * The Mac menu manager does not like null strings.
+ */
+
+ Tcl_DStringAppend(dStringPtr, " ", -1);
+ } else {
+ int length;
+ char *text = Tcl_GetStringFromObj(mePtr->labelPtr, &length);
+ char *dStringText;
+ int i;
+
+ for (i = 0; *text; text++, i++) {
+ if ((*text == '.')
+ && (*(text + 1) != '\0') && (*(text + 1) == '.')
+ && (*(text + 2) != '\0') && (*(text + 2) == '.')) {
+ Tcl_DStringAppend(dStringPtr, elipsisString, -1);
+ i += strlen(elipsisString) - 1;
+ text += 2;
+ } else {
+ Tcl_DStringSetLength(dStringPtr,
+ Tcl_DStringLength(dStringPtr) + 1);
+ dStringText = Tcl_DStringValue(dStringPtr);
+ dStringText[i] = *text;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindMarkCharacter --
+ *
+ * Finds the Macintosh mark character based on the font of the
+ * item. We calculate a good mark character based on the font
+ * that this item is rendered in.
+ *
+ * We try the following special mac characters. If none of them
+ * are present, just use the check mark.
+ * '' - Check mark character (\022)
+ * 'Â¥' - Mac Bullet character (\245)
+ * '' - Filled diamond (\023)
+ * '—' - Hollow diamond (\327)
+ * '‘' = Mac Long dash ("em dash") (\321)
+ * '-' = short dash (minus, "en dash");
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New item is added to platform menu
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char
+FindMarkCharacter(
+ TkMenuEntry *mePtr) /* The entry we are finding the character
+ * for. */
+{
+ char markChar;
+ Tk_Font tkfont;
+
+ tkfont = Tk_GetFontFromObj(mePtr->menuPtr->tkwin,
+ (mePtr->fontPtr == NULL) ? mePtr->menuPtr->fontPtr
+ : mePtr->fontPtr);
+
+ if (!TkMacOSXIsCharacterMissing(tkfont, '\022')) {
+ markChar = '\022'; /* Check mark */
+ } else if (!TkMacOSXIsCharacterMissing(tkfont, '\245')) {
+ markChar = '\245'; /* Bullet */
+ } else if (!TkMacOSXIsCharacterMissing(tkfont, '\023')) {
+ markChar = '\023'; /* Filled Diamond */
+ } else if (!TkMacOSXIsCharacterMissing(tkfont, '\327')) {
+ markChar = '\327'; /* Hollow Diamond */
+ } else if (!TkMacOSXIsCharacterMissing(tkfont, '\321')) {
+ markChar = '\321'; /* Long Dash */
+ } else if (!TkMacOSXIsCharacterMissing(tkfont, '-')) {
+ markChar = '-'; /* Short Dash */
+ } else {
+ markChar = '\022'; /* Check mark */
+ }
+ return 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
+mySetMenuTitle(
+ MenuRef menuHdl, /* The menu we are setting the title of. */
+ Tcl_Obj *titlePtr) /* The C string to set the title to. */
+{
+ char *title = (titlePtr == NULL) ? ""
+ : Tcl_GetStringFromObj(titlePtr, NULL);
+ Str255 menuTitle;
+ menuTitle [ 0 ] = strlen ( title ) + 1;
+ strcpy ( menuTitle + 1, title );
+ SetMenuTitle ( menuHdl, menuTitle );
+}
+static int ParseAccelerators(char **accelStringPtr) {
+ char *accelString = *accelStringPtr;
+ int flags = 0;
+ while (1) {
+ if ((0 == strncasecmp("Control", accelString, 6))
+ && (('-' == accelString[6]) || ('+' == accelString[6]))) {
+ flags |= ENTRY_CONTROL_ACCEL;
+ accelString += 7;
+ } else if ((0 == strncasecmp("Ctrl", accelString, 4))
+ && (('-' == accelString[4]) || ('+' == accelString[4]))) {
+ flags |= ENTRY_CONTROL_ACCEL;
+ accelString += 5;
+ } else if ((0 == strncasecmp("Shift", accelString, 5))
+ && (('-' == accelString[5]) || ('+' == accelString[5]))) {
+ flags |= ENTRY_SHIFT_ACCEL;
+ accelString += 6;
+ } else if ((0 == strncasecmp("Option", accelString, 6))
+ && (('-' == accelString[6]) || ('+' == accelString[6]))) {
+ flags |= ENTRY_OPTION_ACCEL;
+ accelString += 7;
+ } else if ((0 == strncasecmp("Opt", accelString, 3))
+ && (('-' == accelString[3]) || ('+' == accelString[3]))) {
+ flags |= ENTRY_OPTION_ACCEL;
+ accelString += 4;
+ } else if ((0 == strncasecmp("Command", accelString, 7))
+ && (('-' == accelString[7]) || ('+' == accelString[7]))) {
+ flags |= ENTRY_COMMAND_ACCEL;
+ accelString += 8;
+ } else if ((0 == strncasecmp("Cmd", accelString, 3))
+ && (('-' == accelString[3]) || ('+' == accelString[3]))) {
+ flags |= ENTRY_COMMAND_ACCEL;
+ accelString += 4;
+ } else if ((0 == strncasecmp("Alt", accelString, 3))
+ && (('-' == accelString[3]) || ('+' == accelString[3]))) {
+ flags |= ENTRY_OPTION_ACCEL;
+ accelString += 4;
+ } else if ((0 == strncasecmp("Meta", accelString, 4))
+ && (('-' == accelString[4]) || ('+' == accelString[4]))) {
+ flags |= ENTRY_COMMAND_ACCEL;
+ accelString += 5;
+ } else {
+ break;
+ }
+ }
+ *accelStringPtr = accelString;
+ return flags;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpConfigureMenuEntry --
+ *
+ * Processes configurations for menu entries.
+ *
+ * Results:
+ * Returns standard TCL result. If TCL_ERROR is returned, then
+ * the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information get set for mePtr; old resources
+ * get freed, if any need it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpConfigureMenuEntry(
+ 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) {
+ mySetMenuTitle(childMenuHdl, mePtr->labelPtr);
+ }
+ }
+ }
+ }
+
+ /*
+ * We need to parse the accelerator string. If it has the strings
+ * for Command, Control, Shift or Option, we need to flag it
+ * so we can draw the symbols for it. We also need to precalcuate
+ * the position of the first real character we are drawing.
+ */
+
+ if (0 == mePtr->accelLength) {
+ ((EntryGeometry *)mePtr->platformEntryData)->accelTextStart = -1;
+ } else {
+ char *accelString = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ char *accel = accelString;
+ mePtr->entryFlags |= ~ENTRY_ACCEL_MASK;
+
+ mePtr->entryFlags |= ParseAccelerators(&accelString);
+
+ ((EntryGeometry *)mePtr->platformEntryData)->accelTextStart
+ = ((long) accelString - (long) 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) {
+ char *name = (mePtr->namePtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+
+ if (strcmp(Tk_PathName(menuPtr->tkwin), name) == 0) {
+ if (mePtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+
+ /*
+ * First, we get rid of all of the old items.
+ */
+
+ count = CountMenuItems(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 {
+ Tcl_DString itemTextDString;
+ int destWrote;
+ CFStringRef cf;
+ GetEntryText(mePtr, &itemTextDString);
+ cf = CFStringCreateWithCString(NULL,
+ Tcl_DStringValue(&itemTextDString), kCFStringEncodingUTF8);
+ AppendMenu(macMenuHdl, "\px");
+ if (cf != NULL) {
+ SetMenuItemTextWithCFString(macMenuHdl, base + index, cf);
+ CFRelease(cf);
+ } else {
+ cf = CFSTR ("<Error>");
+ SetMenuItemTextWithCFString(macMenuHdl, base + index, cf);
+ }
+ Tcl_DStringFree(&itemTextDString);
+
+ /*
+ * Set enabling and disabling correctly.
+ */
+
+ if (parentDisabled || (mePtr->state == ENTRY_DISABLED)) {
+ DisableMenuItem(macMenuHdl, base + index);
+ } else {
+ EnableMenuItem(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)) {
+ CheckMenuItem(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) {
+ {
+ SetMenuItemHierarchicalID(macMenuHdl, base + index,
+ GetMenuID(childMenuHdl));
+ }
+ }
+ /*
+ * 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) && (mePtr->accelPtr != NULL)) {
+ int accelLen;
+ int modifiers = 0;
+ int hasCmd = 0;
+ int offset = ((EntryGeometry *)mePtr->platformEntryData)->accelTextStart;
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, &accelLen);
+ accelLen -= offset;
+ accel+= offset;
+
+ if (mePtr->entryFlags & ENTRY_OPTION_ACCEL) {
+ modifiers |= kMenuOptionModifier;
+ }
+ if (mePtr->entryFlags & ENTRY_SHIFT_ACCEL) {
+ modifiers |= kMenuShiftModifier;
+ }
+ if (mePtr->entryFlags & ENTRY_CONTROL_ACCEL) {
+ modifiers |= kMenuControlModifier;
+ }
+ if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
+ hasCmd = 1;
+ }
+ if (accelLen == 1) {
+ if (hasCmd || (modifiers != 0 && modifiers != kMenuShiftModifier)) {
+ SetItemCmd(macMenuHdl, base + index, accel[0]);
+ if (!hasCmd) {
+ modifiers |= kMenuNoCommandModifier;
+ }
+ }
+ } else {
+ /*
+ * Now we need to convert from various textual names
+ * to Carbon codes
+ */
+ char glyph = 0x0;
+ char first = UCHAR(accel[0]);
+ if (first == 'F' && (accel[1] > '0' && accel[1] <= '9')) {
+ int fkey = accel[1] - '0';
+ if (accel[2] > '0' && accel[2] <= '9') {
+ fkey = 10*fkey + (accel[2] - '0');
+ }
+ if (fkey > 0 && fkey < 16) {
+ glyph = kMenuF1Glyph + fkey - 1;
+ }
+ } else if (first == 'P' && 0 ==strcasecmp(accel,"pageup")) {
+ glyph = kMenuPageUpGlyph;
+ } else if (first == 'P' && 0 ==strcasecmp(accel,"pagedown")) {
+ glyph = kMenuPageDownGlyph;
+ } else if (first == 'L' && 0 ==strcasecmp(accel,"left")) {
+ glyph = kMenuLeftArrowGlyph;
+ } else if (first == 'R' && 0 ==strcasecmp(accel,"right")) {
+ glyph = kMenuRightArrowGlyph;
+ } else if (first == 'U' && 0 ==strcasecmp(accel,"up")) {
+ glyph = kMenuUpArrowGlyph;
+ } else if (first == 'D' && 0 ==strcasecmp(accel,"down")) {
+ glyph = kMenuDownArrowGlyph;
+ } else if (first == 'E' && 0 ==strcasecmp(accel,"escape")) {
+ glyph = kMenuEscapeGlyph;
+ } else if (first == 'C' && 0 ==strcasecmp(accel,"clear")) {
+ glyph = kMenuClearGlyph;
+ } else if (first == 'E' && 0 ==strcasecmp(accel,"enter")) {
+ glyph = kMenuEnterGlyph;
+ } else if (first == 'D' && 0 ==strcasecmp(accel,"backspace")) {
+ glyph = kMenuDeleteLeftGlyph;
+ } else if (first == 'S' && 0 ==strcasecmp(accel,"space")) {
+ glyph = kMenuSpaceGlyph;
+ } else if (first == 'T' && 0 ==strcasecmp(accel,"tab")) {
+ glyph = kMenuTabRightGlyph;
+ } else if (first == 'F' && 0 ==strcasecmp(accel,"delete")) {
+ glyph = kMenuDeleteRightGlyph;
+ } else if (first == 'H' && 0 ==strcasecmp(accel,"home")) {
+ glyph = kMenuNorthwestArrowGlyph;
+ } else if (first == 'R' && 0 ==strcasecmp(accel,"return")) {
+ glyph = kMenuReturnGlyph;
+ } else if (first == 'H' && 0 ==strcasecmp(accel,"help")) {
+ glyph = kMenuHelpGlyph;
+ } else if (first == 'P' && 0 ==strcasecmp(accel,"power")) {
+ glyph = kMenuPowerGlyph;
+ }
+ if (glyph != 0x0) {
+ SetMenuItemKeyGlyph(macMenuHdl, base + index, glyph);
+ if (modifiers == 0) {
+ if (!hasCmd) {
+ modifiers |= kMenuNoCommandModifier;
+ }
+ }
+ }
+ }
+
+ SetMenuItemModifiers(macMenuHdl, base + index, modifiers);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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) {
+ AppendResMenu(macMenuHdl, 'DRVR');
+ }
+ if (GetMenuID(macMenuHdl) == currentHelpMenuID) {
+ MenuItemIndex helpIndex;
+ HMGetHelpMenu(&helpMenuHdl,&helpIndex);
+ 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);
+ CountMenuItems(macMenuHdl);
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ popUpResult = PopUpMenuSelect(macMenuHdl, y, x, menuPtr->active);
+ Tcl_SetServiceMode(oldMode);
+
+ menuPtr->totalWidth = oldWidth;
+ RecursivelyDeleteMenu(menuPtr);
+ DeleteMenu(GetMenuID(macMenuHdl));
+
+ /*
+ * 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 = TkMacOSXDispatchMenuEvent(menuID, LoWord(popUpResult));
+ } else {
+ TkMacOSXHandleTearoffMenu();
+ result = TCL_OK;
+ }
+
+ /*
+ * Be careful, here. The command executed in handling the menu event
+ * could destroy the window. Don't try to do anything with it then.
+ */
+
+ if (menuPtr->tkwin) {
+ 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_MacOSXTurnOffMenus --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MacOSXTurnOffMenus()
+{
+ 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 *) ((int)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 *) ((int)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);
+ TkMacOSXGetNewMenuID(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 == ENTRY_DISABLED) {
+ DisableMenuItem(((MacMenu *) menuBarPtr->entries[i]
+ ->childMenuRefPtr->menuPtr
+ ->platformData)->menuHdl,
+ 0);
+ } else {
+ EnableMenuItem(((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 = GetMenuID(macMenuHdl);
+ } 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(GetMenuID(macMenuHdl));
+ InsertMenu(macMenuHdl, 0);
+ RecursivelyInsertMenu(cascadeMenuPtr);
+ if (menuBarPtr->entries[i]->state == ENTRY_DISABLED) {
+ DisableMenuItem(((MacMenu *) menuBarPtr->entries[i]
+ ->childMenuRefPtr->menuPtr
+ ->platformData)->menuHdl,
+ 0);
+ } else {
+ EnableMenuItem(((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(GetMenuID(macMenuHdl));
+ 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;
+ CGrafPtr winPort;
+ WindowRef macWindowPtr;
+ WindowRef frontNonFloating;
+
+ winPort=TkMacOSXGetDrawablePort(winPtr->window);
+ if (!winPort) {
+ return;
+ }
+ macWindowPtr = GetWindowFromPort(winPort);
+
+ frontNonFloating = FrontNonFloatingWindow();
+ if ((macWindowPtr == NULL) || (macWindowPtr != frontNonFloating)) {
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXDispatchMenuEvent --
+ *
+ * Given a menu id and an item, dispatches the command associated
+ * with it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands get executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXDispatchMenuEvent(
+ 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 *) ((int)menuID));
+ if (commandEntryPtr != NULL) {
+ TkMenu *menuPtr = (TkMenu *) Tcl_GetHashValue(commandEntryPtr);
+ if ((currentAppleMenuID == menuID)
+ && (index > menuPtr->numEntries + 1)) {
+ Str255 itemText;
+
+ GetMenuItemText(GetMenuHandle(menuID), index, itemText);
+ result = TCL_OK;
+ } else {
+ result = TkInvokeMenu(menuPtr->interp, menuPtr, index - 1);
+ }
+ } else {
+ return TCL_ERROR;
+ }
+ }
+ }
+ 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 {
+ char *accel = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+
+ if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
+ *textWidthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
+ } else {
+ int emWidth = Tk_TextWidth(tkfont, "W", 1) + 1;
+ if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
+ int width = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
+ *textWidthPtr = emWidth;
+ if (width < emWidth) {
+ *modWidthPtr = 0;
+ } else {
+ *modWidthPtr = width - emWidth;
+ }
+ } else {
+ 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, 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 */
+{
+ SInt16 outHeight;
+
+ GetThemeMenuSeparatorHeight(&outHeight);
+ *widthPtr = 0;
+ *heightPtr = outHeight;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)) {
+ if (mePtr->indicatorOn
+ && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ int baseline;
+ short markShort;
+
+ baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+ GetItemMark(((MacMenu *) menuPtr->platformData)->menuHdl,
+ mePtr->index + 1, &markShort);
+ if (markShort != 0) {
+ char markChar;
+ char markCharUTF[TCL_UTF_MAX + 1];
+ int dstWrote;
+
+ markChar = (char) markShort;
+ /*
+ * Not sure if this is the correct encoding, but this function
+ * doesn't appear to be used at all in, since the Carbon Menus
+ * draw themselves
+ */
+ Tcl_ExternalToUtf(NULL, NULL, &markChar, 1, 0, NULL,
+ markCharUTF, TCL_UTF_MAX + 1, NULL, &dstWrote, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, markCharUTF,
+ dstWrote, x + 2, baseline);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuBackground --
+ *
+ * If Appearance is present, draws the Appearance background
+ *
+ * Results:
+ * Nothing
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DrawMenuBackground(
+ Rect *menuRectPtr, /* The menu rect */
+ Drawable d, /* What we are drawing into */
+ ThemeMenuType type /* Type of menu */
+ )
+{
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+
+ destPort = TkMacOSXGetDrawablePort(d);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpClippingRgn(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;
+ const BitMap *destBitMap;
+ RGBColor origForeColor, origBackColor, foreColor, backColor;
+
+ HLock(sicnHandle);
+ destPort = TkMacOSXGetDrawablePort(d);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpClippingRgn(d);
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+ GetForeColor(&origForeColor);
+ GetBackColor(&origBackColor);
+
+ if (TkSetMacColor(gc->foreground, &foreColor)) {
+ RGBForeColor(&foreColor);
+ }
+
+ if (TkSetMacColor(gc->background, &backColor)) {
+ 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 = GetPortBitMapForCopyBits(destPort);
+ CopyBits(&sicnBitmap, destBitMap, &sicnBitmap.bounds, &destRect, GetPortTextMode(destPort), 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 */
+{
+ int activeBorderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ if (mePtr->type == CASCADE_ENTRY) {
+ /*
+ * Under Appearance, we let the Appearance Manager draw the icon
+ */
+
+ } else if (mePtr->accelLength != 0) {
+ int leftEdge = x + width;
+ int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+ char *accel;
+
+ accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+
+ if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
+ leftEdge -= ((EntryGeometry *) mePtr->platformEntryData)
+ ->accelTextWidth;
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
+ mePtr->accelLength, leftEdge, baseline);
+ } else {
+ EntryGeometry *geometryPtr =
+ (EntryGeometry *) mePtr->platformEntryData;
+ int length = mePtr->accelLength - geometryPtr->accelTextStart;
+
+ leftEdge -= geometryPtr->accelTextWidth;
+ if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
+ leftEdge -= geometryPtr->modifierWidth;
+ }
+
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel
+ + geometryPtr->accelTextStart, length, leftEdge, baseline);
+
+ if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
+ leftEdge -= COMMAND_ICON_WIDTH;
+ DrawSICN(SICN_RESOURCE_NUMBER, COMMAND_ICON, d, gc,
+ leftEdge, (y + (height / 2)) - (SICN_HEIGHT / 2) - 1);
+ }
+
+ 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;
+ Rect r;
+
+ destPort = TkMacOSXGetDrawablePort(d);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpClippingRgn(d);
+ r.top = y;
+ r.left = x;
+ r.bottom = y + height;
+ r.right = x + width;
+
+ DrawThemeMenuSeparator(&r);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppearanceEntryDrawWrapper --
+ *
+ * It routes to the Appearance Managers DrawThemeEntry, which will
+ * then call us back after setting up the drawing context.
+ *
+ * Results:
+ * A menu entry is drawn
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+AppearanceEntryDrawWrapper(
+ TkMenuEntry *mePtr,
+ Rect *menuRectPtr,
+ MenuTrackingData *mtdPtr,
+ Drawable d,
+ Tk_FontMetrics *fmPtr,
+ Tk_Font tkfont,
+ int x,
+ int y,
+ int width,
+ int height)
+{
+ MenuEntryUserData meData;
+ Rect itemRect;
+ ThemeMenuState theState;
+ ThemeMenuItemType theType;
+
+ meData.mePtr = mePtr;
+ meData.mdefDrawable = d;
+ meData.fmPtr = fmPtr;
+ meData.tkfont = tkfont;
+
+ itemRect.top = y;
+ itemRect.left = x;
+ itemRect.bottom = itemRect.top + height;
+ itemRect.right = itemRect.left + width;
+
+ if (mePtr->state == ENTRY_ACTIVE) {
+ theState = kThemeMenuSelected;
+ } else if (mePtr->state == ENTRY_DISABLED) {
+ theState = kThemeMenuDisabled;
+ } else {
+ theState = kThemeMenuActive;
+ }
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ theType = kThemeMenuItemHierarchical;
+ } else {
+ theType = kThemeMenuItemPlain;
+ }
+
+ DrawThemeMenuItem (menuRectPtr, &itemRect,
+ mtdPtr->virtualMenuTop, mtdPtr->virtualMenuBottom, theState,
+ theType, tkThemeMenuItemDrawingUPP,
+ (unsigned long) &meData);
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXHandleTearoffMenu() --
+ *
+ * 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
+TkMacOSXHandleTearoffMenu(void)
+{
+ if (tearoffStruct.menuPtr != NULL) {
+ Tcl_DString tearoffCmdStr;
+ char intString[TCL_INTEGER_SPACE];
+ short windowPart;
+ WindowRef whichWindow;
+
+ windowPart = FindWindow(tearoffStruct.point, &whichWindow);
+
+ if (windowPart != inMenuBar) {
+ Tcl_DStringInit(&tearoffCmdStr);
+ 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;
+ Tk_3DBorder border;
+
+ if (menuPtr->menuType != MASTER_MENU ) {
+ return;
+ }
+
+ margin = (fmPtr->ascent + fmPtr->descent)/2;
+ points[0].x = x;
+ points[0].y = y + height/2;
+ points[1].y = points[0].y;
+ segmentWidth = 6;
+ maxX = width - 1;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+
+ while (points[0].x < maxX) {
+ points[1].x = points[0].x + segmentWidth;
+ if (points[1].x > maxX) {
+ points[1].x = maxX;
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+ points[0].x += 2*segmentWidth;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXSetHelpMenuItemCount --
+ *
+ * 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
+TkMacOSXSetHelpMenuItemCount()
+{
+ MenuRef helpMenuHandle;
+ MenuItemIndex itemIndex;
+
+ if ((HMGetHelpMenu(&helpMenuHandle,&itemIndex) != noErr)
+ || (helpMenuHandle == NULL)) {
+ helpItemCount = -1;
+ } else {
+ helpItemCount = CountMenuItems(helpMenuHandle);
+ DeleteMenuItem(helpMenuHandle, helpItemCount);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXMenuClick --
+ *
+ * Prepares a menubar for MenuSelect or MenuKey.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any pending configurations of the menubar are completed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXMenuClick()
+{
+ 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;
+ TkMenu *menuPtr = mePtr->menuPtr;
+ int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
+ GC indicatorGC;
+ Tk_3DBorder bgBorder, activeBorder;
+ const Tk_FontMetrics *fmPtr;
+ Tk_FontMetrics entryMetrics;
+ 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 == ENTRY_ACTIVE) && !strictMotif) {
+ gc = mePtr->activeGC;
+ if (gc == NULL) {
+ gc = menuPtr->activeGC;
+ }
+ } else {
+ TkMenuEntry *cascadeEntryPtr;
+ int parentDisabled = 0;
+
+ for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ char *name = (cascadeEntryPtr->namePtr == NULL) ? ""
+ : Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL);
+
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
+ if (cascadeEntryPtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
+ gc = mePtr->disabledGC;
+ if (gc == NULL) {
+ gc = menuPtr->disabledGC;
+ }
+ } else {
+ gc = mePtr->textGC;
+ if (gc == NULL) {
+ gc = menuPtr->textGC;
+ }
+ }
+ }
+
+ indicatorGC = mePtr->indicatorGC;
+ if (indicatorGC == NULL) {
+ indicatorGC = menuPtr->indicatorGC;
+ }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL)
+ ? menuPtr->borderPtr : mePtr->borderPtr);
+ if (strictMotif) {
+ activeBorder = bgBorder;
+ } else {
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL)
+ ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
+ }
+
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = menuMetricsPtr;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ /*
+ * Need to draw the entire background, including padding. On Unix,
+ * for menubars, we have to draw the rest of the entry taking
+ * 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, menuFont;
+ Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
+ int x, y, height, modifierWidth, labelWidth, indicatorSpace;
+ int windowWidth, windowHeight, accelWidth, maxAccelTextWidth;
+ int i, j, lastColumnBreak, maxModifierWidth, maxWidth, nonAccelMargin;
+ int maxNonAccelMargin, maxEntryWithAccelWidth, maxEntryWithoutAccelWidth;
+ int entryWidth, maxIndicatorSpace, borderWidth, activeBorderWidth;
+ TkMenuEntry *mePtr, *columnEntryPtr;
+ EntryGeometry *geometryPtr;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ x = y = borderWidth;
+ indicatorSpace = labelWidth = accelWidth = maxAccelTextWidth = 0;
+ windowHeight = windowWidth = maxWidth = lastColumnBreak = 0;
+ maxModifierWidth = nonAccelMargin = maxNonAccelMargin = 0;
+ maxEntryWithAccelWidth = maxEntryWithoutAccelWidth = 0;
+ maxIndicatorSpace = 0;
+
+ /*
+ * On the Mac especially, getting font metrics can be quite slow,
+ * so we want to do it intelligently. We are going to precalculate
+ * them and pass them down to all of the measuring and drawing
+ * routines. We will measure the font metrics of the menu once.
+ * If an entry does not have its own font set, then we give
+ * the geometry/drawing routines the menu's font and metrics.
+ * If an entry has its own font, we will measure that font and
+ * give all of the geometry/drawing the entry's font and metrics.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mePtr->fontPtr == NULL) {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ if ((i > 0) && mePtr->columnBreak) {
+ if (maxIndicatorSpace != 0) {
+ maxIndicatorSpace += 2;
+ }
+ for (j = lastColumnBreak; j < i; j++) {
+ columnEntryPtr = menuPtr->entries[j];
+ geometryPtr =
+ (EntryGeometry *) columnEntryPtr->platformEntryData;
+
+ columnEntryPtr->indicatorSpace = maxIndicatorSpace;
+ columnEntryPtr->width = maxIndicatorSpace + maxWidth
+ + 2 * activeBorderWidth;
+ geometryPtr->accelTextWidth = maxAccelTextWidth;
+ geometryPtr->modifierWidth = maxModifierWidth;
+ columnEntryPtr->x = x;
+ columnEntryPtr->entryFlags &= ~ENTRY_LAST_COLUMN;
+ if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
+ geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
+ - maxEntryWithAccelWidth;
+ if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
+ geometryPtr->nonAccelMargin = maxNonAccelMargin;
+ }
+ } else {
+ geometryPtr->nonAccelMargin = 0;
+ }
+ }
+ x += maxIndicatorSpace + maxWidth + 2 * borderWidth;
+ windowWidth = x;
+ maxWidth = maxIndicatorSpace = maxAccelTextWidth = 0;
+ maxModifierWidth = maxNonAccelMargin = maxEntryWithAccelWidth = 0;
+ maxEntryWithoutAccelWidth = 0;
+ lastColumnBreak = i;
+ y = borderWidth;
+ }
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &entryWidth, &height);
+ mePtr->height = height;
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ GetTearoffEntryGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &entryWidth, &height);
+ mePtr->height = height;
+ } else {
+ /*
+ * For each entry, compute the height required by that
+ * particular entry, plus three widths: the width of the
+ * label, the width to allow for an indicator to be displayed
+ * to the left of the label (if any), and the width of the
+ * accelerator to be displayed to the right of the label
+ * (if any). These sizes depend, of course, on the type
+ * of the entry.
+ */
+
+ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &labelWidth,
+ &height);
+ mePtr->height = height;
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr,
+ &modifierWidth, &accelWidth, &height);
+ nonAccelMargin = 0;
+ } else if (mePtr->accelLength == 0) {
+ nonAccelMargin = mePtr->hideMargin ? 0
+ : Tk_TextWidth(tkfont, "m", 1);
+ accelWidth = modifierWidth = 0;
+ } else {
+ labelWidth += Tk_TextWidth(tkfont, "m", 1);
+ GetMenuAccelGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &modifierWidth, &accelWidth, &height);
+ if (height > mePtr->height) {
+ mePtr->height = height;
+ }
+ 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 * activeBorderWidth;
+ }
+ mePtr->y = y;
+ y += menuPtr->entries[i]->height + borderWidth;
+ if (y > windowHeight) {
+ windowHeight = y;
+ }
+ }
+
+ for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
+ columnEntryPtr = menuPtr->entries[j];
+ geometryPtr = (EntryGeometry *) columnEntryPtr->platformEntryData;
+
+ columnEntryPtr->indicatorSpace = maxIndicatorSpace;
+ columnEntryPtr->width = maxIndicatorSpace + maxWidth
+ + 2 * activeBorderWidth;
+ geometryPtr->accelTextWidth = maxAccelTextWidth;
+ geometryPtr->modifierWidth = maxModifierWidth;
+ columnEntryPtr->x = x;
+ columnEntryPtr->entryFlags |= ENTRY_LAST_COLUMN;
+ if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
+ geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
+ - maxEntryWithAccelWidth;
+ if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
+ geometryPtr->nonAccelMargin = maxNonAccelMargin;
+ }
+ } else {
+ geometryPtr->nonAccelMargin = 0;
+ }
+ }
+ windowWidth = x + maxIndicatorSpace + maxWidth
+ + 2 * activeBorderWidth + borderWidth;
+ windowHeight += borderWidth;
+
+ /*
+ * The X server doesn't like zero dimensions, so round up to at least
+ * 1 (a zero-sized menu should never really occur, anyway).
+ */
+
+ if (windowWidth <= 0) {
+ 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->bitmapPtr != NULL) {
+ int width, height;
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display,
+ bitmap, &width, &height);
+ XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0,
+ (unsigned) width, (unsigned) height, leftEdge,
+ (int) (y + (mePtr->height - height)/2), 1);
+ } else {
+ if (mePtr->labelLength > 0) {
+ Tcl_DString itemTextDString, convertedTextDString;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+#ifdef USE_ATSU
+ int runLengths;
+ CFStringRef stringRef;
+ ATSUTextLayout textLayout;
+ UniCharCount runLength;
+ ATSUStyle style;
+ int length;
+ int err;
+ Str255 fontName;
+ SInt16 fontSize;
+ Style fontStyle;
+ ATSUAttributeValuePtr valuePtr;
+ ByteCount valueSize;
+ Fixed fixedSize;
+ short iFONDNumber;
+ ATSUFontID fontID;
+ ATSUAttributeTag tag;
+
+ GetThemeFont (kThemeMenuItemFont, smSystemScript, fontName, &fontSize, &fontStyle);
+ if ((err = ATSUCreateStyle(&style)) != noErr) {
+ fprintf(stderr,"ATSUCreateStyle failed, %d\n", err);
+ return;
+ }
+ fixedSize = fontSize<<16;
+ tag = kATSUSizeTag;
+ valueSize = sizeof(fixedSize);
+ valuePtr = &fixedSize;
+ if ((err=ATSUSetAttributes(style, 1, &tag, &valueSize, &valuePtr))!= noErr) {
+ fprintf(stderr,"ATSUSetAttributes failed,%d\n", err );
+ }
+
+ GetFNum(fontName, &iFONDNumber);
+ ATSUFONDtoFontID(iFONDNumber, NULL, &fontID);
+ tag = kATSUFontTag;
+ valueSize = sizeof(fontID);
+ valuePtr = &fontID;
+ if ((err=ATSUSetAttributes(style, 1, &tag, &valueSize, &valuePtr))!= noErr) {
+ fprintf(stderr,"ATSUSetAttributes failed,%d\n", err );
+ }
+
+#endif
+
+ GetEntryText(mePtr, &itemTextDString);
+#ifdef USE_ATSU
+ runLengths = 1;
+ length = Tcl_DStringLength(&itemTextDString);
+ stringRef = CFStringCreateWithCString(NULL, Tcl_DStringValue(&itemTextDString), GetApplicationTextEncoding());
+ if (!stringRef) {
+ fprintf(stderr,"CFStringCreateWithCString failed\n");
+ }
+ if ((err=ATSUCreateTextLayoutWithTextPtr(CFStringGetCharactersPtr(stringRef), 0, length, length,
+ 1, &runLengths, &style, &textLayout)) != noErr) {
+ fprintf(stderr,"ATSUCreateTextLayoutWithTextPtr failed, %d\n", err);
+ return;
+ }
+#endif
+
+ /* Somehow DrawChars is changing the colors, it is odd, since
+ it works for the Apple Platinum Appearance, but not for
+ some Kaleidoscope Themes... Untill I can figure out what
+ exactly is going on, this will have to do: */
+
+ destPort = TkMacOSXGetDrawablePort(d);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpGraphicsPort(gc, destPort);
+
+ MoveTo((short) leftEdge, (short) baseline);
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString), &convertedTextDString);
+#ifdef USE_ATSU
+ xLocation = leftEdge<<16;
+ yLocation = baseline<<16;
+ ATSUDrawText(textLayout,kATSUFromTextBeginning, kATSUToTextEnd, xLocation, yLocation);
+ ATSUDisposeTextLayout(textLayout);
+ CFRelease(stringRef);
+#else
+ DrawText(Tcl_DStringValue(&convertedTextDString), 0,
+ Tcl_DStringLength(&convertedTextDString));
+#endif
+
+ /* Tk_DrawChars(menuPtr->display, d, gc,
+ tkfont, Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString),
+ leftEdge, baseline); */
+
+ Tcl_DStringFree(&itemTextDString);
+ }
+ }
+
+ if (mePtr->state == ENTRY_DISABLED) {
+ if (menuPtr->disabledFgPtr == NULL) {
+ } 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 ((menuPtr->menuType == TEAROFF_MENU)
+ || ((mePtr->state == ENTRY_ACTIVE)
+ && (mePtr->activeBorderPtr != None))
+ || ((mePtr->state != ENTRY_ACTIVE) && (mePtr->borderPtr != None))) {
+ if (mePtr->state == ENTRY_ACTIVE) {
+ 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->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
+ } else {
+ *heightPtr = fmPtr->linespace;
+
+ if (mePtr->labelPtr != NULL) {
+ Tcl_DString itemTextDString;
+
+ GetEntryText(mePtr, &itemTextDString);
+ *widthPtr = Tk_TextWidth(tkfont,
+ Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString));
+ Tcl_DStringFree(&itemTextDString);
+ } else {
+ *widthPtr = 0;
+ }
+ }
+ *heightPtr += 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ CGrafPtr port;
+ Rect bounds;
+
+ 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);
+ GetPort(&port);
+ GetPortBounds(port,&bounds);
+ event.x_root = where.h + bounds.left;
+ event.y_root = where.v + bounds.top;
+ event.state = TkMacOSXButtonKeyState();
+ 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;
+ TkMacOSXWindowList *listPtr;
+
+ if (totalMenuRgn == NULL) {
+ return;
+ }
+
+ GetGWorld(&saveWorld, &saveDevice);
+ for (listPtr = tkMacOSXWindowListPtr ; listPtr != NULL;
+ listPtr = listPtr->nextPtr) {
+ macDraw = (MacDrawable *) Tk_WindowId(listPtr->winPtr);
+ if (macDraw->flags & TK_DRAWN_UNDER_MENU) {
+ destPort = TkMacOSXGetDrawablePort(Tk_WindowId(listPtr->winPtr));
+ SetGWorld(destPort, NULL);
+ scratch.h = scratch.v = 0;
+ GlobalToLocal(&scratch);
+ OffsetRgn(totalMenuRgn, scratch.v, scratch.h);
+ InvalWindowRgn(GetWindowFromPort(destPort),totalMenuRgn);
+ OffsetRgn(totalMenuRgn, -scratch.v, -scratch.h);
+ macDraw->flags &= ~TK_DRAWN_UNDER_MENU;
+ }
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+ SetEmptyRgn(totalMenuRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXClearMenubarActive --
+ *
+ * Recursively clears the active entry in the current menubar hierarchy.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates <<MenuSelect>> virtual events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXClearMenubarActive(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();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuInit --
+ *
+ * Initializes Mac-specific menu data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates a hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuInit(void)
+{
+ lastMenuID = 256;
+ Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
+ currentMenuBarOwner = NULL;
+ tearoffStruct.menuPtr = NULL;
+ currentAppleMenuID = 0;
+ currentHelpMenuID = 0;
+ currentMenuBarInterp = NULL;
+ currentMenuBarName = NULL;
+ windowListPtr = NULL;
+
+ tkThemeMenuItemDrawingUPP
+ = NewMenuItemDrawingUPP(tkThemeMenuItemDrawingProc);
+
+ /*
+ * We should just hardcode the utf-8 ellipsis character into
+ * 'elipsisString' here
+ */
+ Tcl_ExternalToUtf(NULL, Tcl_GetEncoding(NULL, "macRoman"),
+ "\311", /* ellipsis character */
+ -1, 0, NULL, elipsisString,
+ TCL_UTF_MAX + 1, NULL, NULL, NULL);
+
+ useMDEFVar = Tcl_NewStringObj("::tk::mac::useCustomMDEF", -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuThreadInit --
+ *
+ * Does platform-specific initialization of thread-specific
+ * menu state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuThreadInit()
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPreprocessMacMenu --
+ *
+ * Handle preprocessing of menubar if it exists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All post commands for the current menubar get executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXPreprocessMenu()
+{
+ TkMenuReferences *mbRefPtr;
+ int code;
+
+ if ((currentMenuBarName != NULL) && (currentMenuBarInterp != NULL)) {
+ mbRefPtr = TkFindMenuReferences(currentMenuBarInterp,
+ currentMenuBarName);
+ if ((mbRefPtr != NULL) && (mbRefPtr->menuPtr != NULL)) {
+ Tcl_Preserve((ClientData)currentMenuBarInterp);
+ code = TkPreprocessMenu(mbRefPtr->menuPtr->masterMenuPtr);
+ if ((code != TCL_OK) && (code != TCL_CONTINUE)
+ && (code != TCL_BREAK)) {
+ Tcl_AddErrorInfo(currentMenuBarInterp,
+ "\n (menu preprocess)");
+ Tcl_BackgroundError(currentMenuBarInterp);
+ }
+ Tcl_Release((ClientData)currentMenuBarInterp);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ SInt16 message, /* What action are we taking? */
+ MenuRef 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. */
+ SInt16 *whichItem) /* Output result. Which item was
+ * hit by the user? */
+{
+ TkMenu *menuPtr;
+ Tcl_HashEntry *commandEntryPtr;
+ int maxMenuHeight;
+ MenuID menuID;
+ BitMap screenBits;
+
+ menuID = GetMenuID(menu);
+ commandEntryPtr = Tcl_FindHashEntry(&commandTable, (char *) ((int)menuID));
+
+ if (commandEntryPtr) {
+ menuPtr = (TkMenu *) Tcl_GetHashValue(commandEntryPtr);
+ } else {
+ menuPtr = NULL;
+ }
+
+ switch (message) {
+ case kMenuInitMsg:
+ *whichItem = noErr;
+ break;
+ case kMenuDisposeMsg:
+ break;
+ case kMenuHiliteItemMsg: {
+ HandleMenuHiliteMsg (menu, menuRectPtr, hitPt, whichItem, menuPtr);
+ break;
+ }
+ case kMenuCalcItemMsg:
+ HandleMenuCalcItemMsg (menu, menuRectPtr, hitPt, whichItem, menuPtr);
+ break;
+ case kMenuDrawItemsMsg: {
+ /*
+ * We do nothing here, because we don't support the Menu Managers
+ * dynamic item groups
+ */
+
+ break;
+ }
+ case kMenuThemeSavvyMsg:
+ *whichItem = kThemeSavvyMenuResponse;
+ break;
+ case kMenuSizeMsg:
+ GetQDGlobalsScreenBits(&screenBits);
+ maxMenuHeight = screenBits.bounds.bottom
+ - screenBits.bounds.top
+ - GetMBarHeight() - SCREEN_MARGIN;
+ SetMenuWidth(menu, menuPtr->totalWidth );
+ SetMenuHeight(menu,maxMenuHeight < menuPtr->totalHeight ? maxMenuHeight : menuPtr->totalHeight );
+ break;
+ case kMenuDrawMsg:
+ HandleMenuDrawMsg (menu, menuRectPtr, hitPt, whichItem, menuPtr);
+ break;
+ case kMenuFindItemMsg:
+ HandleMenuFindItemsMsg (menu, menuRectPtr, hitPt, whichItem, menuPtr);
+ break;
+ case kMenuPopUpMsg:
+ HandleMenuPopUpMsg (menu, menuRectPtr, hitPt, whichItem, menuPtr);
+ break;
+ }
+}
+
+void
+HandleMenuHiliteMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr)
+{
+ TkMenuEntry *mePtr = NULL;
+ Tk_Font tkfont;
+ Tk_FontMetrics fontMetrics;
+ int oldItem;
+ int newItem = -1;
+ MDEFHiliteItemData * hidPtr = ( MDEFHiliteItemData *)whichItem;
+ MenuTrackingData mtd, *mtdPtr = &mtd;
+ int err;
+ oldItem = hidPtr->previousItem - 1;
+ newItem = hidPtr->newItem - 1;
+
+ err = GetMenuTrackingData(menu, mtdPtr);
+ if (err !=noErr) {
+ fprintf(stderr,"GetMenuTrackingData failed : %d\n", err );
+ return;
+ }
+
+ if (oldItem >= 0) {
+ Rect oldItemRect;
+ int width;
+
+ mePtr = menuPtr->entries[oldItem];
+ if (mePtr->fontPtr == NULL) {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ menuPtr->fontPtr);
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ mePtr->fontPtr);
+ }
+ Tk_GetFontMetrics(tkfont, &fontMetrics);
+
+ width = (mePtr->entryFlags & ENTRY_LAST_COLUMN)
+ ? menuPtr->totalWidth - mePtr->x : mePtr->width;
+
+ /*
+ * In Aqua, have to call EraseMenuBackground when you overdraw
+ * a previously selected menu item, otherwise you will see the
+ * old select highlight under the transparency of the new menu item.
+ */
+
+ oldItemRect.left = menuRectPtr->left + mePtr->x;
+ oldItemRect.right = oldItemRect.left +width;
+ oldItemRect.top = mtdPtr->virtualMenuTop + mePtr->y;
+ oldItemRect.bottom = oldItemRect.top + mePtr->height;
+
+ EraseMenuBackground(menu, & oldItemRect, NULL);
+
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, mtdPtr,
+ (Drawable) &macMDEFDrawable, &fontMetrics, tkfont,
+ oldItemRect.left,
+ oldItemRect.top,
+ width,
+ mePtr->height);
+ }
+ if (newItem != -1) {
+ mePtr = menuPtr->entries[newItem];
+ if (mePtr->state != ENTRY_DISABLED) {
+ TkActivateMenuEntry(menuPtr, newItem);
+ }
+ if (mePtr->fontPtr == NULL) {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ }
+ Tk_GetFontMetrics(tkfont, &fontMetrics);
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, mtdPtr,
+ (Drawable) &macMDEFDrawable, &fontMetrics, tkfont,
+ menuRectPtr->left + mePtr->x,
+ mtdPtr->virtualMenuTop + mePtr->y,
+ (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
+ menuPtr->totalWidth - mePtr->x : mePtr->width,
+ mePtr->height);
+ }
+ tkUseMenuCascadeRgn = 1;
+ MenuSelectEvent(menuPtr);
+ Tcl_ServiceAll();
+ tkUseMenuCascadeRgn = 0;
+ if (newItem!=-1 && mePtr->state != ENTRY_DISABLED) {
+ TkActivateMenuEntry(menuPtr, -1);
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleMenuDrawMsg --
+ *
+ * It handles the MenuDefProc's draw message.
+ *
+ * Results:
+ * A menu entry is drawn
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+void
+HandleMenuDrawMsg(MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr)
+{
+ Tk_Font tkfont, menuFont;
+ Tk_FontMetrics fontMetrics, entryMetrics;
+ Tk_FontMetrics *fmPtr;
+ TkMenuEntry *mePtr;
+ int i;
+ GDHandle device;
+ TkMenu *searchMenuPtr;
+ Rect menuClipRect;
+ ThemeMenuType menuType;
+ MenuTrackingData * mtdPtr = (MenuTrackingData *)whichItem;
+ /*
+ * 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.grafPtr, &device);
+
+ 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 (mtdPtr->virtualMenuTop < 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 ((mtdPtr->virtualMenuTop + 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.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &fontMetrics);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mtdPtr->virtualMenuTop + mePtr->y + mePtr->height
+ < menuClipRect.top) {
+ continue;
+ } else if (mtdPtr->virtualMenuTop + mePtr->y
+ > menuClipRect.bottom) {
+ continue;
+ }
+ ClipRect(&menuClipRect);
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = &fontMetrics;
+ tkfont = menuFont;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, mtdPtr,
+ (Drawable) &macMDEFDrawable, fmPtr, tkfont,
+ menuRectPtr->left + mePtr->x,
+ mtdPtr->virtualMenuTop + mePtr->y,
+ (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
+ menuPtr->totalWidth - mePtr->x : mePtr->width,
+ menuPtr->entries[i]->height);
+ }
+ mtdPtr->virtualMenuBottom = mtdPtr->virtualMenuTop
+ + menuPtr->totalHeight;
+ if (!EmptyRgn(utilRgn)) {
+ SetClip(utilRgn);
+ SetEmptyRgn(utilRgn);
+ }
+ MDEFScrollFlag = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleMenuFindItemsMsg --
+ *
+ * It handles the MenuDefProc's FindItems message. We have to
+ * respond by filling in the itemSelected, itemUnderMouse and
+ * itemRect fields. This is also the time to scroll the menu if
+ * it is too long to fit on the screen.
+ *
+ * Results:
+ * The Menu system is informed of the selected item & the item
+ * under the mouse.
+ *
+ * Side effects:
+ * The menu might get scrolled.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+HandleMenuFindItemsMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr)
+{
+ TkMenuEntry *parentEntryPtr;
+ Tk_Font tkfont;
+ Tk_FontMetrics fontMetrics, entryMetrics;
+ Tk_FontMetrics *fmPtr;
+ TkMenuEntry *mePtr;
+ int i;
+ 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;
+ Rect menuClipRect;
+
+ int hasTopScroll, hasBottomScroll;
+ MenuTrackingData * mtdPtr = (MenuTrackingData *)whichItem;
+ int itemUnderMouse = -1;
+ enum {
+ DONT_SCROLL, DOWN_SCROLL, UP_SCROLL
+ } scrollDirection;
+ Rect updateRect;
+ short scrollAmt = 0;
+ RGBColor origForeColor, origBackColor;
+
+ /*
+ * Find out which item was hit. If it is the same as the old item,
+ * we don't need to do anything.
+ */
+
+ if (PtInRect(hitPt, menuRectPtr)) {
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ itemRect.left = menuRectPtr->left + mePtr->x;
+ itemRect.top = mtdPtr->virtualMenuTop + 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
+ + mePtr->height;
+ if (PtInRect(hitPt, &itemRect)) {
+ if ((mePtr->type == SEPARATOR_ENTRY)
+ || (mePtr->state == ENTRY_DISABLED)) {
+ newItem = -1;
+ itemUnderMouse = i;
+ } else {
+ TkMenuEntry *cascadeEntryPtr;
+ int parentDisabled = 0;
+
+ for (cascadeEntryPtr
+ = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr
+ = cascadeEntryPtr->nextCascadePtr) {
+ char *name;
+
+ name = Tcl_GetStringFromObj(
+ cascadeEntryPtr->namePtr, NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin))
+ == 0) {
+ if (cascadeEntryPtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+
+ if (parentDisabled) {
+ newItem = -1;
+ itemUnderMouse = i;
+ } else {
+ newItem = i;
+ itemUnderMouse = i;
+ }
+ }
+ break;
+ }
+ }
+ } else {
+ }
+
+ /*
+ * Now we need to take care of scrolling the menu.
+ */
+
+ hasTopScroll = mtdPtr->virtualMenuTop < menuRectPtr->top;
+ hasBottomScroll = mtdPtr->virtualMenuBottom > 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);
+
+ mtdPtr->itemSelected = newItem + 1;
+ mtdPtr->itemUnderMouse = itemUnderMouse + 1;
+ mtdPtr->itemRect = itemRect;
+
+ GetGWorld(&macMDEFDrawable.grafPtr, &device);
+ GetForeColor(&origForeColor);
+ GetBackColor(&origBackColor);
+
+ if (scrollDirection == UP_SCROLL) {
+ scrollAmt = menuClipRect.bottom - hitPt.v;
+ if (scrollAmt < menuRectPtr->bottom
+ - mtdPtr->virtualMenuBottom) {
+ scrollAmt = menuRectPtr->bottom - mtdPtr->virtualMenuBottom;
+ }
+ if (!hasTopScroll && ((mtdPtr->virtualMenuTop + scrollAmt)
+ < menuRectPtr->top)) {
+ SetRect(&updateRect, menuRectPtr->left,
+ mtdPtr->virtualMenuTop, menuRectPtr->right,
+ mtdPtr->virtualMenuTop + 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 - mtdPtr->virtualMenuTop) {
+ scrollAmt = menuRectPtr->top - mtdPtr->virtualMenuTop;
+ }
+
+ if (!hasBottomScroll && ((mtdPtr->virtualMenuBottom + scrollAmt)
+ > menuRectPtr->bottom)) {
+ SetRect(&updateRect, menuRectPtr->left,
+ mtdPtr->virtualMenuBottom - SICN_HEIGHT,
+ menuRectPtr->right, mtdPtr->virtualMenuBottom);
+ 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) {
+ Tk_Font menuFont;
+ RgnHandle updateRgn = NewRgn();
+
+ ScrollMenuImage(menu, menuRectPtr, 0, scrollAmt, NULL);
+ mtdPtr->virtualMenuTop += scrollAmt;
+ mtdPtr->virtualMenuBottom += scrollAmt;
+#if 0
+ GetRegionBounds(updateRgn,&updateRect);
+ DisposeRgn(updateRgn);
+ if (mtdPtr->virtualMenuTop == menuRectPtr->top) {
+ updateRect.top -= SICN_HEIGHT;
+ }
+ if (mtdPtr->virtualMenuBottom == menuRectPtr->bottom) {
+ updateRect.bottom += SICN_HEIGHT;
+ }
+ ClipRect(&updateRect);
+ EraseRect(&updateRect);
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &fontMetrics);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mtdPtr->virtualMenuTop + mePtr->y + mePtr->height
+ < updateRect.top) {
+ continue;
+ } else if (mtdPtr->virtualMenuTop + mePtr->y
+ > updateRect.bottom) {
+ continue;
+ }
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = &fontMetrics;
+ tkfont = menuFont;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+ AppearanceEntryDrawWrapper(mePtr, menuRectPtr, mtdPtr,
+ (Drawable) &macMDEFDrawable, fmPtr, tkfont,
+ menuRectPtr->left + mePtr->x,
+ mtdPtr->virtualMenuTop + mePtr->y,
+ (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
+ menuPtr->totalWidth - mePtr->x : mePtr->width,
+ menuPtr->entries[i]->height);
+ }
+#endif
+ }
+
+ SetClip(utilRgn);
+ SetEmptyRgn(utilRgn);
+ RGBForeColor(&origForeColor);
+ RGBBackColor(&origBackColor);
+
+ /*
+ * If the menu is a tearoff, and the mouse is outside the menu,
+ * we need to draw the drag rectangle.
+ *
+ * In order for tearoffs to work properly, we need to set
+ * the active member of the containing menubar.
+ */
+
+ menuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ Tk_PathName(menuPtr->tkwin));
+
+ if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) {
+ char *name;
+ for (parentEntryPtr = menuRefPtr->parentEntryPtr;
+ parentEntryPtr != NULL
+ ; parentEntryPtr = parentEntryPtr->nextCascadePtr) {
+ name = Tcl_GetStringFromObj(parentEntryPtr->namePtr,
+ NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) != 0) {
+ break;
+ }
+ }
+ if (parentEntryPtr != NULL) {
+ TkActivateMenuEntry(parentEntryPtr->menuPtr,
+ parentEntryPtr->index);
+ }
+ }
+
+ if (menuPtr->tearoff) {
+ scratchRect = *menuRectPtr;
+ if (tearoffStruct.menuPtr == NULL) {
+ scratchRect.top -= 10;
+ scratchRect.bottom += 10;
+ scratchRect.left -= 10;
+ scratchRect.right += 10;
+ }
+
+ windowPart = FindWindow(hitPt, &whichWindow);
+ if ((windowPart != inMenuBar) && (newItem == -1)
+ && (hitPt.v != 0) && (hitPt.h != 0)
+ && (!PtInRect(hitPt, &scratchRect))
+ && (!PtInRect(hitPt, &tearoffStruct.excludeRect))) {
+ unsigned long dummy;
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleMenuPopUpMsg --
+ *
+ * It handles the MenuDefProc's PopUp message. The menu is
+ * posted with the selected item at the point given in hitPt.
+ *
+ * Results:
+ * A menu is posted.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+HandleMenuPopUpMsg (MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr)
+{
+ int maxMenuHeight;
+ int oldItem;
+ Rect portRect;
+ BitMap screenBits;
+
+ /*
+ * Note that for some oddball reason, h and v are reversed in the
+ * point given to us by the MDEF.
+ */
+ GetQDGlobalsScreenBits(&screenBits);
+
+ oldItem = *whichItem;
+ if (oldItem >= menuPtr->numEntries) {
+ oldItem = -1;
+ }
+ portRect.top = 0;
+ portRect.bottom = 1280;
+ maxMenuHeight = screenBits.bounds.bottom
+ - screenBits.bounds.top
+ - GetMBarHeight() - SCREEN_MARGIN;
+ if (menuPtr->totalHeight > maxMenuHeight) {
+ menuRectPtr->top = GetMBarHeight();
+ } else {
+ int delta;
+ menuRectPtr->top = hitPt.h;
+ if (oldItem >= 0) {
+ menuRectPtr->top -= menuPtr->entries[oldItem]->y;
+ }
+
+ if (menuRectPtr->top < GetMBarHeight()) {
+ /* Displace downward if the menu would stick off the
+ * top of the screen.
+ */
+
+ menuRectPtr->top = GetMBarHeight() + SCREEN_MARGIN;
+ } else {
+ /*
+ * Or upward if the menu sticks off the
+ * bottom end...
+ */
+
+ delta = menuRectPtr->top + menuPtr->totalHeight
+ - maxMenuHeight;
+ if (delta > 0) {
+ menuRectPtr->top -= delta;
+ }
+ }
+ }
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleMenuCalcItemMsg --
+ *
+ * It handles the MenuDefProc's CalcItem message. It is supposed
+ * to calculate the Rect of the menu entry in whichItem in the
+ * menu, and put that in menuRectPtr. I assume this works, but I
+ * have never seen the MenuManager send this message.
+ *
+ * Results:
+ * The Menu Manager is informed of the bounding rect of a
+ * menu rect.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+HandleMenuCalcItemMsg(MenuRef menu,
+ Rect *menuRectPtr,
+ Point hitPt,
+ SInt16 *whichItem,
+ TkMenu *menuPtr)
+{
+ TkMenuEntry *mePtr;
+ MenuTrackingData mtd, *mtdPtr = &mtd;
+ int err, virtualTop;
+
+ err = GetMenuTrackingData(menu, mtdPtr);
+ if (err == noErr) {
+ virtualTop = mtdPtr->virtualMenuTop;
+ } else {
+ virtualTop = 0;
+ }
+
+ mePtr = menuPtr->entries[*whichItem];
+ menuRectPtr->left = mePtr->x;
+ menuRectPtr->top = mePtr->y - virtualTop;
+ if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
+ menuRectPtr->right = menuPtr->totalWidth;
+ } else {
+ menuRectPtr->right = mePtr->x + mePtr->width;
+ }
+ menuRectPtr->bottom = menuRectPtr->top
+ + mePtr->height;
+}
diff --git a/tcl/macosx/tkMacOSXMenu.r b/tcl/macosx/tkMacOSXMenu.r
new file mode 100644
index 00000000000..3291e5dba27
--- /dev/null
+++ b/tcl/macosx/tkMacOSXMenu.r
@@ -0,0 +1,47 @@
+/*
+ * tkMacOSXMenu.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 <Carbon.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/tcl/macosx/tkMacOSXMenubutton.c b/tcl/macosx/tkMacOSXMenubutton.c
new file mode 100644
index 00000000000..aff5d249b59
--- /dev/null
+++ b/tcl/macosx/tkMacOSXMenubutton.c
@@ -0,0 +1,861 @@
+/*
+ * tkMacOSXMenubutton.c --
+ *
+ * This file implements the Macintosh specific portion of the
+ * menubutton widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 <Carbon/Carbon.h>
+#include "tkMenu.h"
+#include "tkMenubutton.h"
+#include "tkMacOSXInt.h"
+#include "tkMacOSXDebug.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 */
+
+#define TK_POPUP_OFFSET 32 /* size of popup marker */
+
+int TkMacOSXGetNewMenuID _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuInstPtr, int cascade, short *menuIDPtr));
+void TkMacOSXFreeMenuID _ANSI_ARGS_((short menuID));
+
+typedef struct {
+ SInt16 initialValue;
+ SInt16 minValue;
+ SInt16 maxValue;
+ SInt16 procID;
+ int isBevel;
+} MenuButtonControlParams;
+
+typedef struct {
+ int len;
+ Str255 title;
+ ControlFontStyleRec style;
+} ControlTitleParams;
+
+/*
+ * Declaration of Mac specific button structure.
+ */
+
+typedef struct MacMenuButton {
+ TkMenuButton info; /* Generic button info. */
+ WindowRef windowRef;
+ ControlRef userPane;
+ ControlRef control;
+ MenuRef menuRef;
+ RGBColor userPaneBackground;
+ MenuButtonControlParams params;
+ ControlTitleParams titleParams;
+ ControlButtonContentInfo bevelButtonContent;
+ OpenCPicParams picParams;
+ int flags;
+} MacMenuButton;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static OSErr SetUserPaneDrawProc(ControlRef control,
+ ControlUserPaneDrawProcPtr upp);
+static OSErr SetUserPaneSetUpSpecialBackgroundProc(ControlRef control,
+ ControlUserPaneBackgroundProcPtr upp);
+static void UserPaneDraw(ControlRef control, ControlPartCode cpc);
+static void UserPaneBackgroundProc(ControlHandle,
+ ControlBackgroundPtr info);
+static int MenuButtonInitControl ( MacMenuButton *mbPtr, Rect *paneRect, Rect *cntrRect );
+
+static int UpdateControlColors _ANSI_ARGS_((MacMenuButton *mbPtr ));
+static void ComputeMenuButtonControlParams _ANSI_ARGS_((TkMenuButton * mbPtr, MenuButtonControlParams * paramsPtr));
+static void ComputeControlTitleParams _ANSI_ARGS_((TkMenuButton * mbPtr, ControlTitleParams * paramsPtr));
+static void CompareControlTitleParams(
+ ControlTitleParams * p1Ptr,
+ ControlTitleParams * p2Ptr,
+ int * titleChanged,
+ int * styleChanged
+);
+
+extern int TkFontGetFirstTextLayout(Tk_TextLayout layout, Tk_Font * font, char * dst);
+extern void TkMacOSXInitControlFontStyle(Tk_Font tkfont,ControlFontStylePtr fsPtr);
+
+extern int tkPictureIsOpen;
+
+/*
+ * The structure below defines menubutton class behavior by means of
+ * procedures that can be invoked from generic window code.
+ */
+
+Tk_ClassProcs tkpMenubuttonClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkMenuButtonWorldChanged, /* worldChangedProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 *mbPtr = (MacMenuButton *) ckalloc(sizeof(MacMenuButton));
+ mbPtr->userPaneBackground.red = 0;
+ mbPtr->userPaneBackground.green = 0;
+ mbPtr->userPaneBackground.blue = ~0;
+ mbPtr->flags = 0;
+ mbPtr->userPane = NULL;
+ mbPtr->control = NULL;
+ mbPtr->picParams.version = -2;
+ mbPtr->picParams.hRes = 0x00480000;
+ mbPtr->picParams.vRes = 0x00480000;
+ mbPtr->picParams.srcRect.top = 0;
+ mbPtr->picParams.srcRect.left = 0;
+ mbPtr->picParams.reserved1 = 0;
+ mbPtr->picParams.reserved2 = 0;
+ mbPtr->bevelButtonContent.contentType = kControlContentPictHandle;
+ mbPtr->menuRef = NULL;
+
+ bzero(&mbPtr->params, sizeof(mbPtr->params));
+ bzero(&mbPtr->titleParams,sizeof(mbPtr->titleParams));
+ return (TkMenuButton *) mbPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 *butPtr = (TkMenuButton *) clientData;
+ Tk_Window tkwin = butPtr->tkwin;
+ TkWindow * winPtr;
+ Pixmap pixmap;
+ MacMenuButton * mbPtr = (MacMenuButton *) butPtr;
+ GWorldPtr dstPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ int hasImageOrBitmap = 0;
+ int width, height;
+ int err;
+ ControlButtonGraphicAlignment theAlignment;
+
+ Rect paneRect, cntrRect;
+
+ butPtr->flags &= ~REDRAW_PENDING;
+ if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+ pixmap = ( Pixmap )Tk_WindowId(tkwin);
+ GetGWorld(&saveWorld, &saveDevice);
+ dstPort = TkMacOSXGetDrawablePort(Tk_WindowId(tkwin));
+ SetGWorld(dstPort, NULL);
+ TkMacOSXSetUpClippingRgn(Tk_WindowId(tkwin));
+
+ winPtr=(TkWindow *)butPtr->tkwin;
+ paneRect.left=winPtr->privatePtr->xOff;
+ paneRect.top=winPtr->privatePtr->yOff;
+ paneRect.right=paneRect.left+Tk_Width(butPtr->tkwin)-1;
+ paneRect.bottom=paneRect.top+Tk_Height(butPtr->tkwin)-1;
+
+ cntrRect=paneRect;
+
+ cntrRect.left+=butPtr->inset;
+ cntrRect.top+=butPtr->inset;
+ cntrRect.right-=butPtr->inset;
+ cntrRect.bottom-=butPtr->inset;
+
+ if (mbPtr->userPane) {
+ MenuButtonControlParams params;
+ bzero(&params, sizeof(params));
+ ComputeMenuButtonControlParams(butPtr, &params );
+ if (bcmp(&params,&mbPtr->params,sizeof(params))) {
+ if (mbPtr->userPane) {
+ DisposeControl(mbPtr->userPane);
+ mbPtr->userPane = NULL;
+ mbPtr->control = NULL;
+ }
+ }
+ }
+ if (!mbPtr->userPane) {
+ if (MenuButtonInitControl(mbPtr,&paneRect,&cntrRect ) ) {
+ fprintf(stderr,"Init Control failed\n" );
+ return;
+ }
+ }
+ SetControlBounds(mbPtr->userPane,&paneRect);
+ SetControlBounds(mbPtr->control,&cntrRect);
+
+ /*
+ * We need to cache the title and its style
+ */
+ if (!(mbPtr->flags&2)) {
+ ControlTitleParams titleParams;
+ int titleChanged;
+ int styleChanged;
+ ComputeControlTitleParams(butPtr,&titleParams);
+ CompareControlTitleParams(&titleParams,&mbPtr->titleParams,
+ &titleChanged,&styleChanged);
+ if (titleChanged) {
+ CFStringRef cf;
+ cf = CFStringCreateWithCString(NULL,
+ titleParams.title, kCFStringEncodingUTF8);
+ if (hasImageOrBitmap) {
+ SetControlTitleWithCFString(mbPtr->control, cf);
+ } else {
+ SetMenuItemTextWithCFString(mbPtr->menuRef, 1, cf);
+ }
+ CFRelease(cf);
+ bcopy(titleParams.title,mbPtr->titleParams.title,titleParams.len+1);
+ mbPtr->titleParams.len = titleParams.len;
+ }
+ if ((titleChanged||styleChanged) && titleParams .len) {
+ if (hasImageOrBitmap) {
+ if ((err=SetControlFontStyle(mbPtr->control,&titleParams.style))!=noErr) {
+ fprintf(stderr,"SetControlFontStyle failed %d\n", err);
+ return;
+ }
+ }
+ bcopy(&titleParams.style,&mbPtr->titleParams.style,sizeof(titleParams.style));
+ }
+ }
+ if (butPtr->image != None) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ hasImageOrBitmap = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ hasImageOrBitmap = 1;
+ }
+ if (hasImageOrBitmap) {
+ mbPtr->picParams.srcRect.right = width;
+ mbPtr->picParams.srcRect.bottom = height;
+ /* Set the flag to circumvent clipping and bounds problems with OS 10.0.4 */
+ tkPictureIsOpen = 1;
+ if (!(mbPtr->bevelButtonContent.u.picture = OpenCPicture(&mbPtr->picParams)) ) {
+ fprintf(stderr,"OpenCPicture failed\n");
+ }
+ /*
+ * 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->image != NULL) {
+ Tk_RedrawImage(butPtr->image, 0, 0, width,
+ height, pixmap, 0, 0);
+ } else {
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, NULL, 0, 0,
+ (unsigned int) width, (unsigned int) height, 0, 0, 1);
+ }
+ ClosePicture();
+
+ tkPictureIsOpen = 0;
+ if ( (err=SetControlData(mbPtr->control, kControlButtonPart,
+ kControlBevelButtonContentTag,
+ sizeof(ControlButtonContentInfo),
+ (char *) &mbPtr->bevelButtonContent)) != noErr ) {
+ fprintf(stderr,"SetControlData BevelButtonContent failed, %d\n", err );
+ }
+ switch (butPtr->anchor) {
+ case TK_ANCHOR_N:
+ theAlignment = kControlBevelButtonAlignTop;
+ break;
+ case TK_ANCHOR_NE:
+ theAlignment = kControlBevelButtonAlignTopRight;
+ break;
+ case TK_ANCHOR_E:
+ theAlignment = kControlBevelButtonAlignRight;
+ break;
+ case TK_ANCHOR_SE:
+ theAlignment = kControlBevelButtonAlignBottomRight;
+ break;
+ case TK_ANCHOR_S:
+ theAlignment = kControlBevelButtonAlignBottom;
+ break;
+ case TK_ANCHOR_SW:
+ theAlignment = kControlBevelButtonAlignBottomLeft;
+ break;
+ case TK_ANCHOR_W:
+ theAlignment = kControlBevelButtonAlignLeft;
+ break;
+ case TK_ANCHOR_NW:
+ theAlignment = kControlBevelButtonAlignTopLeft;
+ break;
+ case TK_ANCHOR_CENTER:
+ theAlignment = kControlBevelButtonAlignCenter;
+ break;
+ }
+
+ if ((err=SetControlData(mbPtr->control, kControlButtonPart,
+ kControlBevelButtonGraphicAlignTag,
+ sizeof(ControlButtonGraphicAlignment),
+ (char *) &theAlignment)) != noErr ) {
+ fprintf(stderr,"SetControlData BevelButtonGraphicAlign failed, %d\n", err );
+ }
+ }
+ if (butPtr->flags & GOT_FOCUS) {
+ HiliteControl(mbPtr->control,kControlButtonPart);
+ } else {
+ HiliteControl(mbPtr->control,kControlNoPart);
+ }
+ UpdateControlColors(mbPtr);
+ if (mbPtr->flags&2) {
+ ShowControl(mbPtr->control);
+ ShowControl(mbPtr->userPane);
+ mbPtr->flags ^= 2;
+ } else {
+ Draw1Control(mbPtr->userPane);
+ SetControlVisibility(mbPtr->control, true, true);
+ }
+ if (hasImageOrBitmap) {
+ KillPicture(mbPtr->bevelButtonContent.u.picture);
+ }
+ 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)
+{
+ MacMenuButton * macMbPtr = (MacMenuButton *)mbPtr;
+ if (macMbPtr->userPane) {
+ DisposeControl(macMbPtr->userPane);
+ macMbPtr->userPane = NULL;
+ }
+ if (macMbPtr->menuRef) {
+ short menuID;
+ menuID = GetMenuID(macMbPtr->menuRef);
+ TkMacOSXFreeMenuID(menuID);
+ DisposeMenu(macMbPtr->menuRef);
+ macMbPtr->menuRef = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ int hasImageOrBitmap = 0;
+
+ 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;
+ }
+ hasImageOrBitmap = 1;
+ } 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;
+ }
+ hasImageOrBitmap = 1;
+ } else {
+ hasImageOrBitmap = 0;
+ 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;
+ }
+ if (!hasImageOrBitmap) {
+ width += TK_POPUP_OFFSET;
+ }
+
+ Tk_GeometryRequest(mbPtr->tkwin, (int) (width + 2*mbPtr->inset),
+ (int) (height + 2*mbPtr->inset));
+ Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeMenuButtonControlParams --
+ *
+ * This procedure computes the various parameters used
+ * when creating a Carbon control (NewControl)
+ * These are determined by the various tk menu button parameters
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the control initialisation parameters
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeMenuButtonControlParams(TkMenuButton * mbPtr,
+ MenuButtonControlParams * paramsPtr )
+{
+ int fakeMenuID = 256;
+
+ /*
+ * Determine ProcID based on button type and dimensions
+ *
+ * We need to set minValue to some non-zero value,
+ * Otherwise, the markers do not show up
+ */
+
+ paramsPtr->minValue = kControlBehaviorMultiValueMenu;
+ paramsPtr->maxValue = 0;
+ if (mbPtr->image || mbPtr->bitmap) {
+ paramsPtr->isBevel = 1;
+ if (mbPtr->borderWidth <= 2) {
+ paramsPtr->procID = kControlBevelButtonSmallBevelProc;
+ } else if (mbPtr->borderWidth == 3) {
+ paramsPtr->procID = kControlBevelButtonNormalBevelProc;
+ } else {
+ paramsPtr->procID = kControlBevelButtonLargeBevelProc;
+ }
+ if (mbPtr->indicatorOn) {
+ paramsPtr->initialValue = fakeMenuID;
+ } else {
+ paramsPtr->initialValue = 0;
+ }
+ } else {
+ paramsPtr->isBevel = 0;
+ paramsPtr->procID = kControlPopupButtonProc
+ + kControlPopupVariableWidthVariant;
+ paramsPtr->minValue = -12345;
+ paramsPtr->maxValue = -1;
+ paramsPtr->initialValue = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * returns 0 if same, 1 otherwise
+ *----------------------------------------------------------------------
+ */
+static void
+CompareControlTitleParams(
+ ControlTitleParams * p1Ptr,
+ ControlTitleParams * p2Ptr,
+ int * titleChanged,
+ int * styleChanged
+)
+{
+ if (p1Ptr->len != p2Ptr->len) {
+ *titleChanged = 1;
+ } else {
+ if (bcmp(p1Ptr->title,p2Ptr->title,p1Ptr->len)) {
+ *titleChanged = 1;
+ } else {
+ *titleChanged = 0;
+ }
+ }
+ if (p1Ptr->len && p2Ptr->len) {
+ *styleChanged = bcmp(&p1Ptr->style, &p2Ptr->style, sizeof(p2Ptr->style));
+ } else {
+ *styleChanged = p1Ptr->len||p2Ptr->len;
+ }
+}
+
+static void
+ComputeControlTitleParams(TkMenuButton * butPtr, ControlTitleParams * paramsPtr )
+{
+ Tk_Font font;
+ paramsPtr->len =TkFontGetFirstTextLayout(butPtr->textLayout,&font, paramsPtr->title);
+ paramsPtr->title [paramsPtr->len] = 0;
+ if (paramsPtr->len) {
+ TkMacOSXInitControlFontStyle(font,&paramsPtr->style);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuButtonInitControl --
+ *
+ * This procedure initialises a Carbon control
+ *
+ * Results:
+ * 0 on success, 1 on failure.
+ *
+ * Side effects:
+ * A background pane control and the control itself is created
+ * The contol is embedded in the background control
+ * The background control is embedded in the root control
+ * of the containing window
+ * The creation parameters for the control are also computed
+ *
+ *----------------------------------------------------------------------
+ */
+int
+MenuButtonInitControl (
+ MacMenuButton *mbPtr, /* Mac button. */
+ Rect *paneRect,
+ Rect *cntrRect
+)
+{
+ OSErr status;
+ TkMenuButton * butPtr = ( TkMenuButton * )mbPtr;
+ ControlRef rootControl;
+ SInt16 procID;
+ Boolean initiallyVisible;
+ SInt16 initialValue;
+ SInt16 minValue;
+ SInt16 maxValue;
+ SInt32 controlReference;
+ int err;
+ short menuID;
+ int length;
+ Str255 itemText;
+
+ rootControl=TkMacOSXGetRootControl(Tk_WindowId(butPtr->tkwin));
+ mbPtr->windowRef=GetWindowFromPort(TkMacOSXGetDrawablePort(Tk_WindowId(butPtr->tkwin)));
+ /*
+ * Set up the user pane
+ */
+ initiallyVisible = false;
+ initialValue = kControlSupportsEmbedding|
+ kControlHasSpecialBackground;
+ minValue = 0;
+ maxValue = 1;
+ procID = kControlUserPaneProc;
+ controlReference = (SInt32)mbPtr;
+ mbPtr->userPane=NewControl(mbPtr->windowRef,
+ paneRect, "\p",
+ initiallyVisible,
+ initialValue,
+ minValue,
+ maxValue,
+ procID,
+ controlReference );
+ if (!mbPtr->userPane) {
+ fprintf(stderr,"Failed to create user pane control\n");
+ return 1;
+ }
+ if ((status=EmbedControl(mbPtr->userPane,rootControl))!=noErr) {
+ fprintf(stderr,"Failed to embed user pane control %d\n", status);
+ return 1;
+ }
+ SetUserPaneSetUpSpecialBackgroundProc(mbPtr->userPane,
+ UserPaneBackgroundProc);
+ SetUserPaneDrawProc(mbPtr->userPane,UserPaneDraw);
+ initiallyVisible = false;
+ ComputeMenuButtonControlParams(butPtr,&mbPtr->params);
+ /* Do this only if we are using bevel buttons */
+ ComputeControlTitleParams(butPtr,&mbPtr->titleParams);
+ mbPtr->control = NewControl(mbPtr->windowRef,
+ cntrRect, "\p", //mbPtr->titleParams.title,
+ initiallyVisible,
+ mbPtr->params.initialValue,
+ mbPtr->params.minValue,
+ mbPtr->params.maxValue,
+ mbPtr->params.procID,
+ controlReference );
+ if (!mbPtr->control) {
+ fprintf(stderr,"failed to create control of type %d : line %d\n",mbPtr->params.procID, __LINE__);
+ return 1;
+ }
+ if ((err=EmbedControl(mbPtr->control,mbPtr->userPane)) != noErr ) {
+ fprintf(stderr,"failed to embed control of type %d,%d\n",procID, err);
+ return 1;
+ }
+ if (mbPtr->params.isBevel) {
+ CFStringRef cf;
+ cf = CFStringCreateWithCString(NULL,
+ mbPtr->titleParams.title, kCFStringEncodingUTF8);
+ SetControlTitleWithCFString(mbPtr->control, cf);
+ CFRelease(cf);
+ if (mbPtr->titleParams.len) {
+ if ((err=SetControlFontStyle(mbPtr->control,&mbPtr->titleParams.style))!=noErr) {
+ fprintf(stderr,"SetControlFontStyle failed %d\n", err);
+ return 1;
+ }
+ }
+ } else {
+ CFStringRef cf;
+ err = TkMacOSXGetNewMenuID(mbPtr->info.interp, (TkMenu *)mbPtr, 0, &menuID);
+ if (err != TCL_OK) {
+ return err;
+ }
+ length = strlen(Tk_PathName(mbPtr->info.tkwin));
+ memmove(&itemText[1], Tk_PathName(mbPtr->info.tkwin),
+ (length > 230) ? 230 : length);
+ itemText[0] = (length > 230) ? 230 : length;
+ if (!(mbPtr->menuRef = NewMenu(menuID,itemText))) {
+ return 1;
+ }
+ cf = CFStringCreateWithCString(NULL,
+ mbPtr->titleParams.title, kCFStringEncodingUTF8);
+ AppendMenuItemText(mbPtr->menuRef, "\px");
+ if (cf != NULL) {
+ SetMenuItemTextWithCFString(mbPtr->menuRef, 1, cf);
+ CFRelease(cf);
+ }
+ err = SetControlData(mbPtr->control,
+ kControlNoPart,
+ kControlPopupButtonMenuRefTag,
+ sizeof(mbPtr->menuRef), &mbPtr->menuRef);
+ SetControlMinimum(mbPtr->control, 1);
+ SetControlMaximum(mbPtr->control, 1);
+ SetControlValue(mbPtr->control, 1);
+ }
+ mbPtr->flags |= 2;
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetUserPane
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+OSErr SetUserPaneDrawProc (
+ ControlRef control,
+ ControlUserPaneDrawProcPtr upp)
+{
+ ControlUserPaneDrawUPP myControlUserPaneDrawUPP;
+ myControlUserPaneDrawUPP = NewControlUserPaneDrawUPP(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.
+ *
+ *--------------------------------------------------------------
+ */
+OSErr
+SetUserPaneSetUpSpecialBackgroundProc(
+ ControlRef control,
+ ControlUserPaneBackgroundProcPtr upp)
+{
+ ControlUserPaneBackgroundUPP myControlUserPaneBackgroundUPP;
+ myControlUserPaneBackgroundUPP = NewControlUserPaneBackgroundUPP(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.
+ *
+ *--------------------------------------------------------------
+ */
+void
+UserPaneDraw(
+ ControlRef control,
+ ControlPartCode cpc)
+{
+ Rect contrlRect;
+ MacMenuButton * mbPtr;
+ mbPtr = ( MacMenuButton *)GetControlReference(control);
+ GetControlBounds(control,&contrlRect);
+ RGBBackColor (&mbPtr->userPaneBackground);
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+UserPaneBackgroundProc(
+ ControlHandle control,
+ ControlBackgroundPtr info)
+{
+ MacMenuButton * mbPtr;
+ mbPtr = (MacMenuButton *)GetControlReference(control);
+ if (info->colorDevice) {
+ RGBBackColor (&mbPtr->userPaneBackground);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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(MacMenuButton * mbPtr)
+{
+ XColor *xcolor;
+ TkMenuButton * butPtr = ( TkMenuButton * )mbPtr;
+
+ /*
+ * 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.
+ */
+
+ xcolor = Tk_3DBorderColor(butPtr->normalBorder);
+ TkSetMacColor(xcolor->pixel, &mbPtr->userPaneBackground);
+
+ return false;
+}
diff --git a/tcl/macosx/tkMacOSXMenus.c b/tcl/macosx/tkMacOSXMenus.c
new file mode 100644
index 00000000000..8ca3542c230
--- /dev/null
+++ b/tcl/macosx/tkMacOSXMenus.c
@@ -0,0 +1,325 @@
+/*
+ * tkMacOSXMenus.c --
+ *
+ * These calls set up and manage the menubar for the
+ * Macintosh version of Tk.
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkInt.h"
+#include "tkMacOSXInt.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 <Carbon/Carbon.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
+
+MenuRef tkAppleMenu;
+MenuRef tkFileMenu;
+MenuRef tkEditMenu;
+
+static Tcl_Interp * gInterp; /* Interpreter for this application. */
+
+static void GenerateEditEvent _ANSI_ARGS_((int flag));
+static void SourceDialog _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXHandleMenuSelect --
+ *
+ * Handles events that occur in the Menu bar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXHandleMenuSelect(
+ long mResult,
+ int optionKeyPressed)
+{
+ short theItem = LoWord(mResult);
+ short theMenu = HiWord(mResult);
+ Tk_Window tkwin;
+ Window window;
+ TkDisplay *dispPtr;
+
+ if (mResult == 0) {
+ TkMacOSXHandleTearoffMenu();
+ TkMacOSXClearMenubarActive();
+ 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;
+ }
+ }
+ break;
+ case kFileMenu:
+ switch (theItem) {
+ case kSourceItem:
+ /* TODO: source script */
+ SourceDialog();
+ break;
+ case kCloseItem:
+ /* Send close event */
+ window = TkMacOSXGetXWindow(FrontNonFloatingWindow());
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->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:
+ TkMacOSXDispatchMenuEvent(theMenu, theItem);
+ TkMacOSXClearMenubarActive();
+ break;
+ }
+ /*
+ * Finally we unhighlight the menu.
+ */
+ HiliteMenu(0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXInitMenus --
+ *
+ * This procedure initializes the Macintosh menu bar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXInitMenus(
+ Tcl_Interp *interp)
+{
+ gInterp = interp;
+
+ /*
+ * At this point, InitMenus() should have already been called.
+ */
+
+ if (TkMacOSXUseMenuID(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(-");
+ /* Not necessary in Carbon:
+ AppendResMenu(tkAppleMenu, 'DRVR');
+ */
+
+ if (TkMacOSXUseMenuID(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 (TkMacOSXUseMenuID(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 (TkMacOSXUseMenuID(kHMHelpMenuID) != TCL_OK) {
+ panic("Help menu ID %s is already in use!", kHMHelpMenuID);
+ }
+
+ DrawMenuBar();
+ TkMacOSXSetHelpMenuItemCount();
+ 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;
+ TkDisplay *dispPtr;
+
+ window = TkMacOSXGetXWindow(FrontNonFloatingWindow());
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
+ if (tkwin == NULL) {
+ return;
+ }
+
+ event.type = VirtualEvent;
+ event.serial = Tk_Display(tkwin)->request;
+ 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 = TkMacOSXButtonKeyState();
+ 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()
+{
+ int result;
+ CONST char *path;
+ CONST char *openCmd = "tk_getOpenFile -filetypes {\
+ {{TCL Scripts} {.tcl} TEXT} {{Text Files} {} TEXT}}";
+
+ if (gInterp == NULL) {
+ return;
+ }
+ if (Tcl_Eval(gInterp, openCmd) != TCL_OK) {
+ return;
+ }
+ path = Tcl_GetStringResult(gInterp);
+ if (strlen(path) == 0) {
+ return;
+ }
+ result = Tcl_EvalFile(gInterp, path);
+ if (result == TCL_ERROR) {
+ Tcl_BackgroundError(gInterp);
+ }
+}
diff --git a/tcl/macosx/tkMacOSXMouseEvent.c b/tcl/macosx/tkMacOSXMouseEvent.c
new file mode 100644
index 00000000000..12bfc939d52
--- /dev/null
+++ b/tcl/macosx/tkMacOSXMouseEvent.c
@@ -0,0 +1,740 @@
+/*
+ * tkMacOSXMouseEvent.c --
+ *
+ * This file implements functions that decode & handle mouse events
+ * on MacOS X.
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#include "tkInt.h"
+#include <X11/X.h>
+#include <X11/Xlib.h>
+#include "tkMacOSXEvent.h"
+#include "tkMacOSXInt.h"
+#include "tkPort.h"
+#include "tkMacOSXDebug.h"
+
+typedef struct {
+ WindowRef whichWin;
+ WindowRef activeNonFloating;
+ WindowPartCode windowPart;
+ Point global;
+ Point local;
+ unsigned int state;
+ long delta;
+} MouseEventData;
+
+/*
+ * Declarations of static variables used in this file.
+ */
+
+static int gEatButtonUp = 0; /* 1 if we need to eat the next * up event */
+
+/*
+ * Declarations of functions used only in this file.
+ */
+
+static void BringWindowForward _ANSI_ARGS_((WindowRef wRef));
+static int GeneratePollingEvents(MouseEventData * medPtr);
+static int GenerateMouseWheelEvent(MouseEventData * medPtr);
+
+extern int TkMacOSXGetEatButtonUp();
+extern void TkMacOSXSetEatButtonUp(int f);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXProcessMouseEvent --
+ *
+ * This routine processes the event in eventPtr, and
+ * generates the appropriate Tk events from it.
+ *
+ * Results:
+ * True if event(s) are generated - false otherwise.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXProcessMouseEvent(TkMacOSXEvent *eventPtr, MacEventStatus * statusPtr)
+{
+ WindowRef frontWindow;
+ Tk_Window tkwin;
+ Point where, where2;
+ int xOffset, yOffset;
+ TkDisplay * dispPtr;
+ Window window;
+ int status,err;
+ MouseEventData mouseEventData, * medPtr = &mouseEventData;
+ KeyMap keyMap;
+
+ switch (eventPtr->eKind) {
+ case kEventMouseUp:
+ case kEventMouseDown:
+ case kEventMouseMoved:
+ case kEventMouseDragged:
+ case kEventMouseWheelMoved:
+ break;
+ default:
+ statusPtr->handledByTk = 1;
+ return 0;
+ break;
+ }
+ statusPtr->handledByTk = 1;
+ status = GetEventParameter(eventPtr->eventRef,
+ kEventParamMouseLocation,
+ typeQDPoint, NULL,
+ sizeof(where), NULL,
+ &where);
+ if (status != noErr) {
+ fprintf (stderr, "Failed to retrieve mouse location,%d\n", status);
+ return 0;
+ }
+ medPtr->state = 0;
+ GetKeys(keyMap);
+ if (keyMap[1] & 2) {
+ medPtr->state |= LockMask;
+ }
+ if (keyMap[1] & 1) {
+ medPtr->state |= ShiftMask;
+ }
+ if (keyMap[1] & 8) {
+ medPtr->state |= ControlMask;
+ }
+ if (keyMap[1] & 32768) {
+ medPtr->state |= Mod1Mask; /* command key */
+ }
+ if (keyMap[1] & 4) {
+ medPtr->state |= Mod2Mask; /* option key */
+ }
+ if (eventPtr->eKind == kEventMouseDown
+ || eventPtr->eKind== kEventMouseDragged ) {
+ EventMouseButton mouseButton;
+ if ((status=GetEventParameter(eventPtr->eventRef,
+ kEventParamMouseButton,
+ typeMouseButton, NULL,
+ sizeof(mouseButton), NULL,&mouseButton)) != noErr ) {
+ fprintf (stderr, "Failed to retrieve mouse button, %d\n", status);
+ statusPtr->err = 1;
+ return 0;
+ }
+ medPtr->state |= 1 << ((mouseButton-1)+8);
+ }
+
+ medPtr->windowPart= FindWindow(where, &medPtr->whichWin);
+ window = TkMacOSXGetXWindow(medPtr->whichWin);
+ if (medPtr->whichWin != NULL && window == None) {
+ statusPtr->handledByTk = 0;
+ return 0;
+ }
+
+ frontWindow = FrontWindow();
+ medPtr->activeNonFloating = ActiveNonFloatingWindow();
+
+ /*
+ * 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->eKind == kEventMouseUp) {
+ if (TkMacOSXGetEatButtonUp()) {
+ TkMacOSXSetEatButtonUp(false);
+ return false;
+ }
+ return TkGenerateButtonEvent(where.h, where.v,
+ window, medPtr->state);
+ }
+ if (eventPtr->eKind == kEventMouseWheelMoved) {
+ if ((status=GetEventParameter(eventPtr->eventRef,
+ kEventParamMouseWheelDelta,
+ typeLongInteger, NULL,
+ sizeof(medPtr->delta), NULL,&medPtr->delta)) != noErr ) {
+ fprintf (stderr,
+ "Failed to retrieve mouse wheel delta, %d\n", status);
+ statusPtr->err = 1;
+ return false;
+ }
+ }
+
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+
+ if (eventPtr->eKind != kEventMouseDown ) {
+ /*
+ * MouseMoved, MouseDragged or kEventMouseWheelMoved
+ */
+
+ medPtr->global = where;
+ medPtr->local = where;
+ /*
+ * We must set the port to the right window -- the one
+ * we are actually going to use -- before finding
+ * the local coordinates, otherwise we will have completely
+ * wrong local x,y!
+ *
+ * I'm pretty sure this window is medPtr->whichWin, unless
+ * perhaps there is a grab. Certainly 'frontWindow' or
+ * 'medPtr->activeNonFloating' are wrong.
+ */
+ SetPortWindowPort(medPtr->whichWin);
+ GlobalToLocal(&medPtr->local);
+ if (eventPtr->eKind == kEventMouseWheelMoved ) {
+ return GenerateMouseWheelEvent(medPtr);
+ } else {
+ return GeneratePollingEvents(medPtr);
+ }
+ }
+
+ if (medPtr->whichWin && eventPtr->eKind==kEventMouseDown) {
+ ProcessSerialNumber frontPsn, ourPsn;
+ Boolean flag;
+ if ((err=GetFrontProcess(&frontPsn))!=noErr) {
+ fprintf(stderr, "GetFrontProcess failed, %d\n", err);
+ statusPtr->err = 1;
+ return 1;
+ }
+
+ GetCurrentProcess(&ourPsn);
+ if ((err=SameProcess(&frontPsn, &ourPsn, &flag))!=noErr) {
+ fprintf(stderr, "SameProcess failed, %d\n", err);
+ statusPtr->err = 1;
+ return 1;
+ } else {
+ if (!flag) {
+ if ((err=SetFrontProcess(&ourPsn)) != noErr) {
+ fprintf(stderr,"SetFrontProcess failed,%d\n", err);
+ statusPtr->err = 1;
+ return 1;
+ }
+ }
+ }
+
+ }
+
+ if (medPtr->whichWin) {
+ /*
+ * We got a mouse down in a window
+ * See if this is the activate click
+ * This click moves the window forward. We don't want
+ * the corresponding mouse-up to be reported to the application
+ * or else it will mess up some Tk scripts.
+ */
+
+ if (!(TkpIsWindowFloating(medPtr->whichWin))
+ && (medPtr->whichWin != medPtr->activeNonFloating)) {
+ Tk_Window grabWin = TkMacOSXGetCapture();
+ if ((grabWin != NULL) && (grabWin != tkwin)) {
+ TkWindow * tkw, * grb;
+ tkw = (TkWindow *)tkwin;
+ grb = (TkWindow *)grabWin;
+ SysBeep(1);
+ return false;
+ }
+ TkMacOSXSetEatButtonUp(true);
+ BringWindowForward(medPtr->whichWin);
+ return false;
+ }
+ }
+
+ switch (medPtr->windowPart) {
+ case inDrag:
+ DragWindow(medPtr->whichWin, where, NULL);
+ where2.h = where2.v = 0;
+ LocalToGlobal(&where2);
+ if (EqualPt(where, where2)) {
+ return false;
+ }
+ TkMacOSXWindowOffset(medPtr->whichWin, &xOffset, &yOffset);
+ where2.h -= xOffset;
+ where2.v -= yOffset;
+ TkGenWMConfigureEvent(tkwin, where2.h, where2.v,
+ -1, -1, TK_LOCATION_CHANGED);
+ return true;
+ break;
+ case inContent:
+ return TkGenerateButtonEvent(where.h, where.v,
+ window, medPtr->state);
+ break;
+ case inGrow:
+ /*
+ * 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 (TkMacOSXGrowToplevel(medPtr->whichWin, where) == true) {
+ return true;
+ } else {
+ return TkGenerateButtonEvent(where.h,
+ where.v, window, medPtr->state);
+ }
+ break;
+ case inGoAway:
+ if (TrackGoAway(medPtr->whichWin,where)) {
+ if (tkwin == NULL) {
+ return false;
+ }
+ TkGenWMDestroyEvent(tkwin);
+ return true;
+ }
+ return false;
+ break;
+ case inMenuBar:
+ {
+ int oldMode;
+ KeyMap theKeys;
+
+ GetKeys(theKeys);
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ TkMacOSXClearMenubarActive();
+
+ /*
+ * Handle -postcommand
+ */
+
+ TkMacOSXPreprocessMenu();
+ TkMacOSXHandleMenuSelect(MenuSelect(where),
+ theKeys[1] & 4);
+ Tcl_SetServiceMode(oldMode);
+ return true; /* TODO: may not be on event on queue. */
+ }
+ break;
+ case inZoomIn:
+ case inZoomOut:
+ if (TkMacOSXZoomToplevel(medPtr->whichWin, where,
+ medPtr->windowPart) == true) {
+ return true;
+ } else {
+ return false;
+ }
+ break;
+ case inCollapseBox:
+ if ((err = CollapseWindow(medPtr->whichWin,
+ !IsWindowCollapsed(medPtr->whichWin)))!=noErr) {
+ fprintf(stderr,"CollapseWindow failed,%d\n", err);
+ statusPtr->err = 1;
+ }
+ break;
+ default:
+ return false;
+ break;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(MouseEventData * medPtr)
+{
+ Tk_Window tkwin, rootwin, grabWin;
+ Window window;
+ int local_x, local_y;
+ TkDisplay *dispPtr;
+
+ /*
+ * I really do not understand this complicated logic. Surely the event
+ * should be to either: (1) medPtr->whichWin, the window under the mouse
+ * (from which we then obviously extract the correct Tk subwindow), or
+ * (2) the current grab window. I really don't see why anything else is
+ * relevant.
+ */
+#if 0
+ if ((!TkpIsWindowFloating(medPtr->whichWin)
+ && (medPtr->activeNonFloating != medPtr->whichWin))) {
+ tkwin = NULL;
+ } else {
+ window = TkMacOSXGetXWindow(medPtr->whichWin);
+ dispPtr = TkGetDisplayList();
+ rootwin = Tk_IdToWindow(dispPtr->display, window);
+ if (rootwin == NULL) {
+ tkwin = NULL;
+ } else {
+ tkwin = Tk_TopCoordsToWindow(rootwin,
+ medPtr->local.h, medPtr->local.v,
+ &local_x, &local_y);
+ }
+ }
+
+ /*
+ * The following call will generate the appropiate X events and
+ * adjust any state that Tk must remember.
+ */
+
+ grabWin = TkMacOSXGetCapture();
+
+ if ((tkwin == NULL) && (grabWin != NULL)) {
+ tkwin = grabWin;
+ }
+#else
+ grabWin = TkMacOSXGetCapture();
+ if (grabWin != NULL) {
+ tkwin = grabWin;
+ } else {
+ window = TkMacOSXGetXWindow(medPtr->whichWin);
+ dispPtr = TkGetDisplayList();
+ rootwin = Tk_IdToWindow(dispPtr->display, window);
+ if (rootwin == NULL) {
+ tkwin = NULL;
+ } else {
+ tkwin = Tk_TopCoordsToWindow(rootwin,
+ medPtr->local.h, medPtr->local.v,
+ &local_x, &local_y);
+ }
+ }
+#endif
+ Tk_UpdatePointer(tkwin, medPtr->global.h, medPtr->global.v,
+ medPtr->state);
+
+
+ TkMacOSXInstallCursor(0);
+
+ return true;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+{
+ if (!TkpIsWindowFloating(wRef)) {
+ if (IsValidWindowPtr(wRef))
+ SelectWindow(wRef);
+ }
+}
+
+static int
+GenerateMouseWheelEvent(MouseEventData * medPtr)
+{
+ Tk_Window tkwin, rootwin, grabWin;
+ Window window;
+ int local_x, local_y;
+ TkDisplay *dispPtr;
+ TkWindow *winPtr;
+ XEvent xEvent;
+
+ if ((!TkpIsWindowFloating(medPtr->whichWin)
+ && (medPtr->activeNonFloating != medPtr->whichWin))) {
+ tkwin = NULL;
+ } else {
+ window = TkMacOSXGetXWindow(medPtr->whichWin);
+ dispPtr = TkGetDisplayList();
+ rootwin = Tk_IdToWindow(dispPtr->display, window);
+ if (rootwin == NULL) {
+ tkwin = NULL;
+ } else {
+ tkwin = Tk_TopCoordsToWindow(rootwin,
+ medPtr->local.h, medPtr->local.v,
+ &local_x, &local_y);
+ }
+ }
+
+ /*
+ * The following call will generate the appropiate X events and
+ * adjust any state that Tk must remember.
+ */
+
+ grabWin = TkMacOSXGetCapture();
+
+ if ((tkwin == NULL) && (grabWin != NULL)) {
+ tkwin = grabWin;
+ }
+ if (!tkwin) {
+ return true;
+ }
+ winPtr = ( TkWindow *)tkwin;
+ xEvent.type = MouseWheelEvent;
+ xEvent.xkey.keycode = medPtr->delta;
+ xEvent.xany.serial = LastKnownRequestProcessed(winPtr->display);
+ xEvent.xany.send_event = false;
+ xEvent.xany.display = winPtr->display;
+ xEvent.xany.window = Tk_WindowId(winPtr);
+ Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL);
+
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetEatButtonUp --
+ *
+ * Results:
+ * Returns the flag indicating if we need to eat the
+ * next mouse up event
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TkMacOSXGetEatButtonUp()
+{
+ return gEatButtonUp;
+}
+
+/*
+ * TkMacOSXSetEatButtonUp --
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the flag indicating if we need to eat the
+ * next mouse up event
+ *
+ */
+void
+TkMacOSXSetEatButtonUp(int f)
+{
+ gEatButtonUp = f;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXButtonKeyState --
+ *
+ * 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
+TkMacOSXButtonKeyState()
+{
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ CGrafPtr port;
+ GDHandle dev;
+
+ GetGWorld(&port,&dev);
+ GetMouse(&where);
+ LocalToGlobal(&where);
+
+ *root_x_return = where.h;
+ *root_y_return = where.v;
+ *mask_return = TkMacOSXButtonKeyState();
+ return True;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ TkDisplay *dispPtr;
+
+ /*
+ * ButtonDown events will always occur in the front
+ * window. ButtonUp events, however, may occur anywhere
+ * on the screen. ButtonUp events should only be sent
+ * to Tk if in the front window or during an implicit grab.
+ */
+
+ where.h = x;
+ where.v = y;
+ FindWindow(where, &whichWin);
+ frontWin = FrontNonFloatingWindow();
+
+ if (0 && ((frontWin == NULL) || ((!(TkpIsWindowFloating(whichWin))
+ && (frontWin != whichWin))
+ && TkMacOSXGetCapture() == NULL))) {
+ return false;
+ }
+
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+
+ /* SetPortWindowPort(ActiveNonFloatingWindow()); */
+ SetPortWindowPort(whichWin);
+ GlobalToLocal(&where);
+ if (tkwin != NULL) {
+ tkwin = Tk_TopCoordsToWindow(tkwin, where.h, where.v,
+ &dummy, &dummy);
+ }
+
+ Tk_UpdatePointer(tkwin, x, y, state);
+
+ return true;
+} \ No newline at end of file
diff --git a/tcl/macosx/tkMacOSXNotify.c b/tcl/macosx/tkMacOSXNotify.c
new file mode 100644
index 00000000000..9862618f3ec
--- /dev/null
+++ b/tcl/macosx/tkMacOSXNotify.c
@@ -0,0 +1,1162 @@
+/*
+ * tclMacOSXNotify.c --
+ *
+ * This file contains the implementation of a merged
+ * Carbon/select-based notifier, which is the lowest-level part
+ * of the Tcl event loop. This file works together with
+ * ../generic/tclNotify.c.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tclInt.h"
+#include "tclPort.h"
+
+/* FIXME - Why do I need these here? */
+
+#undef environ
+#include "tkMacOSX.h"
+#include "tkMacOSXEvent.h"
+#include <signal.h>
+
+extern TclStubs tclStubs;
+
+/*
+ * This structure is used to keep track of the notifier info for a
+ * a registered file.
+ */
+
+typedef struct FileHandler {
+ int fd;
+ int mask; /* Mask of desired events: TCL_READABLE,
+ * etc. */
+ int readyMask; /* Mask of events that have been seen since the
+ * last time file handlers were invoked for
+ * this file. */
+ Tcl_FileProc *proc; /* Procedure to call, in the style of
+ * Tcl_CreateFileHandler. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+} FileHandler;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file handlers are ready to fire.
+ */
+
+typedef struct FileHandlerEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ int fd; /* File descriptor that is ready. Used
+ * to find the FileHandler structure for
+ * the file (can't point directly to the
+ * FileHandler structure because it could
+ * go away while the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * select based implementation of the Tcl notifier. One of these structures
+ * is created for each thread that is using the notifier.
+ */
+
+typedef struct ThreadSpecificData {
+ FileHandler *firstFileHandlerPtr;
+ /* Pointer to head of file handler list. */
+ fd_mask checkMasks[3*MASK_SIZE];
+ /* This array is used to build up the masks
+ * to be used in the next call to select.
+ * Bits are set in response to calls to
+ * Tcl_CreateFileHandler. */
+ fd_mask readyMasks[3*MASK_SIZE];
+ /* This array reflects the readable/writable
+ * conditions that were found to exist by the
+ * last call to select. */
+ int numFdBits; /* Number of valid bits in checkMasks
+ * (one more than highest fd for which
+ * Tcl_WatchFile has been called). */
+ int isMainLoop; /* Is this the main Carbon Loop (in which case
+ * we will call RNE in the actual wait... */
+#ifdef TCL_THREADS
+ int onList; /* True if it is in this list */
+ unsigned int pollState; /* pollState is used to implement a polling
+ * handshake between each thread and the
+ * notifier thread. Bits defined below. */
+ struct ThreadSpecificData *nextPtr, *prevPtr;
+ /* All threads that are currently waiting on
+ * an event have their ThreadSpecificData
+ * structure on a doubly-linked listed formed
+ * from these pointers. You must hold the
+ * notifierMutex lock before accessing these
+ * fields. */
+ Tcl_Condition waitCV; /* Any other thread alerts a notifier
+ * that an event is ready to be processed
+ * by signaling this condition variable. */
+ int eventReady; /* True if an event is ready to be processed.
+ * Used as condition flag together with
+ * waitCV above. */
+#endif
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+#ifdef TCL_THREADS
+/*
+ * The following static indicates the number of threads that have
+ * initialized notifiers.
+ *
+ * You must hold the notifierMutex lock before accessing this variable.
+ */
+
+static int notifierCount = 0;
+
+/*
+ * The following variable points to the head of a doubly-linked list of
+ * of ThreadSpecificData structures for all threads that are currently
+ * waiting on an event.
+ *
+ * You must hold the notifierMutex lock before accessing this list.
+ */
+
+static ThreadSpecificData *waitingListPtr = NULL;
+
+/*
+ * The notifier thread spends all its time in select() waiting for a
+ * file descriptor associated with one of the threads on the waitingListPtr
+ * list to do something interesting. But if the contents of the
+ * waitingListPtr list ever changes, we need to wake up and restart
+ * the select() system call. You can wake up the notifier thread by
+ * writing a single byte to the file descriptor defined below. This
+ * file descriptor is the input-end of a pipe and the notifier thread is
+ * listening for data on the output-end of the same pipe. Hence writing
+ * to this file descriptor will cause the select() system call to return
+ * and wake up the notifier thread.
+ *
+ * You must hold the notifierMutex lock before accessing this list.
+ */
+
+static int triggerPipe = -1;
+
+/*
+ * The notifierMutex locks access to all of the global notifier state.
+ */
+
+TCL_DECLARE_MUTEX(notifierMutex)
+
+/*
+ * The notifier thread signals the notifierCV when it has finished
+ * initializing the triggerPipe and right before the notifier
+ * thread terminates.
+ */
+
+static Tcl_Condition notifierCV;
+
+/*
+ * The pollState bits
+ * POLL_WANT is set by each thread before it waits on its condition
+ * variable. It is checked by the notifier before it does
+ * select.
+ * POLL_DONE is set by the notifier if it goes into select after
+ * seeing POLL_WANT. The idea is to ensure it tries a select
+ * with the same bits the initial thread had set.
+ */
+#define POLL_WANT 0x1
+#define POLL_DONE 0x2
+
+/*
+ * This is the thread ID of the notifier thread that does select.
+ */
+static Tcl_ThreadId notifierThread;
+
+#endif
+
+/*
+ * Static routines defined in this file.
+ */
+
+#ifdef TCL_THREADS
+static void NotifierThreadProc _ANSI_ARGS_((ClientData clientData));
+#endif
+static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+
+void TkMacOSXSetTimer(Tcl_Time *timePtr);
+void TkMacOSXCreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData);
+void TkMacOSXDeleteFileHandler(int fd);
+int TkMacOSXWaitForEvent(Tcl_Time *timePtr);
+void TkMacOSXAlertNotifier(ClientData clientData);
+ClientData TkMacOSXInitNotifier();
+void TkMacOSXFinalizeNotifier(ClientData clientData);
+void TkMacOSXServiceModeHook(int mode);
+EventRef TkMacOSXCreateFakeEvent ();
+ /*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXSetupTkNotifier --
+ *
+ * Replaces the Tcl notifier (from tclUnixNotfy.c) with
+ * the Mac notifier that melds the Unix select based notifer
+ * with the Carbon event handling side of the Tk notifier.
+ *
+ * Results:
+ * Replaces the notifier callbacks with MacOS X specific ones.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MacOSXSetupTkNotifier()
+{
+ EventQueueRef mainEventQueue;
+ Tcl_NotifierProcs macNotifierProcs = {
+ TkMacOSXSetTimer,
+ TkMacOSXWaitForEvent,
+ TkMacOSXCreateFileHandler,
+ TkMacOSXDeleteFileHandler,
+ TkMacOSXInitNotifier,
+ TkMacOSXFinalizeNotifier,
+ TkMacOSXAlertNotifier,
+ TkMacOSXServiceModeHook
+ };
+
+ /*
+ * Dispose of existing unix notifier thread
+ */
+
+ TclFinalizeNotifier();
+
+ Tcl_SetNotifier(&macNotifierProcs);
+
+ /* HACK ALERT: There is a bug in Jaguar where when it goes to make
+ * the event queue for the Main Event Loop, it stores the Current
+ * event loop rather than the Main Event Loop in the Queue structure.
+ * So we have to make sure that the Main Event Queue gets set up on
+ * the main thread. Calling GetMainEventQueue will force this to
+ * happen.
+ */
+
+ mainEventQueue = GetMainEventQueue();
+
+ /*
+ * Tcl_SetNotifier doesn't call the TclInitNotifier
+ * so we call it now. If we don't do this the
+ * ThreadSpecificData will keep a pointer to the original
+ * InitNotifier. See tclNotify.c:TclInitNotifier().
+ */
+
+ TclInitNotifier();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitNotifier --
+ *
+ * Initializes the platform specific notifier state.
+ *
+ * Results:
+ * Returns a handle to the notifier state for this thread..
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+TkMacOSXInitNotifier()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+#ifdef TCL_THREADS
+ tsdPtr->eventReady = 0;
+
+ /*
+ * Start the Notifier thread if necessary.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ if (notifierCount == 0) {
+ if (Tcl_CreateThread(&notifierThread, NotifierThreadProc, NULL,
+ TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) {
+ panic("Tcl_InitNotifier: unable to start notifier thread");
+ }
+ }
+ notifierCount++;
+
+ if (GetCurrentEventLoop() == GetMainEventLoop()) {
+ tsdPtr->isMainLoop = 1;
+ } else {
+ tsdPtr->isMainLoop = 0;
+ }
+
+ /*
+ * Wait for the notifier pipe to be created.
+ */
+
+ while (triggerPipe < 0) {
+ Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL);
+ }
+
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
+ return (ClientData) tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeNotifier --
+ *
+ * This function is called to cleanup the notifier state before
+ * a thread is terminated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May terminate the background notifier thread if this is the
+ * last notifier instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXFinalizeNotifier(clientData)
+ ClientData clientData; /* Not used. */
+{
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ Tcl_MutexLock(&notifierMutex);
+ notifierCount--;
+
+ /*
+ * If this is the last thread to use the notifier, close the notifier
+ * pipe and wait for the background thread to terminate.
+ */
+
+ if (notifierCount == 0) {
+ if (triggerPipe < 0) {
+ panic("Tcl_FinalizeNotifier: notifier pipe not initialized");
+ }
+
+ /*
+ * Send "q" message to the notifier thread so that it will
+ * terminate. The notifier will return from its call to select()
+ * and notice that a "q" message has arrived, it will then close
+ * its side of the pipe and terminate its thread. Note the we can
+ * not just close the pipe and check for EOF in the notifier
+ * thread because if a background child process was created with
+ * exec, select() would not register the EOF on the pipe until the
+ * child processes had terminated. [Bug: 4139]
+ */
+ write(triggerPipe, "q", 1);
+ close(triggerPipe);
+
+ Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL);
+ }
+
+ /*
+ * Clean up any synchronization objects in the thread local storage.
+ */
+
+ Tcl_ConditionFinalize(&(tsdPtr->waitCV));
+
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AlertNotifier --
+ *
+ * Wake up the specified notifier from any thread. This routine
+ * is called by the platform independent notifier code whenever
+ * the Tcl_ThreadAlert routine is called. This routine is
+ * guaranteed not to be called on a given notifier after
+ * Tcl_FinalizeNotifier is called for that notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Signals the notifier condition variable for the specified
+ * notifier.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXAlertNotifier(clientData)
+ ClientData clientData;
+{
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ Tcl_MutexLock(&notifierMutex);
+ tsdPtr->eventReady = 1;
+ Tcl_ConditionNotify(&tsdPtr->waitCV);
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimer --
+ *
+ * This procedure sets the current notifier timer value. This
+ * interface is not implemented in this notifier because we are
+ * always running inside of Tcl_DoOneEvent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXSetTimer(timePtr)
+ Tcl_Time *timePtr; /* Timeout value, may be NULL. */
+{
+ /*
+ * The interval timer doesn't do anything in this implementation,
+ * because the only event loop is via Tcl_DoOneEvent, which passes
+ * timeout values to Tcl_WaitForEvent.
+ */
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ServiceModeHook --
+ *
+ * This function is invoked whenever the service mode changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXServiceModeHook(mode)
+ int mode; /* Either TCL_SERVICE_ALL, or
+ * TCL_SERVICE_NONE. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateFileHandler --
+ *
+ * This procedure registers a file handler with the select notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new file handler structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXCreateFileHandler(fd, mask, proc, clientData)
+ int fd; /* Handle of stream to watch. */
+ int mask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION:
+ * indicates conditions under which
+ * proc should be called. */
+ Tcl_FileProc *proc; /* Procedure to call for each
+ * selected event. */
+ ClientData clientData; /* Arbitrary data to pass to proc. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ FileHandler *filePtr;
+ int index, bit;
+
+ for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+ if (filePtr == NULL) {
+ filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr->fd = fd;
+ filePtr->readyMask = 0;
+ filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
+ tsdPtr->firstFileHandlerPtr = filePtr;
+ }
+ filePtr->proc = proc;
+ filePtr->clientData = clientData;
+ filePtr->mask = mask;
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+ if (mask & TCL_READABLE) {
+ tsdPtr->checkMasks[index] |= bit;
+ } else {
+ tsdPtr->checkMasks[index] &= ~bit;
+ }
+ if (mask & TCL_WRITABLE) {
+ (tsdPtr->checkMasks+MASK_SIZE)[index] |= bit;
+ } else {
+ (tsdPtr->checkMasks+MASK_SIZE)[index] &= ~bit;
+ }
+ if (mask & TCL_EXCEPTION) {
+ (tsdPtr->checkMasks+2*(MASK_SIZE))[index] |= bit;
+ } else {
+ (tsdPtr->checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+ }
+ if (tsdPtr->numFdBits <= fd) {
+ tsdPtr->numFdBits = fd+1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteFileHandler --
+ *
+ * Cancel a previously-arranged callback arrangement for
+ * a file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a callback was previously registered on file, remove it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXDeleteFileHandler(fd)
+ int fd; /* Stream id for which to remove callback procedure. */
+{
+ FileHandler *filePtr, *prevPtr;
+ int index, bit, i;
+ unsigned long flags;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Find the entry for the given file (and return if there isn't one).
+ */
+
+ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ if (filePtr == NULL) {
+ return;
+ }
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+
+ if (filePtr->mask & TCL_READABLE) {
+ tsdPtr->checkMasks[index] &= ~bit;
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ (tsdPtr->checkMasks+MASK_SIZE)[index] &= ~bit;
+ }
+ if (filePtr->mask & TCL_EXCEPTION) {
+ (tsdPtr->checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+ }
+
+ /*
+ * Find current max fd.
+ */
+
+ if (fd+1 == tsdPtr->numFdBits) {
+ for (tsdPtr->numFdBits = 0; index >= 0; index--) {
+ flags = tsdPtr->checkMasks[index]
+ | (tsdPtr->checkMasks+MASK_SIZE)[index]
+ | (tsdPtr->checkMasks+2*(MASK_SIZE))[index];
+ if (flags) {
+ for (i = (NBBY*sizeof(fd_mask)); i > 0; i--) {
+ if (flags & (((unsigned long)1) << (i-1))) {
+ break;
+ }
+ }
+ tsdPtr->numFdBits = index * (NBBY*sizeof(fd_mask)) + i;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Clean up information in the callback record.
+ */
+
+ if (prevPtr == NULL) {
+ tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = filePtr->nextPtr;
+ }
+ ckfree((char *) filePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileHandlerEventProc --
+ *
+ * This procedure is called by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure is
+ * responsible for actually handling the event by invoking the
+ * callback for the file handler.
+ *
+ * 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 only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the file handler's callback procedure does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileHandlerEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ int mask;
+ FileHandler *filePtr;
+ FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
+ ThreadSpecificData *tsdPtr;
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the file handlers to find the one whose handle matches
+ * the event. We do this rather than keeping a pointer to the file
+ * handler directly in the event, so that the handler can be deleted
+ * while the event is queued without leaving a dangling pointer.
+ */
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd != fileEvPtr->fd) {
+ continue;
+ }
+
+ /*
+ * The code is tricky for two reasons:
+ * 1. The file handler's desired events could have changed
+ * since the time when the event was queued, so AND the
+ * ready mask with the desired mask.
+ * 2. The file could have been closed and re-opened since
+ * the time when the event was queued. This is why the
+ * ready mask is stored in the file handler rather than
+ * the queued event: it will be zeroed when a new
+ * file handler is created for the newly opened file.
+ */
+
+ mask = filePtr->readyMask & filePtr->mask;
+ filePtr->readyMask = 0;
+ if (mask != 0) {
+ (*filePtr->proc)(filePtr->clientData, mask);
+ }
+ break;
+ }
+ return 1;
+}
+
+void
+DoActualWait(timePtr)
+ Tcl_Time *timePtr; /* Maximum block time, or NULL. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!tsdPtr->isMainLoop) {
+ Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
+ } else {
+ EventRef eventRef;
+ EventTime waitTime;
+ Tcl_MutexUnlock(&notifierMutex);
+
+ if (timePtr == NULL) {
+ waitTime = kEventDurationForever;
+ } else {
+ waitTime = timePtr->sec * kEventDurationSecond
+ + timePtr->usec * kEventDurationMicrosecond;
+ }
+ ReceiveNextEvent(0, NULL, waitTime, false, &eventRef);
+ Tcl_MutexLock(&notifierMutex);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ * This function is called by Tcl_DoOneEvent to wait for new
+ * events on the message queue. If the block time is 0, then
+ * Tcl_WaitForEvent just polls without blocking.
+ *
+ * Results:
+ * Returns -1 if the select would block forever, otherwise
+ * returns 0.
+ *
+ * Side effects:
+ * Queues file events that are detected by the select.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXWaitForEvent(timePtr)
+ Tcl_Time *timePtr; /* Maximum block time, or NULL. */
+{
+ FileHandler *filePtr;
+ FileHandlerEvent *fileEvPtr;
+ struct timeval timeout, *timeoutPtr;
+ int bit, index, mask;
+#ifdef TCL_THREADS
+ int waitForFiles;
+#else
+ int numFound;
+#endif
+
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Set up the timeout structure. Note that if there are no events to
+ * check for, we return with a negative result rather than blocking
+ * forever.
+ */
+
+ if (timePtr) {
+ timeout.tv_sec = timePtr->sec;
+ timeout.tv_usec = timePtr->usec;
+ timeoutPtr = &timeout;
+#ifndef TCL_THREADS
+ } else if (tsdPtr->numFdBits == 0) {
+ /*
+ * If there are no threads, no timeout, and no fds registered,
+ * then there are no events possible and we must avoid deadlock.
+ * Note that this is not entirely correct because there might
+ * be a signal that could interrupt the select call, but we
+ * don't handle that case if we aren't using threads.
+ */
+
+ return -1;
+#endif
+ } else {
+ timeoutPtr = NULL;
+ }
+
+#ifdef TCL_THREADS
+ /*
+ * Place this thread on the list of interested threads, signal the
+ * notifier thread, and wait for a response or a timeout.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+
+ waitForFiles = (tsdPtr->numFdBits > 0);
+ if (timePtr != NULL && timePtr->sec == 0 && timePtr->usec == 0) {
+ /*
+ * Cannot emulate a polling select with a polling condition variable.
+ * Instead, pretend to wait for files and tell the notifier
+ * thread what we are doing. The notifier thread makes sure
+ * it goes through select with its select mask in the same state
+ * as ours currently is. We block until that happens.
+ */
+
+ waitForFiles = 1;
+ tsdPtr->pollState = POLL_WANT;
+ timePtr = NULL;
+ } else {
+ tsdPtr->pollState = 0;
+ }
+
+ if (waitForFiles) {
+ /*
+ * Add the ThreadSpecificData structure of this thread to the list
+ * of ThreadSpecificData structures of all threads that are waiting
+ * on file events.
+ */
+
+
+ tsdPtr->nextPtr = waitingListPtr;
+ if (waitingListPtr) {
+ waitingListPtr->prevPtr = tsdPtr;
+ }
+ tsdPtr->prevPtr = 0;
+ waitingListPtr = tsdPtr;
+ tsdPtr->onList = 1;
+
+ write(triggerPipe, "", 1);
+ }
+
+ memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+
+ if (!tsdPtr->eventReady) {
+ DoActualWait(timePtr);
+ }
+ tsdPtr->eventReady = 0;
+
+ if (waitForFiles && tsdPtr->onList) {
+ /*
+ * Remove the ThreadSpecificData structure of this thread from the
+ * waiting list. Alert the notifier thread to recompute its select
+ * masks - skipping this caused a hang when trying to close a pipe
+ * which the notifier thread was still doing a select on.
+ */
+
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ waitingListPtr = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
+ tsdPtr->onList = 0;
+ write(triggerPipe, "", 1);
+ }
+
+
+#else
+ memcpy((VOID *) tsdPtr->readyMasks, (VOID *) tsdPtr->checkMasks,
+ 3*MASK_SIZE*sizeof(fd_mask));
+ numFound = select(tsdPtr->numFdBits,
+ (SELECT_MASK *) &tsdPtr->readyMasks[0],
+ (SELECT_MASK *) &tsdPtr->readyMasks[MASK_SIZE],
+ (SELECT_MASK *) &tsdPtr->readyMasks[2*MASK_SIZE], timeoutPtr);
+
+ /*
+ * Some systems don't clear the masks after an error, so
+ * we have to do it here.
+ */
+
+ if (numFound == -1) {
+ memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+ }
+#endif
+
+ /*
+ * Queue all detected file events before returning.
+ */
+
+ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
+ filePtr = filePtr->nextPtr) {
+ index = filePtr->fd / (NBBY*sizeof(fd_mask));
+ bit = 1 << (filePtr->fd % (NBBY*sizeof(fd_mask)));
+ mask = 0;
+
+ if (tsdPtr->readyMasks[index] & bit) {
+ mask |= TCL_READABLE;
+ }
+ if ((tsdPtr->readyMasks+MASK_SIZE)[index] & bit) {
+ mask |= TCL_WRITABLE;
+ }
+ if ((tsdPtr->readyMasks+2*(MASK_SIZE))[index] & bit) {
+ mask |= TCL_EXCEPTION;
+ }
+
+ if (!mask) {
+ continue;
+ }
+
+ /*
+ * Don't bother to queue an event if the mask was previously
+ * non-zero since an event must still be on the queue.
+ */
+
+ if (filePtr->readyMask == 0) {
+ fileEvPtr = (FileHandlerEvent *) ckalloc(
+ sizeof(FileHandlerEvent));
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ }
+ filePtr->readyMask = mask;
+ }
+
+ /*
+ * Also queue the Mac Events found...
+ */
+
+#ifdef TCL_THREADS
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
+
+ if (tsdPtr->isMainLoop) {
+ TkMacOSXCountAndProcessMacEvents();
+ }
+
+ return 0;
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierThreadProc --
+ *
+ * This routine is the initial (and only) function executed by the
+ * special notifier thread. Its job is to wait for file descriptors
+ * to become readable or writable or to have an exception condition
+ * and then to notify other threads who are interested in this
+ * information by signalling a condition variable. Other threads
+ * can signal this notifier thread of a change in their interests
+ * by writing a single byte to a special pipe that the notifier
+ * thread is monitoring.
+ *
+ * Result:
+ * None. Once started, this routine never exits. It dies with
+ * the overall process.
+ *
+ * Side effects:
+ * The trigger pipe used to signal the notifier thread is created
+ * when the notifier thread first starts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifierThreadProc(clientData)
+ ClientData clientData; /* Not used. */
+{
+ ThreadSpecificData *tsdPtr;
+ fd_mask masks[3*MASK_SIZE];
+ long *maskPtr = (long *)masks; /* masks[] cast to type long[] */
+ int fds[2];
+ int i, status, index, bit, numFdBits, found, receivePipe, word;
+ struct timeval poll = {0., 0.}, *timePtr;
+ int maskSize = 3 * ((MASK_SIZE) / sizeof(long)) * sizeof(fd_mask);
+ char buf[2];
+
+ if (pipe(fds) != 0) {
+ panic("NotifierThreadProc: could not create trigger pipe.");
+ }
+
+ receivePipe = fds[0];
+
+#ifndef USE_FIONBIO
+ status = fcntl(receivePipe, F_GETFL);
+ status |= O_NONBLOCK;
+ if (fcntl(receivePipe, F_SETFL, status) < 0) {
+ panic("NotifierThreadProc: could not make receive pipe non blocking.");
+ }
+ status = fcntl(fds[1], F_GETFL);
+ status |= O_NONBLOCK;
+ if (fcntl(fds[1], F_SETFL, status) < 0) {
+ panic("NotifierThreadProc: could not make trigger pipe non blocking.");
+ }
+#else
+ if (ioctl(receivePipe, (int) FIONBIO, &status) < 0) {
+ panic("NotifierThreadProc: could not make receive pipe non blocking.");
+ }
+ if (ioctl(fds[1], (int) FIONBIO, &status) < 0) {
+ panic("NotifierThreadProc: could not make trigger pipe non blocking.");
+ }
+#endif
+
+ /*
+ * Install the write end of the pipe into the global variable.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ triggerPipe = fds[1];
+
+ /*
+ * Signal any threads that are waiting.
+ */
+
+ Tcl_ConditionNotify(&notifierCV);
+ Tcl_MutexUnlock(&notifierMutex);
+
+ /*
+ * Look for file events and report them to interested threads.
+ */
+
+ while (1) {
+ /*
+ * Set up the select mask to include the receive pipe.
+ */
+
+ memset((VOID *)masks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+ numFdBits = receivePipe + 1;
+ index = receivePipe / (NBBY*sizeof(fd_mask));
+ bit = 1 << (receivePipe % (NBBY*sizeof(fd_mask)));
+ masks[index] |= bit;
+
+ /*
+ * Add in the check masks from all of the waiting notifiers.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ timePtr = NULL;
+ for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ for (i = 0; i < maskSize; i++) {
+ maskPtr[i] |= ((long*)tsdPtr->checkMasks)[i];
+ }
+ if (tsdPtr->numFdBits > numFdBits) {
+ numFdBits = tsdPtr->numFdBits;
+ }
+ if (tsdPtr->pollState & POLL_WANT) {
+ /*
+ * Here we make sure we go through select() with the same
+ * mask bits that were present when the thread tried to poll.
+ */
+
+ tsdPtr->pollState |= POLL_DONE;
+ timePtr = &poll;
+ }
+ }
+ Tcl_MutexUnlock(&notifierMutex);
+
+ maskSize = 3 * ((MASK_SIZE) / sizeof(long)) * sizeof(fd_mask);
+
+ if (select(numFdBits, (SELECT_MASK *) &masks[0],
+ (SELECT_MASK *) &masks[MASK_SIZE],
+ (SELECT_MASK *) &masks[2*MASK_SIZE], timePtr) == -1) {
+ /*
+ * Try again immediately on an error.
+ */
+
+ continue;
+ }
+
+ /*
+ * Alert any threads that are waiting on a ready file descriptor.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ found = 0;
+
+ for (i = 0; i < maskSize; i++) {
+ word = maskPtr[i] & ((long*)tsdPtr->checkMasks)[i];
+ found |= word;
+ (((long*)(tsdPtr->readyMasks))[i]) = word;
+ }
+ if (found || (tsdPtr->pollState & POLL_DONE)) {
+ if (tsdPtr->onList) {
+ /*
+ * Remove the ThreadSpecificData structure of this
+ * thread from the waiting list. This prevents us from
+ * continuously spining on select until the other
+ * threads runs and services the file event.
+ */
+
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ waitingListPtr = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
+ tsdPtr->onList = 0;
+ tsdPtr->pollState = 0;
+ }
+ tsdPtr->eventReady = 1;
+ if (tsdPtr->isMainLoop) {
+ /* We need to wake up the main loop, and let it have the event. */
+ EventRef fakeEvent = TkMacOSXCreateFakeEvent();
+ PostEventToQueue(GetMainEventQueue(), fakeEvent, kEventPriorityHigh);
+ ReleaseEvent(fakeEvent);
+ } else {
+ Tcl_ConditionNotify(&tsdPtr->waitCV);
+ }
+ }
+ }
+ Tcl_MutexUnlock(&notifierMutex);
+
+ /*
+ * Consume the next byte from the notifier pipe if the pipe was
+ * readable. Note that there may be multiple bytes pending, but
+ * to avoid a race condition we only read one at a time.
+ */
+
+ if (masks[index] & bit) {
+ i = read(receivePipe, buf, 1);
+
+ if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
+ /*
+ * Someone closed the write end of the pipe or sent us a
+ * Quit message [Bug: 4139] and then closed the write end
+ * of the pipe so we need to shut down the notifier thread.
+ */
+
+ break;
+ }
+ }
+ }
+
+ /*
+ * Clean up the read end of the pipe and signal any threads waiting on
+ * termination of the notifier thread.
+ */
+
+ close(receivePipe);
+ Tcl_MutexLock(&notifierMutex);
+ triggerPipe = -1;
+ Tcl_ConditionNotify(&notifierCV);
+ Tcl_MutexUnlock(&notifierMutex);
+}
+#endif
+
+EventRef
+TkMacOSXCreateFakeEvent ()
+{
+ EventKind eKind;
+ EventClass eClass;
+ EventTime eTime;
+ EventRef eventRef;
+ EventAttributes flags;
+ eClass=kEventClassWish;
+ eKind = 0xffff;
+ eTime =GetLastUserEventTime() + 0.001;
+ flags=kEventAttributeUserEvent;
+ if (CreateEvent(NULL,eClass,eKind,eTime,flags,&eventRef)!=noErr) {
+ fprintf(stderr,"CreateEvent failed\n");
+ return NULL;
+ }
+ return eventRef;
+}
diff --git a/tcl/macosx/tkMacOSXPort.h b/tcl/macosx/tkMacOSXPort.h
new file mode 100644
index 00000000000..70e29477d75
--- /dev/null
+++ b/tcl/macosx/tkMacOSXPort.h
@@ -0,0 +1,154 @@
+/*
+ * tkMacOSXPort.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 2001, Apple Computer, 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 _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 <X11/Xlib.h>
+#include <X11/cursorfont.h>
+#include <X11/keysym.h>
+#include <X11/Xatom.h>
+#include <X11/Xfuncproto.h>
+#include <X11/Xutil.h>
+#include "tkIntXlibDecls.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.
+ */
+
+#ifndef panic /* In a stubs-aware setting, this could confuse the #define */
+extern void panic _ANSI_ARGS_(TCL_VARARGS(char *, string));
+#endif
+#ifndef strcasecmp
+extern int strcasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2));
+#endif
+#ifndef strncasecmp
+extern int strncasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2, size_t n));
+#endif
+/*
+ * 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 them out.
+ */
+
+#define TkFreeWindowId(dispPtr,w)
+#define TkInitXId(dispPtr)
+#define TkpButtonSetDefaults(specPtr) {}
+#define TkpCmapStressed(tkwin,colormap) (0)
+#define TkpFreeColor(tkColPtr)
+#define TkSetPixmapColormap(p,c) {}
+#define TkpSync(display)
+
+/*
+ * The following macro returns the pixel value that corresponds to the
+ * RGB values in the given XColor structure.
+ */
+
+#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.
+ * This should perhaps use the real size of an XID.
+ */
+
+#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),(int *) (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/tcl/macosx/tkMacOSXRegion.c b/tcl/macosx/tkMacOSXRegion.c
new file mode 100644
index 00000000000..77aa9b46b93
--- /dev/null
+++ b/tcl/macosx/tkMacOSXRegion.c
@@ -0,0 +1,252 @@
+/*
+ * tkMacOSXRegion.c --
+ *
+ * Implements X window calls for manipulating regions
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+#include "X11/X.h"
+#include "X11/Xlib.h"
+
+#include <Carbon/Carbon.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 rect;
+
+ GetRegionBounds(rgn,&rect);
+
+ rect_return->x = rect.left;
+ rect_return->y = rect.top;
+ rect_return->width = rect.right-rect.left;
+ rect_return->height = rect.bottom-rect.top;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSubtractRegion --
+ *
+ * Implements the equivilent of the X window function
+ * XSubtractRegion. See X window documentation for more details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSubtractRegion(
+ TkRegion sra,
+ TkRegion srb,
+ TkRegion dr_return)
+{
+ RgnHandle srcRgnA = (RgnHandle) sra;
+ RgnHandle srcRgnB = (RgnHandle) srb;
+ RgnHandle destRgn = (RgnHandle) dr_return;
+
+ DiffRgn(srcRgnA, srcRgnB, destRgn);
+}
diff --git a/tcl/macosx/tkMacOSXResource.r b/tcl/macosx/tkMacOSXResource.r
new file mode 100644
index 00000000000..95a28d98694
--- /dev/null
+++ b/tcl/macosx/tkMacOSXResource.r
@@ -0,0 +1,502 @@
+/*
+ * tkMacOSXResources.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 & Jim Ingham " "\n" "© 1993-1997 Sun Microsystems" "\n" "© 1998-1999 Scriptics Inc."
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ "Wish " TK_PATCH_LEVEL " © 1993-1999"
+};
+
+
+/*
+ * 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 "tclMacTclCode.r"
+
+read 'TEXT' (10, "tk", purgeable, preload) "::library:tk.tcl";
+read 'TEXT' (11, "button", purgeable, preload) "::library:button.tcl";
+read 'TEXT' (12, "dialog", purgeable, preload) "::library:dialog.tcl";
+read 'TEXT' (13, "entry", purgeable, preload) "::library:entry.tcl";
+read 'TEXT' (14, "focus", purgeable, preload) "::library:focus.tcl";
+read 'TEXT' (15, "listbox", purgeable, preload) "::library:listbox.tcl";
+read 'TEXT' (16, "menu", purgeable, preload) "::library:menu.tcl";
+read 'TEXT' (17, "optionMenu", purgeable, preload) "::library:optMenu.tcl";
+read 'TEXT' (18, "palette", purgeable, preload) "::library:palette.tcl";
+read 'TEXT' (19, "scale", purgeable, preload) "::library:scale.tcl";
+read 'TEXT' (20, "scrollbar", purgeable, preload) "::library:scrlbar.tcl";
+read 'TEXT' (21, "tearoff", purgeable, preload) "::library:tearoff.tcl";
+read 'TEXT' (22, "text", purgeable, preload) "::library:text.tcl";
+read 'TEXT' (23, "tkerror", purgeable, preload) "::library:bgerror.tcl";
+read 'TEXT' (24, "Console", purgeable, preload) "::library:console.tcl";
+read 'TEXT' (25, "msgbox", purgeable, preload) "::library:msgbox.tcl";
+read 'TEXT' (26, "comdlg", purgeable, preload) "::library:comdlg.tcl";
+
+/*
+ * The following resource is used when creating the 'env' variable in
+ * the Macintosh environment. The creation mechanisim looks for the
+ * 'STR#' resource named "Tcl Environment Variables" rather than a
+ * specific resource number. (In other words, feel free to change the
+ * resource id if it conflicts with your application.) Each string in
+ * 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, 260, 412}, dBoxProc, visible, goAway, 0,
+ 128, "", centerMainScreen
+};
+
+resource 'DITL' (128, "About Box", purgeable) {
+ {
+ {143, 147, 167, 201}, Button {enabled, "Ok"},
+ { 14, 108, 137, 314}, StaticText {disabled,
+ "Wish - Windowing Shell" "\n" "based on Tcl "
+ TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n"
+ "Ray Johnson & Jim Ingham" "\n"
+ "Scriptics Inc." "\n"
+ "jim.ingham@cygnus.com"},
+ { 19, 24, 119, 92}, Picture {enabled, 128}
+ }
+};
+
+data 'PICT' (128) {
+ $"13A4 0000 0000 0064 0044 0011 02FF 0C00"
+ $"FFFE 0000 0048 0000 0048 0000 0000 0000"
+ $"0064 0044 0000 0000 0001 000A 0000 0000"
+ $"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/tcl/macosx/tkMacOSXScale.c b/tcl/macosx/tkMacOSXScale.c
new file mode 100644
index 00000000000..59ced70bcad
--- /dev/null
+++ b/tcl/macosx/tkMacOSXScale.c
@@ -0,0 +1,431 @@
+/*
+ * tkMacOSXScale.c --
+ *
+ * This file implements the Macintosh specific portion of the
+ * scale widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 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 "tkScale.h"
+#include "tkInt.h"
+#include <Carbon/Carbon.h>
+#include "tkMacOSXInt.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 = NewControlActionUPP(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;
+ CGrafPtr destPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ MacDrawable *macDraw;
+ SInt16 initialValue;
+ SInt16 minValue;
+ SInt16 maxValue;
+ SInt16 procID;
+ SInt32 controlReference;
+ Boolean initiallyVisible=true;
+
+ fprintf(stderr,"TkpDisplayScale\n");
+ scalePtr->flags &= ~REDRAW_PENDING;
+ 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->flags & SCALE_DELETED) {
+ 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;
+
+ gc = Tk_GCForColor(scalePtr->highlightColorPtr, 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=TkMacOSXGetDrawablePort(Tk_WindowId(tkwin));
+ windowRef=GetWindowFromPort(destPort);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpClippingRgn(Tk_WindowId(tkwin));
+
+ /*
+ * Create Macintosh control.
+ */
+ if (macScalePtr->scaleHandle == NULL) {
+ fprintf(stderr,"Initialising scale\n");
+ r.left=macDraw->xOff;
+ r.top=macDraw->yOff;
+ r.right=macDraw->xOff+Tk_Width(tkwin) - scalePtr->inset;
+ r.bottom=macDraw->yOff+Tk_Height(tkwin) - scalePtr->inset;
+
+ initialValue=scalePtr->value;
+ minValue=scalePtr->toValue;
+ maxValue=scalePtr->fromValue;
+ procID=kControlSliderProc;
+ controlReference=(SInt32) macScalePtr;
+ macScalePtr->scaleHandle = NewControl(windowRef,
+ &r, "\p", initiallyVisible, initialValue,minValue,maxValue,
+ procID, controlReference);
+
+ /*
+ * If we are foremost than make us active.
+ */
+ if (windowRef==FrontWindow()) {
+ macScalePtr->flags |= ACTIVE;
+ }
+ }
+
+ /*
+ * Finally draw the control.
+ */
+ SetControlVisibility(macScalePtr->scaleHandle,true,true);
+ HiliteControl(macScalePtr->scaleHandle,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;
+ fprintf(stderr,"TkpScaleElement\n");
+
+ destPort = TkMacOSXGetDrawablePort(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.
+ */
+
+ TkMacOSXWinBounds((TkWindow *) scalePtr->tkwin, &bounds);
+ where.h = x + bounds.left;
+ where.v = y + bounds.top;
+ part = TestControl(macScalePtr->scaleHandle, where);
+
+ SetGWorld(saveWorld, saveDevice);
+
+ fprintf (stderr,"ScalePart %d, pos ( %d %d )\n", part, where.h, where.v );
+
+ switch (part) {
+ case inSlider:
+ return SLIDER;
+ case inInc:
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ return TROUGH1;
+ } else {
+ return TROUGH2;
+ }
+ case inDecr:
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ return TROUGH2;
+ } else {
+ return TROUGH1;
+ }
+ default:
+ return OTHER;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+
+ fprintf(stderr,"MacScaleEventProc\n" );
+ /*
+ * 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 = TkMacOSXGetDrawablePort(Tk_WindowId(macScalePtr->info.tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpClippingRgn(Tk_WindowId(macScalePtr->info.tkwin));
+
+ TkMacOSXWinBounds((TkWindow *) macScalePtr->info.tkwin, &bounds);
+ where.h = eventPtr->xbutton.x + bounds.left;
+ where.v = eventPtr->xbutton.y + bounds.top;
+ fprintf(stderr,"calling TestControl\n");
+ part = TestControl(macScalePtr->scaleHandle, where);
+ if (part == 0) {
+ return;
+ }
+
+ part = TrackControl(macScalePtr->scaleHandle, where, scaleActionProc);
+
+ /*
+ * Update the value for the widget.
+ */
+ macScalePtr->info.value = GetControlValue(macScalePtr->scaleHandle);
+ /* TkScaleSetValue(&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" */
+{
+ int value;
+ TkScale *scalePtr = (TkScale *) GetControlReference(theControl);
+
+ fprintf(stderr,"ScaleActionProc\n");
+ value = GetControlValue(theControl);
+ TkScaleSetValue(scalePtr, value, 1, 1);
+ Tcl_Preserve((ClientData) scalePtr);
+ Tcl_DoOneEvent(TCL_IDLE_EVENTS);
+ Tcl_Release((ClientData) scalePtr);
+}
+
diff --git a/tcl/macosx/tkMacOSXScrlbr.c b/tcl/macosx/tkMacOSXScrlbr.c
new file mode 100644
index 00000000000..77241054f2f
--- /dev/null
+++ b/tcl/macosx/tkMacOSXScrlbr.c
@@ -0,0 +1,1076 @@
+/*
+ * tkMacOSXScrollbar.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.
+ * Copyright 2001, Apple Computer, 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 "tkMacOSXInt.h"
+
+#include <Carbon/Carbon.h>
+
+#include "tkMacOSXDebug.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);
+
+typedef ThumbActionFunc ThumbActionUPP;
+
+enum {
+ uppThumbActionProcInfo = kPascalStackBased
+};
+
+#define NewThumbActionProc(userRoutine) ((ThumbActionUPP) (userRoutine))
+
+/*
+ * 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
+#define MIN_SCROLLBAR_VALUE 0
+#define MAX_SCROLLBAR_VALUE 1000
+#define MAX_SCROLLBAR_DVALUE 1000.0
+
+/*
+ * Declaration of Windows specific scrollbar structure.
+ */
+
+typedef struct MacScrollbar {
+ TkScrollbar info; /* Generic scrollbar info */
+ ControlRef sbHandle; /* Opaque handle to the Scrollbar contol struct */
+ int macFlags; /* Various flags; see below */
+} MacScrollbar;
+
+/* Handle to the Scrollbar control structure */
+
+
+/*
+ * 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. Leave the proc fields
+ * initialized to NULL, which should happen automatically because of the scope
+ * at which the variable is declared.
+ */
+
+Tk_ClassProcs tkpScrollbarProcs = {
+ sizeof(Tk_ClassProcs) /* size */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = NewControlActionUPP (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. */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ MacScrollbar *macScrollPtr = (MacScrollbar *) clientData;
+ 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 fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(scrollPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+
+ if (scrollPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(scrollPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, scrollPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, 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 = TkMacOSXGetDrawablePort(Tk_WindowId(tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpClippingRgn(Tk_WindowId(tkwin));
+
+ if (macScrollPtr->sbHandle == NULL) {
+ Rect r;
+ SInt16 initialValue;
+ SInt16 minValue;
+ SInt16 maxValue;
+ SInt16 procID;
+ WindowRef frontNonFloating;
+
+ r.left = r.top = 0;
+ r.right = r.bottom = 1;
+
+ minValue = MIN_SCROLLBAR_VALUE;
+ maxValue = MAX_SCROLLBAR_VALUE;
+ initialValue = (minValue + maxValue)/2;
+ procID = kControlScrollBarLiveProc;
+
+ windowRef = GetWindowFromPort(destPort);
+ macScrollPtr->sbHandle = NewControl(windowRef, &r, "\p",
+ false, initialValue,minValue,maxValue,
+ procID, (SInt32) scrollPtr);
+
+ /*
+ * If we are foremost then make us active.
+ */
+
+ frontNonFloating = FrontNonFloatingWindow();
+
+ if ((windowRef == FrontWindow()) || TkpIsWindowFloating(windowRef)) {
+ macScrollPtr->macFlags |= ACTIVE;
+ }
+ }
+
+ /*
+ * Update the control values before we draw.
+ */
+ windowRef = GetControlOwner (macScrollPtr->sbHandle);
+ UpdateControlValues(macScrollPtr);
+
+ if (macScrollPtr->macFlags & ACTIVE) {
+ Draw1Control(macScrollPtr->sbHandle);
+ if (macScrollPtr->macFlags & DRAW_GROW) {
+ DrawGrowIcon(windowRef);
+ }
+ } else {
+ HiliteControl (macScrollPtr->sbHandle, 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;
+ int x0, y0;
+
+ x0 = x;
+ y0 = y;
+
+ 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 = TkMacOSXGetDrawablePort(Tk_WindowId(scrollPtr->tkwin));
+ SetGWorld(destPort, NULL);
+ UpdateControlValues(macScrollPtr);
+ if ( GetControlHilite(macScrollPtr->sbHandle) == 255 ) {
+ inactive = true;
+ HiliteControl(macScrollPtr->sbHandle, 0 );
+ }
+
+ TkMacOSXWinBounds((TkWindow *) scrollPtr->tkwin, &bounds);
+ where.h = x0 + bounds.left;
+ where.v = y0 + bounds.top;
+ part = TestControl(((MacScrollbar *) scrollPtr)->sbHandle, where);
+ if (inactive) {
+ HiliteControl(macScrollPtr->sbHandle, 255 );
+ }
+ switch (part) {
+ case kControlUpButtonPart:
+ return TOP_ARROW;
+ case kControlPageUpPart:
+ return TOP_GAP;
+ case kControlIndicatorPart:
+ return SLIDER;
+ case kControlPageDownPart:
+ return BOTTOM_GAP;
+ case kControlDownButtonPart:
+ 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;
+ int origValue, trackBarPin;
+ double thumbWidth, newFirstFraction, trackBarSize;
+ char valueString[40];
+ Point currentPoint = { 0, 0 };
+ Rect trackRect;
+ Tcl_Interp *interp;
+ MouseTrackingResult trackingResult;
+ OSErr err;
+
+ 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);
+ GetControlBounds(macScrollPtr->sbHandle, &trackRect);
+ 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.
+ */
+
+ do {
+ err = TrackMouseLocationWithOptions(NULL,
+ kTrackMouseLocationOptionDontConsumeMouseUp,
+ kEventDurationForever,
+ &currentPoint,
+ NULL,
+ &trackingResult);
+
+ if ((err==noErr)
+ && ((trackingResult == kMouseTrackingMouseDragged)
+ || (trackingResult == kMouseTrackingMouseMoved))) {
+ /*
+ * 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 / MAX_SCROLLBAR_DVALUE)
+ * (1.0 - thumbWidth);
+ }
+ sprintf(valueString, "%g", newFirstFraction);
+ Tcl_DStringSetLength(&cmdString, 0);
+ Tcl_DStringAppend(&cmdString, scrollPtr->command,
+ scrollPtr->commandSize);
+ Tcl_DStringAppendElement(&cmdString, "moveto");
+ Tcl_DStringAppendElement(&cmdString, valueString);
+ 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);
+ }
+ } while ((err==noErr) && trackingResult!=kMouseTrackingMouseReleased );
+
+ 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" */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) GetControlReference(theControl);
+ Tcl_DString cmdString;
+
+ Tcl_DStringInit(&cmdString);
+ Tcl_DStringAppend(&cmdString, scrollPtr->command,
+ scrollPtr->commandSize);
+
+ if ( partCode == kControlUpButtonPart ||
+ partCode == kControlDownButtonPart ) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (partCode == kControlUpButtonPart ) ? "-1" : "1");
+ Tcl_DStringAppendElement(&cmdString, "unit");
+ } else if (partCode == kControlPageUpPart || partCode == kControlPageDownPart ) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (partCode == kControlPageUpPart ) ? "-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 = TkMacOSXGetDrawablePort(Tk_WindowId(scrollPtr->tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacOSXSetUpClippingRgn(Tk_WindowId(scrollPtr->tkwin));
+
+ TkMacOSXWinBounds((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 == kControlIndicatorPart && 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 == kControlIndicatorPart) {
+ /*
+ * 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 == kControlIndicatorPart) {
+ double newFirstFraction, thumbWidth;
+ Tcl_DString cmdString;
+ char valueString[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) / MAX_SCROLLBAR_DVALUE);
+ sprintf(valueString, "%g", newFirstFraction);
+
+ Tcl_DStringInit(&cmdString);
+ Tcl_DStringAppend(&cmdString, scrollPtr->command,
+ strlen(scrollPtr->command));
+ Tcl_DStringAppendElement(&cmdString, "moveto");
+ Tcl_DStringAppendElement(&cmdString, valueString);
+ 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) {
+ TkMacOSXSetScrollbarGrow((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 = GetControlOwner(macScrollPtr->sbHandle);
+ double middle;
+ SInt32 viewSize;
+ int flushRight = false;
+ int flushBottom = false;
+ Rect contrlRect, portRect;
+ UInt8 contrlHilite;
+
+ /*
+ * 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).
+ */
+
+ contrlRect.left = macDraw->xOff + scrollPtr->inset;
+ contrlRect.top = macDraw->yOff + scrollPtr->inset;
+ contrlRect.right = macDraw->xOff + Tk_Width(tkwin) - scrollPtr->inset;
+ contrlRect.bottom = macDraw->yOff + Tk_Height(tkwin) - scrollPtr->inset;
+
+ SetControlBounds(macScrollPtr->sbHandle, &contrlRect );
+
+ /*
+ * 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;
+ }
+ GetPortBounds ( GetWindowPort ( windowRef ), &portRect );
+ if ( portRect.left == contrlRect.left ) {
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ contrlRect.left--;
+ SetControlBounds ( macScrollPtr->sbHandle, &contrlRect );
+ }
+ 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 (portRect.top == contrlRect.top) {
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ 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 (portRect.right == contrlRect.right) {
+ flushRight = true;
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ 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 (portRect.bottom == contrlRect.bottom) {
+ flushBottom = true;
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ 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 corner 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) {
+ TkMacOSXSetScrollbarGrow((TkWindow *) tkwin, true);
+ if (TkMacOSXResizable(macDraw->toplevel->winPtr)) {
+ if (scrollPtr->vertical) {
+ contrlRect.bottom -= 14;
+ } else {
+ contrlRect.right -= 14;
+ }
+ macScrollPtr->macFlags |= DRAW_GROW;
+ }
+ } else {
+ TkMacOSXSetScrollbarGrow((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));
+ viewSize = (SInt32)((scrollPtr->lastFraction-scrollPtr->firstFraction)
+ * MAX_SCROLLBAR_DVALUE);
+ SetControlViewSize(macScrollPtr->sbHandle,viewSize);
+ SetControlValue(macScrollPtr->sbHandle,
+ (short) (middle * MAX_SCROLLBAR_VALUE) );
+ contrlHilite=GetControlHilite(macScrollPtr->sbHandle);
+ if ( contrlHilite == 0 || contrlHilite == 255) {
+ if (scrollPtr->firstFraction == 0.0 &&
+ scrollPtr->lastFraction == 1.0) {
+ HiliteControl(macScrollPtr->sbHandle,255);
+ } else {
+ HiliteControl(macScrollPtr->sbHandle,0);
+ }
+ }
+ if ( !IsControlVisible (macScrollPtr -> sbHandle) ) {
+ SetControlVisibility(macScrollPtr->sbHandle,TRUE,FALSE);
+ }
+}
diff --git a/tcl/macosx/tkMacOSXSend.c b/tcl/macosx/tkMacOSXSend.c
new file mode 100644
index 00000000000..8b0489906fc
--- /dev/null
+++ b/tcl/macosx/tkMacOSXSend.c
@@ -0,0 +1,552 @@
+/*
+ * tkMacOSXSend.c --
+ *
+ * This file provides procedures that implement the "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter. This current implementation for the Mac
+ * has most functionality stubed out.
+ *
+ * The current plan, which we have not had time to implement, is
+ * for the first Wish app to create a gestalt of type 'WIsH'.
+ * This gestalt will point to a table, in system memory, of
+ * Tk apps. Each Tk app, when it starts up, will register their
+ * name, and process ID, in this table. This will allow us to
+ * implement "tk appname".
+ *
+ * Then the send command will look up the process id of the target
+ * app in this table, and send an AppleEvent to that process. The
+ * AppleEvent handler is much like the do script handler, except that
+ * you have to specify the name of the tk app as well, since there may
+ * be many interps in one wish app, and you need to send it to the
+ * right one.
+ *
+ * Implementing this has been on our list of things to do, but what
+ * with the demise of Tcl at Sun, and the lack of resources at
+ * Scriptics it may not get done for awhile. So this sketch is
+ * offered for the brave to attempt if they need the functionality...
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 <Carbon/Carbon.h>
+/*
+#include <Gestalt.h>
+*/
+#include "tkPort.h"
+#include "tkInt.h"
+
+EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+ /*
+ * The following structure is used to keep track of the
+ * interpreters registered by this process.
+ */
+
+typedef struct RegisteredInterp {
+ char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Interp *interp; /* Interpreter associated with
+ * name. */
+ struct RegisteredInterp *nextPtr;
+ /* Next in list of names associated
+ * with interps in this process.
+ * NULL means end of list. */
+} RegisteredInterp;
+
+/*
+ * A registry of all interpreters for a display is kept in a
+ * property "InterpRegistry" on the root window of the display.
+ * It is organized as a series of zero or more concatenated strings
+ * (in no particular order), each of the form
+ * window space name '\0'
+ * where "window" is the hex id of the comm. window to use to talk
+ * 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;
+
+static int initialized = false; /* A flag to denote if we have initialized yet. */
+
+static RegisteredInterp *interpListPtr = NULL;
+/* List of all interpreters
+ * registered by this process. */
+
+ /*
+ * The information below is used for communication between processes
+ * during "send" commands. Each process keeps a private window, never
+ * even mapped, with one property, "Comm". When a command is sent to
+ * an interpreter, the command is appended to the comm property of the
+ * communication window associated with the interp's process. Similarly,
+ * 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 SendInit _ANSI_ARGS_((Tcl_Interp *interp));
+/*
+static int AppendErrorProc _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errorPtr));
+static void DeleteProc _ANSI_ARGS_((ClientData clientData));
+static void RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name, Window commWindow));
+static void RegClose _ANSI_ARGS_((NameRegistry *regPtr));
+static void RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name));
+static Window RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name));
+static NameRegistry * RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr, int lock));
+static void SendEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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. */
+ CONST char *name) /* The name that will be used to
+ * refer to the interpreter in later
+ * "send" commands. Must be globally
+ * unique. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ Tcl_Interp *interp = winPtr->mainPtr->interp;
+ int i, suffix, offset, result;
+ RegisteredInterp *riPtr, *prevPtr;
+ CONST char *actualName;
+ Tcl_DString dString;
+ Tcl_Obj *resultObjPtr, *interpNamePtr;
+ char *interpName;
+
+ if (!initialized) {
+ SendInit(interp);
+ }
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry. The deletion of the command
+ * will take care of disposing of this entry.
+ */
+
+ for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL;
+ prevPtr = riPtr, riPtr = riPtr->nextPtr) {
+ if (riPtr->interp == interp) {
+ if (prevPtr == NULL) {
+ interpListPtr = interpListPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = riPtr->nextPtr;
+ }
+ break;
+ }
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ actualName = name;
+ suffix = 1;
+ offset = 0;
+ Tcl_DStringInit(&dString);
+
+ TkGetInterpNames(interp, tkwin);
+ resultObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObjPtr);
+ for (i = 0; ; ) {
+ result = Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr);
+ if (interpNamePtr == NULL) {
+ break;
+ }
+ interpName = Tcl_GetStringFromObj(interpNamePtr, NULL);
+ if (strcmp(actualName, interpName) == 0) {
+ if (suffix == 1) {
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset + 10);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ suffix++;
+ sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
+ i = 0;
+ } else {
+ i++;
+ }
+ }
+
+ Tcl_DecrRefCount(resultObjPtr);
+ Tcl_ResetResult(interp);
+
+ /*
+ * We have found a unique name. Now add it to the registry.
+ */
+
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+ riPtr->name = ckalloc(strlen(actualName) + 1);
+ riPtr->nextPtr = interpListPtr;
+ interpListPtr = riPtr;
+ strcpy(riPtr->name, actualName);
+
+ Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd,
+ (ClientData) riPtr, NULL /* TODO: DeleteProc */);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "send", "send");
+ }
+ Tcl_DStringFree(&dString);
+
+ return riPtr->name;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SendObjCmd --
+ *
+ * This procedure is invoked to process the "send" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SendObjCmd(
+ ClientData clientData, /* Used only for deletion */
+ Tcl_Interp *interp, /* The interp we are sending from */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]) /* The arguments */
+{
+ CONST char *sendOptions[] = {"-async", "-displayof", "-", (char *) NULL};
+ char *stringRep, *destName;
+ int async = 0;
+ int i, index, firstArg;
+ RegisteredInterp *riPtr;
+ Tcl_Obj *resultPtr, *listObjPtr;
+ int result = TCL_OK;
+
+ for (i = 1; i < (objc - 1); ) {
+ stringRep = Tcl_GetStringFromObj(objv[i], NULL);
+ if (stringRep[0] == '-') {
+ if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == 0) {
+ async = 1;
+ i++;
+ } else if (index == 1) {
+ i += 2;
+ } else {
+ i++;
+ }
+ } else {
+ break;
+ }
+ }
+
+ if (objc < (i + 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?options? interpName arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ destName = Tcl_GetStringFromObj(objv[i], NULL);
+ firstArg = i + 1;
+
+ resultPtr = Tcl_GetObjResult(interp);
+
+ /*
+ * See if the target interpreter is local. If so, execute
+ * the command directly without going through the DDE server.
+ * The only tricky thing is passing the result from the target
+ * interpreter to the invoking interpreter. Watch out: they
+ * could be the same!
+ */
+
+ for (riPtr = interpListPtr; (riPtr != NULL)
+ && (strcmp(destName, riPtr->name)); riPtr = riPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ if (riPtr != NULL) {
+ /*
+ * This command is to a local interp. No need to go through
+ * the server.
+ */
+
+ Tcl_Interp *localInterp;
+
+ Tcl_Preserve((ClientData) riPtr);
+ localInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) localInterp);
+ if (firstArg == (objc - 1)) {
+ /*
+ * This might be one of those cases where the new
+ * parser is faster.
+ */
+
+ result = Tcl_EvalObjEx(localInterp, objv[firstArg], TCL_EVAL_DIRECT);
+ } else {
+ listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ for (i = firstArg; i < objc; i++) {
+ Tcl_ListObjAppendList(interp, listObjPtr, objv[i]);
+ }
+ Tcl_IncrRefCount(listObjPtr);
+ result = Tcl_EvalObjEx(localInterp, listObjPtr, TCL_EVAL_DIRECT);
+ Tcl_DecrRefCount(listObjPtr);
+ }
+ if (interp != localInterp) {
+ if (result == TCL_ERROR) {
+ /* Tcl_Obj *errorObjPtr; */
+
+ /*
+ * An error occurred, so transfer error information from the
+ * destination interpreter back to our interpreter. Must clear
+ * interp's result before calling Tcl_AddErrorInfo, since
+ * Tcl_AddErrorInfo will store the interp's result in errorInfo
+ * before appending riPtr's $errorInfo; we've already got
+ * everything we need in riPtr's $errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
+ "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
+ /* errorObjPtr = Tcl_GetObjVar2(localInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, errorObjPtr); */
+ }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) localInterp);
+ } else {
+ /*
+ * This is a non-local request. Send the script to the server and poll
+ * it for a result. TODO!!!
+ */
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_Obj *listObjPtr;
+ RegisteredInterp *riPtr;
+
+ listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ riPtr = interpListPtr;
+ while (riPtr != NULL) {
+ Tcl_ListObjAppendElement(interp, listObjPtr,
+ Tcl_NewStringObj(riPtr->name, -1));
+ riPtr = riPtr->nextPtr;
+ }
+
+ Tcl_SetObjResult(interp, listObjPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SendInit --
+ *
+ * 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). */
+{
+ return TCL_OK;
+}
diff --git a/tcl/macosx/tkMacOSXSubwindows.c b/tcl/macosx/tkMacOSXSubwindows.c
new file mode 100644
index 00000000000..c5886da963b
--- /dev/null
+++ b/tcl/macosx/tkMacOSXSubwindows.c
@@ -0,0 +1,1304 @@
+/*
+ * tkMacOSXSubwindows.c --
+ *
+ * Implements subwindows for the macintosh version of Tk.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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 "X11/X.h"
+#include "X11/Xlib.h"
+#include <stdio.h>
+
+#include <Carbon/Carbon.h>
+#include "tkMacOSXInt.h"
+#include "tkMacOSXDebug.h"
+
+/*
+ * Temporary region that can be reused.
+ */
+static RgnHandle tmpRgn = NULL;
+
+static void UpdateOffsets _ANSI_ARGS_((TkWindow *winPtr, int deltaX, int deltaY));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ CGrafPtr 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 = TkMacOSXGetDrawablePort(window);
+ if (destPort != NULL) {
+ TkMacOSXWindowList *listPtr, *prevPtr;
+ WindowRef winRef;
+ winRef = GetWindowFromPort(destPort);
+ TkMacOSXUnregisterMacWindow(winRef);
+ DisposeWindow(winRef);
+
+ for (listPtr = tkMacOSXWindowListPtr, prevPtr = NULL;
+ tkMacOSXWindowListPtr != NULL;
+ prevPtr = listPtr, listPtr = listPtr->nextPtr) {
+ if (listPtr->winPtr == macWin->winPtr) {
+ if (prevPtr == NULL) {
+ tkMacOSXWindowListPtr = listPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = listPtr->nextPtr;
+ }
+ ckfree((char *) listPtr);
+ break;
+ }
+ }
+ }
+ }
+
+ macWin->grafPtr = NULL;
+
+ /*
+ * Delay deletion of a toplevel data structure untill all
+ * children have been deleted.
+ */
+ if (macWin->toplevel->referenceCount == 0) {
+ ckfree((char *) macWin->toplevel);
+ }
+ } else {
+ CGrafPtr destPort;
+ destPort = TkMacOSXGetDrawablePort(window);
+ if (destPort != NULL) {
+ SetGWorld(destPort, NULL);
+ TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW);
+ }
+ if (macWin->winPtr->parentPtr != NULL) {
+ TkMacOSXInvalClipRgns(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;
+ CGrafPtr 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 (!TkMacOSXHostToplevelExists(macWin->toplevel->winPtr)) {
+ TkMacOSXMakeRealWindowExist(macWin->toplevel->winPtr);
+ }
+ destPort = TkMacOSXGetDrawablePort (window);
+
+ display->request++;
+ macWin->winPtr->flags |= TK_MAPPED;
+ if (Tk_IsTopLevel(macWin->winPtr)) {
+ if (!Tk_IsEmbedded(macWin->winPtr)) {
+ ShowWindow(GetWindowFromPort(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 {
+ TkMacOSXInvalClipRgns(macWin->winPtr->parentPtr);
+ }
+
+ /*
+ * Generate damage for that area of the window
+ */
+ SetGWorld (destPort, NULL);
+ TkMacOSXUpdateClipRgn(macWin->winPtr);
+ TkMacOSXInvalidateWindow(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;
+ CGrafPtr destPort;
+
+ destPort = TkMacOSXGetDrawablePort(window);
+
+ display->request++;
+ macWin->winPtr->flags &= ~TK_MAPPED;
+ if (Tk_IsTopLevel(macWin->winPtr)) {
+ if (!Tk_IsEmbedded(macWin->winPtr)) {
+ HideWindow(GetWindowFromPort(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);
+ TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW); /* TODO: may not be valid */
+ TkMacOSXInvalClipRgns(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;
+ CGrafPtr destPort;
+
+ destPort = TkMacOSXGetDrawablePort(window);
+ if (destPort == NULL) {
+ return;
+ }
+
+ display->request++;
+ SetPort( 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(GetWindowFromPort(destPort),
+ (short) width, (short) height, false);
+ TkMacOSXInvalidateWindow(macWin, TK_WINDOW_ONLY);
+ TkMacOSXInvalClipRgns(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;
+
+ TkMacOSXInvalClipRgns(macParent->winPtr);
+ TkMacOSXInvalidateWindow(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.
+ */
+
+ TkMacOSXInvalidateWindow(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 */
+ }
+
+ TkMacOSXInvalClipRgns(macParent->winPtr);
+ TkMacOSXInvalidateWindow(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;
+ CGrafPtr destPort;
+
+ destPort = TkMacOSXGetDrawablePort(window);
+ if (destPort == NULL) {
+ return;
+ }
+
+ SetPort( 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(GetWindowFromPort(destPort),
+ (short) width, (short) height, false);
+ MoveWindowStructure(GetWindowFromPort(destPort), x, y);
+
+ /* TODO: is the following right? */
+ TkMacOSXInvalidateWindow(macWin, TK_WINDOW_ONLY);
+ TkMacOSXInvalClipRgns(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 */
+ }
+ }
+
+ TkMacOSXInvalClipRgns(macParent->winPtr);
+ TkMacOSXInvalidateWindow(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);
+ TkMacOSXWinBounds(macWin->winPtr, &bounds);
+ InvalWindowRect(GetWindowFromPort(destPort),&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;
+ CGrafPtr destPort;
+
+ destPort = TkMacOSXGetDrawablePort(window);
+ if (destPort == NULL) {
+ return;
+ }
+
+ SetPort( 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.
+ */
+ MoveWindowStructure( GetWindowFromPort(destPort), x, y);
+
+ /* TODO: is the following right? */
+ TkMacOSXInvalidateWindow(macWin, TK_WINDOW_ONLY);
+ TkMacOSXInvalClipRgns(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 */
+ }
+ }
+
+ TkMacOSXInvalClipRgns(macParent->winPtr);
+ TkMacOSXInvalidateWindow(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);
+ TkMacOSXWinBounds(macWin->winPtr, &bounds);
+ InvalWindowRect(GetWindowFromPort(destPort),&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 */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XLowerWindow --
+ *
+ * Change the stacking order of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the stacking order of the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XLowerWindow(
+ Display* display, /* Display. */
+ Window window) /* Window. */
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+
+ display->request++;
+ if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) {
+ TkWmRestackToplevel(macWin->winPtr, Below, 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;
+ CGrafPtr destPort;
+
+ destPort = TkMacOSXGetDrawablePort(w);
+ if (destPort != NULL) {
+ SetPort( destPort);
+ TkMacOSXInvalClipRgns(winPtr->parentPtr);
+ TkMacOSXWinBounds(winPtr, &bounds);
+ InvalWindowRect(GetWindowFromPort(destPort),&bounds);
+ }
+ }
+
+ /* TkGenWMMoveRequestEvent(macWin->winPtr,
+ macWin->winPtr->changes.x, macWin->winPtr->changes.y); */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXUpdateClipRgn --
+ *
+ * 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
+TkMacOSXUpdateClipRgn(
+ 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)) {
+ TkMacOSXUpdateClipRgn(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) {
+ TkMacOSXUpdateClipRgn(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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXVisableClipRgn --
+ *
+ * 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
+TkMacOSXVisableClipRgn(
+ TkWindow *winPtr)
+{
+ if (winPtr->privatePtr->flags & TK_CLIP_INVALID) {
+ TkMacOSXUpdateClipRgn(winPtr);
+ }
+
+ return winPtr->privatePtr->clipRgn;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXInvalidateWindow --
+ *
+ * This function makes the window as invalid will generate damage
+ * for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Damage is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXInvalidateWindow(
+ MacDrawable *macWin, /* Make window that's causing damage. */
+ int flag) /* Should be TK_WINDOW_ONLY or
+ * TK_PARENT_WINDOW */
+{
+ WindowRef windowRef;
+ CGrafPtr grafPtr;
+
+ grafPtr=TkMacOSXGetDrawablePort((Drawable)macWin);
+ windowRef=GetWindowFromPort(grafPtr);
+
+ if (flag == TK_WINDOW_ONLY) {
+ InvalWindowRgn(windowRef,macWin->clipRgn);
+ } else {
+ if (!EmptyRgn(macWin->aboveClipRgn)) {
+ InvalWindowRgn(windowRef,macWin->aboveClipRgn);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetDrawablePort --
+ *
+ * This function returns the Graphics Port for a given X drawable.
+ *
+ * Results:
+ * A CGrafPort . Either an off screen pixmap or a Window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CGrafPtr
+TkMacOSXGetDrawablePort(
+ 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->grafPtr;
+ }
+
+ /*
+ * 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->grafPtr;
+ } else {
+ TkWindow *contWinPtr;
+
+ contWinPtr = TkpGetOtherWindow(macWin->toplevel->winPtr);
+
+ if (contWinPtr != NULL) {
+ resultPort = TkMacOSXGetDrawablePort(
+ (Drawable) contWinPtr->privatePtr);
+ } else if (gMacEmbedHandler != NULL) {
+ resultPort = gMacEmbedHandler->getPortProc(
+ (Tk_Window) macWin->winPtr);
+ }
+
+ if (resultPort == NULL) {
+ /*
+ * FIXME:
+ *
+ * So far as I can tell, the only time that this happens is when
+ * we are tearing down an embedded child interpreter, and most
+ * of the time, this is harmless... However, we really need to
+ * find why the embedding loses.
+ */
+ DebugStr("\pTkMacOSXGetDrawablePort couldn't find container");
+ return NULL;
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ }
+ return resultPort;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetRootControl --
+ *
+ * This function returns the Root Control for a given X drawable.
+ *
+ * Results:
+ * A ControlRef .
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ControlRef
+TkMacOSXGetRootControl(
+ Drawable drawable)
+{
+ /*
+ * will probably need to fix this up for embedding
+ */
+ MacDrawable *macWin = (MacDrawable *) drawable;
+ ControlRef result = NULL;
+
+ if (macWin == NULL) {
+ return NULL;
+ }
+ if (!(macWin->toplevel->flags & TK_EMBEDDED)) {
+ return macWin->toplevel->rootControl;
+ } else {
+ TkWindow *contWinPtr;
+
+ contWinPtr = TkpGetOtherWindow(macWin->toplevel->winPtr);
+
+ if (contWinPtr != NULL) {
+ result = TkMacOSXGetRootControl(
+ (Drawable) contWinPtr->privatePtr);
+ } else if (gMacEmbedHandler != NULL) {
+ result = NULL;
+ }
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXInvalClipRgns --
+ *
+ * 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
+TkMacOSXInvalClipRgns(
+ 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)) {
+ TkMacOSXInvalClipRgns(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)) {
+ TkMacOSXInvalClipRgns(childPtr);
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXWinBounds --
+ *
+ * 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
+TkMacOSXWinBounds(
+ 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);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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->grafPtr = 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->grafPtr);
+ UnlockPixels(pixels);
+ DisposeGWorld(macPix->grafPtr);
+ ckfree((char *) macPix);
+}
diff --git a/tcl/macosx/tkMacOSXTest.c b/tcl/macosx/tkMacOSXTest.c
new file mode 100644
index 00000000000..e933446b580
--- /dev/null
+++ b/tcl/macosx/tkMacOSXTest.c
@@ -0,0 +1,82 @@
+/*
+ * tkMacOSXTest.c --
+ *
+ * Contains commands for platform specific tests for
+ * the Macintosh platform.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, 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>
+
+/*
+ * 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/tcl/macosx/tkMacOSXUtil.c b/tcl/macosx/tkMacOSXUtil.c
new file mode 100644
index 00000000000..1e4e8567578
--- /dev/null
+++ b/tcl/macosx/tkMacOSXUtil.c
@@ -0,0 +1,330 @@
+#include <Carbon/Carbon.h>
+
+#include "tkMacOSXUtil.h"
+
+#define DIR_SEP_CHAR ':'
+
+/*****************************************************************************/
+pascal OSErr FSMakeFSSpecCompat(short vRefNum,
+ long dirID,
+ ConstStr255Param fileName,
+ FSSpec *spec)
+{
+ OSErr result;
+
+ {
+ /* Let the file system create the FSSpec if it can since it does the job */
+ /* much more efficiently than I can. */
+ result = FSMakeFSSpec(vRefNum, dirID, fileName, spec);
+ /* Fix a bug in Macintosh PC Exchange's MakeFSSpec code where 0 is */
+ /* returned in the parID field when making an FSSpec to the volume's */
+ /* root directory by passing a full pathname in MakeFSSpec's */
+ /* fileName parameter. Fixed in Mac OS 8.1 */
+ if ( (result == noErr) && (spec->parID == 0) )
+ spec->parID = fsRtParID;
+ }
+ return ( result );
+}
+
+
+/*****************************************************************************/
+pascal OSErr GetCatInfoNoName(short vRefNum,
+ long dirID,
+ ConstStr255Param name,
+ CInfoPBPtr pb)
+{
+ Str31 tempName;
+ OSErr error;
+
+ /* Protection against File Sharing problem */
+ if ( (name == NULL) || (name[0] == 0) )
+ {
+ tempName[0] = 0;
+ pb->dirInfo.ioNamePtr = tempName;
+ pb->dirInfo.ioFDirIndex = -1; /* use ioDirID */
+ }
+ else
+ {
+ pb->dirInfo.ioNamePtr = (StringPtr)name;
+ pb->dirInfo.ioFDirIndex = 0; /* use ioNamePtr and ioDirID */
+ }
+ pb->dirInfo.ioVRefNum = vRefNum;
+ pb->dirInfo.ioDrDirID = dirID;
+ error = PBGetCatInfoSync(pb);
+ pb->dirInfo.ioNamePtr = NULL;
+ return ( error );
+}
+/*****************************************************************************/
+pascal OSErr GetDirectoryID(short vRefNum,
+ long dirID,
+ ConstStr255Param name,
+ long *theDirID,
+ Boolean *isDirectory)
+{
+ CInfoPBRec pb;
+ OSErr error;
+ error = GetCatInfoNoName(vRefNum, dirID, name, &pb);
+ if ( error == noErr )
+ {
+ *isDirectory = (pb.hFileInfo.ioFlAttrib & kioFlAttribDirMask) != 0;
+ if ( *isDirectory )
+ {
+ *theDirID = pb.dirInfo.ioDrDirID;
+ }
+ else
+ {
+ *theDirID = pb.hFileInfo.ioFlParID;
+ }
+ }
+
+ return ( error );
+}
+
+/*****************************************************************************/
+pascal OSErr FSpGetDirectoryID(const FSSpec *spec,
+ long *theDirID,
+ Boolean *isDirectory)
+{
+ return ( GetDirectoryID(spec->vRefNum, spec->parID, spec->name,
+ theDirID, isDirectory) );
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpPathFromLocation --
+ *
+ * This function obtains a full path name for a given macintosh
+ * FSSpec. Unlike the More Files function FSpGetFullPath, this
+ * function will return a C string in the Handle. It also will
+ * create paths for FSSpec that do not yet exist.
+ *
+ * Results:
+ * OSErr code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+OSErr
+FSpPathFromLocation(
+ FSSpec *spec, /* The location we want a path for. */
+ int *length, /* Length of the resulting path. */
+ Handle *fullPath) /* Handle to path. */
+{
+ OSErr err;
+ FSSpec tempSpec;
+ CInfoPBRec pb;
+
+ *fullPath = NULL;
+
+ /*
+ * Make a copy of the input FSSpec that can be modified.
+ */
+ BlockMoveData(spec, &tempSpec, sizeof(FSSpec));
+
+ if (tempSpec.parID == fsRtParID) {
+ /*
+ * The object is a volume. Add a colon to make it a full
+ * pathname. Allocate a handle for it and we are done.
+ */
+ tempSpec.name[0] += 2;
+ tempSpec.name[tempSpec.name[0] - 1] = DIR_SEP_CHAR;
+ tempSpec.name[tempSpec.name[0]] = '\0';
+
+ err = PtrToHand(&tempSpec.name[1], fullPath, tempSpec.name[0]);
+ } else {
+ /*
+ * The object isn't a volume. Is the object a file or a directory?
+ */
+ pb.dirInfo.ioNamePtr = tempSpec.name;
+ pb.dirInfo.ioVRefNum = tempSpec.vRefNum;
+ pb.dirInfo.ioDrDirID = tempSpec.parID;
+ pb.dirInfo.ioFDirIndex = 0;
+ err = PBGetCatInfoSync(&pb);
+
+ if ((err == noErr) || (err == fnfErr)) {
+ /*
+ * If the file doesn't currently exist we start over. If the
+ * directory exists everything will work just fine. Otherwise we
+ * will just fail later. If the object is a directory, append a
+ * colon so full pathname ends with colon, but only if the name is
+ * not empty. NavServices returns FSSpec's with the parent ID set,
+ * but the name empty...
+ */
+ if (err == fnfErr) {
+ BlockMoveData(spec, &tempSpec, sizeof(FSSpec));
+ } else if ( (pb.hFileInfo.ioFlAttrib & ioDirMask) != 0 ) {
+ if (tempSpec.name[0] > 0) {
+ tempSpec.name[0] += 1;
+ tempSpec.name[tempSpec.name[0]] = DIR_SEP_CHAR;
+ }
+ }
+
+ /*
+ * Create a new Handle for the object - make it a C string.
+ */
+ tempSpec.name[0] += 1;
+ tempSpec.name[tempSpec.name[0]] = '\0';
+ err = PtrToHand(&tempSpec.name[1], fullPath, tempSpec.name[0]);
+ if (err == noErr) {
+ /*
+ * Get the ancestor directory names - loop until we have an
+ * error or find the root directory.
+ */
+ pb.dirInfo.ioNamePtr = tempSpec.name;
+ pb.dirInfo.ioVRefNum = tempSpec.vRefNum;
+ pb.dirInfo.ioDrParID = tempSpec.parID;
+ do {
+ pb.dirInfo.ioFDirIndex = -1;
+ pb.dirInfo.ioDrDirID = pb.dirInfo.ioDrParID;
+ err = PBGetCatInfoSync(&pb);
+ if (err == noErr) {
+ /*
+ * Append colon to directory name and add
+ * directory name to beginning of fullPath.
+ */
+ ++tempSpec.name[0];
+ tempSpec.name[tempSpec.name[0]] = DIR_SEP_CHAR;
+
+ (void) Munger(*fullPath, 0, NULL, 0, &tempSpec.name[1],
+ tempSpec.name[0]);
+ fprintf(stderr,"mem\n");
+ err = MemError();
+ }
+ } while ( (err == noErr) &&
+ (pb.dirInfo.ioDrDirID != fsRtDirID) );
+ }
+ }
+ }
+
+ /*
+ * On error Dispose the handle, set it to NULL & return the err.
+ * Otherwise, set the length & return.
+ */
+ if (err == noErr) {
+ *length = GetHandleSize(*fullPath) - 1;
+ } else {
+ if ( *fullPath != NULL ) {
+ DisposeHandle(*fullPath);
+ }
+ *fullPath = NULL;
+ *length = 0;
+ }
+
+ return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpLocationFromPath --
+ *
+ * This function obtains an FSSpec for a given macintosh path.
+ * Unlike the More Files function FSpLocationFromFullPath, this
+ * function will also accept partial paths and resolve any aliases
+ * along the path.
+ *
+ * Results:
+ * OSErr code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+OSErr
+FSpLocationFromPath(
+ int length, /* Length of path. */
+ const char *path, /* The path to convert. */
+ FSSpecPtr fileSpecPtr) /* On return the spec for the path. */
+{
+ Str255 fileName;
+ OSErr err;
+ short vRefNum;
+ long dirID;
+ int pos, cur;
+ Boolean isDirectory;
+ Boolean wasAlias;
+
+ /*
+ * Check to see if this is a full path. If partial
+ * we assume that path starts with the current working
+ * directory. (Ie. volume & dir = 0)
+ */
+ vRefNum = 0;
+ dirID = 0;
+ cur = 0;
+ if (length == 0) {
+ return fnfErr;
+ }
+ if (path[cur] == DIR_SEP_CHAR) {
+ cur++;
+ if (cur >= length) {
+ /*
+ * If path = ":", just return current directory.
+ */
+ FSMakeFSSpecCompat(0, 0, NULL, fileSpecPtr);
+ return noErr;
+ }
+ } else {
+ while (path[cur] != DIR_SEP_CHAR && cur < length) {
+ cur++;
+ }
+ if (cur > 255) {
+ return bdNamErr;
+ }
+ if (cur < length) {
+ /*
+ * This is a full path
+ */
+ cur++;
+ strncpy((char *) fileName + 1, path, cur);
+ fileName[0] = cur;
+ err = FSMakeFSSpecCompat(0, 0, fileName, fileSpecPtr);
+ if (err != noErr) return err;
+ FSpGetDirectoryID(fileSpecPtr, &dirID, &isDirectory);
+ vRefNum = fileSpecPtr->vRefNum;
+ } else {
+ cur = 0;
+ }
+ }
+
+ isDirectory = 1;
+ while (cur < length) {
+ if (!isDirectory) {
+ return dirNFErr;
+ }
+ pos = cur;
+ while (path[pos] != DIR_SEP_CHAR && pos < length) {
+ pos++;
+ }
+ if (pos == cur) {
+ /* Move up one dir */
+ /* cur++; */
+ fileName[1] = DIR_SEP_CHAR;
+ fileName[2] = DIR_SEP_CHAR;
+ fileName[0] = 2;
+ } else if (pos - cur > 255) {
+ return bdNamErr;
+ } else {
+ strncpy((char *) fileName + 1, &path[cur], pos - cur);
+ fileName[0] = pos - cur;
+ }
+ err = FSMakeFSSpecCompat(vRefNum, dirID, fileName, fileSpecPtr);
+ if (err != noErr) return err;
+ err = ResolveAliasFile(fileSpecPtr, true, &isDirectory, &wasAlias);
+ if (err != noErr) return err;
+ FSpGetDirectoryID(fileSpecPtr, &dirID, &isDirectory);
+ vRefNum = fileSpecPtr->vRefNum;
+ cur = pos;
+ if (path[cur] == DIR_SEP_CHAR) {
+ cur++;
+ }
+ }
+
+ return noErr;
+}
diff --git a/tcl/macosx/tkMacOSXUtil.h b/tcl/macosx/tkMacOSXUtil.h
new file mode 100644
index 00000000000..e38f8a53390
--- /dev/null
+++ b/tcl/macosx/tkMacOSXUtil.h
@@ -0,0 +1,65 @@
+/*
+ * tkMacOSXUtil.h --
+ *
+ * Declarations of utility functions from the MoreFiles package.
+ *
+ * FIXME: We should be able to replace all these with FSRef calls
+ * much more simply.
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#ifndef TK_MAC_UTIL_H
+#define TK_MAC_UTIL_H
+
+#include <Carbon/Carbon.h>
+
+OSErr FSpPathFromLocation(FSSpec *spec, int *length, Handle *fullPath);
+OSErr FSpLocationFromPath(int length, const char *path, FSSpecPtr fileSpecPtr);
+OSErr FSpGetDirectoryID(const FSSpec *spec, long *theDirID, Boolean *isDirectory);
+
+#endif
diff --git a/tcl/macosx/tkMacOSXWindowEvent.c b/tcl/macosx/tkMacOSXWindowEvent.c
new file mode 100644
index 00000000000..d21d1f1d8b3
--- /dev/null
+++ b/tcl/macosx/tkMacOSXWindowEvent.c
@@ -0,0 +1,693 @@
+/*
+ * tkMacOSXWindowEvent.c --
+ *
+ * This file defines the routines for both creating and handling
+ * Window Manager class events for Tk.
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#include "tkMacOSXInt.h"
+#include "tkPort.h"
+#include "tkMacOSXWm.h"
+#include "tkMacOSXEvent.h"
+#include "tkMacOSXDebug.h"
+
+/*
+ * Declarations of global variables defined in this file.
+ */
+
+int tkMacOSXAppInFront = true; /* Boolean variable for determining if
+ * we are the frontmost app. Only set
+ * in TkMacOSXProcessApplicationEvent
+ */
+static RgnHandle gDamageRgn;
+static RgnHandle visRgn;
+
+/*
+ * Declaration of functions used only in this file
+ */
+
+static int GenerateUpdateEvent( Window window);
+static void GenerateUpdates( RgnHandle updateRgn, TkWindow *winPtr);
+static int GenerateActivateEvents( Window window, int activeFlag);
+static int GenerateFocusEvent( Window window, int activeFlag);
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXProcessApplicationEvent --
+ *
+ * This processes Application level events, mainly activate
+ * and deactivate.
+ *
+ * Results:
+ * o.
+ *
+ * Side effects:
+ * Hide or reveal floating windows, and set tkMacOSXAppInFront.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXProcessApplicationEvent(
+ TkMacOSXEvent *eventPtr,
+ MacEventStatus *statusPtr)
+{
+ statusPtr->handledByTk = 1;
+ switch (eventPtr->eKind) {
+ case kEventAppActivated:
+ tkMacOSXAppInFront = true;
+ ShowFloatingWindows();
+ break;
+ case kEventAppDeactivated:
+ TkSuspendClipboard();
+ tkMacOSXAppInFront = false;
+ HideFloatingWindows();
+ break;
+ case kEventAppQuit:
+ case kEventAppLaunchNotification:
+ case kEventAppLaunched:
+ case kEventAppTerminated:
+ case kEventAppFrontSwitched:
+ break;
+ }
+ return 0;
+}
+ /*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXProcessWindowEvent --
+ *
+ * This processes Window level events, mainly activate
+ * and deactivate.
+ *
+ * Results:
+ * 0.
+ *
+ * Side effects:
+ * Cause Windows to be moved forward or backward in the
+ * window stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacOSXProcessWindowEvent(
+ TkMacOSXEvent * eventPtr,
+ MacEventStatus * statusPtr)
+{
+ OSStatus status;
+ WindowRef whichWindow;
+ Window window;
+ int eventFound;
+
+ switch (eventPtr->eKind) {
+ case kEventWindowActivated:
+ case kEventWindowDeactivated:
+ case kEventWindowUpdate:
+ break;
+ default:
+ statusPtr->handledByTk = 1;
+ return 0;
+ break;
+ }
+ statusPtr->handledByTk = 1;
+ status = GetEventParameter(eventPtr->eventRef,
+ kEventParamDirectObject,
+ typeWindowRef, NULL,
+ sizeof(whichWindow), NULL,
+ &whichWindow);
+ if (status != noErr) {
+ fprintf ( stderr, "TkMacOSXHandleWindowEvent:Failed to retrieve window" );
+ return 0;
+ }
+
+ window = TkMacOSXGetXWindow(whichWindow);
+
+ switch (eventPtr->eKind) {
+ case kEventWindowActivated:
+ eventFound |= GenerateActivateEvents(window, 1);
+ eventFound |= GenerateFocusEvent(window, 1);
+ break;
+ case kEventWindowDeactivated:
+ eventFound |= GenerateActivateEvents(window, 0);
+ eventFound |= GenerateFocusEvent(window, 0);
+ break;
+ case kEventWindowUpdate:
+ if (GenerateUpdateEvent(window)) {
+ eventFound = true;
+ } else {
+ statusPtr->handledByTk = 0;
+ }
+ break;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateUpdateEvent --
+ *
+ * Given a Macintosh window 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(Window window)
+{
+ WindowRef macWindow;
+ TkDisplay * dispPtr;
+ TkWindow * winPtr;
+ Rect bounds;
+
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *)Tk_IdToWindow(dispPtr->display, window);
+
+ if (winPtr ==NULL ){
+ return false;
+ }
+ if (gDamageRgn == NULL) {
+ gDamageRgn = NewRgn();
+ }
+ if (visRgn == NULL) {
+ visRgn = NewRgn();
+ }
+ macWindow = GetWindowFromPort(TkMacOSXGetDrawablePort(window));
+ BeginUpdate(macWindow);
+ /*
+ * In the Classic version of the code, this was the "visRgn" field of the WindowRec
+ * This no longer exists in OS X, so retrieve the content region instead
+ * Note that this is in screen coordinates
+ * We therefore convert it to window relative coordinates
+ */
+ GetWindowRegion (macWindow, kWindowContentRgn, visRgn );
+ GetRegionBounds(visRgn,&bounds);
+ bounds.right -= bounds.left;
+ bounds.bottom -= bounds.top;
+ bounds.left=
+ bounds.top=0;
+ RectRgn(visRgn, &bounds);
+ GenerateUpdates(visRgn, winPtr);
+ EndUpdate(macWindow);
+ 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, updateBounds, damageBounds;
+
+ TkMacOSXWinBounds(winPtr, &bounds);
+ GetRegionBounds(updateRgn,&updateBounds);
+
+ if (bounds.top > updateBounds.bottom ||
+ updateBounds.top > bounds.bottom ||
+ bounds.left > updateBounds.right ||
+ updateBounds.left > bounds.right ||
+ !RectInRgn(&bounds, updateRgn)) {
+ return;
+ }
+ if (!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(TkMacOSXVisableClipRgn(winPtr), rgn);
+ * TODO: this call doesn't work doing resizes!!!
+ */
+ RectRgn(gDamageRgn, &bounds);
+ SectRgn(gDamageRgn, updateRgn, gDamageRgn);
+ OffsetRgn(gDamageRgn, -bounds.left, -bounds.top);
+ GetRegionBounds(gDamageRgn,&damageBounds);
+ event.xexpose.x = damageBounds.left;
+ event.xexpose.y = damageBounds.top;
+ event.xexpose.width = damageBounds.right-damageBounds.left;
+ event.xexpose.height = damageBounds.bottom-damageBounds.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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateActivateEvents --
+ *
+ * Given a Macintosh window activate event this function generates all the
+ * X Activate 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+GenerateActivateEvents(
+ Window window, /* Root X window for event. */
+ int activeFlag )
+{
+ TkWindow *winPtr;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
+ if (winPtr == NULL || winPtr->window == None) {
+ return false;
+ }
+
+ TkGenerateActivateEvents(winPtr,activeFlag);
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateFocusEvent --
+ *
+ * Given a Macintosh window activate event this function generates all the
+ * X Focus 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+GenerateFocusEvent(
+ Window window, /* Root X window for event. */
+ int activeFlag )
+{
+ XEvent event;
+ Tk_Window tkwin;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ if (tkwin == NULL) {
+ return false;
+ }
+
+ /*
+ * Generate FocusIn and FocusOut events. This event
+ * is only sent to the toplevel window.
+ */
+
+ if (activeFlag) {
+ event.xany.type = FocusIn;
+ } else {
+ event.xany.type = FocusOut;
+ }
+
+ event.xany.serial = dispPtr->display->request;
+ event.xany.send_event = False;
+ event.xfocus.display = dispPtr->display;
+ event.xfocus.window = window;
+ event.xfocus.mode = NotifyNormal;
+ event.xfocus.detail = NotifyDetailNone;
+
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ TkMacOSXInvalClipRgns(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGenWMDestroyEvent --
+ *
+ * Generate a WM Destroy event for Tk. *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A WM_PROTOCOL/WM_DELETE_WINDOW event is sent to Tk.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MacOSXIsAppInFront --
+ *
+ * Returns 1 if this app is the foreground app.
+ *
+ * Results:
+ * 1 if app is in front, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_MacOSXIsAppInFront (void)
+{
+ return tkMacOSXAppInFront;
+} \ No newline at end of file
diff --git a/tcl/macosx/tkMacOSXWm.c b/tcl/macosx/tkMacOSXWm.c
new file mode 100644
index 00000000000..f55b7b0270d
--- /dev/null
+++ b/tcl/macosx/tkMacOSXWm.c
@@ -0,0 +1,5512 @@
+/*
+ * tkMacOSXWm.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.
+ * Copyright 2001, Apple Computer, 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 <Carbon/Carbon.h>
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkMacOSXInt.h"
+#include <errno.h>
+#include "tkScrollbar.h"
+#include "tkMacOSXWm.h"
+#include "tkMacOSXEvent.h"
+#include "tkMacOSXUtil.h"
+
+/*
+ * 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.
+ */
+
+TkMacOSXWindowList *tkMacOSXWindowListPtr = 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;
+
+/*
+ * 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));
+static int WmAspectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmAttributesCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmClientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmColormapwindowsCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmCommandCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmDeiconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFocusmodelCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFrameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGeometryCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGridCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGroupCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconbitmapCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconwindowCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMaxsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMinsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmOverrideredirectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmPositionfromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmProtocolCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmResizableCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmSizefromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStackorderCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStateCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTitleCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTransientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr,
+ TkWindow *winPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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 = -1;
+ wmPtr->macClass = kDocumentWindowClass;
+ wmPtr->attributes = kWindowStandardDocumentAttributes;
+ 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. */
+{
+ 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 (!TkMacOSXHostToplevelExists(winPtr)) {
+ TkMacOSXMakeRealWindowExist(winPtr);
+ }
+
+ /*
+ * Generate configure event when we first map the window.
+ */
+ LocalToGlobal(&where);
+ TkMacOSXWindowOffset( GetWindowFromPort(TkMacOSXGetDrawablePort((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).
+ */
+ TkMacOSXWindowOffset( GetWindowFromPort(TkMacOSXGetDrawablePort(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. */
+{
+ 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_WmObjCmd --
+ *
+ * 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_WmObjCmd(
+ 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;
+ static CONST char *optionStrings[] = {
+ "aspect", "attributes", "client", "colormapwindows",
+ "command", "deiconify", "focusmodel", "frame",
+ "geometry", "grid", "group", "iconbitmap",
+ "iconify", "iconmask", "iconname", "iconposition",
+ "iconwindow", "maxsize", "minsize", "overrideredirect",
+ "positionfrom", "protocol", "resizable", "sizefrom",
+ "stackorder", "state", "title", "transient",
+ "withdraw", (char *) NULL };
+ enum options {
+ WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
+ WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
+ WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
+ WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
+ WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
+ WMOPT_WITHDRAW };
+ int index, length;
+ char *argv1;
+ TkWindow *winPtr;
+
+ if (objc < 2) {
+wrongNumArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ argv1 = Tcl_GetStringFromObj(objv[1], &length);
+ if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0)
+ && (length >= 3)) {
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC);
+ return TCL_OK;
+ }
+ return Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing);
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc < 3) {
+ goto wrongNumArgs;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case WMOPT_ASPECT:
+ return WmAspectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ATTRIBUTES:
+ return WmAttributesCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_CLIENT:
+ return WmClientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COLORMAPWINDOWS:
+ return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COMMAND:
+ return WmCommandCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_DEICONIFY:
+ return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FOCUSMODEL:
+ return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FRAME:
+ return WmFrameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GEOMETRY:
+ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GRID:
+ return WmGridCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GROUP:
+ return WmGroupCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONBITMAP:
+ return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONIFY:
+ return WmIconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONMASK:
+ return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONNAME:
+ return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPOSITION:
+ return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONWINDOW:
+ return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MAXSIZE:
+ return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MINSIZE:
+ return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_OVERRIDEREDIRECT:
+ return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_POSITIONFROM:
+ return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_PROTOCOL:
+ return WmProtocolCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_RESIZABLE:
+ return WmResizableCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_SIZEFROM:
+ return WmSizefromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STACKORDER:
+ return WmStackorderCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STATE:
+ return WmStateCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TITLE:
+ return WmTitleCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TRANSIENT:
+ return WmTransientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_WITHDRAW:
+ return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAspectCmd --
+ *
+ * This procedure is invoked to process the "wm aspect" 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
+WmAspectCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int numer1, denom1, numer2, denom2;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?minNumer minDenom maxNumer maxDenom?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PAspect) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
+ wmPtr->minAspect.y, wmPtr->maxAspect.x,
+ wmPtr->maxAspect.y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~PAspect;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
+ (denom2 <= 0)) {
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ wmPtr->minAspect.x = numer1;
+ wmPtr->minAspect.y = denom1;
+ wmPtr->maxAspect.x = numer2;
+ wmPtr->maxAspect.y = denom2;
+ wmPtr->sizeHintsFlags |= PAspect;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAttributesCmd --
+ *
+ * This procedure is invoked to process the "wm attributes" 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
+WmAttributesCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ char buf[TCL_INTEGER_SPACE];
+ int i;
+ WindowRef macWindow;
+
+ if (objc < 3) {
+configArgs:
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ Tcl_GetStringFromObj (objv[0], NULL), " attributes window",
+ " ?-modified ?bool??",
+ " ?-titlepath ?path??",
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ macWindow = GetWindowFromPort(TkMacOSXGetDrawablePort(winPtr->window));
+ if (objc == 3) {
+ FSSpec spec;
+ sprintf(buf, "%d", (IsWindowModified(macWindow) == true));
+ Tcl_AppendResult(interp, "-modified ", buf, (char *) NULL);
+ if (GetWindowProxyFSSpec(macWindow, &spec) == noErr) {
+ Tcl_AppendResult(interp, " -titlepath", (char *) NULL);
+ /* Need to get the path from the spec */
+ Tcl_AppendElement(interp, "<read_unimplemented>");
+ } else {
+ Tcl_AppendResult(interp, " -titlepath {}", (char *) NULL);
+ }
+ return TCL_OK;
+ }
+ for (i = 3; i < objc; i += 2) {
+ int length;
+ char *argPtr = Tcl_GetStringFromObj(objv[i], &length);
+ if ((length < 2) || (*argPtr != '-')) {
+ goto configArgs;
+ }
+ if (strncmp(argPtr, "-modified", length) == 0) {
+ int boolean;
+ if (i < objc - 1) {
+ if (Tcl_GetBooleanFromObj(interp, objv[i+1], &boolean) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ SetWindowModified(macWindow, boolean);
+ }
+ } else if (strncmp(argPtr, "-titlepath", length) == 0) {
+ if (i < objc - 1) {
+ OSErr err;
+ FSSpec spec;
+ FSRef ref;
+ Boolean isDirectory;
+ err = FSPathMakeRef(Tcl_GetStringFromObj(objv[i+1], NULL), &ref, &isDirectory);
+ if (err == noErr) {
+ err = FSGetCatalogInfo(&ref, kFSCatInfoNone, NULL, NULL,
+ &spec, NULL);
+ if (err == noErr) {
+ if (SetWindowProxyFSSpec(macWindow,&spec) != noErr) {
+ Tcl_AppendResult(interp, "couldn't set window proxy title path",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+ } else {
+ goto configArgs;
+ }
+ if (i == objc - 2) {
+ /* Want to return last result */
+ Tcl_SetObjResult(interp, objv[i+1]);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmClientCmd --
+ *
+ * This procedure is invoked to process the "wm client" 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
+WmClientCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->clientMachine != NULL) {
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (argv3[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) (length + 1));
+ strcpy(wmPtr->clientMachine, argv3);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmColormapwindowsCmd --
+ *
+ * This procedure is invoked to process the "wm colormapwindows"
+ * 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
+WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ TkWindow **cmapList;
+ TkWindow *winPtr2;
+ int i, windowObjc, gotToplevel = 0;
+ Tcl_Obj **windowObjv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?");
+ return TCL_ERROR;
+ }
+ if (objc == 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_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (TkWindow **) ckalloc((unsigned)
+ ((windowObjc+1)*sizeof(TkWindow*)));
+ for (i = 0; i < windowObjc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, windowObjv[i],
+ (Tk_Window *) &winPtr2) != TCL_OK)
+ {
+ ckfree((char *) cmapList);
+ 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[windowObjc] = winPtr;
+ windowObjc++;
+ } 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 = windowObjc;
+
+ /*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmCommandCmd --
+ *
+ * This procedure is invoked to process the "wm command" 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
+WmCommandCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int cmdArgc;
+ CONST char **cmdArgv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?value?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->cmdArgv != NULL) {
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (argv3[0] == 0) {
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ wmPtr->cmdArgv = NULL;
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ wmPtr->cmdArgc = cmdArgc;
+ wmPtr->cmdArgv = cmdArgv;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmDeiconifyCmd --
+ *
+ * This procedure is invoked to process the "wm deiconify" 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
+WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[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 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);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFocusmodelCmd --
+ *
+ * This procedure is invoked to process the "wm focusmodel" 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
+WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "active", "passive", (char *) NULL };
+ enum options {
+ OPT_ACTIVE, OPT_PASSIVE };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ACTIVE) {
+ wmPtr->hints.input = False;
+ } else { /* OPT_PASSIVE */
+ wmPtr->hints.input = True;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFrameCmd --
+ *
+ * This procedure is invoked to process the "wm frame" 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
+WmFrameCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Window window;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ window = wmPtr->reparent;
+ if (window == None) {
+ window = Tk_WindowId((Tk_Window) winPtr);
+ }
+ sprintf(buf, "0x%x", (unsigned int) window);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGeometryCmd --
+ *
+ * This procedure is invoked to process the "wm geometry" 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
+WmGeometryCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char xSign, ySign;
+ int width, height;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
+ xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
+ ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
+ if (wmPtr->gridWin != NULL) {
+ width = wmPtr->reqGridWidth + (winPtr->changes.width
+ - winPtr->reqWidth)/wmPtr->widthInc;
+ height = wmPtr->reqGridHeight + (winPtr->changes.height
+ - winPtr->reqHeight)/wmPtr->heightInc;
+ } else {
+ width = winPtr->changes.width;
+ height = winPtr->changes.height;
+ }
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\0') {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+ }
+ return ParseGeometry(interp, argv3, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGridCmd --
+ *
+ * This procedure is invoked to process the "wm grid" 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
+WmGridCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int reqWidth, reqHeight, widthInc, heightInc;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?baseWidth baseHeight widthInc heightInc?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PBaseSize) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
+ wmPtr->reqGridHeight, wmPtr->widthInc,
+ wmPtr->heightInc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (reqWidth < 0) {
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (reqHeight < 0) {
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (widthInc < 0) {
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (heightInc < 0) {
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
+ heightInc);
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGroupCmd --
+ *
+ * This procedure is invoked to process the "wm group" 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
+WmGroupCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & WindowGroupHint) {
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (*argv3 == '\0') {
+ wmPtr->hints.flags &= ~WindowGroupHint;
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(tkwin2);
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->hints.window_group = Tk_WindowId(tkwin2);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->leaderName, argv3);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconbitmapCmd --
+ *
+ * This procedure is invoked to process the "wm iconbitmap" 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
+WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ Pixmap pixmap;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tcl_SetResult(interp,
+ (char *) Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\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 {
+ OSErr err;
+ FSSpec spec;
+ FSRef ref;
+ Boolean isDirectory;
+ err = FSPathMakeRef(Tcl_GetStringFromObj(objv[3], NULL), &ref, &isDirectory);
+ if (err == noErr) {
+ err = FSGetCatalogInfo (&ref, kFSCatInfoNone, NULL, NULL, &spec, NULL);
+ if (err == noErr) {
+ WindowRef macWin
+ = GetWindowFromPort(TkMacOSXGetDrawablePort(winPtr->window));
+ SetWindowProxyFSSpec(macWin, &spec);
+ return TCL_OK;
+ }
+ }
+ pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr,
+ Tk_GetUid(Tcl_GetStringFromObj(objv[3], NULL)));
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconifyCmd --
+ *
+ * This procedure is invoked to process the "wm iconify" 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
+WmIconifyCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ 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 ", winPtr->pathName,
+ ": 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);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconmaskCmd --
+ *
+ * This procedure is invoked to process the "wm iconmask" 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
+WmIconmaskCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Pixmap pixmap;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tcl_SetResult(interp,
+ (char *) Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\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, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconnameCmd --
+ *
+ * This procedure is invoked to process the "wm iconname" 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
+WmIconnameCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ CONST char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp,
+ (char *) ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->iconName != NULL) {
+ ckfree((char *) wmPtr->iconName);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->iconName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->iconName, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconpositionCmd --
+ *
+ * This procedure is invoked to process the "wm iconposition"
+ * 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
+WmIconpositionCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPositionHint) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->hints.icon_x,
+ wmPtr->hints.icon_y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->hints.flags &= ~IconPositionHint;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconwindowCmd --
+ *
+ * This procedure is invoked to process the "wm iconwindow" 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
+WmIconwindowCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->icon != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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 {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]),
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[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);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMaxsizeCmd --
+ *
+ * This procedure is invoked to process the "wm maxsize" 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
+WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->maxWidth, wmPtr->maxHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->maxWidth = width;
+ wmPtr->maxHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMinsizeCmd --
+ *
+ * This procedure is invoked to process the "wm minsize" 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
+WmMinsizeCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->minWidth = width;
+ wmPtr->minHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmOverrideredirectCmd --
+ *
+ * This procedure is invoked to process the "wm overrideredirect"
+ * 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
+WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int boolean;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ Tk_Attributes((Tk_Window) winPtr)->override_redirect);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[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;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmPositionfromCmd --
+ *
+ * This procedure is invoked to process the "wm positionfrom"
+ * 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
+WmPositionfromCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USPosition) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PPosition) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmProtocolCmd --
+ *
+ * This procedure is invoked to process the "wm protocol" 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
+WmProtocolCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ char *cmd;
+ int cmdLength;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?");
+ return TCL_ERROR;
+ }
+ if (objc == 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, Tcl_GetString(objv[3]));
+ if (objc == 4) {
+ /*
+ * Return the command to handle a given protocol.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * 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;
+ }
+ }
+ cmd = Tcl_GetStringFromObj(objv[4], &cmdLength);
+ 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, cmd);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmResizableCmd --
+ *
+ * This procedure is invoked to process the "wm resizable" 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
+WmResizableCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
+ (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[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);
+ }
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmSizefromCmd --
+ *
+ * This procedure is invoked to process the "wm sizefrom" 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
+WmSizefromCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USSize) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PSize) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USSize|PSize);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else { /* OPT_PROGRAM */
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStackorderCmd --
+ *
+ * This procedure is invoked to process the "wm stackorder" 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
+WmStackorderCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ TkWindow **windows, **window_ptr;
+ static CONST char *optionStrings[] = {
+ "isabove", "isbelow", (char *) NULL };
+ enum options {
+ OPT_ISABOVE, OPT_ISBELOW };
+ int index;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ windows = TkWmStackorderToplevel(winPtr);
+ if (windows == NULL) {
+ panic("TkWmStackorderToplevel failed");
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ Tcl_AppendElement(interp, (*window_ptr)->pathName);
+ }
+ ckfree((char *) windows);
+ return TCL_OK;
+ }
+ } else {
+ TkWindow *winPtr2;
+ int index1=-1, index2=-1, result;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsTopLevel(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Lookup stacking order of all toplevels that are children
+ * of "." and find the position of winPtr and winPtr2
+ * in the stacking order.
+ */
+
+ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
+
+ if (windows == NULL) {
+ Tcl_AppendResult(interp, "TkWmStackorderToplevel failed",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ if (*window_ptr == winPtr)
+ index1 = (window_ptr - windows);
+ if (*window_ptr == winPtr2)
+ index2 = (window_ptr - windows);
+ }
+ if (index1 == -1)
+ panic("winPtr window not found");
+ if (index2 == -1)
+ panic("winPtr2 window not found");
+
+ ckfree((char *) windows);
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ISABOVE) {
+ result = index1 > index2;
+ } else { /* OPT_ISBELOW */
+ result = index1 < index2;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+ return TCL_OK;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStateCmd --
+ *
+ * This procedure is invoked to process the "wm state" 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
+WmStateCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "normal", "iconic", "withdrawn", "zoomed", (char *) NULL };
+ enum options {
+ OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN, OPT_ZOOMED };
+ int index;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?state?");
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ",
+ Tcl_GetString(objv[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 change state of ",
+ winPtr->pathName, ": it is an embedded window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == OPT_NORMAL) {
+ TkpWmSetState(winPtr, NormalState);
+ /*
+ * This varies from 'wm deiconify' because it does not
+ * force the window to be raised and receive focus
+ */
+ } else if (index == OPT_ICONIC) {
+ 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 != NULL) {
+ Tcl_AppendResult(interp, "can't iconify \"",
+ winPtr->pathName,
+ "\": it is a transient", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, IconicState);
+ } else if (index == OPT_WITHDRAWN) {
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else { /* OPT_ZOOMED */
+ TkpWmSetState(winPtr, ZoomState);
+ }
+ } else {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else {
+ switch (wmPtr->hints.initial_state) {
+ case NormalState:
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ break;
+ case IconicState:
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ break;
+ case WithdrawnState:
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ break;
+ case ZoomState:
+ Tcl_SetResult(interp, "zoomed", TCL_STATIC);
+ break;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTitleCmd --
+ *
+ * This procedure is invoked to process the "wm title" 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
+WmTitleCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp,
+ (char *) ((wmPtr->titleUid != NULL) ? wmPtr->titleUid : winPtr->nameUid),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->titleUid = Tk_GetUid(argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED) && !Tk_IsEmbedded(winPtr)) {
+ TkSetWMName(winPtr, wmPtr->titleUid);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTransientCmd --
+ *
+ * This procedure is invoked to process the "wm transient" 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
+WmTransientCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window master;
+ WmInfo *wmPtr2;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?master?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->master != None) {
+ Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ wmPtr->master = None;
+ if (wmPtr->masterWindowName != NULL) {
+ ckfree(wmPtr->masterWindowName);
+ }
+ wmPtr->masterWindowName = NULL;
+ wmPtr->style = documentProc;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(master);
+
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[2]),
+ "\" a transient: it is an icon for ",
+ Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ wmPtr2 = ((TkWindow *) master)->wmInfoPtr;
+
+ /* Under some circumstances, wmPtr2 is NULL here */
+ if (wmPtr2 != NULL && wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[3]),
+ "\" a master: it is an icon for ",
+ Tk_PathName(wmPtr2->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->master = Tk_WindowId(master);
+ wmPtr->masterWindowName = ckalloc((unsigned) length+1);
+ strcpy(wmPtr->masterWindowName, argv3);
+ wmPtr->style = plainDBox;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmWithdrawCmd --
+ *
+ * This procedure is invoked to process the "wm withdraw" 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
+WmWithdrawCmd(tkwin, winPtr, interp, objc, objv)
+Tk_Window tkwin; /* Main window of the application. */
+TkWindow *winPtr; /* Toplevel to work with */
+Tcl_Interp *interp; /* Current interpreter. */
+int objc; /* Number of arguments. */
+Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, WithdrawnState);
+ return TCL_OK;
+}
+
+/*
+ * Invoked by those wm subcommands that affect geometry.
+ * Schedules a geometry update.
+ */
+static void
+WmUpdateGeom(wmPtr, winPtr)
+WmInfo *wmPtr;
+TkWindow *winPtr;
+{
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tk_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ 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;
+ 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. */
+{
+ 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. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ 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)
+{
+ 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
+ * the interp's 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. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height, flags;
+ char *end;
+ 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;
+ 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;
+ TkWindow *winPtr, *childPtr;
+ TkWindow *nextPtr; /* Coordinates of highest child found so
+ * far that contains point. */
+ int x, y; /* Coordinates in winPtr. */
+ int tmpx, tmpy, bd;
+ TkDisplay *dispPtr;
+
+ /*
+ * Step 1: find the top-level window that contains the desired point.
+ */
+
+ where.h = rootX;
+ where.v = rootY;
+ FindWindow(where, &whichWin);
+ if (whichWin == NULL) {
+ return NULL;
+ }
+ rootChild = TkMacOSXGetXWindow(whichWin);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, rootChild);
+ if (winPtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Step 2: work down through the hierarchy underneath this window.
+ * At each level, scan through all the children to find the highest
+ * 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) */
+{
+ 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;
+ 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);
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ WindowRef macWindow, otherMacWindow, frontWindow, tmpWindow;
+
+ 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 = GetWindowFromPort(TkMacOSXGetDrawablePort(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 =GetWindowFromPort(TkMacOSXGetDrawablePort(otherPtr->window));
+ } else {
+ otherMacWindow = NULL;
+ }
+
+
+ frontWindow = FrontNonFloatingWindow();
+
+ 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(macWindow);
+ } else {
+ SelectWindow(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 &&
+ ( tmpWindow = GetNextWindow (frontWindow) ) != otherMacWindow) {
+ frontWindow = tmpWindow;
+ }
+ if (frontWindow != NULL) {
+ SendBehind(macWindow, frontWindow);
+ }
+ }
+ } else {
+ /*
+ * Send behind. If it was in front find another window to make active.
+ */
+ if (macWindow == frontWindow) {
+ if ( ( tmpWindow = GetNextWindow ( macWindow )) != NULL) {
+ SelectWindow(tmpWindow);
+ }
+ }
+ SendBehind(macWindow, 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.
+ */
+ BitMap screenBits;
+ GetQDGlobalsScreenBits(&screenBits);
+ if (((screenBits.bounds.right - defaultX) < 30) ||
+ ((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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXResizable --
+ *
+ * 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
+TkMacOSXResizable(
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGrowToplevel --
+ *
+ * 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
+TkMacOSXGrowToplevel(
+ WindowRef whichWindow,
+ Point start)
+{
+ Point where = start;
+ TkDisplay *dispPtr;
+ Rect portRect;
+
+ GlobalToLocal(&where);
+ GetPortBounds(GetWindowPort(whichWindow), &portRect );
+ if (where.h > (portRect.right - 16) &&
+ where.v > (portRect.bottom - 16)) {
+
+ Window window;
+ TkWindow *winPtr;
+ WmInfo *wmPtr;
+ Rect bounds;
+ long growResult;
+
+ window = TkMacOSXGetXWindow(whichWindow);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
+ wmPtr = winPtr->wmInfoPtr;
+
+ /* TODO: handle grid size options. */
+ if ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) &&
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
+ return false;
+ }
+ 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( GetWindowPort(whichWindow));
+ InvalWindowRect(whichWindow,&portRect); /* TODO: may not be needed */
+ TkMacOSXInvalClipRgns(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;
+ WindowRef macWin;
+ int destWrote;
+
+ if (Tk_IsEmbedded(winPtr)) {
+ return;
+ }
+ Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, titleUid,
+ strlen(titleUid), 0, NULL,
+ (char *) &pTitle[1],
+ 255, NULL, &destWrote, NULL); /* Internalize native */
+ pTitle[0] = destWrote;
+
+ macWin = GetWindowFromPort(TkMacOSXGetDrawablePort(winPtr->window));
+
+ /*
+ * FIXME: Convert this to SetWindowTitleWithCFString, we should
+ * use CFStrings and not pascal strings wherever they are supported,
+ * since at some point there will be encodings that can't be supported
+ * with the pascal string interfaces.
+ */
+
+ SetWTitle( macWin, pTitle);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetXWindow --
+ *
+ * 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
+TkMacOSXGetXWindow(
+ WindowRef macWinPtr)
+{
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXZoomToplevel --
+ *
+ * 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
+TkMacOSXZoomToplevel(
+ WindowRef 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;
+ TkDisplay *dispPtr;
+ Rect portRect;
+
+ SetPort( GetWindowPort(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 = TkMacOSXGetXWindow(whichWindow);
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ if (tkwin == NULL) {
+ return false;
+ }
+
+ /*
+ * The following block of code works around a bug in the window
+ * definition for Apple's floating windows. The zoom behavior is
+ * 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) {
+ BitMap screenBits;
+ Rect zoomRect;
+ GetQDGlobalsScreenBits(&screenBits);
+ zoomRect = screenBits.bounds;
+ InsetRect(&zoomRect, 60, 60);
+ SetWindowStandardState(whichWindow, &zoomRect);
+ zoomPart = inZoomOut;
+ } else {
+ zoomPart = inZoomIn;
+ }
+ } else {
+ zoomPart = inZoomIn;
+ }
+
+ ZoomWindow(whichWindow, zoomPart, false);
+ InvalWindowRect(whichWindow,&portRect);
+ TkMacOSXInvalClipRgns((TkWindow *) tkwin);
+
+ LocalToGlobal(&location);
+ TkMacOSXWindowOffset(whichWindow, &xOffset, &yOffset);
+ location.h -= xOffset;
+ location.v -= yOffset;
+ GetPortBounds ( GetWindowPort(whichWindow), &portRect );
+ TkGenWMConfigureEvent(tkwin, location.h, location.v,
+ portRect.right - portRect.left,
+ portRect.bottom - portRect.top,
+ TK_BOTH_CHANGED);
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnsupported1Cmd --
+ *
+ * This procedure is invoked to process the
+ * "::tk::unsupported::MacWindowStyle" 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. */
+ CONST char **argv) /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr;
+ WmInfo *wmPtr;
+ int c;
+ size_t length;
+
+ if (argc < 3) {
+ 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 > 5)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " style window ?windowStyle?\"",
+ " or \"", argv[0], "style window ?class attributes?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (argc == 3) {
+ int appearanceSpec = 0;
+
+ switch (wmPtr->style) {
+ case -1:
+ appearanceSpec = 1;
+ break;
+ case noGrowDocProc:
+ case documentProc:
+ Tcl_SetResult(interp, "documentProc", TCL_STATIC);
+ break;
+ case dBoxProc:
+ Tcl_SetResult(interp, "dBoxProc", TCL_STATIC);
+ break;
+ case plainDBox:
+ Tcl_SetResult(interp, "plainDBox", TCL_STATIC);
+ break;
+ case altDBoxProc:
+ Tcl_SetResult(interp, "altDBoxProc", TCL_STATIC);
+ break;
+ case movableDBoxProc:
+ Tcl_SetResult(interp, "movableDBoxProc", TCL_STATIC);
+ break;
+ case zoomDocProc:
+ case zoomNoGrow:
+ Tcl_SetResult(interp, "zoomDocProc", TCL_STATIC);
+ break;
+ /* Not supported in Carbon
+ case rDocProc:
+ Tcl_SetResult(interp, "rDocProc", TCL_STATIC);
+ break;
+ */
+ case floatProc:
+ case floatGrowProc:
+ Tcl_SetResult(interp, "floatProc", TCL_STATIC);
+ break;
+ case floatZoomProc:
+ case floatZoomGrowProc:
+ Tcl_SetResult(interp, "floatZoomProc", TCL_STATIC);
+ break;
+ case floatSideProc:
+ case floatSideGrowProc:
+ Tcl_SetResult(interp, "floatSideProc", TCL_STATIC);
+ break;
+ case floatSideZoomProc:
+ case floatSideZoomGrowProc:
+ Tcl_SetResult(interp, "floatSideZoomProc", TCL_STATIC);
+ break;
+ default:
+ panic("invalid style");
+ }
+ if (appearanceSpec) {
+ Tcl_Obj *attributeList, *newResult = NULL;
+
+ switch (wmPtr->macClass) {
+ case kAlertWindowClass:
+ newResult = Tcl_NewStringObj("alert", -1);
+ break;
+ case kMovableAlertWindowClass:
+ newResult = Tcl_NewStringObj("moveableAlert", -1);
+ break;
+ case kModalWindowClass:
+ newResult = Tcl_NewStringObj("modal", -1);
+ break;
+ case kMovableModalWindowClass:
+ newResult = Tcl_NewStringObj("moveableModal", -1);
+ break;
+ case kFloatingWindowClass:
+ newResult = Tcl_NewStringObj("floating", -1);
+ break;
+ case kDocumentWindowClass:
+ newResult = Tcl_NewStringObj("document", -1);
+ break;
+ case kHelpWindowClass:
+ newResult = Tcl_NewStringObj("help", -1);
+ break;
+ case kToolbarWindowClass:
+ newResult = Tcl_NewStringObj("toolbar", -1);
+ break;
+ default:
+ panic("invalid class");
+ }
+
+ attributeList = Tcl_NewListObj(0, NULL);
+ if (wmPtr->attributes == kWindowNoAttributes) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("none", -1));
+ } else if (wmPtr->attributes == kWindowStandardDocumentAttributes) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("standardDocument", -1));
+ } else if (wmPtr->attributes == kWindowStandardFloatingAttributes) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("standardFloating", -1));
+ } else {
+ if (wmPtr->attributes & kWindowCloseBoxAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("closeBox", -1));
+ }
+ if (wmPtr->attributes & kWindowHorizontalZoomAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("horizontalZoom", -1));
+ }
+ if (wmPtr->attributes & kWindowVerticalZoomAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("verticalZoom", -1));
+ }
+ if (wmPtr->attributes & kWindowCollapseBoxAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("collapseBox", -1));
+ }
+ if (wmPtr->attributes & kWindowResizableAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("resizable", -1));
+ }
+ if (wmPtr->attributes & kWindowSideTitlebarAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("sideTitlebar", -1));
+ }
+ if (wmPtr->attributes & kWindowNoUpdatesAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("noUpdates", -1));
+ }
+ if (wmPtr->attributes & kWindowNoActivatesAttribute) {
+ Tcl_ListObjAppendElement(interp, attributeList,
+ Tcl_NewStringObj("noActivates", -1));
+ }
+ }
+ Tcl_ListObjAppendElement(interp, newResult, attributeList);
+ Tcl_SetObjResult(interp, newResult);
+ }
+ return TCL_OK;
+ } else if (argc == 4) {
+ 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 if (argc == 5) {
+ int oldClass = wmPtr->macClass;
+ int oldAttributes = wmPtr->attributes;
+
+ if (strcmp(argv[3], "alert") == 0) {
+ wmPtr->macClass = kAlertWindowClass;
+ } else if (strcmp(argv[3], "moveableAlert") == 0) {
+ wmPtr->macClass = kMovableAlertWindowClass;
+ } else if (strcmp(argv[3], "modal") == 0) {
+ wmPtr->macClass = kModalWindowClass;
+ } else if (strcmp(argv[3], "moveableModal") == 0) {
+ wmPtr->macClass = kMovableModalWindowClass;
+ } else if (strcmp(argv[3], "floating") == 0) {
+ wmPtr->macClass = kFloatingWindowClass;
+ } else if (strcmp(argv[3], "document") == 0) {
+ wmPtr->macClass = kDocumentWindowClass;
+ } else if (strcmp(argv[3], "help") == 0) {
+ wmPtr->macClass = kHelpWindowClass;
+ } else if (strcmp(argv[3], "toolbar") == 0) {
+ wmPtr->macClass = kToolbarWindowClass;
+ } else {
+ wmPtr->macClass = oldClass;
+ Tcl_AppendResult(interp, "bad class: should be alert, ",
+ "moveableAlert, modal, moveableModal, floating, ",
+ "help, or document",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[4], "none") == 0) {
+ wmPtr->attributes = kWindowNoAttributes;
+ } else if (strcmp(argv[4], "standardDocument") == 0) {
+ wmPtr->attributes = kWindowStandardDocumentAttributes;
+ } else if (strcmp(argv[4], "standardFloating") == 0) {
+ wmPtr->attributes = kWindowStandardFloatingAttributes;
+ } else {
+ int foundOne = 0;
+ int attrArgc, i;
+ CONST char **attrArgv = NULL;
+
+ if (Tcl_SplitList(interp, argv[4], &attrArgc, &attrArgv) != TCL_OK) {
+ wmPtr->macClass = oldClass;
+ Tcl_AppendResult(interp, "Ill-formed attributes list: \"",
+ argv[4], "\".", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ wmPtr->attributes = kWindowNoAttributes;
+
+ for (i = 0; i < attrArgc; i++) {
+ if ((*attrArgv[i] == 'c')
+ && (strcmp(attrArgv[i], "closeBox") == 0)) {
+ wmPtr->attributes |= kWindowCloseBoxAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'h')
+ && (strcmp(attrArgv[i], "horizontalZoom") == 0)) {
+ wmPtr->attributes |= kWindowHorizontalZoomAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'v')
+ && (strcmp(attrArgv[i], "verticalZoom") == 0)) {
+ wmPtr->attributes |= kWindowVerticalZoomAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'c')
+ && (strcmp(attrArgv[i], "collapseBox") == 0)) {
+ wmPtr->attributes |= kWindowCollapseBoxAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'r')
+ && (strcmp(attrArgv[i], "resizable") == 0)) {
+ wmPtr->attributes |= kWindowResizableAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 's')
+ && (strcmp(attrArgv[i], "sideTitlebar") == 0)) {
+ wmPtr->attributes |= kWindowSideTitlebarAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'n')
+ && (strcmp(attrArgv[i], "noActivates") == 0)) {
+ wmPtr->attributes |= kWindowNoActivatesAttribute;
+ foundOne = 1;
+ } else if ((*attrArgv[i] == 'n')
+ && (strcmp(attrArgv[i], "noUpdates") == 0)) {
+ wmPtr->attributes |= kWindowNoUpdatesAttribute;
+ foundOne = 1;
+ } else {
+ foundOne = 0;
+ break;
+ }
+ }
+
+ if (attrArgv != NULL) {
+ ckfree ((char *) attrArgv);
+ }
+
+ if (foundOne != 1) {
+ wmPtr->macClass = oldClass;
+ wmPtr->attributes = oldAttributes;
+
+ Tcl_AppendResult(interp, "bad attribute: \"", argv[4],
+ "\", should be standardDocument, ",
+ "standardFloating, or some combination of ",
+ "closeBox, horizontalZoom, verticalZoom, ",
+ "collapseBox, resizable, or sideTitlebar.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ wmPtr->style = -1;
+ }
+ } 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXMakeRealWindowExist --
+ *
+ * This function finally creates the real Macintosh window that
+ * the Mac actually understands.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new Macintosh toplevel is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXMakeRealWindowExist(
+ TkWindow *winPtr) /* Tk window. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ WindowRef newWindow = NULL;
+ ControlRef rootControl = NULL;
+ MacDrawable *macWin;
+ Rect geometry = {0,0,0,0};
+ Tcl_HashEntry *valueHashPtr;
+ int new;
+ TkMacOSXWindowList *listPtr;
+
+ if (TkMacOSXHostToplevelExists(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) {
+ TkMacOSXMakeRealWindowExist(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("TkMacOSXMakeRealWindowExist could not find container");
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ }
+
+ InitialWindowBounds(winPtr, &geometry);
+
+ if (wmPtr->style == -1) {
+ OSStatus err;
+ /*
+ * There seems to be a bug in CreateNewWindow: If I set the
+ * window geometry to be the too small for the structure region,
+ * then the whole window is positioned incorrectly.
+ * Adding this here makes the positioning work, and the size will
+ * get overwritten when you actually map the contents of the window.
+ */
+
+ geometry.right += 64;
+ geometry.bottom += 24;
+ err = CreateNewWindow(wmPtr->macClass, wmPtr->attributes,
+ &geometry, &newWindow);
+ if (err != noErr) {
+ newWindow = NULL;
+ }
+
+ } else {
+ newWindow = NewCWindow(NULL, &geometry, "\ptemp", false,
+ (short) wmPtr->style, (WindowRef) -1, true, 0);
+ }
+
+ if (newWindow == NULL) {
+ panic("couldn't allocate new Mac window");
+ }
+ if (CreateRootControl(newWindow,&rootControl) != noErr ) {
+ panic("couldn't create root control for new Mac window");
+ }
+
+ /*
+ * Add this window to the list of toplevel windows.
+ */
+
+ listPtr = (TkMacOSXWindowList *) ckalloc(sizeof(TkMacOSXWindowList));
+ listPtr->nextPtr = tkMacOSXWindowListPtr;
+ listPtr->winPtr = winPtr;
+ tkMacOSXWindowListPtr = listPtr;
+
+ macWin->grafPtr = GetWindowPort ( newWindow );
+ macWin->rootControl = rootControl;
+ MoveWindowStructure(newWindow, geometry.left, geometry.top);
+ SetPort(GetWindowPort(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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXRegisterOffScreenWindow --
+ *
+ * This function adds the passed in Off Screen Port to the
+ * hash table that maps Mac windows to root X windows.
+ *
+ * FIXME: This is not currently used. Is there any reason
+ * to keep it?
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An entry is added to the windowTable hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacOSXRegisterOffScreenWindow(
+ Window window, /* Window structure. */
+ GWorldPtr portPtr) /* Pointer to a Mac GWorld. */
+{
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXUnregisterMacWindow --
+ *
+ * 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
+TkMacOSXUnregisterMacWindow(
+ WindowRef macWinPtr) /* Reference to a Mac Window */
+{
+ Tcl_HashEntry *entryPtr;
+ if (!windowHashInit) {
+ panic("TkMacOSXUnregisterMacWindow: unmapping before inited");
+ }
+ entryPtr=Tcl_FindHashEntry(&windowTable,(char *) macWinPtr);
+ if (!entryPtr) {
+ fprintf(stderr,"Unregister:failed to find window %08x\n",
+ (int) macWinPtr );
+ }
+ else {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXSetScrollbarGrow --
+ *
+ * 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
+TkMacOSXSetScrollbarGrow(
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ WindowRef macWin;
+
+ wmPtr->hints.initial_state = state;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return;
+ }
+
+ macWin = GetWindowFromPort(TkMacOSXGetDrawablePort (winPtr->window));
+
+ if (state == WithdrawnState) {
+ Tk_UnmapWindow((Tk_Window) winPtr);
+ } else if (state == IconicState) {
+ Tk_UnmapWindow((Tk_Window) winPtr);
+ /*
+ * 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(macWin)) {
+ ShowWindow(macWin);
+ CollapseWindow( macWin, true);
+ }
+
+ } else if (state == NormalState) {
+ Tk_MapWindow((Tk_Window) winPtr);
+ CollapseWindow((WindowPtr) macWin, false);
+ } else if (state == ZoomState) {
+ /* TODO: need to support zoomed windows */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpIsWindowFloating --
+ *
+ * Returns 1 if a window is floating, 0 otherwise.
+ *
+ * Results:
+ * 1 or 0 depending on window's floating attribute.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpIsWindowFloating(WindowRef wRef)
+{
+ WindowClass class;
+ GetWindowClass(wRef, &class);
+ return (class == kFloatingWindowClass);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXWindowOffset --
+ *
+ * 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
+TkMacOSXWindowOffset(
+ WindowRef wRef,
+ int *xOffset,
+ int *yOffset)
+{
+ OSErr err = noErr;
+ static RgnHandle strucRgn = NULL;
+ static RgnHandle contRgn = NULL;
+ Rect strucRect, contRect;
+
+ if (!strucRgn) {
+ if(!(strucRgn = NewRgn())) {
+ err=MemError();
+ }
+ }
+ if (!contRgn) {
+ if(!(contRgn = NewRgn())) {
+ err=MemError();
+ }
+ }
+ if (err==noErr) {
+ GetWindowRegion(wRef, kWindowStructureRgn, strucRgn);
+ GetWindowRegion(wRef, kWindowContentRgn, contRgn);
+ GetRegionBounds(strucRgn,&strucRect);
+ GetRegionBounds(contRgn,&contRect);
+ *xOffset = contRect.left - strucRect.left;
+ *yOffset = contRect.top - strucRect.top;
+ } else {
+ *xOffset = 0;
+ *yOffset = 0;
+ }
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevelWrapperMap --
+ *
+ * This procedure will create a table that maps the reparent wrapper
+ * X id for a toplevel to the TkWindow structure that is wraps.
+ * Tk keeps track of a mapping from the window X id to the TkWindow
+ * structure but that does us no good here since we only get the X
+ * id of the wrapper window. Only those toplevel windows that are
+ * mapped have a position in the stacking order.
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds entries to the passed hashtable.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TkWmStackorderToplevelWrapperMap(winPtr, table)
+ TkWindow *winPtr; /* TkWindow to recurse on */
+ Tcl_HashTable *table; /* Maps mac window to TkWindow */
+{
+ TkWindow *childPtr;
+ Tcl_HashEntry *hPtr;
+ void *wrapper;
+ int newEntry;
+
+ if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr)) {
+ wrapper = (void *) TkMacOSXGetDrawablePort(winPtr->window);
+
+ hPtr = Tcl_CreateHashEntry(table,
+ (char *) wrapper, &newEntry);
+ Tcl_SetHashValue(hPtr, winPtr);
+ }
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ TkWmStackorderToplevelWrapperMap(childPtr, table);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevel --
+ *
+ * This procedure returns the stack order of toplevel windows.
+ *
+ * Results:
+ * An array of pointers to tk window objects in stacking order
+ * or else NULL if there was an error.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow **
+TkWmStackorderToplevel(parentPtr)
+ TkWindow *parentPtr; /* Parent toplevel window. */
+{
+ WindowRef frontWindow;
+ TkWindow *childWinPtr, **windows, **window_ptr;
+ Tcl_HashTable table;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Map mac windows to a TkWindow of the wrapped toplevel.
+ */
+
+ Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS);
+ TkWmStackorderToplevelWrapperMap(parentPtr, &table);
+
+ windows = (TkWindow **) ckalloc((table.numEntries+1)
+ * sizeof(TkWindow *));
+
+ /*
+ * Special cases: If zero or one toplevels were mapped
+ * there is no need to enumerate Windows.
+ */
+
+ switch (table.numEntries) {
+ case 0:
+ windows[0] = NULL;
+ goto done;
+ case 1:
+ hPtr = Tcl_FirstHashEntry(&table, &search);
+ windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr);
+ windows[1] = NULL;
+ goto done;
+ }
+
+ frontWindow = (WindowRef) FrontWindow();
+
+ if (frontWindow == NULL) {
+ ckfree((char *) windows);
+ windows = NULL;
+ } else {
+ window_ptr = windows + table.numEntries;
+ *window_ptr-- = NULL;
+ while (frontWindow != NULL) {
+ hPtr = Tcl_FindHashEntry(&table, (char *) frontWindow);
+ if (hPtr != NULL) {
+ childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr);
+ *window_ptr-- = childWinPtr;
+ }
+ frontWindow = GetNextWindow(frontWindow);
+ }
+ if (window_ptr != (windows-1))
+ panic("num matched toplevel windows does not equal num children");
+ }
+
+ done:
+ Tcl_DeleteHashTable(&table);
+ return windows;
+}
+
+
+
+
+
diff --git a/tcl/macosx/tkMacOSXWm.h b/tcl/macosx/tkMacOSXWm.h
new file mode 100644
index 00000000000..eaa0dd52ef6
--- /dev/null
+++ b/tcl/macosx/tkMacOSXWm.h
@@ -0,0 +1,302 @@
+/*
+/*
+ * tkMacOSXWm.h --
+ *
+ * Declarations of Macintosh specific functions for implementing the
+ * Mac OS X Notifier.
+ *
+ * Copyright 2001, Apple Computer, Inc.
+ *
+ * The following terms apply to all files originating from Apple
+ * Computer, Inc. ("Apple") and associated with the software
+ * unless explicitly disclaimed in individual files.
+ *
+ *
+ * Apple hereby grants 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 APPLE, THE AUTHORS OR DISTRIBUTORS OF THE
+ * SOFTWARE 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 APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE. APPLE, 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 APPLE,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.
+ */
+
+#ifndef _TKMACWM
+#define _TKMACWM
+
+#include <Carbon/Carbon.h>
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkMacOSXInt.h"
+#include <errno.h>
+#include "tkScrollbar.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. */
+ char *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. */
+ CONST 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. */
+ int macClass;
+ int attributes;
+ 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
+
+#endif
+
diff --git a/tcl/macosx/tkMacOSXXCursors.r b/tcl/macosx/tkMacOSXXCursors.r
new file mode 100644
index 00000000000..f2902bbde2c
--- /dev/null
+++ b/tcl/macosx/tkMacOSXXCursors.r
@@ -0,0 +1,961 @@
+/*
+ * tkMacOSXXCursors.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/tcl/macosx/tkMacOSXXStubs.c b/tcl/macosx/tkMacOSXXStubs.c
new file mode 100644
index 00000000000..397929bc498
--- /dev/null
+++ b/tcl/macosx/tkMacOSXXStubs.c
@@ -0,0 +1,862 @@
+/*
+ * tkMacOSXXStubs.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.
+ * Copyright 2001, Apple Computer, 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 <X11/X.h>
+#include <X11/Xlib.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include <sys/types.h>
+
+#include <X11/Xatom.h>
+
+#include <Carbon/Carbon.h>
+#include "tkMacOSXInt.h"
+#include "tkPort.h"
+#include "tkMacOSXEvent.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 declarations
+ */
+
+int TkMacOSXXDestroyImage _ANSI_ARGS_((XImage *image));
+unsigned long TkMacOSXXGetPixel _ANSI_ARGS_((XImage *image, int x, int y));
+int TkMacOSXXPutPixel _ANSI_ARGS_((XImage *image, int x, int y,
+ unsigned long pixel));
+XImage *TkMacOSXXSubImage _ANSI_ARGS_((XImage *image, int x, int y,
+ unsigned int width, unsigned int height));
+int TkMacOSXXAddPixel _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(
+ CONST char *display_name)
+{
+ Display *display;
+ Screen *screen;
+ GDHandle graphicsDevice;
+ int fd = 0;
+ if (gMacDisplay != NULL) {
+ if (strcmp(gMacDisplay->display->display_name, display_name) == 0) {
+ return gMacDisplay;
+ } else {
+ return NULL;
+ }
+ }
+ InitCursor();
+
+ 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;
+ display->fd = fd;
+
+ 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));
+
+ /*
+ * This is the quickest way to make sure that all the *Init
+ * flags get properly initialized
+ */
+
+ bzero (gMacDisplay, 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ XImage * imagePtr;
+ Visual * visual = NULL;
+ int depth = 0;
+ int offset = 0;
+ char * data = NULL;
+ int bitmap_pad = 0;
+ int bytes_per_line = 0;
+ CGrafPtr grafPtr;
+
+ imagePtr = XCreateImage(display,visual,depth,format, offset, data,
+ width, height, bitmap_pad, bytes_per_line );
+ grafPtr = TkMacOSXGetDrawablePort(d);
+ imagePtr->data = (char *) grafPtr;
+ return imagePtr;
+}
+
+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 = TkMacOSXXDestroyImage;
+ ximage->f.get_pixel = TkMacOSXXGetPixel;
+ ximage->f.put_pixel = TkMacOSXXPutPixel;
+ ximage->f.sub_image = TkMacOSXXSubImage;
+ ximage->f.add_pixel = TkMacOSXXAddPixel;
+
+ 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;
+}
+
+void
+XClearWindow(
+ Display* display,
+ Window w)
+{
+}
+
+/*
+void
+XDrawPoint(
+ Display* display,
+ Drawable d,
+ GC gc,
+ int x,
+ int y)
+{
+}
+
+void
+XDrawPoints(
+ Display* display,
+ Drawable d,
+ GC gc,
+ XPoint* points,
+ int npoints,
+ int mode)
+{
+}
+*/
+
+void
+XWarpPointer(
+ 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)
+{
+}
+
+void
+XQueryColor(
+ Display* display,
+ Colormap colormap,
+ XColor* def_in_out)
+{
+}
+
+void
+XQueryColors(
+ 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;
+}
+
+
+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( XMappingEvent* x)
+{
+ /* 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++;
+}
+
+void
+Tk_FreeXId (
+ Display *display,
+ XID xid)
+{
+ /* no-op function needed for stubs implementation. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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[8 + TCL_INTEGER_SPACE * 2];
+ char buffer2[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
+ ProtocolRevision(Tk_Display(tkwin)));
+ sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
+ Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
+ buffer2, (char *) NULL);
+}
+/*
+ * Image stuff
+ */
+
+int
+TkMacOSXXDestroyImage(
+ XImage *image)
+{
+ Debugger();
+ return 0;
+}
+
+unsigned long
+TkMacOSXXGetPixel(
+ XImage *image,
+ int x,
+ int y)
+{
+ CGrafPtr grafPtr;
+ RGBColor cPix;
+ unsigned long r, g, b, c;
+ grafPtr = (CGrafPtr)image->data;
+ SetPort(grafPtr);
+ GetCPixel(x,y,&cPix);
+ r = cPix . red;
+ g = cPix . green;
+ b = cPix . blue;
+ c = (r<<16)|(g<<8)|(b);
+ return c;
+}
+
+int
+TkMacOSXXPutPixel(
+ XImage *image,
+ int x,
+ int y,
+ unsigned long pixel)
+{
+ CGrafPtr grafPtr;
+ RGBColor cPix;
+ unsigned long r, g, b;
+ grafPtr = (CGrafPtr)image->data;
+ SetPort(grafPtr);
+ r = (pixel & image->red_mask)>>16;
+ g = (pixel & image->green_mask)>>8;
+ b = (pixel & image->blue_mask);
+ cPix . red = r;
+ cPix . green = g;
+ cPix . blue = b;
+ SetCPixel(x,y,&cPix);
+ return 0;
+}
+
+XImage *
+TkMacOSXXSubImage(
+ XImage *image,
+ int x,
+ int y,
+ unsigned int width,
+ unsigned int height)
+{
+ Debugger();
+ return NULL;
+}
+
+int
+TkMacOSXXAddPixel(
+ 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();
+}
+
+Status
+XStringListToTextProperty(
+ char** list,
+ int count,
+ XTextProperty* text_prop_return)
+{
+ Debugger();
+ return (Status) 0;
+}
+void
+XSetWMClientMachine(
+ Display* display,
+ Window w,
+ XTextProperty* text_prop)
+{
+ Debugger();
+}
+XIC
+XCreateIC(
+ void)
+{
+ Debugger();
+ return (XIC) 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDefaultScreenName --
+ *
+ * Returns the name of the screen that Tk should use during
+ * initialization.
+ *
+ * Results:
+ * Returns a statically allocated string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+TkGetDefaultScreenName(
+ Tcl_Interp *interp, /* Not used. */
+ CONST char *screenName) /* If NULL, use default string. */
+{
+#if 0
+ if ((screenName == NULL) || (screenName[0] == '\0')) {
+ screenName = macScreenName;
+ }
+ return screenName;
+#endif
+ return macScreenName;
+}
diff --git a/tcl/tests/README b/tcl/tests/README
index 4c88826f9ee..66a428ec6b6 100644
--- a/tcl/tests/README
+++ b/tcl/tests/README
@@ -1,90 +1,7 @@
-README -- Tcl test suite design document.
+README -- Tk test suite design document.
RCS: @(#) $Id$
-Contents:
----------
-
- 1. Introduction
- 2. Incompatibilities with prior Tcl versions
-
-1. Introduction:
-----------------
-
-This directory contains a set of validation tests for the Tcl commands
-and C Library procedures for Tcl. Each of the files whose name ends
-in ".test" is intended to fully exercise the functions in the C source
-file that corresponds to the file prefix. The C functions and/or Tcl
-commands tested by a given file are listed in the first line of the
-file.
-
-You can run the tests in three ways:
-
- (a) type "make test" in ../unix; this will create the tcltest
- executable and run all of the tests. At least "make tcltest"
- must be run to create the tcltest executable for the other
- options.
-
- (b) type "tcltest <testFile> ?<option> <value>?
-
- where the options and values are the configuration options
- of the tcltest package.
-
- (c) start up tcltest in this directory, then "source" the test
- file (for example, type "source parse.test"). To run all
- of the tests, type "source all.tcl". To use the options in
- interactive mode, you can set them with the tcltest::configure
- command. Set constraints with the tcltest::testConstraints
- command.
-
-Please see the tcltest man page for more information regarding how to
-write and run tests.
-
-Please note that the all.tcl file will source your new test file if
-the filename matches the tests/*.test pattern (as it should). The
-names of test files that contain regression (or glass-box) tests
-should correspond to the Tcl or C code file that they are testing.
-For example, the test file for the C file "tclCmdAH.c" is
-"cmdAH.test". Test files that contain black-box tests may not
-correspond to any Tcl or C code file so they should match the pattern
-"*_bb.test".
-
-Be sure your new test file can be run from any working directory.
-
-Be sure no temporary files are left behind by your test file.
-Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests]
-properly to be sure of this.
-
-Be sure your tests can run cross-platform in both a build environment
-as well as an installation environment. If your test file contains
-tests that should not be run in one or more of those cases, please use
-the constraints mechanism to skip those tests.
-
-2. Incompatibilities of package tcltest 2.1 with
- testing machinery of very old versions of Tcl:
-------------------------------------------------
-
-1) Global variables such as VERBOSE, TESTS, and testConfig of the
- old machinery correspond to the [configure -verbose],
- [configure -match], and [testConstraint] commands of tcltest 2.1,
- respectively.
-
-2) VERBOSE values were longer numeric. [configure -verbose] values
- are lists of keywords.
-
-3) When you run "make test", the working dir for the test suite is now
- the one from which you called "make test", rather than the "tests"
- directory. This change allows for both unix and windows test
- suites to be run simultaneously without interference with each
- other or with existing files. All tests must now run independently
- of their working directory.
-
-4) The "all" file is now called "all.tcl"
-
-5) The "defs" and "defs.tcl" files no longer exist.
-
-6) Instead of creating a doAllTests file in the tests directory, to
- run all nonPortable tests, just use the "-constraints nonPortable"
- command line flag. If you are running interactively, you can run
- [tcltest::testConstraint nonPortable 1] (after loading the tcltest
- package).
+This directory contains a set of validation tests for the Tk commands.
+Please see the tests/README file in the Tcl source distribution for
+information about the test suite.
diff --git a/tcl/tests/all.tcl b/tcl/tests/all.tcl
index 80c7d6886c0..fbf8cde9452 100644
--- a/tcl/tests/all.tcl
+++ b/tcl/tests/all.tcl
@@ -1,25 +1,19 @@
# all.tcl --
#
-# This file contains a top-level script to run all of the Tcl
-# tests. Execute it by invoking "source all.test" when running tcltest
+# This file contains a top-level script to run all of the Tk
+# tests. Execute it by invoking "source all.tcl" when running tktest
# in this directory.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2000 by Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-set tcltestVersion [package require tcltest]
-namespace import -force tcltest::*
-
-if {$tcl_platform(platform) == "macintosh"} {
- tcltest::singleProcess 1
-}
-
-tcltest::testsDirectory [file dir [info script]]
+package require Tcl 8.4
+package require tcltest 2.1
+tcltest::configure -testdir [file join [pwd] [file dirname [info script]]]
+tcltest::configure -singleproc 1
+eval tcltest::configure $argv
tcltest::runAllTests
-
-return
diff --git a/tcl/tests/arc.tcl b/tcl/tests/arc.tcl
new file mode 100644
index 00000000000..6f754639270
--- /dev/null
+++ b/tcl/tests/arc.tcl
@@ -0,0 +1,153 @@
+# 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/tcl/tests/bell.test b/tcl/tests/bell.test
new file mode 100644
index 00000000000..e1ab217d37c
--- /dev/null
+++ b/tcl/tests/bell.test
@@ -0,0 +1,64 @@
+# This file is a Tcl script to test out Tk's "bell" command.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test bell-1.1 {bell command} {
+ list [catch {bell a} msg] $msg
+} {1 {bad option "a": must be -displayof or -nice}}
+test bell-1.2 {bell command} {
+ list [catch {bell a b} msg] $msg
+} {1 {bad option "a": must be -displayof or -nice}}
+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} {
+ list [catch {bell -nice -displayof} msg] $msg
+} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}}
+test bell-1.5 {bell command} {
+ list [catch {bell -nice -nice -nice} msg] $msg
+} {0 {}}
+test bell-1.6 {bell command} {
+ list [catch {bell -displayof . -nice} msg] $msg
+} {0 {}}
+test bell-1.7 {bell command} {
+ list [catch {bell -nice -displayof . -nice} msg] $msg
+} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}}
+test bell-1.8 {bell command} {
+ puts "Bell should ring now ..."
+ flush stdout
+ after 200
+ bell -displayof .
+ after 200
+ bell -nice
+ after 200
+ bell
+} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/bevel.tcl b/tcl/tests/bevel.tcl
new file mode 100644
index 00000000000..9a55f966cbc
--- /dev/null
+++ b/tcl/tests/bevel.tcl
@@ -0,0 +1,141 @@
+# 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/tcl/tests/bgerror.test b/tcl/tests/bgerror.test
new file mode 100644
index 00000000000..9566282fe05
--- /dev/null
+++ b/tcl/tests/bgerror.test
@@ -0,0 +1,76 @@
+# This file is a Tcl script to test the bgerror command.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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.
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/bind.test b/tcl/tests/bind.test
new file mode 100644
index 00000000000..536188c0a6d
--- /dev/null
+++ b/tcl/tests/bind.test
@@ -0,0 +1,2681 @@
+# This file is a Tcl script to test out Tk's "bind" and "bindtags"
+# commands plus the procedures in tkBind.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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 ?taglist?"}}
+test bind-2.2 {bindtags command} {
+ list [catch {bindtags a b c} msg] $msg
+} {1 {wrong # args: should be "bindtags window ?taglist?"}}
+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
+} {}
+
+testConstraint testcbind [llength [info commands testcbind]]
+
+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} testcbind {
+ 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: bad binding} {
+ catch {destroy .b.c}
+ canvas .b.c
+ list [catch {.b.c bind foo <} msg] $msg
+} {1 {no event type or button # or keysym}}
+test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} testcbind {
+ 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} testcbind {
+ list [catch {testcbind . <xyz> "xyz"} msg] $msg
+} {1 {bad event type or keysym "xyz"}}
+test bind-8.2 {TkCreateBindingProcedure: new binding} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ 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} testcbind {
+ setup
+ bind .b.f <1> x
+ testcbind .b.f <2> y
+ destroy .b.f
+} {}
+test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} testcbind {
+ 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} testcbind {
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 31 -y 39
+ event gen .b.f <ButtonRelease-1>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 29 -y 41
+ event gen .b.f <ButtonRelease-1>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 40 -y 40
+ event gen .b.f <ButtonRelease-2>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 20 -y 40
+ event gen .b.f <ButtonRelease-1>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 30 -y 30
+ event gen .b.f <ButtonRelease-1>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 30 -y 50
+ event gen .b.f <ButtonRelease-1>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -time 300
+ event gen .b.f <Button-1> -time 700
+ event gen .b.f <ButtonRelease-1>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Button-1> -time 300
+ event gen .b.f <Button-1> -time 900
+ event gen .b.f <ButtonRelease-1>
+ 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
+ event gen .b.f <ButtonRelease-1>
+ 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
+ event gen .b.f <ButtonRelease-1>
+ 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>
+ event gen .b.f <ButtonRelease-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>
+ event gen .b.f <ButtonRelease-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
+ event gen .b.f <ButtonRelease-1>
+ 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
+ event gen .b.f <ButtonRelease-1>
+ 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>
+ event gen .b.f <ButtonRelease-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>
+ event gen .b.f <ButtonRelease-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>
+ event gen .b.f <ButtonRelease-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 1402
+ event gen .b.f <ButtonRelease-1>
+ set x
+} 1402
+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
+ event gen .b.f <ButtonRelease>
+ 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
+ event gen .b.f <ButtonRelease>
+ 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
+ event gen .b.f <Key-Multi_key>
+ event gen .b.f <Key-e>
+ event gen .b.f <Key-apostrophe>
+ set x
+} "a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9"
+test bind-16.36 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Configure> {set x "%B"}
+ set x none
+ event gen .b.f <Configure> -borderwidth 24 -window .b.f
+ set x
+} 24
+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
+ event gen .b.f <ButtonRelease>
+ set x
+} {422 13}
+
+
+test bind-17.1 {event command} {
+ list [catch {event} msg] $msg
+} {1 {wrong # args: should be "event option ?arg?"}}
+test bind-17.2 {event command} {
+ list [catch {event xyz} msg] $msg
+} {1 {bad option "xyz": must be add, delete, generate, or info}}
+test bind-17.3 {event command: add} {
+ list [catch {event add} msg] $msg
+} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}}
+test bind-17.4 {event command: add 1} {
+ setup
+ event add <<Paste>> <Control-v>
+ event info <<Paste>>
+} {<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": must be add, delete, generate, or info}}
+
+test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
+ list [catch {event add asd <Ctrl-v>} msg] $msg
+} {1 {virtual event "asd" is badly formed}}
+test bind-18.2 {CreateVirtualEvent procedure: FindSequence} {
+ list [catch {event add <<asd>> <Ctrl-v>} msg] $msg
+} {1 {bad event type or keysym "Ctrl"}}
+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 gen .b.f <ButtonRelease-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2> -serial 102
+ event gen .b.f <ButtonRelease-2>
+ 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 <ButtonRelease-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Control-ButtonRelease-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Control-ButtonRelease-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 <ButtonRelease-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Control-ButtonRelease-2>
+ event gen .b.f <Shift-Button-2>
+ event gen .b.f <Shift-ButtonRelease-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Shift-Button-2>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.f <Control-ButtonRelease-2>
+ event gen .b.f <Shift-ButtonRelease-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 <ButtonRelease-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Control-ButtonRelease-2>
+ event gen .b.f <Shift-Button-2>
+ event gen .b.f <Shift-ButtonRelease-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Control-ButtonRelease-2>
+ event gen .b.f <Shift-Button-2>
+ event gen .b.f <Shift-ButtonRelease-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.f <ButtonRelease-2>
+ event gen .b.g <Button-2>
+ event gen .b.g <ButtonRelease-2>
+ event gen .b.h <Button-2>
+ event gen .b.h <ButtonRelease-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.g <Button-2>
+ event gen .b.g <ButtonRelease-2>
+ event gen .b.h <Button-2>
+ event gen .b.h <ButtonRelease-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.f <ButtonRelease-2>
+ event gen .b.g <Button-2>
+ event gen .b.g <ButtonRelease-2>
+ event gen .b.h <Button-2>
+ event gen .b.h <ButtonRelease-2>
+ event delete <<abc>>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.g <Button-2>
+ event gen .b.g <ButtonRelease-2>
+ event gen .b.h <Button-2>
+ event gen .b.h <ButtonRelease-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.f <ButtonRelease-2>
+ event gen .b.g <Button-2>
+ event gen .b.g <ButtonRelease-2>
+ event gen .b.h <Button-2>
+ event gen .b.h <ButtonRelease-2>
+ event delete <<def>>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.g <Button-2>
+ event gen .b.g <ButtonRelease-2>
+ event gen .b.h <Button-2>
+ event gen .b.h <ButtonRelease-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 {bad window name/identifier "47"}}
+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> -state 260
+ set x
+} {260 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 <ButtonRelease-1>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.f <ButtonRelease-3>
+ event gen .b.f <Control-Button-1>
+ event gen .b.f <Control-ButtonRelease-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
+ event gen .b.f <ButtonRelease> -when now
+ 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
+ event gen .b.f <ButtonRelease> -when tail
+ 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
+ event gen .b.f <ButtonRelease> -when tail
+ 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
+ event gen .b.f <ButtonRelease> -when tail
+ lappend x foo
+ update
+ set x
+} {foo 99 100 101 102}
+test bind-22.17 {HandleEventGenerate} {
+ list [catch {event gen . <Button> -when xyz} msg] $msg
+} {1 {bad -when value "xyz": must be now, head, mark, or tail}}
+test bind-22.18 {HandleEventGenerate} {
+ # Bug 411307
+ list [catch {event gen . <a> -root 98765} msg] $msg
+} {1 {bad window name/identifier "98765"}}
+set i 19
+foreach check {
+ {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
+ {<Configure> %a {-above .b} {[winfo id .b]}}
+ {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
+ {<Key> %b {-above .} {{1 {<Key> event doesn't accept "-above" option}}}}
+
+ {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}
+ {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
+ {<Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}}
+
+ {<Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}}
+ {<Button> %b {-button 1} 1}
+ {<ButtonRelease> %b {-button 1} 1}
+ {<Key> %k {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}}
+
+ {<Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}}
+ {<Expose> %c {-count 20} 20}
+ {<Key> %b {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}}
+
+ {<Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}}
+ {<FocusIn> %d {-detail NotifyVirtual} {{}}}
+ {<Enter> %d {-detail NotifyVirtual} NotifyVirtual}
+ {<Key> %k {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}}
+
+ {<Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
+ {<Enter> %f {-focus 1} 1}
+ {<Key> %k {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}}
+
+ {<Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}}
+ {<Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}}
+ {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
+ {<Key> %k {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}}
+
+ {<Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
+ {<Key> %k {-keycode 20} 20}
+ {<Button> %b {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}}
+
+ {<Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
+ {<Key> %K {-keysym a} a}
+ {<Button> %b {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}}
+
+ {<Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}}
+ {<Enter> %m {-mode NotifyNormal} NotifyNormal}
+ {<FocusIn> %m {-mode NotifyNormal} {{}}}
+ {<Key> %k {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}}
+
+ {<Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
+ {<Map> %o {-override 1} 1}
+ {<Reparent> %o {-override 1} 1}
+ {<Configure> %o {-override 1} 1}
+ {<Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}
+
+ {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
+ {<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
+ {<Key> %k {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}}
+
+ {<Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}}
+ {<Key> %R {-root .b} {[winfo id .b]}}
+ {<Key> %R {-root xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {<Key> %R {-root [winfo id .b]} {[winfo id .b]}}
+ {<Button> %R {-root .b} {[winfo id .b]}}
+ {<ButtonRelease> %R {-root .b} {[winfo id .b]}}
+ {<Motion> %R {-root .b} {[winfo id .b]}}
+ {<<Paste>> %R {-root .b} {[winfo id .b]}}
+ {<Enter> %R {-root .b} {[winfo id .b]}}
+ {<Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}}
+
+ {<Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
+ {<Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {<Button> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {<ButtonRelease> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {<Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {<<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {<Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {<Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}}
+
+ {<Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
+ {<Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {<Button> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {<ButtonRelease> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {<Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {<<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {<Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {<Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}}
+
+ {<Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
+ {<Key> %E {-sendevent 1} 1}
+ {<Key> %E {-sendevent yes} 1}
+ {<Key> %E {-sendevent 43} 43}
+
+ {<Key> %# {-serial xyz} {{1 {expected integer but got "xyz"}}}}
+ {<Key> %# {-serial 100} 100}
+
+ {<Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}}
+ {<Key> %s {-state 1} 1}
+ {<Button> %s {-state 1025} 1025}
+ {<ButtonRelease> %s {-state 1025} 1025}
+ {<Motion> %s {-state 1} 1}
+ {<<Paste>> %s {-state 1} 1}
+ {<Enter> %s {-state 1} 1}
+ {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}}
+ {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
+ {<Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}}
+
+ {<Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
+ {<Key> %S {-subwindow .b} {[winfo id .b]}}
+ {<Key> %S {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {<Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}}
+ {<Button> %S {-subwindow .b} {[winfo id .b]}}
+ {<ButtonRelease> %S {-subwindow .b} {[winfo id .b]}}
+ {<Motion> %S {-subwindow .b} {[winfo id .b]}}
+ {<<Paste>> %S {-subwindow .b} {[winfo id .b]}}
+ {<Enter> %S {-subwindow .b} {[winfo id .b]}}
+ {<Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}}
+
+ {<Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}}
+ {<Key> %t {-time 100} 100}
+ {<Button> %t {-time 100} 100}
+ {<ButtonRelease> %t {-time 100} 100}
+ {<Motion> %t {-time 100} 100}
+ {<<Paste>> %t {-time 100} 100}
+ {<Enter> %t {-time 100} 100}
+ {<Property> %t {-time 100} 100}
+ {<Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}}
+
+ {<Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}}
+ {<Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}}
+ {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
+ {<Key> %k {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}}
+
+ {<Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}}
+ {<Unmap> %W {-window .b.f} .b.f}
+ {<Unmap> %W {-window xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {<Unmap> %W {-window [winfo id .b.f]} .b.f}
+ {<Unmap> %W {-window .b.f} .b.f}
+ {<Map> %W {-window .b.f} .b.f}
+ {<Reparent> %W {-window .b.f} .b.f}
+ {<Configure> %W {-window .b.f} .b.f}
+ {<Gravity> %W {-window .b.f} .b.f}
+ {<Circulate> %W {-window .b.f} .b.f}
+ {<Key> %W {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}}
+
+ {<Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}}
+ {<Key> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Button> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<ButtonRelease> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Motion> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<<Paste>> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Enter> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Expose> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {<Map> %x {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}}
+
+ {<Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}}
+ {<Key> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Button> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<ButtonRelease> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Motion> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<<Paste>> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Enter> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Expose> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {<Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}
+
+ {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y}}}}
+} {
+ set event [lindex $check 0]
+ test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
+ setup
+ bind .b.f $event "lappend x [lindex $check 1]"
+ set x {}
+ if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {
+ 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}
+ bind .b.f <Quadruple-1> {lappend x quadruple}
+ set x press
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ lappend x press
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ lappend x press
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ lappend x press
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ lappend x press
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ set x
+} {press single press double press triple press quadruple press quadruple}
+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 <ButtonRelease-1>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-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 <ButtonRelease-2>
+ 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
+} {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 <ButtonRelease-2>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ 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
+} {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 <ButtonRelease-2>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ event gen .b.f <Button-2> -x 100
+ event gen .b.f <ButtonRelease-2>
+ event gen .b.f <Button-2> -x 200
+ event gen .b.f <ButtonRelease-2>
+ 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-24.13 {FindSequence procedure: no binding} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ list [catch {bind .b.f <a>} msg] $msg
+} {0 {}}
+test bind-24.14 {FindSequence procedure: no binding} {
+ catch {destroy .b.f}
+ canvas .b.f
+ set i [.b.f create rect 10 10 100 100]
+ list [catch {.b.f bind $i <a>} msg] $msg
+} {0 {}}
+
+test bind-25.1 {ParseEventDescription procedure} {
+ list [catch {bind .b \x7 test} msg] $msg
+} {1 {bad ASCII character 0x7}}
+test bind-25.2 {ParseEventDescription procedure} {
+ list [catch {bind .b "\x7f" test} msg] $msg
+} {1 {bad ASCII character 0x7f}}
+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>
+ event gen .b.f <ButtonRelease-$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>
+ event gen .b.f <ButtonRelease>
+ 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>
+ event gen .b.f <ButtonRelease>
+ }
+ 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
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/bitmap.test b/tcl/tests/bitmap.test
new file mode 100644
index 00000000000..cf839b3107a
--- /dev/null
+++ b/tcl/tests/bitmap.test
@@ -0,0 +1,111 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkBitmap.c. It is organized in the standard white-box fashion for
+# Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint testbitmap [llength [info commands testbitmap]]
+
+test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} testbitmap {
+ set x gray25
+ lindex $x 0
+ destroy .b1
+ button .b1 -bitmap $x
+ lindex $x 0
+ testbitmap gray25
+} {{1 0}}
+test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} testbitmap {
+ set x gray25
+ destroy .b1 .b2
+ button .b1 -bitmap $x
+ destroy .b1
+ set result {}
+ lappend result [testbitmap gray25]
+ button .b2 -bitmap $x
+ lappend result [testbitmap gray25]
+} {{} {{1 1}}}
+test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} testbitmap {
+ set x gray25
+ destroy .b1 .b2
+ button .b1 -bitmap $x
+ set result {}
+ lappend result [testbitmap gray25]
+ button .b2 -bitmap $x
+ pack .b1 .b2 -side top
+ lappend result [testbitmap gray25]
+} {{{1 1}} {{2 1}}}
+
+test bitmap-2.1 {Tk_GetBitmap procedure} {
+ destroy .b1
+ list [catch {button .b1 -bitmap bad_name} msg] $msg
+} {1 {bitmap "bad_name" not defined}}
+test bitmap-2.2 {Tk_GetBitmap procedure} {
+ destroy .b1
+ list [catch {button .b1 -bitmap @xyzzy} msg] $msg
+} {1 {error reading bitmap file "xyzzy"}}
+
+test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap {
+ set x questhead
+ destroy .b1 .b2 .b3
+ button .b1 -bitmap $x
+ button .b3 -bitmap $x
+ button .b2 -bitmap $x
+ set result {}
+ lappend result [testbitmap questhead]
+ destroy .b1
+ lappend result [testbitmap questhead]
+ destroy .b2
+ lappend result [testbitmap questhead]
+ destroy .b3
+ lappend result [testbitmap questhead]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+
+test bitmap-4.1 {FreeBitmapObjProc} testbitmap {
+ destroy .b
+ set x [format questhead]
+ button .b -bitmap $x
+ set y [format questhead]
+ .b configure -bitmap $y
+ set z [format questhead]
+ .b configure -bitmap $z
+ set result {}
+ lappend result [testbitmap questhead]
+ set x red
+ lappend result [testbitmap questhead]
+ set z 32
+ lappend result [testbitmap questhead]
+ destroy .b
+ lappend result [testbitmap questhead]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/border.test b/tcl/tests/border.test
new file mode 100644
index 00000000000..675ecade63d
--- /dev/null
+++ b/tcl/tests/border.test
@@ -0,0 +1,181 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkBorder.c. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint testborder [llength [info commands testborder]]
+
+if {[testConstraint pseudocolor8]} {
+ toplevel .t -visual {pseudocolor 8} -colormap new
+ wm geom .t +0+0
+}
+
+test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} testborder {
+ set x orange
+ lindex $x 0
+ destroy .b1
+ button .b1 -bg $x -text .b1
+ lindex $x 0
+ testborder orange
+} {{1 0}}
+test border-1.3 {Tk_AllocBorderFromObj - discard stale border} testborder {
+ set x orange
+ destroy .b1 .b2
+ button .b1 -bg $x -text First
+ destroy .b1
+ set result {}
+ lappend result [testborder orange]
+ button .b2 -bg $x -text Second
+ lappend result [testborder orange]
+} {{} {{1 1}}}
+test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} testborder {
+ set x orange
+ destroy .b1 .b2
+ button .b1 -bg $x -text First
+ set result {}
+ lappend result [testborder orange]
+ button .b2 -bg $x -text Second
+ pack .b1 .b2 -side top
+ lappend result [testborder orange]
+} {{{1 1}} {{2 1}}}
+test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor8 testborder} {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -bg $x -text First
+ pack .b1 -side top
+ set result {}
+ lappend result [testborder purple]
+ button .t.b -bg $x -text Second
+ pack .t.b -side top
+ lappend result [testborder purple]
+ button .b2 -bg $x -text Third
+ pack .b2 -side top
+ lappend result [testborder purple]
+} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
+
+test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -bg $x -text First
+ pack .b1 -side top
+ button .t.b -bg $x -text Second
+ pack .t.b -side top
+ button .b2 -bg $x -text Third
+ pack .b2 -side top
+ set result {}
+ lappend result [testborder purple]
+ destroy .b1
+ lappend result [testborder purple]
+ destroy .b2
+ lappend result [testborder purple]
+ destroy .t.b
+ lappend result [testborder purple]
+} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
+test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder} {
+ destroy .b .t.b .t2 .t3
+ toplevel .t2 -visual {pseudocolor 8} -colormap new
+ toplevel .t3 -visual {pseudocolor 8} -colormap new
+ set x purple
+ button .b -bg $x -text .b1
+ button .t.b1 -bg $x -text .t.b1
+ button .t.b2 -bg $x -text .t.b2
+ button .t2.b1 -bg $x -text .t2.b1
+ button .t2.b2 -bg $x -text .t2.b2
+ button .t2.b3 -bg $x -text .t2.b3
+ button .t3.b1 -bg $x -text .t3.b1
+ button .t3.b2 -bg $x -text .t3.b2
+ button .t3.b3 -bg $x -text .t3.b3
+ button .t3.b4 -bg $x -text .t3.b4
+ set result {}
+ lappend result [testborder purple]
+ destroy .t2
+ lappend result [testborder purple]
+ destroy .b
+ lappend result [testborder purple]
+ destroy .t3
+ lappend result [testborder purple]
+ destroy .t
+ lappend result [testborder purple]
+} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
+test border-4.1 {FreeBorderObjProc} testborder {
+ destroy .b
+ set x [format purple]
+ button .b -bg $x -text .b1
+ set y [format purple]
+ .b configure -bg $y
+ set z [format purple]
+ .b configure -bg $z
+ set result {}
+ lappend result [testborder purple]
+ set x red
+ lappend result [testborder purple]
+ set z 32
+ lappend result [testborder purple]
+ destroy .b
+ lappend result [testborder purple]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+catch {destroy .b}
+button .b
+test get-2.1 {Tk_GetReliefFromObj} {
+ .b configure -relief flat
+ .b cget -relief
+} {flat}
+test get-2.2 {Tk_GetReliefFromObj} {
+ .b configure -relief groove
+ .b cget -relief
+} {groove}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief raised
+ .b cget -relief
+} {raised}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief ridge
+ .b cget -relief
+} {ridge}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief solid
+ .b cget -relief
+} {solid}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief sunken
+ .b cget -relief
+} {sunken}
+test get-2.4 {Tk_GetReliefFromObj - error} {
+ list [catch {.b configure -relief upanddown} msg] $msg
+} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}}
+
+if {[testConstraint pseudocolor8]} {
+ destroy .t
+}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/bugs.tcl b/tcl/tests/bugs.tcl
new file mode 100644
index 00000000000..36f30ce701f
--- /dev/null
+++ b/tcl/tests/bugs.tcl
@@ -0,0 +1,43 @@
+# This file is a Tcl script to test out various known bugs that will
+# cause Tk to crash. This file ends with .tcl instead of .test to make
+# sure it isn't run when you type "source all". We currently are not
+# shipping this file with the rest of the source release.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/butGeom.tcl b/tcl/tests/butGeom.tcl
new file mode 100644
index 00000000000..38991e30cdd
--- /dev/null
+++ b/tcl/tests/butGeom.tcl
@@ -0,0 +1,128 @@
+# 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/tcl/tests/butGeom2.tcl b/tcl/tests/butGeom2.tcl
new file mode 100644
index 00000000000..65e90fae734
--- /dev/null
+++ b/tcl/tests/butGeom2.tcl
@@ -0,0 +1,126 @@
+# 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/tcl/tests/button.test b/tcl/tests/button.test
new file mode 100644
index 00000000000..27c46316be1
--- /dev/null
+++ b/tcl/tests/button.test
@@ -0,0 +1,812 @@
+# This file is a Tcl script to test labels, buttons, checkbuttons, and
+# radiobuttons in Tk (i.e., all the widgets defined in tkButton.c). It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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]
+if {[testConstraint testImageType]} {
+ 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"} {1 1 1 1}}
+ {-activeforeground #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"} {1 1 1 1}}
+ {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} {1 1 1 1}}
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"} {1 1 1 1}}
+ {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
+ {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}
+ {1 1 1 1}}
+ {-bitmap questhead questhead badValue {bitmap "badValue" not defined}
+ {1 1 1 1}}
+ {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}}
+ {-command "set x" {set x} {} {} {0 1 1 1}}
+ {-compound left left bogus {bad compound "bogus": must be bottom, center, left, none, right, or top} {1 1 1 1}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}}
+ {-default active active huh?
+ {bad default "huh?": must be active, disabled, or normal}
+ {0 1 0 0}}
+ {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}
+ {1 1 1 1}}
+ {-fg #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
+ {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist} {1 1 1 1}}
+ {-foreground #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
+ {-height 18 18 20.0 {expected integer but got "20.0"} {1 1 1 1}}
+ {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}
+ {1 1 1 1}}
+ {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}
+ {1 1 1 1}}
+ {-highlightthickness 6m 6m badValue {bad screen distance "badValue"}
+ {1 1 1 1}}
+ {-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}}
+ {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}
+ {0 0 1 1}}
+ {-justify right right bogus {bad justification "bogus": must be left, right, or center} {1 1 1 1}}
+ {-offrelief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 0 1 1}}
+ {-offvalue lousy lousy {} {} {0 0 1 0}}
+ {-offvalue fantastic fantastic {} {} {0 0 1 0}}
+ {-overrelief "" "" 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 1 1 1}}
+ {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+ {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+ {-repeatdelay 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
+ {-repeatinterval 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
+ {-relief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {1 1 1 1}}
+ {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}}
+ {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
+ {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal} {1 1 1 1}}
+ {-takefocus "any string" "any string" {} {} {1 1 1 1}}
+ {-text "Sample text" {Sample text} {} {} {1 1 1 1}}
+ {-textvariable i i {} {} {1 1 1 1}}
+ {-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}}
+ {-value anyString anyString {} {} {0 0 0 1}}
+ {-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}}
+ {-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}}
+} {
+ set name [lindex $test 0]
+ set classes [lindex $test 5]
+ foreach w {.l .b .c .r} hasOption [lindex $test 5] {
+ if $hasOption {
+ test button-1.$i {configuration options} testImageType {
+ $w configure $name [lindex $test 1]
+ lindex [$w configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test button-1.$i {configuration options} testImageType {
+ list [catch {$w configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ $w configure $name [lindex [$w configure $name] 3]
+ } else {
+ test button-1.$i {configuration options} testImageType {
+ list [catch {$w configure $name [lindex $test 1]} msg] $msg
+ } "1 {unknown option \"$name\"}"
+ }
+ }
+ incr i
+}
+test button-1.$i {configuration options} {
+ .c configure -selectcolor {}
+} {}
+
+test button-3.1 {ButtonCreate - not enough cd ../unix
+} {
+ list [catch {button} msg] $msg
+} {1 {wrong # args: should be "button pathName ?options?"}}
+test button-3.2 {ButtonCreate procedure - setting label class} {
+ catch {destroy .x}
+ label .x
+ winfo class .x
+} {Label}
+test button-3.3 {ButtonCreate - setting button class} {
+ catch {destroy .x}
+ button .x
+ winfo class .x
+} {Button}
+test button-3.4 {ButtonCreate - setting checkbutton class} {
+ catch {destroy .x}
+ checkbutton .x
+ winfo class .x
+} {Checkbutton}
+test button-3.5 {ButtonCreate - setting radiobutton class} {
+ catch {destroy .x}
+ radiobutton .x
+ winfo class .x
+} {Radiobutton}
+rename button gorp
+test button-3.6 {ButtonCreate - setting class} {
+ catch {destroy .x}
+ gorp .x
+ winfo class .x
+} {Button}
+rename gorp button
+test button-3.7 {ButtonCreate - bad window name} {
+ list [catch {button foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test button-3.8 {ButtonCreate procedure - error in default option value} {
+ catch {destroy .funny}
+ option add *funny.background bogus
+ list [catch {button .funny} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+ (database entry for "-background" in widget ".funny")
+ invoked from within
+"button .funny"}}
+test button-3.9 {ButtonCreate procedure - option error} {
+ catch {destroy .x}
+ list [catch {button .x -gorp foo} msg] $msg [winfo exists .x]
+} {1 {unknown option "-gorp"} 0}
+test button-3.10 {ButtonCreate procedure - return value} {
+ catch {destroy .abcd}
+ set x [button .abcd]
+ destroy .abc
+ set x
+} {.abcd}
+
+test button-4.1 {ButtonWidgetCmd - too few arguments} {
+ list [catch {.b} msg] $msg
+} {1 {wrong # args: should be ".b option ?arg arg ...?"}}
+test button-4.2 {ButtonWidgetCmd - bad option name} {
+ list [catch {.b c} msg] $msg
+} {1 {ambiguous option "c": must be cget, configure, flash, or invoke}}
+test button-4.3 {ButtonWidgetCmd - bad option name} {
+ list [catch {.b bogus} msg] $msg
+} {1 {bad option "bogus": must be cget, configure, flash, or invoke}}
+test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
+ list [catch {.b cget a b} msg] $msg
+} {1 {wrong # args: should be ".b cget option"}}
+test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
+ list [catch {.b cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
+ .b configure -highlightthickness 3
+ .b cget -highlightthickness
+} {3}
+test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
+ catch {.l cget -disabledforeground}
+} {0}
+test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
+ catch {.b cget -disabledforeground}
+} {0}
+test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
+ list [catch {.b cget -variable} msg] $msg
+} {1 {unknown option "-variable"}}
+test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
+ catch {.c cget -variable}
+} {0}
+test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
+ list [catch {.c cget -value} msg] $msg
+} {1 {unknown option "-value"}}
+test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
+ catch {.r cget -value}
+} {0}
+test button-4.13 {ButtonWidgetCmd procedure, "cget" option} {
+ list [catch {.r cget -onvalue} msg] $msg
+} {1 {unknown option "-onvalue"}}
+test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
+ llength [.c configure]
+} {39}
+test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
+ list [catch {.b configure -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
+ list [catch {.b co -bg #ffffff -fg} msg] $msg
+} {1 {value for "-fg" missing}}
+test button-4.17 {ButtonWidgetCmd procedure, "configure" option} {
+ .b configure -fg #123456
+ .b configure -bg #654321
+ lindex [.b configure -fg] 4
+} {#123456}
+.c configure -variable value -onvalue 1 -offvalue 0
+.r configure -variable value2 -value red
+test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
+ list [catch {.c deselect foo} msg] $msg
+} {1 {wrong # args: should be ".c deselect"}}
+test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
+ list [catch {.l deselect} msg] $msg
+} {1 {bad option "deselect": must be cget or configure}}
+test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
+ list [catch {.b deselect} msg] $msg
+} {1 {bad option "deselect": must be cget, configure, flash, or invoke}}
+test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
+ set value 1
+ .c d
+ set value
+} {0}
+test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
+ set value2 green
+ .r deselect
+ set value2
+} {green}
+test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
+ set value2 red
+ .r deselect
+ set value2
+} {}
+test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
+ set value 1
+ trace variable value w bogusTrace
+ set result [list [catch {.c deselect} msg] $msg $errorInfo $value]
+ trace vdelete value w bogusTrace
+ set result
+} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
+ while executing
+".c deselect"} 0}
+test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} {
+ set value2 red
+ trace variable value2 w bogusTrace
+ set result [list [catch {.r deselect} msg] $msg $errorInfo $value2]
+ trace vdelete value2 w bogusTrace
+ set result
+} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
+ while executing
+".r deselect"} {}}
+test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
+ list [catch {.b flash foo} msg] $msg
+} {1 {wrong # args: should be ".b flash"}}
+test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
+ list [catch {.l flash} msg] $msg
+} {1 {bad option "flash": must be cget or configure}}
+test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
+ list [catch {.b flash} msg] $msg
+} {0 {}}
+test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
+ list [catch {.c flash} msg] $msg
+} {0 {}}
+test button-4.30 {ButtonWidgetCmd procedure, "flash" option} {
+ list [catch {.r f} msg] $msg
+} {0 {}}
+test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
+ list [catch {.b invoke foo} msg] $msg
+} {1 {wrong # args: should be ".b invoke"}}
+test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
+ list [catch {.l invoke} msg] $msg
+} {1 {bad option "invoke": must be cget or configure}}
+test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
+ .b configure -command {set x invoked}
+ set x "not invoked"
+ .b invoke
+ set x
+} {invoked}
+test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
+ .b configure -command {set x invoked} -state disabled
+ set x "not invoked"
+ .b invoke
+ set x
+} {not invoked}
+test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
+ set value bogus
+ .c configure -command {set x invoked} -variable value -onvalue 1 \
+ -offvalue 0
+ set x "not invoked"
+ .c invoke
+ list $x $value
+} {invoked 1}
+test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} {
+ set value2 green
+ .r configure -command {set x invoked} -variable value2 -value red
+ set x "not invoked"
+ .r i
+ list $x $value2
+} {invoked red}
+test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
+ list [catch {.l select} msg] $msg
+} {1 {bad option "select": must be cget or configure}}
+test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
+ list [catch {.b select} msg] $msg
+} {1 {bad option "select": must be cget, configure, flash, or invoke}}
+test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
+ list [catch {.c select foo} msg] $msg
+} {1 {wrong # args: should be ".c select"}}
+test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
+ set value bogus
+ .c configure -command {} -variable value -onvalue lovely -offvalue 0
+ .c s
+ set value
+} {lovely}
+test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
+ set value2 green
+ .r configure -command {} -variable value2 -value red
+ .r select
+ set value2
+} {red}
+test button-4.42 {ButtonWidgetCmd procedure, "select" option} {
+ set value2 yellow
+ trace variable value2 w bogusTrace
+ set result [list [catch {.r select} msg] $msg $errorInfo $value2]
+ trace vdelete value2 w bogusTrace
+ set result
+} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
+ while executing
+".r select"} red}
+test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
+ list [catch {.l toggle} msg] $msg
+} {1 {bad option "toggle": must be cget or configure}}
+test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
+ list [catch {.b toggle} msg] $msg
+} {1 {bad option "toggle": must be cget, configure, flash, or invoke}}
+test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
+ list [catch {.r toggle} msg] $msg
+} {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}}
+test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
+ list [catch {.c toggle foo} msg] $msg
+} {1 {wrong # args: should be ".c toggle"}}
+test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
+ set value bogus
+ .c configure -command {} -variable value -onvalue sunshine -offvalue rain
+ .c toggle
+ set result $value
+ .c toggle
+ lappend result $value
+ .c toggle
+ lappend result $value
+} {sunshine rain sunshine}
+test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
+ .c configure -onvalue xyz -offvalue abc
+ set value xyz
+ trace variable value w bogusTrace
+ set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
+ trace vdelete value w bogusTrace
+ set result
+} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
+ while executing
+".c toggle"} abc}
+test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} {
+ .c configure -onvalue xyz -offvalue abc
+ set value abc
+ trace variable value w bogusTrace
+ set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
+ trace vdelete value w bogusTrace
+ set result
+} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
+ while executing
+".c toggle"} xyz}
+test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
+ catch {unset value}; set value(1) 1;
+ set result [list [catch {.c toggle} msg] $msg $errorInfo]
+ unset value;
+ set result
+} {1 {can't set "value": variable is array} {can't set "value": variable is array
+ while executing
+".c toggle"}}
+
+test button-5.1 {DestroyButton procedure} testImageType {
+ 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
+ deleteWindows
+} {}
+
+test button-6.1 {ConfigureButton - textvariable trace} {
+ catch {destroy .b1}
+ button .b1 -bd 4 -bg green
+ catch {.b1 configure -bd 7 -bg green -fg bogus}
+ list [catch {.b1 configure -bd 7 -bg red -fg bogus} msg] \
+ $msg [.b1 cget -bd] [.b1 cget -bg]
+} {1 {unknown color name "bogus"} 4 green}
+test button-6.2 {ConfigureButton - textvariable trace} {
+ catch {destroy .b1}
+ set x From-x
+ set y From-y
+ button .b1 -textvariable x
+ .b1 configure -textvariable y
+ set x New
+ lindex [.b1 configure -text] 4
+} {From-y}
+test button-6.2 {ConfigureButton - variable traces} {
+ catch {destroy .b1}
+ catch {unset x}
+ checkbutton .b1 -variable x
+ set x 1
+ set y 1
+ .b1 configure -textvariable y
+ set x 0
+ .b1 toggle
+ set y
+} {1}
+test button-6.3 {ConfigureButton - image handling} testImageType {
+ catch {destroy .b1}
+ eval image delete [image names]
+ image create test image1
+ image create test image2
+ button .b1 -image image1
+ image delete image1
+ .b1 configure -image image2
+ image names
+} {image2}
+test button-6.5 {ConfigureButton - default value for variable} {
+ catch {destroy .b1}
+ checkbutton .b1
+ .b1 cget -variable
+} {b1}
+test button-6.6 {ConfigureButton - setting selected state from variable} {
+ catch {destroy .b1}
+ set x 0
+ set y Shiny
+ checkbutton .b1 -variable x
+ .b1 configure -variable y -onvalue Shiny
+ .b1 toggle
+ set y
+} 0
+test button-6.7 {ConfigureButton - setting selected state from variable} {
+ catch {destroy .b1}
+ catch {unset x}
+ checkbutton .b1 -variable x -offvalue Bogus
+ set x
+} Bogus
+test button-6.8 {ConfigureButton - setting selected state from variable} {
+ catch {destroy .b1}
+ catch {unset x}
+ radiobutton .b1 -variable x
+ set x
+} {}
+test button-6.9 {ConfigureButton - error in setting variable} {
+ catch {destroy .b1}
+ catch {unset x}
+ trace variable x w bogusTrace
+ set result [list [catch {radiobutton .b1 -variable x} msg] $msg]
+ trace vdelete x w bogusTrace
+ set result
+} {1 {can't set "x": trace aborted}}
+test button-6.10 {ConfigureButton - bad image name} {
+ catch {destroy .b1}
+ list [catch {button .b1 -image bogus} msg] $msg
+} {1 {image "bogus" doesn't exist}}
+test button-6.11 {ConfigureButton - setting variable from current text value} {
+ catch {destroy .b1}
+ catch {unset x}
+ button .b1 -textvariable x -text "Button 1"
+ set x
+} {Button 1}
+test button-6.12 {ConfigureButton - using current value of variable} {
+ catch {destroy .b1}
+ set x Override
+ button .b1 -textvariable x -text "Button 1"
+ set x
+} {Override}
+test button-6.13 {ConfigureButton - variable handling} {
+ catch {destroy .b1}
+ catch {unset x}
+ trace variable x w bogusTrace
+ set result [list [catch {radiobutton .b1 -text foo -textvariable x} msg] \
+ $msg $x]
+ trace vdelete x w bogusTrace
+ set result
+} {1 {can't set "x": trace aborted} foo}
+test button-6.14 {ConfigureButton - -width option} {
+ catch {destroy .b1}
+ button .b1 -text "Button 1"
+ list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
+} {1 {expected integer but got "1i"} {expected integer but got "1i"
+ (processing -width option)
+ invoked from within
+".b1 configure -width 1i"}}
+test button-6.15 {ConfigureButton - -height option} {
+ catch {destroy .b1}
+ button .b1 -text "Button 1"
+ list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo
+} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c"
+ (processing -height option)
+ invoked from within
+".b1 configure -height 0.5c"}}
+test button-6.16 {ConfigureButton - -width option} {
+ catch {destroy .b1}
+ button .b1 -bitmap questhead
+ list [catch {.b1 configure -width abc} msg] $msg $errorInfo
+} {1 {bad screen distance "abc"} {bad screen distance "abc"
+ (processing -width option)
+ invoked from within
+".b1 configure -width abc"}}
+test button-6.17 {ConfigureButton - -height option} testImageType {
+ catch {destroy .b1}
+ eval image delete [image names]
+ image create test image1
+ button .b1 -image image1
+ list [catch {.b1 configure -height 0.5x} msg] $msg $errorInfo
+} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
+ (processing -height option)
+ invoked from within
+".b1 configure -height 0.5x"}}
+test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} {
+ catch {destroy .b1}
+ button .b1 -text "Sample text" -width 10 -height 2
+ pack .b1
+ set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
+ .b1 configure -bitmap questhead
+ lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
+} {102 46 20 12}
+test button-6.19 {ConfigureButton - computing geometry} {
+ catch {destroy .b1}
+ button .b1 -text "Button 1"
+ set old [winfo reqwidth .b1]
+ .b1 configure -text "Much longer text"
+ set new [winfo reqwidth .b1]
+ expr $old == $new
+} {0}
+
+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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ set x 0
+ checkbutton .b1 -variable x
+ set x 44
+ .b1 toggle
+ set x
+} {1}
+test button-10.3 {ButtonVarProc procedure} {
+ deleteWindows
+ set x 1
+ checkbutton .b1 -variable x
+ set x 44
+ .b1 toggle
+ set x
+} {1}
+test button-10.4 {ButtonVarProc procedure} {
+ deleteWindows
+ set x 0
+ checkbutton .b1 -variable x
+ set x 1
+ .b1 toggle
+ set x
+} {0}
+test button-10.5 {ButtonVarProc procedure} {
+ deleteWindows
+ set x 1
+ checkbutton .b1 -variable x
+ set x 1
+ .b1 toggle
+ set x
+} {0}
+test button-10.6 {ButtonVarProc procedure} {
+ deleteWindows
+ set x 0
+ checkbutton .b1 -variable x
+ set x 0
+ .b1 toggle
+ set x
+} {1}
+test button-10.7 {ButtonVarProc procedure} {
+ deleteWindows
+ 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.
+ deleteWindows
+ catch {unset a}
+ checkbutton .b1 -variable a
+ unset a
+ set a(32) 0
+ unset a
+} {}
+
+test button-11.1 {ButtonTextVarProc procedure} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ # Windows buttons have a default min width, so we have to
+ # set this to be longer to force the wider button.
+ set x ExtraLongLabel
+ 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} testImageType {
+ deleteWindows
+ 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}
+
+deleteWindows
+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]
+
+deleteWindows
+
+test button-14.1 {size behaviouor} {
+ set res {}
+ foreach class {label button radiobutton checkbutton} {
+ eval destroy [winfo children .]
+
+ $class .a -text Hej
+ $class .b -text Hej -width 10 -height 1
+ $class .c -text "" -width 10 -height 1
+
+ for {set t 0} {$t < 2} {incr t} {
+ set res2 {}
+ # With -width, width should not be affected by text change
+ lappend res2 [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}]
+ # With -height, height should not be affected by text change
+ lappend res2 [expr {[winfo reqheight .b] == [winfo reqheight .c]}]
+ # A one line text should be as high as -height 1
+ lappend res2 [expr {[winfo reqheight .a] == [winfo reqheight .b]}]
+ lappend res $res2
+
+ # Do the second round with another font
+ .a configure -font "Arial 20"
+ .b configure -font "Arial 20"
+ .c configure -font "Arial 20"
+ }
+ }
+ set res
+} {{1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1}}
+
+deleteWindows
+
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/canvImg.test b/tcl/tests/canvImg.test
new file mode 100644
index 00000000000..090d5ef2963
--- /dev/null
+++ b/tcl/tests/canvImg.test
@@ -0,0 +1,409 @@
+# This file is a Tcl script to test out the procedures in tkCanvImg.c,
+# which implement canvas "image" items. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+eval image delete [image names]
+canvas .c
+pack .c
+update
+if {[testConstraint testImageType]} {
+ 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} testImageType {
+ .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} testImageType {
+ .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 # coordinates: expected 2, got 1}}
+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} testImageType {
+ list [catch {.c create image 50 50 -gorp foo} msg] $msg
+} {1 {unknown option "-gorp"}}
+
+test canvImg-3.1 {ImageCoords procedure} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1
+ list [catch {.c coords i1 250} msg] $msg
+} {1 {wrong # coordinates: expected 2, got 1}}
+test canvImg-3.5 {ImageCoords procedure} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ 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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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 testImageType} {
+ .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
+if {[testConstraint testImageType]} {
+ .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} testImageType {
+ eval .c coords rect [lindex $check 0]
+ .c gettags [eval .c find closest [lindex $check 1]]
+ } [lindex $check 2]
+ incr i
+}
+
+.c delete all
+if {[testConstraint testImageType]} {
+ .c create image 50 100 -image foo -tags image -anchor nw
+}
+test canvImg-8.19 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 60 0 70 99]
+} {}
+test canvImg-8.20 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 60 0 70 99.999]
+} {}
+test canvImg-8.21 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 60 0 70 101]
+} {image}
+test canvImg-8.22 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 81 105 120 115]
+} {}
+test canvImg-8.23 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 80.001 105 120 115]
+} {}
+test canvImg-8.24 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 79 105 120 115]
+} {image}
+test canvImg-8.25 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 60 116 70 150]
+} {}
+test canvImg-8.26 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 60 115.001 70 150]
+} {}
+test canvImg-8.27 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 60 114 70 150]
+} {image}
+test canvImg-8.28 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 0 105 49 115]
+} {}
+test canvImg-8.29 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 0 105 50 114.999]
+} {}
+test canvImg-8.30 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 0 105 51 115]
+} {image}
+test canvImg-8.31 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 0 0 49.999 99.999]
+} {}
+test canvImg-8.32 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 0 0 51 101]
+} {image}
+test canvImg-8.33 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 80 0 150 100]
+} {}
+test canvImg-8.34 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 79 0 150 101]
+} {image}
+test canvImg-8.35 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 80.001 115.001 150 180]
+} {}
+test canvImg-8.36 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 79 114 150 180]
+} {image}
+test canvImg-8.37 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 0 115 50 180]
+} {}
+test canvImg-8.38 {ImageToArea procedure} testImageType {
+ .c gettags [.c find overlapping 0 114 51 180]
+} {image}
+test canvImg-8.39 {ImageToArea procedure} testImageType {
+ .c gettags [.c find enclosed 0 0 200 200]
+} {image}
+test canvImg-8.40 {ImageToArea procedure} testImageType {
+ .c gettags [.c find enclosed 49.999 99.999 80.001 115.001]
+} {image}
+test canvImg-8.41 {ImageToArea procedure} testImageType {
+ .c gettags [.c find enclosed 51 100 80 115]
+} {}
+test canvImg-8.42 {ImageToArea procedure} testImageType {
+ .c gettags [.c find enclosed 50 101 80 115]
+} {}
+test canvImg-8.43 {ImageToArea procedure} testImageType {
+ .c gettags [.c find enclosed 50 100 79 115]
+} {}
+test canvImg-8.44 {ImageToArea procedure} testImageType {
+ .c gettags [.c find enclosed 50 100 80 114]
+} {}
+
+test canvImg-9.1 {DisplayImage procedure} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ .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}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/canvPs.test b/tcl/tests/canvPs.test
new file mode 100644
index 00000000000..4eb50f88c3d
--- /dev/null
+++ b/tcl/tests/canvPs.test
@@ -0,0 +1,115 @@
+# This file is a Tcl script to test out procedures to write postscript
+# for canvases to files and channels. It exercises the procedure
+# TkCanvPostscriptCmd in generic/tkCanvPs.c
+#
+# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+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
+
+# cleanup
+removeFile foo.ps
+removeFile bar.ps
+deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/canvPsArc.tcl b/tcl/tests/canvPsArc.tcl
new file mode 100644
index 00000000000..00ff211872a
--- /dev/null
+++ b/tcl/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/tcl/tests/canvPsBmap.tcl b/tcl/tests/canvPsBmap.tcl
new file mode 100644
index 00000000000..86aa55a211c
--- /dev/null
+++ b/tcl/tests/canvPsBmap.tcl
@@ -0,0 +1,84 @@
+# 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/tcl/tests/canvPsGrph.tcl b/tcl/tests/canvPsGrph.tcl
new file mode 100644
index 00000000000..4c02e475d0f
--- /dev/null
+++ b/tcl/tests/canvPsGrph.tcl
@@ -0,0 +1,100 @@
+# 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/tcl/tests/canvPsImg.tcl b/tcl/tests/canvPsImg.tcl
new file mode 100644
index 00000000000..043afa7cef8
--- /dev/null
+++ b/tcl/tests/canvPsImg.tcl
@@ -0,0 +1,84 @@
+# This file creates a screen to exercise Postscript generation
+# for images in canvases. It is part of the Tk visual test suite,
+# which is invoked via the "visual" script.
+#
+# RCS: @(#) $Id$
+
+# Build a test image in a canvas
+proc BuildTestImage {} {
+ global BitmapImage PhotoImage visual level
+ catch {destroy .t.f}
+ frame .t.f -visual $visual -colormap new
+ pack .t.f -side top -after .t.top
+ bind .t.f <Enter> {wm colormapwindows .t {.t.f .t}}
+ bind .t.f <Leave> {wm colormapwindows .t {.t .t.f}}
+ canvas .t.f.c -width 550 -height 350 -borderwidth 2 -relief raised
+ pack .t.f.c
+ .t.f.c create rectangle 25 25 525 325 -fill {} -outline black
+ .t.f.c create image 50 50 -anchor nw -image $BitmapImage
+ .t.f.c create image 250 50 -anchor nw -image $PhotoImage
+}
+
+# Put postscript in a file
+proc FilePostscript { canvas } {
+ global level
+ $canvas postscript -file /tmp/test.ps -colormode $level
+}
+
+# Send postscript output to printer
+proc PrintPostcript { canvas } {
+ global level
+ $canvas postscript -file tmp.ps -colormode $level
+ exec lpr tmp.ps
+}
+
+catch {destroy .t}
+toplevel .t
+wm title .t "Postscript Tests for Canvases: Images"
+wm iconname .t "Postscript"
+
+message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for images. Click the buttons below to select a Visual type for the canvas and colormode for the Postscript output. Then click "Print" to send the results to the default printer, or "Print to file" to put the Postscript output in a file called "/tmp/test.ps". You can also click on items in the canvas to delete them.
+NOTE: Some Postscript printers may not be able to handle Postscript generated in color mode.} -width 6i
+pack .t.m -side top -fill both
+
+frame .t.top
+pack .t.top -side top
+frame .t.top.l -relief raised -borderwidth 2
+frame .t.top.r -relief raised -borderwidth 2
+pack .t.top.l .t.top.r -side left -fill both -expand 1
+
+label .t.visuals -text "Visuals"
+pack .t.visuals -in .t.top.l
+
+set visual [lindex [winfo visualsavailable .] 0]
+foreach v [winfo visualsavailable .] {
+ # The hack below is necessary for some systems, which have more than one
+ # visual of the same type...
+ if {![winfo exists .t.$v]} {
+ radiobutton .t.$v -text $v -variable visual -value $v \
+ -command BuildTestImage
+ pack .t.$v -in .t.top.l -anchor w
+ }
+}
+
+label .t.levels -text "Color Levels"
+pack .t.levels -in .t.top.r
+set level monochrome
+foreach l { monochrome gray color } {
+ radiobutton .t.$l -text $l -variable level -value $l
+ pack .t.$l -in .t.top.r -anchor w
+}
+
+set BitmapImage [image create bitmap -file $tk_library/demos/images/face.bmp \
+ -background white -foreground black]
+set PhotoImage [image create photo -file $tk_library/demos/images/teapot.ppm]
+
+BuildTestImage
+
+frame .t.bot
+pack .t.bot -side top -fill x -expand 1
+
+button .t.file -text "Print to File" -command { FilePostscript .t.f.c }
+button .t.print -text "Print" -command { PrintPostscript .t.f.c }
+button .t.quit -text "Quit" -command { destroy .t }
+pack .t.file .t.print .t.quit -in .t.bot -side left -fill x -expand 1
diff --git a/tcl/tests/canvPsText.tcl b/tcl/tests/canvPsText.tcl
new file mode 100644
index 00000000000..02ec274e787
--- /dev/null
+++ b/tcl/tests/canvPsText.tcl
@@ -0,0 +1,96 @@
+# 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/tcl/tests/canvRect.test b/tcl/tests/canvRect.test
new file mode 100644
index 00000000000..ad59f5c7afe
--- /dev/null
+++ b/tcl/tests/canvRect.test
@@ -0,0 +1,341 @@
+# This file is a Tcl script to test out the procedures in tkRectOval.c,
+# which implement canvas "rectangle" and "oval" items. It is organized
+# in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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.0 6.0 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.0}
+test canvRect-4.2 {ConfigureRectOval procedure} {
+ list [catch {.c itemconfigure x -width -5} msg] $msg
+} {1 {bad screen distance "-5"}}
+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 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
+}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/canvText.test b/tcl/tests/canvText.test
new file mode 100644
index 00000000000..ee271b5022a
--- /dev/null
+++ b/tcl/tests/canvText.test
@@ -0,0 +1,534 @@
+# This file is a Tcl script to test out the procedures in tkCanvText.c,
+# which implement canvas "text" items. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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 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 nonPortable} {
+ .c itemconfig test -font $font -text 0
+ .c coords test 0 0
+ set x {}
+ lappend x [.c itemconfig test -anchor n; .c bbox test]
+ lappend x [.c itemconfig test -anchor nw; .c bbox test]
+ lappend x [.c itemconfig test -anchor w; .c bbox test]
+ lappend x [.c itemconfig test -anchor sw; .c bbox test]
+ 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.0 {DisplayText procedure: stippling} {
+ .c itemconfig test -stipple gray50
+ update
+ .c itemconfig test -stipple {}
+ update
+} {}
+test canvText-7.2 {DisplayText procedure: draw selection} {
+ .c select from test 0
+ .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-7.9 {DisplayText procedure: select end} {
+ catch {destroy .t}
+ toplevel .t
+ wm geometry .t +0+0
+ canvas .t.c
+ pack .t.c
+ set id [.t.c create text 0 0 -text Dummy -anchor nw]
+ update
+ .t.c select from $id 0
+ .t.c select to $id end
+ update
+ #catch {destroy .t}
+ 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
+"
+
+test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
+ catch {destroy .c}
+ canvas .c
+ pack .c
+ .c delete all
+ .c create text 100 100 -text Hello\n -anchor nw
+ set bbox [.c bbox 1]
+ set x2 [lindex $bbox 2]
+ set y2 [lindex $bbox 3]
+ incr y2
+ update
+ .c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1]
+} 1
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/canvWind.test b/tcl/tests/canvWind.test
new file mode 100644
index 00000000000..d0e6155fb03
--- /dev/null
+++ b/tcl/tests/canvWind.test
@@ -0,0 +1,147 @@
+# This file is a Tcl script to test out the procedures in tkCanvWind.c,
+# which implement canvas "window" items. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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}}
+catch {destroy .t}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/canvas.test b/tcl/tests/canvas.test
new file mode 100644
index 00000000000..2cde224e940
--- /dev/null
+++ b/tcl/tests/canvas.test
@@ -0,0 +1,459 @@
+# 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-2000 Ajuba Solutions.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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
+}
+
+test canvas-1.40 {configure throws error on bad option} {
+ set res [list [catch {.c configure -gorp foo}]]
+ .c create rect 10 10 100 100
+ lappend res [catch {.c configure -gorp foo}]
+ set res
+} [list 1 1]
+
+
+catch {destroy .c}
+canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
+ -highlightthickness 0
+pack .c
+update
+
+test canvas-2.1 {CanvasWidgetCmd, bind option} {
+ set i [.c create rect 10 10 100 100]
+ list [catch {.c bind $i <a>} msg] $msg
+} {0 {}}
+test canvas-2.2 {CanvasWidgetCmd, bind option} {
+ set i [.c create rect 10 10 100 100]
+ list [catch {.c bind $i <} msg] $msg
+} {1 {no event type or button # or keysym}}
+test canvas-2.3 {CanvasWidgetCmd, xview option} {
+ .c configure -xscrollincrement 40 -yscrollincrement 5
+ .c xview moveto 0
+ update
+ set x [list [.c xview]]
+ .c xview scroll 2 units
+ update
+ lappend x [.c xview]
+} {{0 0.3} {0.4 0.7}}
+test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} {
+ # This test gives slightly different results on platforms such
+ # as NetBSD. I don't know why...
+ .c configure -xscrollincrement 0 -yscrollincrement 5
+ .c xview moveto 0.6
+ update
+ set x [list [.c xview]]
+ .c xview scroll 2 units
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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]
+deleteWindows
+
+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 ""
+} {}
+test canvas-10.1 {find items using tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 60 40 80 -fill yellow -tag [list b a]
+ .c create oval 20 100 40 120 -fill green -tag [list c b]
+ .c create oval 20 140 40 160 -fill blue -tag [list b]
+ .c create oval 20 180 40 200 -fill bisque -tag [list a d e]
+ .c create oval 20 220 40 240 -fill bisque -tag b
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ set res {}
+ lappend res [.c find withtag {!a}]
+ lappend res [.c find withtag {b&&c}]
+ lappend res [.c find withtag {b||c}]
+ lappend res [.c find withtag {a&&!b}]
+ lappend res [.c find withtag {!b&&!c}]
+ lappend res [.c find withtag {d&&a&&c&&b}]
+ lappend res [.c find withtag {b^a}]
+ lappend res [.c find withtag {(a&&!b)||(!a&&b)}]
+ lappend res [.c find withtag { ( a && ! b ) || ( ! a && b ) }]
+ lappend res [.c find withtag {a&&!(c||d)}]
+ lappend res [.c find withtag {d&&"tag with spaces"}]
+ lappend res [.c find withtag "tag with spaces"]
+} {{3 4 6 7} {1 3} {1 2 3 4 6} 5 {5 7} 1 {3 4 5 6} {3 4 5 6} {3 4 5 6} 2 7 7}
+test canvas-10.2 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {&&c}} err
+ set err
+} {Unexpected operator in tag search expression}
+test canvas-10.3 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {!!c}} err
+ set err
+} {Too many '!' in tag search expression}
+test canvas-10.4 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {b||}} err
+ set err
+} {Missing tag in tag search expression}
+test canvas-10.5 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {b&&(c||)}} err
+ set err
+} {Unexpected operator in tag search expression}
+test canvas-10.6 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {d&&""}} err
+ set err
+} {Null quoted tag string in tag search expression}
+test canvas-10.7 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag "d&&\"tag with spaces"} err
+ set err
+} {Missing endquote in tag search expression}
+test canvas-10.8 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {a&&"tag with spaces"z}} err
+ set err
+} {Invalid boolean operator in tag search expression}
+test canvas-10.9 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {a&&b&c}} err
+ set err
+} {Singleton '&' in tag search expression}
+test canvas-10.10 {check errors from tag expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list a b c d]
+ .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"]
+ catch {.c find withtag {a||b|c}} err
+ set err
+} {Singleton '|' in tag search expression}
+test canvas-10.11 {backward compatility - strange tags that are not expressions} {
+ catch {destroy .c}
+ canvas .c
+ .c create oval 20 20 40 40 -fill red -tag [list { strange tag(xxx&yyy|zzz) " && \" || ! ^ " }]
+ .c find withtag { strange tag(xxx&yyy|zzz) " && \" || ! ^ " }
+} {1}
+test canvas-10.12 {multple events bound to same tag expr} {
+ catch {destroy .c}
+ canvas .c
+ .c bind {a && b} <Enter> {puts Enter}
+ .c bind {a && b} <Leave> {puts Leave}
+} {}
+
+test canvas-11.1 {canvas poly fill check, bug 5783} {
+ # This would crash in 8.3.0 and 8.3.1
+ destroy .c
+ pack [canvas .c]
+ .c create polygon 0 0 100 100 200 50 \
+ -fill {} -stipple gray50 -outline black
+} 1
+test canvas-11.2 {canvas poly overlap fill check, bug 226357} {
+ destroy .c
+ pack [canvas .c]
+ set result {}
+ .c create poly 30 30 90 90 30 90 90 30
+ lappend result [.c find over 40 40 45 45]; # rect region inc. edge
+ lappend result [.c find over 60 40 60 40]; # top-center point
+ lappend result [.c find over 0 0 0 0]; # not on poly
+ lappend result [.c find over 60 60 60 60]; # center-point
+ lappend result [.c find over 45 50 45 50]; # outside poly
+ .c itemconfig 1 -fill "" -outline black
+ lappend result [.c find over 40 40 45 45]; # rect region inc. edge
+ lappend result [.c find over 60 40 60 40]; # top-center point
+ lappend result [.c find over 0 0 0 0]; # not on poly
+ lappend result [.c find over 60 60 60 60]; # center-point
+ lappend result [.c find over 45 50 45 50]; # outside poly
+ .c itemconfig 1 -width 8
+ lappend result [.c find over 45 50 45 50]; # outside poly
+} {1 1 {} 1 {} 1 1 {} 1 {} 1}
+
+test canvas-12.1 {canvas mm obj, patch SF-403327, 102471} {
+ destroy .c
+ pack [canvas .c]
+ set qx [expr {1.+1.}]
+ # qx has type double and no string representation
+ .c scale all $qx 0 1. 1.
+ # qx has now type MMRep and no string representation
+ list $qx [string length $qx]
+} {2.0 3}
+test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} {
+ destroy .c
+ pack [canvas .c]
+ set val 10
+ incr val
+ # qx has type double and no string representation
+ .c scale all $val 0 1 1
+ # qx has now type MMRep and no string representation
+ incr val
+} {12}
+
+proc kill_canvas {w} {
+ destroy $w
+ pack [canvas $w -height 200 -width 200] -fill both -expand yes
+ update idle
+ $w create rectangle 80 80 120 120 -fill blue -tags blue
+ # bind a button press to re-build the canvas
+ $w bind blue <ButtonRelease-1> [subst {
+ [lindex [info level 0] 0] $w
+ append ::x ok
+ }
+ ]
+}
+
+test canvas-13.1 {canvas delete during event, SF bug-228024} {
+ kill_canvas .c
+ set ::x {}
+ # do this many times to improve chances of triggering the crash
+ for {set i 0} {$i < 30} {incr i} {
+ event generate .c <1> -x 100 -y 100
+ event generate .c <ButtonRelease-1> -x 100 -y 100
+ }
+ set ::x
+} okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok
+
+test canvas-14.1 {canvas scan SF bug 581560} {
+ destroy .c; canvas .c
+ list [catch {.c scan} msg] $msg
+} {1 {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}}
+test canvas-14.2 {canvas scan} {
+ destroy .c; canvas .c
+ list [catch {.c scan bogus} msg] $msg
+} {1 {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}}
+test canvas-14.3 {canvas scan} {
+ destroy .c; canvas .c
+ list [catch {.c scan mark} msg] $msg
+} {1 {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}}
+test canvas-14.4 {canvas scan} {
+ destroy .c; canvas .c
+ list [catch {.c scan mark 10 10} msg] $msg
+} {0 {}}
+test canvas-14.5 {canvas scan} {
+ destroy .c; canvas .c
+ list [catch {.c scan mark 10 10 5} msg] $msg
+} {1 {wrong # args: should be ".c scan mark x y"}}
+test canvas-14.6 {canvas scan} {
+ destroy .c; canvas .c
+ list [catch {.c scan dragto 10 10 5} msg] $msg
+} {0 {}}
+
+destroy .c
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/choosedir.test b/tcl/tests/choosedir.test
new file mode 100644
index 00000000000..799c07b7f70
--- /dev/null
+++ b/tcl/tests/choosedir.test
@@ -0,0 +1,154 @@
+# This file is a Tcl script to test out Tk's "tk_chooseDir" and
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+#
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeDirectory
+
+#----------------------------------------------------------------------
+#
+# Procedures needed by this test file
+#
+#----------------------------------------------------------------------
+
+proc ToPressButton {parent btn} {
+ after 100 SendButtonPress $parent $btn mouse
+}
+
+proc ToEnterDirsByKey {parent dirs} {
+ after 100 [list EnterDirsByKey $parent $dirs]
+}
+
+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 EnterDirsByKey {parent dirs} {
+ global tk_strictMotif
+ if {$parent == "."} {
+ set w .__tk_choosedir
+ } else {
+ set w $parent.__tk_choosedir
+ }
+ upvar ::tk::dialog::file::__tk_choosedir data
+
+ foreach dir $dirs {
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $dir
+ update
+ SendButtonPress $parent ok mouse
+ after 50
+ }
+}
+
+proc SendButtonPress {parent btn type} {
+ global tk_strictMotif
+ if {$parent == "."} {
+ set w .__tk_choosedir
+ } else {
+ set w $parent.__tk_choosedir
+ }
+ upvar ::tk::dialog::file::__tk_choosedir 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
+#
+#----------------------------------------------------------------------
+# Make a dir for us to rely on for tests
+makeDirectory choosedirTest
+set dir [pwd]
+set fake [file join $dir non-existant]
+set real [file join $dir choosedirTest]
+
+set parent .
+
+foreach opt {-initialdir -mustexist -parent -title} {
+ test choosedir-1.1 "tk_chooseDirectory command" unixOnly {
+ list [catch {tk_chooseDirectory $opt} msg] $msg
+ } [list 1 "value for \"$opt\" missing"]
+}
+test choosedir-1.2 "tk_chooseDirectory command" unixOnly {
+ list [catch {tk_chooseDirectory -foo bar} msg] $msg
+} [list 1 "bad option \"-foo\": must be -initialdir, -mustexist, -parent, or -title"]
+test choosedir-1.3 "tk_chooseDirectory command" unixOnly {
+ list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg
+} {1 {bad window path name "foo.bar"}}
+
+
+test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unixOnly} {
+ ToPressButton $parent cancel
+ tk_chooseDirectory -title "Press Cancel" -parent $parent
+} ""
+
+test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly} {
+ # first enter a bogus dirname, then enter a real one.
+ ToEnterDirsByKey $parent [list $fake $real $real]
+ set result [tk_chooseDirectory \
+ -title "Enter \"$fake\", press OK, enter \"$real\", press OK" \
+ -parent $parent -mustexist 1]
+ set result
+} $real
+test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly} {
+ ToEnterDirsByKey $parent [list $fake $fake]
+ tk_chooseDirectory -title "Enter \"$fake\", press OK" \
+ -parent $parent -mustexist 0
+} $fake
+
+test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unixOnly} {
+ ToPressButton $parent ok
+ tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
+} $real
+test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unixOnly} {
+ ToEnterDirsByKey $parent [list $fake $fake]
+ tk_chooseDirectory \
+ -title "Enter \"$fake\" and press Ok" \
+ -parent $parent -initialdir $real
+} $fake
+test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unixOnly} {
+ catch {unset ::tk::dialog::file::__tk_choosedir}
+ ToPressButton $parent ok
+ tk_chooseDirectory \
+ -title "Press OK" \
+ -parent $parent -initialdir ""
+} [pwd]
+
+test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unixOnly} {
+ ToEnterDirsByKey $parent [list "" $real $real]
+ tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \
+ -parent $parent
+} $real
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/clipboard.test b/tcl/tests/clipboard.test
new file mode 100644
index 00000000000..b117169de33
--- /dev/null
+++ b/tcl/tests/clipboard.test
@@ -0,0 +1,262 @@
+# This file is a Tcl script to test out Tk's clipboard management code,
+# especially the "clipboard" command. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+#
+# Note: Multiple display clipboard handling will only be tested if the
+# environment variable TK_ALT_DISPLAY is set to an alternate display.
+#
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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"
+ clipboard get
+} {test}
+test clipboard-1.2 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append "test"
+ clipboard append "ing"
+ clipboard get
+} {testing}
+test clipboard-1.3 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append "t"
+ clipboard append "e"
+ clipboard append "s"
+ clipboard append "t"
+ clipboard get
+} {test}
+test clipboard-1.4 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append $longValue
+ clipboard get
+} "$longValue"
+test clipboard-1.5 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append $longValue
+ clipboard append "test"
+ clipboard get
+} "${longValue}test"
+test clipboard-1.6 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append -t TEST $longValue
+ clipboard append -t STRING "test"
+ list [clipboard get -t STRING] \
+ [clipboard get -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 [clipboard get -t STRING] \
+ [clipboard get -t TEST]
+} [list test [string range $longValue 1 4000]]
+test clipboard-1.8 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append ""
+ clipboard get
+} {}
+test clipboard-1.9 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append ""
+ clipboard append "Test"
+ clipboard get
+} {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 {clipboard get} 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 {clipboard get} msg] $msg \
+ [catch {clipboard get -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 {clipboard get} msg] $msg \
+ [catch {clipboard get -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 [clipboard get TARGETS]]
+ clipboard clear
+ list $result [lsort [clipboard get 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 [clipboard get TARGETS]]
+ selection own -s CLIPBOARD .
+ lappend result [lsort [clipboard get TARGETS]]
+ clipboard clear
+ clipboard append -t TEST "test"
+ lappend result [lsort [clipboard get 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"
+ clipboard get
+ } 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 {clipboard get 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 {bad option "--x": must be -displayof, -format, or -type}}
+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 {bad option "-displayofoo": must be -displayof, -format, or -type}}
+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 {wrong # args: should be "clipboard clear ?-displayof window?"}}
+test clipboard-7.11 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard clear -displayofoo f} msg] $msg
+} {1 {bad option "-displayofoo": must be -displayof}}
+test clipboard-7.12 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard clear foo} msg] $msg
+} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}}
+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 append, clear, or get}}
+
+test clipboard-7.15 {Tk_ClipboardCmd procedure} {
+ clipboard clear
+ list [catch {clipboard append -displayof} msg] $msg \
+ [selection get -selection CLIPBOARD]
+} {0 {} -displayof}
+test clipboard-7.16 {Tk_ClipboardCmd procedure} {
+ clipboard clear
+ list [catch {clipboard append -type} msg] $msg \
+ [selection get -selection CLIPBOARD]
+} {0 {} -type}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/clrpick.test b/tcl/tests/clrpick.test
new file mode 100644
index 00000000000..4da9bfac72f
--- /dev/null
+++ b/tcl/tests/clrpick.test
@@ -0,0 +1,219 @@
+# This file is a Tcl script to test out Tk's "tk_chooseColor" command.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+#
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test clrpick-1.1 {tk_chooseColor command} {
+ list [catch {tk_chooseColor -foo} msg] $msg
+} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
+
+catch {tk_chooseColor -foo 1} msg
+regsub -all , $msg "" options
+regsub \"-foo\" $options "" options
+
+foreach option $options {
+ if {[string index $option 0] == "-"} {
+ test clrpick-1.2 {tk_chooseColor command} {
+ list [catch {tk_chooseColor $option} msg] $msg
+ } [list 1 "value for \"$option\" missing"]
+ }
+}
+
+test clrpick-1.3 {tk_chooseColor command} {
+ list [catch {tk_chooseColor -foo bar} msg] $msg
+} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
+
+test clrpick-1.4 {tk_chooseColor command} {
+ list [catch {tk_chooseColor -initialcolor} msg] $msg
+} {1 {value for "-initialcolor" missing}}
+
+test clrpick-1.5 {tk_chooseColor command} {
+ list [catch {tk_chooseColor -parent foo.bar} msg] $msg
+} {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 tk::dialog::color::] == ""} {
+ set isNative 1
+} else {
+ set isNative 0
+}
+
+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 ::tk::dialog::color::[winfo name $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.
+ tk::dialog::color::HandleRGBEntry $w
+
+ SendButtonPress $parent ok mouse
+}
+
+proc SendButtonPress {parent btn type} {
+ set w .__tk__color
+ upvar ::tk::dialog::color::[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
+ }
+}
+
+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.
+# some tests will be skipped if there are no more colors
+set numcolors 32
+testConstraint colorsLeftover 1
+set i 0
+canvas .c
+pack .c -expand 1 -fill both
+while {$i<$numcolors} {
+ set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]]
+ .c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color
+ incr i
+}
+set i 0
+while {$i<$numcolors} {
+ set color [.c itemcget $i -fill]
+ if {$color != ""} {
+ foreach {r g b} [winfo rgb . $color] {}
+ set r [expr $r/256]
+ set g [expr $g/256]
+ set b [expr $b/256]
+ if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
+ testConstraint colorsLeftover 0
+ }
+ }
+ .c delete $i
+ incr i
+}
+
+destroy .c
+
+set color #404040
+test clrpick-2.1 {tk_chooseColor command} \
+ {nonUnixUserInteraction colorsLeftover} {
+ ToPressButton $parent ok
+ tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \
+ -parent $parent
+} "$color"
+
+set color #808040
+test clrpick-2.2 {tk_chooseColor command} \
+ {nonUnixUserInteraction colorsLeftover} {
+ if {$tcl_platform(platform) == "macintosh"} {
+ set colors "32768 32768 16384"
+ } else {
+ set colors "128 128 64"
+ }
+ ToChooseColorByKey $parent 128 128 64
+ tk_chooseColor -parent $parent -title "choose $colors"
+} "$color"
+
+test clrpick-2.3 {tk_chooseColor command} \
+ {nonUnixUserInteraction colorsLeftover} {
+ ToPressButton $parent ok
+ tk_chooseColor -parent $parent -title "Press OK"
+} "$color"
+
+test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} {
+ ToPressButton $parent cancel
+ tk_chooseColor -parent $parent -title "Press Cancel"
+} ""
+
+set color "#000000"
+test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} {
+ after 1 {set x 53}
+ ToPressButton $parent ok
+ tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color
+} "#000000"
+test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
+ after 1 {set x 53}
+ ToPressButton $parent cancel
+ tk_chooseColor -parent $parent -title "Press Cancel"
+} ""
+
+test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} unixOnly {
+ after 50 {set ::scr [winfo screen .__tk__color]}
+ ToPressButton $parent cancel
+ tk_chooseColor -parent $parent
+ set ::scr
+} [winfo screen $parent]
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/cmap.tcl b/tcl/tests/cmap.tcl
new file mode 100644
index 00000000000..f39d1786c60
--- /dev/null
+++ b/tcl/tests/cmap.tcl
@@ -0,0 +1,74 @@
+# 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/tcl/tests/cmds.test b/tcl/tests/cmds.test
new file mode 100644
index 00000000000..9cba0c56e15
--- /dev/null
+++ b/tcl/tests/cmds.test
@@ -0,0 +1,60 @@
+# This file is a Tcl script to test the procedures in the file
+# tkCmds.c. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/color.test b/tcl/tests/color.test
new file mode 100644
index 00000000000..d9cf5f9a2f9
--- /dev/null
+++ b/tcl/tests/color.test
@@ -0,0 +1,276 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkColor.c. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1995-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint testcolor [llength [info commands testcolor]]
+
+# 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)
+}
+
+if {[testConstraint psuedocolor8]} {
+ toplevel .t -visual {pseudocolor 8} -colormap new
+ wm geom .t +0+0
+ mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
+ pack .t.c
+ update
+
+ testConstraint colorsFree [colorsFree .t.c 101 233 17]
+
+ if {[testConstraint colorsFree]} {
+ mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
+ pack .t.c2
+ testConstraint colorsFree [expr {![colorsFree .t.c]}]
+ }
+ destroy .t.c .t.c2
+}
+
+test color-1.1 {Tk_AllocColorFromObj - converting internal reps} colorsFree {
+ set x green
+ lindex $x 0
+ destroy .b1
+ button .b1 -foreground $x -text .b1
+ lindex $x 0
+ testcolor green
+} {{1 0}}
+test color-1.2 {Tk_AllocColorFromObj - discard stale color} colorsFree {
+ set x green
+ destroy .b1 .b2
+ button .b1 -foreground $x -text First
+ destroy .b1
+ set result {}
+ lappend result [testcolor green]
+ button .b2 -foreground $x -text Second
+ lappend result [testcolor green]
+} {{} {{1 1}}}
+test color-1.3 {Tk_AllocColorFromObj - reuse existing color} colorsFree {
+ set x green
+ destroy .b1 .b2
+ button .b1 -foreground $x -text First
+ set result {}
+ lappend result [testcolor green]
+ button .b2 -foreground $x -text Second
+ pack .b1 .b2 -side top
+ lappend result [testcolor green]
+} {{{1 1}} {{2 1}}}
+test color-1.4 {Tk_AllocColorFromObj - try other colors in list} colorsFree {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -foreground $x -text First
+ pack .b1 -side top
+ set result {}
+ lappend result [testcolor purple]
+ button .t.b -foreground $x -text Second
+ pack .t.b -side top
+ lappend result [testcolor purple]
+ button .b2 -foreground $x -text Third
+ pack .b2 -side top
+ lappend result [testcolor purple]
+} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
+
+test color-2.1 {Tk_GetColor procedure} colorsFree {
+ c255 [winfo rgb .t #FF0000]
+} {255 0 0}
+test color-2.2 {Tk_GetColor procedure} colorsFree {
+ list [catch {winfo rgb .t noname} msg] $msg
+} {1 {unknown color name "noname"}}
+test color-2.3 {Tk_GetColor procedure} colorsFree {
+ c255 [winfo rgb .t #123456]
+} {18 52 86}
+test color-2.4 {Tk_GetColor procedure} colorsFree {
+ list [catch {winfo rgb .t #xyz} msg] $msg
+} {1 {invalid color name "#xyz"}}
+test color-2.5 {Tk_GetColor procedure} colorsFree {
+ winfo rgb .t #00FF00
+} {0 65535 0}
+test color-2.6 {Tk_GetColor procedure} {colorsFree nonPortable} {
+ # Red doesn't always map to *pure* red
+ winfo rgb .t red
+} {65535 0 0}
+test color-2.7 {Tk_GetColor procedure} colorsFree {
+ winfo rgb .t #ff0000
+} {65535 0 0}
+
+test color-3.1 {Tk_FreeColor procedure, reference counting} colorsFree {
+ eval destroy [winfo child .t]
+ mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
+ pack .t.c
+ mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
+ pack .t.c2
+ update
+ set last [.t.c2 create rectangle 50 50 70 60 -outline {} \
+ -fill [cname 0 240 240]]
+ .t.c delete 1
+ set result [colorsFree .t]
+ .t.c2 delete $last
+ lappend result [colorsFree .t]
+} {0 1}
+test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} colorsFree {
+ eval destroy [winfo child .t]
+ mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
+ pack .t.c
+ mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
+ mkColors .t.c2 20 1 250 250 0 -10 -10 0 0 0 0
+ pack .t.c2
+ update
+ closest .t 241 241 1
+} {240 240 0}
+test color-3.3 {Tk_FreeColorFromObj - reference counts} colorsFree {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -foreground $x -text First
+ pack .b1 -side top
+ button .t.b -foreground $x -text Second
+ pack .t.b -side top
+ button .b2 -foreground $x -text Third
+ pack .b2 -side top
+ set result {}
+ lappend result [testcolor purple]
+ destroy .b1
+ lappend result [testcolor purple]
+ destroy .b2
+ lappend result [testcolor purple]
+ destroy .t.b
+ lappend result [testcolor purple]
+} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
+test color-3.4 {Tk_FreeColorFromObj - unlinking from list} colorsFree {
+ destroy .b .t.b .t2 .t3
+ toplevel .t2 -visual {pseudocolor 8} -colormap new
+ toplevel .t3 -visual {pseudocolor 8} -colormap new
+ set x purple
+ button .b -foreground $x -text .b1
+ button .t.b1 -foreground $x -text .t.b1
+ button .t.b2 -foreground $x -text .t.b2
+ button .t2.b1 -foreground $x -text .t2.b1
+ button .t2.b2 -foreground $x -text .t2.b2
+ button .t2.b3 -foreground $x -text .t2.b3
+ button .t3.b1 -foreground $x -text .t3.b1
+ button .t3.b2 -foreground $x -text .t3.b2
+ button .t3.b3 -foreground $x -text .t3.b3
+ button .t3.b4 -foreground $x -text .t3.b4
+ set result {}
+ lappend result [testcolor purple]
+ destroy .t2
+ lappend result [testcolor purple]
+ destroy .b
+ lappend result [testcolor purple]
+ destroy .t3
+ lappend result [testcolor purple]
+ destroy .t
+ lappend result [testcolor purple]
+} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
+test color-4.1 {FreeColorObjProc} colorsFree {
+ destroy .b
+ set x [format purple]
+ button .b -foreground $x -text .b1
+ set y [format purple]
+ .b configure -foreground $y
+ set z [format purple]
+ .b configure -foreground $z
+ set result {}
+ lappend result [testcolor purple]
+ set x red
+ lappend result [testcolor purple]
+ set z 32
+ lappend result [testcolor purple]
+ destroy .b
+ lappend result [testcolor purple]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/config.test b/tcl/tests/config.test
new file mode 100644
index 00000000000..f6b1d1f89f3
--- /dev/null
+++ b/tcl/tests/config.test
@@ -0,0 +1,897 @@
+# This file is a Tcl script to test the procedures in tkConfig.c,
+# which comprise the new new option configuration system. It is
+# organized in the standard "white-box" fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint testobjconfig [llength [info commands testobjconfig]]
+
+proc killTables {} {
+ # Note: it's important to delete chain2 before chain1, because
+ # chain2 depends on chain1. If chain1 is deleted first, the
+ # delete of chain2 will crash.
+
+ foreach t {alltypes chain2 chain1 configerror internal new notenoughparams
+ twowindows} {
+ while {[testobjconfig info $t] != ""} {
+ testobjconfig delete $t
+ }
+ }
+}
+
+if {[testConstraint testobjconfig]} {
+ killTables
+}
+
+test config-1.1 {Tk_CreateOptionTable - reference counts} testobjconfig {
+ deleteWindows
+ killTables
+ set x {}
+ testobjconfig alltypes .a
+ lappend x [testobjconfig info alltypes]
+ testobjconfig alltypes .b
+ lappend x [testobjconfig info alltypes]
+ deleteWindows
+ set x
+} {{1 16 -boolean} {2 16 -boolean}}
+test config-1.2 {Tk_CreateOptionTable - synonym initialization} testobjconfig {
+ deleteWindows
+ testobjconfig alltypes .a -synonym green
+ .a cget -color
+} {green}
+test config-1.3 {Tk_CreateOptionTable - option database initialization} testobjconfig {
+ deleteWindows
+ option clear
+ testobjconfig alltypes .a
+ option add *b.string different
+ testobjconfig alltypes .b
+ list [.a cget -string] [.b cget -string]
+} {foo different}
+test config-1.4 {Tk_CreateOptionTable - option database initialization} testobjconfig {
+ deleteWindows
+ option clear
+ testobjconfig alltypes .a
+ option add *b.String bar
+ testobjconfig alltypes .b
+ list [.a cget -string] [.b cget -string]
+} {foo bar}
+test config-1.5 {Tk_CreateOptionTable - default initialization} testobjconfig {
+ deleteWindows
+ testobjconfig alltypes .a
+ .a cget -relief
+} {raised}
+test config-1.6 {Tk_CreateOptionTable - chained tables} testobjconfig {
+ deleteWindows
+ killTables
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ testobjconfig info chain2
+} {1 4 -three 2 2 -one}
+test config-1.7 {Tk_CreateOptionTable - chained tables} testobjconfig {
+ deleteWindows
+ killTables
+ testobjconfig chain2 .b
+ testobjconfig chain1 .a
+ testobjconfig info chain2
+} {1 4 -three 2 2 -one}
+test config-1.8 {Tk_CreateOptionTable - chained tables} testobjconfig {
+ deleteWindows
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ list [catch {.a cget -four} msg] $msg [.a cget -one] \
+ [.b cget -four] [.b cget -one]
+} {1 {unknown option "-four"} one four one}
+
+test config-2.1 {Tk_DeleteOptionTable - reference counts} testobjconfig {
+ deleteWindows
+ killTables
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ testobjconfig chain2 .c
+ deleteWindows
+ set x {}
+ testobjconfig delete chain2
+ lappend x [testobjconfig info chain2] [testobjconfig info chain1]
+ testobjconfig delete chain2
+ lappend x [testobjconfig info chain2] [testobjconfig info chain1]
+} {{1 4 -three 2 2 -one} {2 2 -one} {} {1 2 -one}}
+
+# No tests for DestroyOptionHashTable; couldn't figure out how to test.
+
+test config-3.1 {Tk_InitOptions - priority of chained tables} testobjconfig {
+ deleteWindows
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ list [.a cget -two] [.b cget -two]
+} {two {two and a half}}
+test config-3.2 {Tk_InitOptions - initialize from database} testobjconfig {
+ deleteWindows
+ option clear
+ option add *a.color blue
+ testobjconfig alltypes .a
+ list [.a cget -color]
+} {blue}
+test config-3.3 {Tk_InitOptions - initialize from database} testobjconfig {
+ deleteWindows
+ option clear
+ option add *a.justify bogus
+ testobjconfig alltypes .a
+ list [.a cget -justify]
+} {left}
+test config-3.4 {Tk_InitOptions - initialize from widget class} testobjconfig {
+ deleteWindows
+ testobjconfig alltypes .a
+ list [.a cget -color]
+} {red}
+test config-3.5 {Tk_InitOptions - no initial value} testobjconfig {
+ deleteWindows
+ testobjconfig alltypes .a
+ .a cget -anchor
+} {}
+test config-3.6 {Tk_InitOptions - bad initial value} testobjconfig {
+ deleteWindows
+ option clear
+ option add *a.color non-existent
+ list [catch {testobjconfig alltypes .a} msg] $msg $errorInfo
+} {1 {unknown color name "non-existent"} {unknown color name "non-existent"
+ (database entry for "-color" in widget ".a")
+ invoked from within
+"testobjconfig alltypes .a"}}
+option clear
+test config-3.7 {Tk_InitOptions - bad initial value} testobjconfig {
+ deleteWindows
+ list [catch {testobjconfig configerror} msg] $msg $errorInfo
+} {1 {expected integer but got "bogus"} {expected integer but got "bogus"
+ (default value for "-int")
+ invoked from within
+"testobjconfig configerror"}}
+option clear
+
+test config-4.1 {DoObjConfig - boolean} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -boolean 0} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 0 0}
+test config-4.2 {DoObjConfig - boolean} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -boolean 1} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 1 0}
+test config-4.3 {DoObjConfig - invalid boolean} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -boolean {}} msg] $msg
+} {1 {expected boolean value but got ""}}
+test config-4.4 {DoObjConfig - boolean internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -boolean 0
+ .foo cget -boolean
+} {0}
+test config-4.5 {DoObjConfig - integer} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -integer 3} msg] $msg [catch {.foo cget -integer} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 3 0}
+test config-4.6 {DoObjConfig - invalid integer} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -integer bar} msg] $msg
+} {1 {expected integer but got "bar"}}
+test config-4.7 {DoObjConfig - integer internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -integer 421
+ .foo cget -integer
+} {421}
+test config-4.8 {DoObjConfig - double} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -double 3.14} msg] $msg [catch {.foo cget -double} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 3.14 0}
+test config-4.9 {DoObjConfig - invalid double} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -double bar} msg] $msg
+} {1 {expected floating-point number but got "bar"}}
+test config-4.10 {DoObjConfig - double internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -double 62.75
+ .foo cget -double
+} {62.75}
+test config-4.11 {DoObjConfig - string} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -string test} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
+} {0 .foo 0 test {}}
+test config-4.12 {DoObjConfig - null string} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -string {}} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.13 {DoObjConfig - string internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -string "this is a test"
+ .foo cget -string
+} {this is a test}
+test config-4.14 {DoObjConfig - string table} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -stringtable two} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
+} {0 .foo 0 two {}}
+test config-4.15 {DoObjConfig - invalid string table} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -stringtable foo} msg] $msg
+} {1 {bad stringtable "foo": must be one, two, three, or four}}
+test config-4.16 {DoObjConfig - new string table} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -stringtable two
+ list [catch {.foo configure -stringtable three} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
+} {0 16 0 three {}}
+test config-4.17 {DoObjConfig - stringtable internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -stringtable "four"
+ .foo cget -stringtable
+} {four}
+test config-4.18 {DoObjConfig - color} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -color blue} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 .foo 0 blue {}}
+test config-4.19 {DoObjConfig - invalid color} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -color xxx} msg] $msg
+} {1 {unknown color name "xxx"}}
+test config-4.20 {DoObjConfig - color internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -color purple
+ .foo cget -color
+} {purple}
+test config-4.21 {DoObjConfig - null color} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -color {}} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.22 {DoObjConfig - getting rid of old color} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -color #333333
+ list [catch {.foo configure -color #444444} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 32 0 #444444 {}}
+test config-4.23 {DoObjConfig - font} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 .foo 0 {Helvetica 72} {}}
+test config-4.24 {DoObjConfig - new font} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig alltypes .foo -font {Courier 12}
+ list [catch {.foo configure -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 64 0 {Helvetica 72} {}}
+test config-4.25 {DoObjConfig - invalid font} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -font {Helvetica 12 foo}} msg] $msg
+} {1 {unknown font style "foo"}}
+test config-4.26 {DoObjConfig - null font} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -font {}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.27 {DoObjConfig - font internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -font {Times 16}
+ .foo cget -font
+} {Times 16}
+test config-4.28 {DoObjConfig - bitmap} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -bitmap gray75} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 .foo 0 gray75 {}}
+test config-4.29 {DoObjConfig - new bitmap} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -bitmap gray75
+ list [catch {.foo configure -bitmap gray50} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 128 0 gray50 {}}
+test config-4.30 {DoObjConfig - invalid bitmap} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -bitmap foo} msg] $msg
+} {1 {bitmap "foo" not defined}}
+test config-4.31 {DoObjConfig - null bitmap} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -bitmap {}} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.32 {DoObjConfig - bitmap internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -bitmap gray25
+ .foo cget -bitmap
+} {gray25}
+test config-4.33 {DoObjConfig - border} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -border green} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 .foo 0 green {}}
+test config-4.34 {DoObjConfig - invalid border} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -border xxx} msg] $msg
+} {1 {unknown color name "xxx"}}
+test config-4.35 {DoObjConfig - null border} testobjconfig {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -border {}} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.36 {DoObjConfig - border internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -border #123456
+ .foo cget -border
+} {#123456}
+test config-4.37 {DoObjConfig - getting rid of old border} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -border #333333
+ list [catch {.foo configure -border #444444} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 256 0 #444444 {}}
+test config-4.38 {DoObjConfig - relief} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
+} {0 .foo 0 flat {}}
+test config-4.39 {DoObjConfig - invalid relief} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -relief foo} msg] $msg
+} {1 {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken}}
+test config-4.40 {DoObjConfig - new relief} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -relief raised
+ list [catch {.foo configure -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
+} {0 512 0 flat {}}
+test config-4.41 {DoObjConfig - relief internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -relief ridge
+ .foo cget -relief
+} {ridge}
+test config-4.42 {DoObjConfig - cursor} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 .foo 0 arrow {}}
+test config-4.43 {DoObjConfig - invalid cursor} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -cursor foo} msg] $msg
+} {1 {bad cursor spec "foo"}}
+test config-4.44 {DoObjConfig - null cursor} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -cursor {}} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.45 {DoObjConfig - new cursor} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -cursor xterm
+ list [catch {.foo configure -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 1024 0 arrow {}}
+test config-4.46 {DoObjConfig - cursor internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -cursor watch
+ .foo cget -cursor
+} {watch}
+test config-4.47 {DoObjConfig - justify} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -justify center} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
+} {0 .foo 0 center {}}
+test config-4.48 {DoObjConfig - invalid justify} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -justify foo} msg] $msg
+} {1 {bad justification "foo": must be left, right, or center}}
+test config-4.49 {DoObjConfig - new justify} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -justify left
+ list [catch {.foo configure -justify right} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
+} {0 2048 0 right {}}
+test config-4.50 {DoObjConfig - justify internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -justify center
+ .foo cget -justify
+} {center}
+test config-4.51 {DoObjConfig - anchor} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -anchor center} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
+} {0 .foo 0 center {}}
+test config-4.52 {DoObjConfig - invalid anchor} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -anchor foo} msg] $msg
+} {1 {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, or center}}
+test config-4.53 {DoObjConfig - new anchor} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -anchor e
+ list [catch {.foo configure -anchor n} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
+} {0 4096 0 n {}}
+test config-4.54 {DoObjConfig - anchor internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -anchor sw
+ .foo cget -anchor
+} {sw}
+test config-4.55 {DoObjConfig - pixel} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -pixel 42} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
+} {0 .foo 0 42 {}}
+test config-4.56 {DoObjConfig - invalid pixel} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -pixel foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+test config-4.57 {DoObjConfig - new pixel} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -pixel 42m
+ list [catch {.foo configure -pixel 3c} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
+} {0 8192 0 3c {}}
+test config-4.58 {DoObjConfig - pixel internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -pixel [winfo screenmmwidth .]m
+ .foo cget -pixel
+} [winfo screenwidth .]
+test config-4.59 {DoObjConfig - window} testobjconfig {
+ catch {destroy .foo}
+ catch {destroy .bar}
+ toplevel .bar
+ list [catch {testobjconfig twowindows .foo -window .bar} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar]
+} {0 .foo 0 .bar {} {}}
+test config-4.60 {DoObjConfig - invalid window} testobjconfig {
+ catch {destroy .foo}
+ toplevel .bar
+ list [catch {testobjconfig twowindows .foo -window foo} msg] $msg [destroy .bar]
+} {1 {bad window path name "foo"} {}}
+test config-4.61 {DoObjConfig - null window} testobjconfig {
+ catch {destroy .foo}
+ catch {destroy .bar}
+ toplevel .bar
+ list [catch {testobjconfig twowindows .foo -window {}} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.62 {DoObjConfig - new window} testobjconfig {
+ catch {destroy .foo}
+ catch {destroy .bar}
+ catch {destroy .blamph}
+ toplevel .bar
+ toplevel .blamph
+ testobjconfig twowindows .foo -window .bar
+ list [catch {.foo configure -window .blamph} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar] [destroy .blamph]
+} {0 0 0 .blamph {} {} {}}
+test config-4.63 {DoObjConfig - window internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -window .
+ .foo cget -window
+} {.}
+test config-4.64 {DoObjConfig - releasing old values} testobjconfig {
+ # This test doesn't generate a useful value to check; if an
+ # error occurs, it will be detected only by memory checking software
+ # such as Purify or Tcl's built-in checker.
+
+ catch {rename .foo {}}
+ testobjconfig alltypes .foo -string {Test string} -color yellow \
+ -font {Courier 18} -bitmap questhead -border green -cursor cross \
+ -custom foobar
+ .foo configure -string {new string} -color brown \
+ -font {Times 8} -bitmap gray75 -border pink -cursor watch \
+ -custom barbaz
+ concat {}
+} {}
+test config-4.65 {DoObjConfig - releasing old values} testobjconfig {
+ # This test doesn't generate a useful value to check; if an
+ # error occurs, it will be detected only by memory checking software
+ # such as Purify or Tcl's built-in checker.
+
+ catch {rename .foo {}}
+ testobjconfig internal .foo -string {Test string} -color yellow \
+ -font {Courier 18} -bitmap questhead -border green -cursor cross \
+ -custom foobar
+ .foo configure -string {new string} -color brown \
+ -font {Times 8} -bitmap gray75 -border pink -cursor watch \
+ -custom barbaz
+ concat {}
+} {}
+test config-4.66 {DoObjConfig - custom} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -custom test} msg] $msg [catch {.foo cget -custom} result] $result [destroy .foo]
+} {0 .foo 0 TEST {}}
+test config-4.67 {DoObjConfig - null custom} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -custom {}} msg] $msg [catch {.foo cget -custom} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.68 {DoObjConfig - custom internal value} testobjconfig {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -custom "this is a test"
+ .foo cget -custom
+} {THIS IS A TEST}
+
+test config-5.1 {ObjectIsEmpty - object is already string} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -color [format ""]
+ .foo cget -color
+} {}
+test config-5.2 {ObjectIsEmpty - object is already string} testobjconfig {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -color [format " "]} msg] $msg
+} {1 {unknown color name " "}}
+test config-5.3 {ObjectIsEmpty - must convert back to string} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -color [list]
+ .foo cget -color
+} {}
+
+deleteWindows
+if {[testConstraint testobjconfig]} {
+ testobjconfig chain2 .a
+ testobjconfig alltypes .b
+}
+test config-6.1 {GetOptionFromObj - cached answer} testobjconfig {
+ list [.a cget -three] [.a cget -three]
+} {three three}
+test config-6.2 {GetOptionFromObj - exact match} testobjconfig {
+ .a cget -one
+} {one}
+test config-6.3 {GetOptionFromObj - abbreviation} testobjconfig {
+ .a cget -fo
+} {four}
+test config-6.4 {GetOptionFromObj - ambiguous abbreviation} testobjconfig {
+ list [catch {.a cget -on} msg] $msg
+} {1 {unknown option "-on"}}
+test config-6.5 {GetOptionFromObj - duplicate options in different tables} testobjconfig {
+ .a cget -tw
+} {two and a half}
+test config-6.6 {GetOptionFromObj - synonym} testobjconfig {
+ .b cget -synonym
+} {red}
+
+deleteWindows
+if {[testConstraint testobjconfig]} {
+ testobjconfig alltypes .a
+}
+test config-7.1 {Tk_SetOptions - basics} testobjconfig {
+ .a configure -color green -rel sunken
+ list [.a cget -color] [.a cget -relief]
+} {green sunken}
+test config-7.2 {Tk_SetOptions - bogus option name} testobjconfig {
+ list [catch {.a configure -bogus} msg] $msg
+} {1 {unknown option "-bogus"}}
+test config-7.3 {Tk_SetOptions - synonym} testobjconfig {
+ .a configure -synonym blue
+ .a cget -color
+} {blue}
+test config-7.4 {Tk_SetOptions - missing value} testobjconfig {
+ list [catch {.a configure -color green -relief} msg] $msg [.a cget -color]
+} {1 {value for "-relief" missing} green}
+test config-7.5 {Tk_SetOptions - saving old values} testobjconfig {
+ .a configure -color red -int 7 -relief raised -double 3.14159
+ list [catch {.a csave -color green -int 432 -relief sunken \
+ -double 2.0 -color bogus} msg] $msg [.a cget -color] \
+ [.a cget -int] [.a cget -relief] [.a cget -double]
+} {1 {unknown color name "bogus"} red 7 raised 3.14159}
+test config-7.6 {Tk_SetOptions - error in DoObjConfig call} testobjconfig {
+ list [catch {.a configure -color bogus} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+ (processing "-color" option)
+ invoked from within
+".a configure -color bogus"}}
+test config-7.7 {Tk_SetOptions - synonym name in error message} testobjconfig {
+ list [catch {.a configure -synonym bogus} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+ (processing "-synonym" option)
+ invoked from within
+".a configure -synonym bogus"}}
+test config-7.8 {Tk_SetOptions - returning mask} testobjconfig {
+ format %x [.a configure -color red -int 7 -relief raised -double 3.14159]
+} {226}
+test config-7.9 {Tk_SetOptions - error in DoObjConfig with custom option} testobjconfig {
+ list [catch {.a configure -custom bad} msg] $msg $errorInfo
+} {1 {expected good value, got "BAD"} {expected good value, got "BAD"
+ (processing "-custom" option)
+ invoked from within
+".a configure -custom bad"}}
+
+test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} testobjconfig {
+ deleteWindows
+ testobjconfig alltypes .a
+ list [catch {.a csave -color green -color black -color blue \
+ -color #ffff00 -color #ff00ff -color bogus} msg] $msg \
+ [.a cget -color]
+} {1 {unknown color name "bogus"} red}
+test config-8.2 {Tk_RestoreSavedOptions - freeing object memory} testobjconfig {
+ deleteWindows
+ testobjconfig alltypes .a
+ .a csave -color green -color black -color blue -color #ffff00 \
+ -color #ff00ff
+} {32}
+test config-8.3 {Tk_RestoreSavedOptions - boolean internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -boolean 0 -color bogus}] [.a cget -boolean]
+} {1 1}
+test config-8.4 {Tk_RestoreSavedOptions - integer internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -integer 24 -color bogus}] [.a cget -integer]
+} {1 148962237}
+test config-8.5 {Tk_RestoreSavedOptions - double internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -double 62.4 -color bogus}] [.a cget -double]
+} {1 3.14159}
+test config-8.6 {Tk_RestoreSavedOptions - string internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -string "A long string" -color bogus}] \
+ [.a cget -string]
+} {1 foo}
+test config-8.7 {Tk_RestoreSavedOptions - string table internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -stringtable three -color bogus}] \
+ [.a cget -stringtable]
+} {1 one}
+test config-8.8 {Tk_RestoreSavedOptions - color internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -color green -color bogus}] [.a cget -color]
+} {1 red}
+test config-8.9 {Tk_RestoreSavedOptions - font internal form} {testobjconfig nonPortable} {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -font {Times 12} -color bogus}] [.a cget -font]
+} {1 {Helvetica 12}}
+test config-8.10 {Tk_RestoreSavedOptions - bitmap internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -bitmap questhead -color bogus}] [.a cget -bitmap]
+} {1 gray50}
+test config-8.11 {Tk_RestoreSavedOptions - border internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -border brown -color bogus}] [.a cget -border]
+} {1 blue}
+test config-8.12 {Tk_RestoreSavedOptions - relief internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -relief sunken -color bogus}] [.a cget -relief]
+} {1 raised}
+test config-8.13 {Tk_RestoreSavedOptions - cursor internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -cursor watch -color bogus}] [.a cget -cursor]
+} {1 xterm}
+test config-8.14 {Tk_RestoreSavedOptions - justify internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -justify right -color bogus}] [.a cget -justify]
+} {1 left}
+test config-8.15 {Tk_RestoreSavedOptions - anchor internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a
+ list [catch {.a csave -anchor center -color bogus}] [.a cget -anchor]
+} {1 n}
+test config-8.16 {Tk_RestoreSavedOptions - window internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a -window .a
+ list [catch {.a csave -window .a -color bogus}] [.a cget -window]
+} {1 .a}
+test config-8.17 {Tk_RestoreSavedOptions - custom internal form} testobjconfig {
+ deleteWindows
+ testobjconfig internal .a -custom "foobar"
+ list [catch {.a csave -custom "barbaz" -color bogus}] [.a cget -custom]
+} {1 FOOBAR}
+
+# Most of the tests below will cause memory leakage if there is a
+# problem. This may not be evident unless the tests are run in
+# conjunction with a memory usage analyzer such as Purify.
+
+test config-9.1 {Tk_FreeConfigOptions/FreeResources - string internal form} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -string "two words"
+ destroy .foo
+} {}
+test config-9.2 {Tk_FreeConfigOptions/FreeResources - color internal form} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -color yellow
+ destroy .foo
+} {}
+test config-9.3 {Tk_FreeConfigOptions/FreeResources - color} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -color [format blue]
+ destroy .foo
+} {}
+test config-9.4 {Tk_FreeConfigOptions/FreeResources - font internal form} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -font {Courier 20}
+ destroy .foo
+} {}
+test config-9.5 {Tk_FreeConfigOptions/FreeResources - font} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -font [format {Courier 24}]
+ destroy .foo
+} {}
+test config-9.6 {Tk_FreeConfigOptions/FreeResources - bitmap internal form} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -bitmap gray75
+ destroy .foo
+} {}
+test config-9.7 {Tk_FreeConfigOptions/FreeResources - bitmap} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -bitmap [format gray75]
+ destroy .foo
+} {}
+test config-9.8 {Tk_FreeConfigOptions/FreeResources - border internal form} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -border orange
+ destroy .foo
+} {}
+test config-9.9 {Tk_FreeConfigOptions/FreeResources - border} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -border [format blue]
+ destroy .foo
+} {}
+test config-9.10 {Tk_FreeConfigOptions/FreeResources - cursor internal form} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -cursor cross
+ destroy .foo
+} {}
+test config-9.11 {Tk_FreeConfigOptions/FreeResources - cursor} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -cursor [format watch]
+ destroy .foo
+} {}
+test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -integer [format 27]
+ destroy .foo
+} {}
+test config-9.13 {Tk_FreeConfigOptions/FreeResources - custom internal form} testobjconfig {
+ catch {destroy .fpp}
+ testobjconfig internal .foo
+ .foo configure -custom "foobar"
+ destroy .foo
+} {}
+
+test config-10.1 {Tk_GetOptionInfo - one item} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -relief groove
+ .foo configure -relief
+} {-relief relief Relief raised groove}
+test config-10.2 {Tk_GetOptionInfo - one item, synonym} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -color black
+ .foo configure -synonym
+} {-color color Color red black}
+test config-10.3 {Tk_GetOptionInfo - all items} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -font {Helvetica 18} -integer 13563
+ .foo configure
+} {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-custom {} {} {} {}} {-synonym -color}}
+test config-10.4 {Tk_GetOptionInfo - chaining through tables} testobjconfig {
+ catch {destroy .foo}
+ testobjconfig chain2 .foo -one asdf -three xyzzy
+ .foo configure
+} {{-three three Three three xyzzy} {-four four Four four four} {-two two Two {two and a half} {two and a half}} {-oneAgain oneAgain OneAgain {one again} {one again}} {-one one One one asdf} {-two two Two two {two and a half}}}
+
+deleteWindows
+if {[testConstraint testobjconfig]} {
+ testobjconfig alltypes .a
+}
+test config-11.1 {GetConfigList - synonym} testobjconfig {
+ lindex [.a configure] end
+} {-synonym -color}
+test config-11.2 {GetConfigList - null database names} testobjconfig {
+ .a configure -justify
+} {-justify {} {} left left}
+test config-11.3 {GetConfigList - null default and current value} testobjconfig {
+ .a configure -anchor
+} {-anchor anchor Anchor {} {}}
+
+deleteWindows
+if {[testConstraint testobjconfig]} {
+ testobjconfig internal .a
+}
+test config-12.1 {GetObjectForOption - boolean} testobjconfig {
+ .a configure -boolean 0
+ .a cget -boolean
+} {0}
+test config-12.2 {GetObjectForOption - integer} testobjconfig {
+ .a configure -integer 1247
+ .a cget -integer
+} {1247}
+test config-12.3 {GetObjectForOption - double} testobjconfig {
+ .a configure -double -88.82
+ .a cget -double
+} {-88.82}
+test config-12.4 {GetObjectForOption - string} testobjconfig {
+ .a configure -string "test value"
+ .a cget -string
+} {test value}
+test config-12.5 {GetObjectForOption - stringTable} testobjconfig {
+ .a configure -stringtable "two"
+ .a cget -stringtable
+} {two}
+test config-12.6 {GetObjectForOption - color} testobjconfig {
+ .a configure -color "green"
+ .a cget -color
+} {green}
+test config-12.7 {GetObjectForOption - font} testobjconfig {
+ .a configure -font {Times 36}
+ .a cget -font
+} {Times 36}
+test config-12.8 {GetObjectForOption - bitmap} testobjconfig {
+ .a configure -bitmap "questhead"
+ .a cget -bitmap
+} {questhead}
+test config-12.9 {GetObjectForOption - border} testobjconfig {
+ .a configure -border #33217c
+ .a cget -border
+} {#33217c}
+test config-12.10 {GetObjectForOption - relief} testobjconfig {
+ .a configure -relief groove
+ .a cget -relief
+} {groove}
+test config-12.11 {GetObjectForOption - cursor} testobjconfig {
+ .a configure -cursor watch
+ .a cget -cursor
+} {watch}
+test config-12.12 {GetObjectForOption - justify} testobjconfig {
+ .a configure -justify right
+ .a cget -justify
+} {right}
+test config-12.13 {GetObjectForOption - anchor} testobjconfig {
+ .a configure -anchor e
+ .a cget -anchor
+} {e}
+test config-12.14 {GetObjectForOption - pixels} testobjconfig {
+ .a configure -pixel 193.2
+ .a cget -pixel
+} {193}
+test config-12.15 {GetObjectForOption - window} testobjconfig {
+ .a configure -window .a
+ .a cget -window
+} {.a}
+test config-12.16 {GetObjectForOption -custom} testobjconfig {
+ .a configure -custom foobar
+ .a cget -custom
+} {FOOBAR}
+test config-12.17 {GetObjectForOption - null values} testobjconfig {
+ .a configure -string {} -color {} -font {} -bitmap {} -border {} \
+ -cursor {} -window {} -custom {}
+ list [.a cget -string] [.a cget -color] [.a cget -font] \
+ [.a cget -bitmap] [.a cget -border] [.a cget -cursor] \
+ [.a cget -window] [.a cget -custom]
+} {{} {} {} {} {} {} {} {}}
+
+test config-13.1 {proper cleanup of options with widget destroy} {
+ foreach type {
+ button canvas entry frame listbox menu menubutton message
+ scale scrollbar text radiobutton checkbutton
+ } {
+ destroy .w
+ $type .w -cursor crosshair
+ destroy .w
+ }
+} {}
+
+deleteWindows
+
+test config-14.1 {Tk_CreateOptionTable - use with namespace import} {
+ namespace export -clear *
+ foreach type {
+ button canvas entry frame listbox menu menubutton message
+ scale scrollbar spinbox text radiobutton checkbutton
+ } {
+ namespace eval ::foo [subst {
+ namespace import -force ::$type
+ ::foo::$type .a
+ ::foo::$type .b
+ }
+ ]
+ destroy .a .b
+ }
+} {}
+
+# cleanup
+deleteWindows
+if {[testConstraint testobjconfig]} {
+ killTables
+}
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/constraints.tcl b/tcl/tests/constraints.tcl
new file mode 100644
index 00000000000..01ed60d0bac
--- /dev/null
+++ b/tcl/tests/constraints.tcl
@@ -0,0 +1,181 @@
+if {[namespace exists tk::test]} {
+ deleteWindows
+ wm geometry . {}
+ raise .
+ return
+}
+
+package require Tcl 8.4
+
+package require Tk 8.4
+tk appname tktest
+wm title . tktest
+# 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
+}
+
+package require tcltest 2.1
+
+namespace eval tk {
+ namespace eval test {
+ namespace eval bg {
+ # Manage a background process.
+ # Replace with slave interp or thread?
+ namespace import ::tcltest::interpreter
+ namespace export setup cleanup do
+
+ proc cleanup {} {
+ variable fd
+ # catch in case the background process has closed $fd
+ catch {puts $fd exit}
+ catch {close $fd}
+ set fd ""
+ }
+ proc setup args {
+ variable fd
+ if {[info exists fd] && [string length $fd]} {
+ cleanup
+ }
+ set fd [open "|[list [interpreter] \
+ -geometry +0+0 -name tktest] $args" r+]
+ puts $fd "puts foo; flush stdout"
+ flush $fd
+ if {[gets $fd data] < 0} {
+ error "unexpected EOF from \"[interpreter]\""
+ }
+ if {$data ne "foo"} {
+ error "unexpected output from\
+ background process: \"$data\""
+ }
+ fileevent $fd readable [namespace code Ready]
+ }
+ proc Ready {} {
+ variable fd
+ variable Data
+ variable Done
+ set x [gets $fd]
+ if {[eof $fd]} {
+ fileevent $fd readable {}
+ set Done 1
+ } elseif {$x eq "**DONE**"} {
+ set Done 1
+ } else {
+ append Data $x
+ }
+ }
+ proc do {cmd {block 0}} {
+ variable fd
+ variable Data
+ variable Done
+ if {$block} {
+ fileevent $fd readable {}
+ }
+ puts $fd "[list catch $cmd msg]; update; puts \$msg;\
+ puts **DONE**; flush stdout"
+ flush $fd
+ set Data {}
+ if {$block} {
+ while {![eof $fd]} {
+ set line [gets $fd]
+ if {$line eq "**DONE**"} {
+ break
+ }
+ append Data $line
+ }
+ } else {
+ set Done 0
+ vwait [namespace which -variable Done]
+ }
+ return $Data
+ }
+ }
+
+ proc Export {internal as external} {
+ uplevel 1 [list namespace import $internal]
+ uplevel 1 [list rename [namespace tail $internal] $external]
+ uplevel 1 [list namespace export $external]
+ }
+ Export bg::setup as setupbg
+ Export bg::cleanup as cleanupbg
+ Export bg::do as dobg
+
+ namespace export deleteWindows
+ proc deleteWindows {} {
+ eval destroy [winfo children .]
+ }
+
+ namespace export fixfocus
+ proc fixfocus {} {
+ catch {destroy .focus}
+ toplevel .focus
+ wm geometry .focus +0+0
+ entry .focus.e
+ .focus.e insert 0 "fixfocus"
+ pack .focus.e
+ update
+ focus -force .focus.e
+ destroy .focus
+ }
+ }
+}
+
+namespace import -force tk::test::*
+
+namespace import -force tcltest::testConstraint
+testConstraint userInteraction 0
+testConstraint nonUnixUserInteraction [expr {[testConstraint userInteraction]
+ || [testConstraint unix]}]
+testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)]
+testConstraint noExceed [expr {![testConstraint unix]
+ || [catch {font actual "\{xyz"}]}]
+testConstraint testImageType [expr {[lsearch [image types] test] >= 0}]
+testConstraint testembed [llength [info commands testembed]]
+testConstraint testwrapper [llength [info commands testwrapper]]
+testConstraint testfont [llength [info commands testfont]]
+testConstraint fonts 1
+destroy .e
+entry .e -width 0 -font {Helvetica -12} -bd 1
+.e insert end a.bcd
+if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
+ testConstraint fonts 0
+}
+destroy .e
+destroy .t
+text .t -width 80 -height 20 -font {Times -14} -bd 1
+pack .t
+.t insert end "This is\na dot."
+update
+set x [list [.t bbox 1.3] [.t bbox 2.5]]
+destroy .t
+if {![string match {{22 3 6 15} {31 18 [34] 15}} $x]} {
+ testConstraint fonts 0
+}
+testConstraint pseudocolor8 [expr {([catch {
+ toplevel .t -visual {pseudocolor 8} -colormap new
+ }] == 0) && ([winfo depth .t] == 8)}]
+destroy .t
+setupbg
+set app [dobg {tk appname}]
+testConstraint secureserver 0
+if {[llength [info commands send]]} {
+ testConstraint secureserver 1
+ if {[catch {send $app set a 0} msg] == 1} {
+ if {[string match "X server insecure *" $msg]} {
+ testConstraint secureserver 0
+ }
+ }
+}
+cleanupbg
+
+eval tcltest::configure $argv
+namespace import -force tcltest::test
+
+deleteWindows
+wm geometry . {}
+raise .
+
diff --git a/tcl/tests/cursor.test b/tcl/tests/cursor.test
new file mode 100644
index 00000000000..8227c5f6f84
--- /dev/null
+++ b/tcl/tests/cursor.test
@@ -0,0 +1,139 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkCursor.c. It is organized in the standard white-box fashion for
+# Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint testcursor [llength [info commands testcursor]]
+
+test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {testcursor} {
+ set x watch
+ lindex $x 0
+ destroy .b1
+ button .b1 -cursor $x
+ lindex $x 0
+ testcursor watch
+} {{1 0}}
+test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {testcursor} {
+ set x watch
+ destroy .b1 .b2
+ button .b1 -cursor $x
+ destroy .b1
+ set result {}
+ lappend result [testcursor watch]
+ button .b2 -cursor $x
+ lappend result [testcursor watch]
+} {{} {{1 1}}}
+test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {testcursor} {
+ set x watch
+ destroy .b1 .b2
+ button .b1 -cursor $x
+ set result {}
+ lappend result [testcursor watch]
+ button .b2 -cursor $x
+ pack .b1 .b2 -side top
+ lappend result [testcursor watch]
+} {{{1 1}} {{2 1}}}
+
+test cursor-2.1 {Tk_GetCursor procedure} {
+ destroy .b1
+ list [catch {button .b1 -cursor bad_name} msg] $msg
+} {1 {bad cursor spec "bad_name"}}
+test cursor-2.2 {Tk_GetCursor procedure} {
+ destroy .b1
+ list [catch {button .b1 -cursor @xyzzy} msg] $msg
+} {1 {bad cursor spec "@xyzzy"}}
+# Next two tests need a helper file with a very specific name and
+# controlled format.
+set wincur(data_octal) {
+ 000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001
+ 000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000
+ 000 000 001 000 001 000 000 000 000 000 000 000 000 000 000 000
+ 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
+ 000 000 377 377 377 000 000 000 000 000 000 000 000 000 000 000
+ 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
+ 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
+ 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
+ 000 000 000 000 000 000 000 000 000 000 160 016 000 000 170 036
+ 000 000 174 076 000 000 076 174 000 000 037 370 000 000 017 360
+ 000 000 007 340 000 000 007 340 000 000 017 360 000 000 037 370
+ 000 000 076 174 000 000 174 076 000 000 170 036 000 000 160 016
+ 000 000 000 000 000 000 377 377 377 377 377 377 377 377 377 377
+ 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377
+ 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377
+ 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377
+ 377 377 377 377 377 377 017 360 377 377 007 340 377 377 003 300
+ 377 377 001 200 377 377 200 001 377 377 300 003 377 377 340 007
+ 377 377 360 017 377 377 360 017 377 377 340 007 377 377 300 003
+ 377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340
+ 377 377 017 360 377 377
+}
+set wincur(data_binary) {}
+foreach wincur(num) $wincur(data_octal) {
+ append wincur(data_binary) [binary format c 0$wincur(num)]
+}
+set wincur(dir) [::tcltest::makeDirectory {dir with spaces}]
+set wincur(file) [::tcltest::makeFile $wincur(data_binary) "test file.cur" $wincur(dir)]
+test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} {
+ destroy .b1
+ button .b1 -cursor [list @$wincur(file)]
+} {.b1}
+test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} {
+ destroy .b1
+ button .b1 -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}]
+} {.b1}
+::tcltest::removeDirectory $wincur(dir)
+unset wincur
+
+test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} {
+ set x heart
+ destroy .b1 .b2 .b3
+ button .b1 -cursor $x
+ button .b3 -cursor $x
+ button .b2 -cursor $x
+ set result {}
+ lappend result [testcursor heart]
+ destroy .b1
+ lappend result [testcursor heart]
+ destroy .b2
+ lappend result [testcursor heart]
+ destroy .b3
+ lappend result [testcursor heart]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+
+test cursor-4.1 {FreeCursorObjProc} {testcursor} {
+ destroy .b
+ set x [format heart]
+ button .b -cursor $x
+ set y [format heart]
+ .b configure -cursor $y
+ set z [format heart]
+ .b configure -cursor $z
+ set result {}
+ lappend result [testcursor heart]
+ set x red
+ lappend result [testcursor heart]
+ set z 32
+ lappend result [testcursor heart]
+ destroy .b
+ lappend result [testcursor heart]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/dialog.test b/tcl/tests/dialog.test
new file mode 100644
index 00000000000..b3501bba615
--- /dev/null
+++ b/tcl/tests/dialog.test
@@ -0,0 +1,64 @@
+# This file is a Tcl script to test out Tk's "tk_dialog" command.
+# It is organized in the standard fashion for Tcl tests.
+#
+# RCS: @(#) $Id$
+#
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test dialog-1.1 {tk_dialog command} {
+ list [catch {tk_dialog} msg] $msg
+} {1 {wrong # args: should be "tk_dialog w title text bitmap default args"}}
+test dialog-1.2 {tk_dialog command} {
+ list [catch {tk_dialog foo foo foo foo foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test dialog-1.3 {tk_dialog command} {
+ set res [list [catch {tk_dialog .d foo foo foo foo} msg] $msg]
+ destroy .d
+ set res
+} {1 {bitmap "foo" not defined}}
+
+proc PressButton {btn} {
+ if {![winfo ismapped $btn]} {
+ update
+ }
+ event generate $btn <Enter>
+ event generate $btn <1> -x 5 -y 5
+ event generate $btn <ButtonRelease-1> -x 5 -y 5
+}
+
+proc HitReturn {w} {
+ event generate $w <Enter>
+ focus -force $w
+ event generate $w <KeyPress> -keysym Return
+}
+
+test dialog-2.0 {tk_dialog operation} {
+ set x [after 5000 [list set tk::Priv(button) "no response"]]
+ after 100 PressButton .d.button0
+ set res [tk_dialog .d foo foo info 0 click]
+ after cancel $x
+ set res
+} {0}
+test dialog-2.1 {tk_dialog operation} {
+ set x [after 5000 [list set tk::Priv(button) "no response"]]
+ after 100 HitReturn .d
+ set res [tk_dialog .d foo foo info 1 click default]
+ after cancel $x
+ set res
+} {1}
+test dialog-2.2 {tk_dialog operation} {
+ set x [after 5000 [list set tk::Priv(button) "no response"]]
+ after 100 destroy .d
+ set res [tk_dialog .d foo foo info 0 click]
+ after cancel $x
+ set res
+} {-1}
+
+tcltest::cleanupTests
+return
diff --git a/tcl/tests/embed.test b/tcl/tests/embed.test
new file mode 100644
index 00000000000..4e6b29dee3a
--- /dev/null
+++ b/tcl/tests/embed.test
@@ -0,0 +1,51 @@
+# This file is a Tcl script to test out embedded Windows.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test embed-1.1 {TkpUseWindow procedure, bad window identifier} {
+ deleteWindows
+ list [catch {toplevel .t -use xyz} msg] $msg
+} {1 {expected integer but got "xyz"}}
+
+test embed-1.2 {CreateFrame procedure, bad window identifier} {
+ deleteWindows
+ list [catch {toplevel .t -container xyz} msg] $msg
+} {1 {expected boolean value but got "xyz"}}
+
+test embed-1.3 {CreateFrame procedure, both -use and
+ -container is invalid } {
+ deleteWindows
+ toplevel .container -container 1
+ list [catch {toplevel .t -use [winfo id .container] \
+ -container 1} msg] $msg
+} {1 {A window cannot have both the -use and the -container option set.}}
+
+test embed-1.4 {TkpUseWindow procedure, -container must be set} {
+ deleteWindows
+ toplevel .container
+ list [catch {toplevel .embd -use [winfo id .container]} err] $err
+} {1 {window ".container" doesn't have -container option set}}
+
+test embed-1.5 {TkpUseWindow procedure, -container must be set} {
+ deleteWindows
+ frame .container
+ list [catch {toplevel .embd -use [winfo id .container]} err] $err
+} {1 {window ".container" doesn't have -container option set}}
+
+
+# FIXME: test cases common to unixEmbed.test and macEmbed.test should
+# be moved here.
+
+tcltest::cleanupTests
+return
diff --git a/tcl/tests/entry.test b/tcl/tests/entry.test
new file mode 100644
index 00000000000..51a39e70db8
--- /dev/null
+++ b/tcl/tests/entry.test
@@ -0,0 +1,1599 @@
+# This file is a Tcl script to test entry widgets in Tk. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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"}}
+ {-disabledbackground green green non-existent
+ {unknown color name "non-existent"}}
+ {-disabledforeground blue blue non-existent
+ {unknown color name "non-existent"}}
+ {-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"}}
+ {-invalidcommand "any string" "any string" {} {}}
+ {-invcmd "any string" "any string" {} {}}
+ {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
+ {-readonlybackground green green non-existent
+ {unknown color name "non-existent"}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
+ {-show * * {} {}}
+ {-state n normal bogus
+ {bad state "bogus": must be disabled, normal, or readonly}}
+ {-takefocus "any string" "any string" {} {}}
+ {-textvariable i i {} {}}
+ {-width 402 402 3p {expected integer but got "3p"}}
+ {-xscrollcommand {Some command} {Some command} {} {}}
+} {
+ set name [lindex $test 0]
+ test entry-1.$i {configuration options} {
+ .e configure $name [lindex $test 1]
+ list [lindex [.e configure $name] 4] [.e cget $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test entry-1.$i {configuration options} {
+ list [catch {.e configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .e configure $name [lindex [.e configure $name] 3]
+ incr i
+}
+
+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]
+set ux [font measure $fixed \u4e4e]
+
+test entry-3.1 {EntryWidgetCmd procedure} {
+ list [catch {.e} msg] $msg
+} {1 {wrong # args: should be ".e option ?arg arg ...?"}}
+test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} {
+ list [catch {.e bbox} msg] $msg
+} {1 {wrong # args: should be ".e bbox index"}}
+test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} {
+ list [catch {.e bbox a b} msg] $msg
+} {1 {wrong # args: should be ".e bbox index"}}
+test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} {
+ list [catch {.e bbox bogus} msg] $msg
+} {1 {bad entry index "bogus"}}
+test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
+ .e delete 0 end
+ .e bbox 0
+} [list 5 5 0 $cy]
+test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): no utf chars
+
+ .e delete 0 end
+ .e insert 0 "abc"
+ list [.e bbox 3] [.e bbox end]
+} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"]
+test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): utf at end
+ .e delete 0 end
+ .e insert 0 "ab\u4e4e"
+ .e bbox end
+} "[expr 5+2*$cx] 5 $ux $cy"
+test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): utf before index
+ .e delete 0 end
+ .e insert 0 "ab\u4e4ec"
+ .e bbox 3
+} "[expr 5+2*$cx+$ux] 5 $cx $cy"
+test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): no chars
+ .e delete 0 end
+ .e bbox end
+} "5 5 0 $cy"
+test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} {
+ .e delete 0 end
+ .e insert 0 "abcdefghij\u4e4eklmnop"
+ list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
+} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"]
+test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} {
+ list [catch {.e cget} msg] $msg
+} {1 {wrong # args: should be ".e cget option"}}
+test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} {
+ list [catch {.e cget a b} msg] $msg
+} {1 {wrong # args: should be ".e cget option"}}
+test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} {
+ list [catch {.e cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} {
+ .e configure -bd 4
+ .e cget -bd
+} {4}
+test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} {
+ llength [.e configure]
+} {36}
+test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} {
+ list [catch {.e configure -foo} msg] $msg
+} {1 {unknown option "-foo"}}
+test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} {
+ .e configure -bd 4
+ .e configure -bg #ffffff
+ lindex [.e configure -bd] 4
+} {4}
+test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete} msg] $msg
+} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
+test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete a b c} msg] $msg
+} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
+test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete foo} msg] $msg
+} {1 {bad entry index "foo"}}
+test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete 0 bar} msg] $msg
+} {1 {bad entry index "bar"}}
+test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e delete 2 4
+ .e get
+} {014567890}
+test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e delete 6
+ .e get
+} {0123457890}
+test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} {
+ # UTF
+ set x {}
+ .e delete 0 end
+ .e insert end "01234\u4e4e67890"
+ .e delete 6
+ lappend x [.e get]
+ .e delete 0 end
+ .e insert end "012345\u4e4e7890"
+ .e delete 6
+ lappend x [.e get]
+ .e delete 0 end
+ .e insert end "0123456\u4e4e890"
+ .e delete 6
+ lappend x [.e get]
+} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
+test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e delete 6 5
+ .e get
+} {01234567890}
+test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e configure -state disabled
+ .e delete 2 8
+ .e configure -state normal
+ .e get
+} {01234567890}
+test entry-3.27 {EntryWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e configure -state readonly
+ .e delete 2 8
+ .e configure -state normal
+ .e get
+} {01234567890}
+test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} {
+ list [catch {.e get foo} msg] $msg
+} {1 {wrong # args: should be ".e get"}}
+test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} {
+ list [catch {.e icursor} msg] $msg
+} {1 {wrong # args: should be ".e icursor pos"}}
+test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} {
+ list [catch {.e icursor foo} msg] $msg
+} {1 {bad entry index "foo"}}
+test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e icursor 4
+ .e index insert
+} {4}
+test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} {
+ list [catch {.e in} msg] $msg
+} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}}
+test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} {
+ list [catch {.e index} msg] $msg
+} {1 {wrong # args: should be ".e index string"}}
+test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} {
+ list [catch {.e index foo} msg] $msg
+} {1 {bad entry index "foo"}}
+test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} {
+ list [catch {.e index 0} msg] $msg
+} {0 0}
+test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} {
+ # UTF
+ .e delete 0 end
+ .e insert 0 abc\u4e4e\u0153def
+ list [.e index 3] [.e index 4] [.e index end]
+} {3 4 8}
+test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert a} msg] $msg
+} {1 {wrong # args: should be ".e insert index text"}}
+test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert a b c} msg] $msg
+} {1 {wrong # args: should be ".e insert index text"}}
+test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert foo Text} msg] $msg
+} {1 {bad entry index "foo"}}
+test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e insert 3 xxx
+ .e get
+} {012xxx34567890}
+test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e configure -state disabled
+ .e insert 3 xxx
+ .e configure -state normal
+ .e get
+} {01234567890}
+test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e configure -state readonly
+ .e insert 3 xxx
+ .e configure -state normal
+ .e get
+} {01234567890}
+test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert a b c} msg] $msg
+} {1 {wrong # args: should be ".e insert index text"}}
+test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} {
+ list [catch {.e scan a} msg] $msg
+} {1 {wrong # args: should be ".e scan mark|dragto x"}}
+test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} {
+ list [catch {.e scan a b c} msg] $msg
+} {1 {wrong # args: should be ".e scan mark|dragto x"}}
+test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} {
+ list [catch {.e scan foobar 20} msg] $msg
+} {1 {bad scan option "foobar": must be mark or dragto}}
+test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} {
+ list [catch {.e scan mark 20.1} msg] $msg
+} {1 {expected integer but got "20.1"}}
+# This test is non-portable because character sizes vary.
+
+test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
+ .e delete 0 end
+ update
+ .e insert end "This is quite a long string, in fact a "
+ .e insert end "very very long string"
+ .e scan mark 30
+ .e scan dragto 28
+ .e index @0
+} {2}
+test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} {
+ list [catch {.e select} msg] $msg
+} {1 {wrong # args: should be ".e selection option ?index?"}}
+test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} {
+ list [catch {.e select foo} msg] $msg
+} {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}}
+test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} {
+ list [catch {.e select clear gorp} msg] $msg
+} {1 {wrong # args: should be ".e selection clear"}}
+test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} {
+ .e delete 0 end
+ .e insert end "0123456789"
+ .e select from 1
+ .e select to 4
+ update
+ .e select clear
+ list [catch {selection get} msg] $msg [selection own]
+} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
+test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} {
+ list [catch {.e selection present foo} msg] $msg
+} {1 {wrong # args: should be ".e selection present"}}
+test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e select from 3
+ .e select to 6
+ .e selection present
+} {1}
+test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e select from 3
+ .e select to 6
+ .e configure -exportselection false
+ .e selection present
+} {1}
+.e configure -exportselection true
+test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e select from 3
+ .e select to 6
+ .e delete 0 end
+ .e selection present
+} {0}
+test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+ list [catch {.e select adjust x} msg] $msg
+} {1 {bad entry index "x"}}
+test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+ list [catch {.e select adjust 2 3} msg] $msg
+} {1 {wrong # args: should be ".e selection adjust index"}}
+test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+ .e delete 0 end
+ .e insert end "0123456789"
+ .e select from 1
+ .e select to 5
+ update
+ .e select adjust 4
+ selection get
+} {123}
+test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+ .e delete 0 end
+ .e insert end "0123456789"
+ .e select from 1
+ .e select to 5
+ update
+ .e select adjust 2
+ selection get
+} {234}
+test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} {
+ list [catch {.e select from 2 3} msg] $msg
+} {1 {wrong # args: should be ".e selection from index"}}
+test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} {
+ list [catch {.e select range 2} msg] $msg
+} {1 {wrong # args: should be ".e selection range start end"}}
+test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} {
+ list [catch {.e selection range 2 3 4} msg] $msg
+} {1 {wrong # args: should be ".e selection range start end"}}
+test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e select from 1
+ .e select to 5
+ .e select range 4 4
+ list [catch {.e index sel.first} msg] $msg
+} {1 {selection isn't in widget .e}}
+test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e select from 3
+ .e select to 7
+ .e select range 2 9
+ list [.e index sel.first] [.e index sel.last] [.e index anchor]
+} {2 9 3}
+test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e selection range 0 end
+ .e configure -state disabled
+ .e selection range 2 4
+ .e configure -state normal
+ list [.e index sel.first] [.e index sel.last]
+} {0 10}
+test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e selection range 0 end
+ .e configure -state readonly
+ .e selection range 2 4
+ .e configure -state normal
+ list [.e index sel.first] [.e index sel.last]
+} {2 4}
+.e delete 0 end
+.e insert end "This is quite a long text string, so long that it "
+.e insert end "runs off the end of the window quite a bit."
+test entry-3.64 {EntryWidgetCmd procedure, "selection to" widget command} {
+ list [catch {.e select to 2 3} msg] $msg
+} {1 {wrong # args: should be ".e selection to index"}}
+test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview 5
+ .e xview
+} {0.0537634 0.268817}
+test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview gorp} msg] $msg
+} {1 {bad entry index "gorp"}}
+test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview 0
+ .e icursor 10
+ .e xview insert
+ .e xview
+} {0.107527 0.322581}
+test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview moveto foo bar} msg] $msg
+} {1 {wrong # args: should be ".e xview moveto fraction"}}
+test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview moveto foo} msg] $msg
+} {1 {expected floating-point number but got "foo"}}
+test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview moveto 0.5
+ .e xview
+} {0.505376 0.72043}
+test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview scroll 24} msg] $msg
+} {1 {wrong # args: should be ".e xview scroll number units|pages"}}
+test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview scroll gorp units} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview moveto 0
+ .e xview scroll 1 pages
+ .e xview
+} {0.193548 0.408602}
+test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview moveto .9
+ update
+ .e xview scroll -2 p
+ .e xview
+} {0.397849 0.612903}
+test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview 30
+ update
+ .e xview scroll 2 units
+ .e index @0
+} {32}
+test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview 30
+ update
+ .e xview scroll -1 units
+ .e index @0
+} {29}
+test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview scroll 23 foobars} msg] $msg
+} {1 {bad argument "foobars": must be units or pages}}
+test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview eat 23 hamburgers} msg] $msg
+} {1 {unknown option "eat": must be moveto or scroll}}
+test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview 0
+ update
+ .e xview -4
+ .e index @0
+} {0}
+test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} {
+ .e xview 300
+ .e index @0
+} {73}
+.e insert 10 \u4e4e
+test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} {
+ # UTF
+ # If Tcl_NumUtfChars wasn't used, wrong answer would be:
+ # 0.106383 0.117021 0.117021
+
+ set x {}
+ .e xview moveto .1
+ lappend x [lindex [.e xview] 0]
+ .e xview moveto .11
+ lappend x [lindex [.e xview] 0]
+ .e xview moveto .12
+ lappend x [lindex [.e xview] 0]
+} {0.0957447 0.106383 0.117021}
+test entry-3.82 {EntryWidgetCmd procedure} {
+ list [catch {.e gorp} msg] $msg
+} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, 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} {unixOnly fonts} {
+ catch {destroy .e}
+ entry .e -bd 1 -relief raised -width 0 -show .
+ .e insert 0 12345
+ pack .e
+ update
+ set x [winfo reqwidth .e]
+ .e configure -show X
+ lappend x [winfo reqwidth .e]
+ .e configure -show ""
+ lappend x [winfo reqwidth .e]
+} {23 53 43}
+test entry-6.11 {EntryComputeGeometry procedure} {pcOnly} {
+ catch {destroy .e}
+ entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12}
+ .e insert 0 12345
+ pack .e
+ update
+ set x [winfo reqwidth .e]
+ .e configure -show X
+ lappend x [winfo reqwidth .e]
+ .e configure -show ""
+ lappend x [winfo reqwidth .e]
+} [list \
+ [expr 8+5*[font measure {helvetica 12} .]] \
+ [expr 8+5*[font measure {helvetica 12} X]] \
+ [expr 8+[font measure {helvetica 12} 12345]]]
+
+catch {destroy .e}
+entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
+pack .e
+focus .e
+test entry-7.1 {InsertChars procedure} {
+ .e delete 0 end
+ .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 widget .e}}
+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 widget .e}}
+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 widget .e}}
+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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {unixOnly} {
+ # On unix, when selection is cleared, entry widget's internal
+ # selection range is reset.
+
+ list [catch {.e index sel.first} msg] $msg
+} {1 {selection isn't in widget .e}}
+test entry-13.11 {GetEntryIndex procedure} {macOrPc} {
+ # On mac and pc, when selection is cleared, entry widget remembers
+ # last selected range. When selection ownership is restored to
+ # entry, the old range will be rehighlighted.
+
+ list [catch {selection get}] [.e index sel.first]
+} {1 1}
+test entry-13.12 {GetEntryIndex procedure} {unixOnly} {
+ list [catch {.e index sbogus} msg] $msg
+} {1 {selection isn't in widget .e}}
+test entry-13.13 {GetEntryIndex procedure} {macOrPc} {
+ list [catch {.e index sbogus} msg] $msg
+} {1 {bad entry index "sbogus"}}
+test entry-13.14 {GetEntryIndex procedure} {macOrPc} {
+ list [catch {selection get}] [catch {.e index sbogus}]
+} {1 1}
+test entry-13.15 {GetEntryIndex procedure} {
+ list [catch {.e index @xyz} msg] $msg
+} {1 {bad entry index "@xyz"}}
+test entry-13.16 {GetEntryIndex procedure} {fonts} {
+ .e index @4
+} {4}
+test entry-13.17 {GetEntryIndex procedure} {fonts} {
+ .e index @11
+} {4}
+test entry-13.18 {GetEntryIndex procedure} {fonts} {
+ .e index @12
+} {5}
+test entry-13.19 {GetEntryIndex procedure} {fonts} {
+ .e index @[expr [winfo width .e] - 6]
+} {8}
+test entry-13.20 {GetEntryIndex procedure} {fonts} {
+ .e index @[expr [winfo width .e] - 5]
+} {9}
+test entry-13.21 {GetEntryIndex procedure} {
+ .e index @1000
+} {9}
+test entry-13.22 {GetEntryIndex procedure} {
+ list [catch {.e index 1xyz} msg] $msg
+} {1 {bad entry index "1xyz"}}
+test entry-13.23 {GetEntryIndex procedure} {
+ .e index -10
+} {0}
+test entry-13.24 {GetEntryIndex procedure} {
+ .e index 12
+} {12}
+test entry-13.25 {GetEntryIndex procedure} {
+ .e index 49
+} {21}
+test entry-13.26 {GetEntryIndex procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -show .
+ .e insert 0 XXXYZZY
+ pack .e
+ update
+ list [.e index @7] [.e index @8]
+} {0 1}
+
+# 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-15.2 {EntryVisibleRange procedure} {unixOnly fonts} {
+ .e configure -show X
+ .e delete 0 end
+ .e insert 0 .............................
+ .e xview
+} {0 0.275862}
+test entry-15.3 {EntryVisibleRange procedure} {pcOnly} {
+ .e configure -show .
+ .e delete 0 end
+ .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+ .e xview
+} {0 0.827586}
+.e configure -show ""
+test entry-15.4 {EntryVisibleRange procedure} {
+ .e delete 0 end
+ .e xview
+} {0 1}
+
+catch {destroy .e}
+entry .e -width 10 -xscrollcommand scroll -font $fixed
+pack .e
+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} {
+ destroy .e
+ proc bgerror msg {
+ global x
+ set x $msg
+ }
+ entry .e -width 5 -xscrollcommand thisisnotacommand
+ pack .e
+ update
+ rename bgerror {}
+ list $x $errorInfo
+} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand"
+ while executing
+"thisisnotacommand 0 1"
+ (horizontal scrolling command executed by .e)}}
+
+set l [interp hidden]
+deleteWindows
+
+test entry-18.1 {Entry widget vs hiding} {
+ destroy .e
+ entry .e
+ interp hide {} .e
+ destroy .e
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+##
+## Entry widget VALIDATION tests
+##
+
+destroy .e
+catch {unset ::e}
+catch {unset ::vVals}
+entry .e -validate all \
+ -validatecommand [list doval %W %d %i %P %s %S %v %V] \
+ -invalidcommand bell \
+ -textvariable ::e \
+ -background red -foreground white
+pack .e
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ return 1
+}
+
+# The validation tests build each one upon the previous, so cascading
+# failures aren't good
+#
+test entry-19.1 {entry widget validation} {
+ .e insert 0 a
+ set ::vVals
+} {.e 1 0 a {} a all key}
+test entry-19.2 {entry widget validation} {
+ .e insert 1 b
+ set ::vVals
+} {.e 1 1 ab a b all key}
+test entry-19.3 {entry widget validation} {
+ .e insert end c
+ set ::vVals
+} {.e 1 2 abc ab c all key}
+test entry-19.4 {entry widget validation} {
+ .e insert 1 123
+ list $::vVals $::e
+} {{.e 1 1 a123bc abc 123 all key} a123bc}
+test entry-19.5 {entry widget validation} {
+ .e delete 2
+ set ::vVals
+} {.e 0 2 a13bc a123bc 2 all key}
+test entry-19.6 {entry widget validation} {
+ .e configure -validate key
+ .e delete 1 3
+ set ::vVals
+} {.e 0 1 abc a13bc 13 key key}
+test entry-19.7 {entry widget validation} {
+ set ::vVals {}
+ .e configure -validate focus
+ .e insert end d
+ set ::vVals
+} {}
+test entry-19.8 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focus focusin}
+test entry-19.9 {entry widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focus focusout}
+.e configure -validate all
+test entry-19.10 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} all focusin}
+test entry-19.11 {entry widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} all focusout}
+.e configure -validate focusin
+test entry-19.12 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focusin focusin}
+test entry-19.13 {entry widget validation} {
+ set ::vVals {}
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {}
+.e configure -validate focuso
+test entry-19.14 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {}
+test entry-19.15 {entry widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focusout focusout}
+test entry-19.16 {entry widget validation} {
+ list [.e validate] $::vVals
+} {1 {.e -1 -1 abcd abcd {} all forced}}
+test entry-19.17 {entry widget validation} {
+ set ::e newdata
+ list [.e cget -validate] $::vVals
+} {focusout {.e -1 -1 newdata abcd {} focusout forced}}
+
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ return 0
+}
+
+test entry-19.18 {entry widget validation} {
+ .e configure -validate all
+ set ::e nextdata
+ list [.e cget -validate] $::vVals
+} {none {.e -1 -1 nextdata newdata {} all forced}}
+
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ set ::e mydata
+ return 1
+}
+
+## This sets validate to none because it shows that we prevent a possible
+## loop condition in the validation, when the entry textvar is also set
+test entry-19.19 {entry widget validation} {
+ .e configure -validate all
+ .e validate
+ list [.e cget -validate] [.e get] $::vVals
+} {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
+
+## This leaves validate alone because we trigger validation through the
+## textvar (a write trace), and the write during validation triggers
+## nothing (by definition of avoiding loops on var traces). This is
+## one of those "dangerous" conditions where the user will have a
+## different value in the entry widget shown as is in the textvar.
+test entry-19.20 {entry widget validation} {
+ .e configure -validate all
+ set ::e testdata
+ list [.e cget -validate] [.e get] $::e $::vVals
+} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
+
+destroy .e
+catch {unset ::e ::vVals}
+
+##
+## End validation tests
+##
+
+test entry-20.1 {widget deletion while active} {
+ destroy .e
+ entry .e -validate all \
+ -validatecommand { destroy %W ; return 1 } \
+ -invalidcommand bell
+ update
+ .e insert 0 abc
+ winfo exists .e
+} 0
+test entry-20.2 {widget deletion while active} {
+ destroy .e
+ entry .e -validate all \
+ -validatecommand { return 0 } \
+ -invalidcommand { destroy %W }
+ .e insert 0 abc
+ winfo exists .e
+} 0
+test entry-20.3 {widget deletion while active} {
+ destroy .e
+ entry .e -validate all \
+ -validatecommand { rename .e {} ; return 1 }
+ .e insert 0 abc
+ winfo exists .e
+} 0
+test entry-20.4 {widget deletion while active} {
+ destroy .e
+ entry .e -validate all \
+ -validatecommand { return 0 } \
+ -invalidcommand { rename .e {} }
+ .e insert 0 abc
+ winfo exists .e
+} 0
+test entry-20.5 {widget deletion while active} {
+ destroy .e
+ entry .e -validatecommand { destroy .e ; return 0 }
+ .e validate
+ winfo exists .e
+} 0
+test entry-20.6 {widget deletion while active} {
+ destroy .e
+ pack [entry .e]
+ update
+ .e config -xscrollcommand { destroy .e }
+ update idle
+ winfo exists .e
+} 0
+
+# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
+# and EntryTextVarProc.
+
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/event.test b/tcl/tests/event.test
index 8d84bb1e03d..84d84c3210b 100644
--- a/tcl/tests/event.test
+++ b/tcl/tests/event.test
@@ -1,594 +1,663 @@
-# This file contains a collection of tests for the procedures in the file
-# tclEvent.c, which includes the "update", and "vwait" Tcl
-# commands. Sourcing this file into Tcl runs the tests and generates
-# output for errors. No output means no errors were found.
+# 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) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# All rights reserved.
#
# RCS: @(#) $Id$
-package require tcltest 2
-namespace import -force ::tcltest::*
-
-testConstraint testfilehandler [llength [info commands testfilehandler]]
-testConstraint testexithandler [llength [info commands testexithandler]]
-testConstraint testfilewait [llength [info commands testfilewait]]
-
-test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
- testfilehandler close
- testfilehandler create 0 readable off
- testfilehandler clear 0
- testfilehandler oneevent
- set result ""
- lappend result [testfilehandler counts 0]
- testfilehandler fillpartial 0
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- set result
-} {{0 0} {1 0} {2 0}}
-test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
- # This test is non-portable because on some systems (e.g.
- # SunOS 4.1.3) pipes seem to be writable always.
- testfilehandler close
- testfilehandler create 0 off writable
- testfilehandler clear 0
- testfilehandler oneevent
- set result ""
- lappend result [testfilehandler counts 0]
- testfilehandler fillpartial 0
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler fill 0
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- set result
-} {{0 1} {0 2} {0 2}}
-test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
- testfilehandler close
- testfilehandler create 2 disabled disabled
- testfilehandler create 1 readable writable
- testfilehandler create 0 disabled disabled
- testfilehandler fillpartial 1
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler create 1 off off
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
-
-test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
- testfilehandler close
- testfilehandler create 2 disabled disabled
- testfilehandler create 1 readable writable
- testfilehandler fillpartial 1
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler create 1 off off
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
- {testfilehandler nonPortable} {
- testfilehandler close
- testfilehandler create 0 readable writable
- testfilehandler fillpartial 0
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- testfilehandler create 0 readable writable
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- set result
-} {{0 1} {0 0}}
-
-test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
- testfilehandler close
- testfilehandler create 1 readable writable
- testfilehandler fillpartial 1
- testfilehandler windowevent
- set result [testfilehandler counts 1]
- testfilehandler close
- set result
-} {0 0}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
-test event-4.1 {FileHandlerEventProc, race between event and disabling} \
- {testfilehandler nonPortable} {
- update
- testfilehandler close
- testfilehandler create 2 disabled disabled
- testfilehandler create 1 readable writable
- testfilehandler fillpartial 1
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler create 1 disabled disabled
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
- {testfilehandler nonPortable} {
- update
- testfilehandler close
- testfilehandler create 1 readable writable
- testfilehandler create 2 readable writable
- testfilehandler fillpartial 1
- testfilehandler fillpartial 2
- testfilehandler oneevent
- set result ""
- lappend result [testfilehandler counts 1] [testfilehandler counts 2]
- testfilehandler windowevent
- lappend result [testfilehandler counts 1] [testfilehandler counts 2]
- testfilehandler close
- set result
-} {{0 0} {0 1} {0 0} {0 1}}
-update
-
-test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
- catch {rename bgerror {}}
- proc bgerror msg {
- global errorInfo errorCode x
- lappend x [list $msg $errorInfo $errorCode]
+# 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.
+
+# Setup table used to query key events.
+
+proc _init_keypress_lookup { } {
+ global keypress_lookup
+
+ scan A %c start
+ scan Z %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
}
- after idle {error "a simple error"}
- after idle {open non_existent}
- after idle {set errorInfo foobar; set errorCode xyzzy}
- set x {}
- update idletasks
- rename bgerror {}
- regsub -all [file join {} non_existent] $x "non_existent" x
- set x
-} {{{a simple error} {a simple error
- while executing
-"error "a simple error""
- ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
- while executing
-"open non_existent"
- ("after" script)} {POSIX ENOENT {no such file or directory}}}}
-test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
- catch {rename bgerror {}}
- proc bgerror msg {
- global x
- lappend x $msg
- return -code break
+
+ scan a %c start
+ scan z %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
}
- after idle {error "a simple error"}
- after idle {open non_existent}
- set x {}
- update idletasks
- rename bgerror {}
- set x
-} {{a simple error}}
-
-test event-6.1 {BgErrorDeleteProc procedure} {
- catch {interp delete foo}
- interp create foo
- set erroutfile [makeFile Unmodified err.out]
- foo eval [list set erroutfile $erroutfile]
- foo eval {
- proc bgerror args {
- global errorInfo erroutfile
- set f [open $erroutfile r+]
- seek $f 0 end
- puts $f "$args $errorInfo"
- close $f
- }
- after 100 {error "first error"}
- after 100 {error "second error"}
+
+ scan 0 %c start
+ scan 9 %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
}
- after 100 {interp delete foo}
- after 200
- update
- set f [open $erroutfile r]
- set result [read $f]
- close $f
- removeFile $erroutfile
- set result
-} {Unmodified
+
+ array set keypress_lookup [list \
+ " " space \
+ ! exclam \
+ \" quotedbl \
+ \# numbersign \
+ \$ dollar \
+ % percent \
+ & ampersand \
+ ( parenleft \
+ ) parenright \
+ * asterisk \
+ + plus \
+ , comma \
+ - minus \
+ . period \
+ / slash \
+ : colon \
+ \; semicolon \
+ < less \
+ = equal \
+ > greater \
+ ? question \
+ @ at \
+ \[ bracketleft \
+ \\ backslash \
+ \] bracketright \
+ ^ asciicircum \
+ _ underscore \
+ \{ braceleft \
+ | bar \
+ \} braceright \
+ ~ asciitilde \
+ ' apostrophe \
+ "\n" Return]
}
-test event-7.1 {bgerror / regular} {
- set errRes {}
- proc bgerror {err} {
- global errRes;
- set errRes $err;
- }
- after 0 {error err1}
- vwait errRes;
- set errRes;
-} err1
-
-test event-7.2 {bgerror / accumulation} {
- set errRes {}
- proc bgerror {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 event-7.3 {bgerror / accumulation / break} {
- set errRes {}
- proc bgerror {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
-
-test event-7.4 {tkerror is nothing special anymore to tcl} {
- set errRes {}
- # we don't just rename bgerror to empty because it could then
- # be autoloaded...
- proc bgerror {err} {
- global errRes;
- lappend errRes "bg:$err";
- }
- proc tkerror {err} {
- global errRes;
- lappend errRes "tk:$err";
- }
- after 0 {error err1}
- update
- rename tkerror {}
- set errRes
-} bg:err1
-testConstraint exec [llength [info commands exec]]
+# Lookup an event in the keypress table.
+# For example:
+# Q -> Q
+# . -> period
+# / -> slash
+# Delete -> Delete
+# Escape -> Escape
+
+proc _keypress_lookup { char } {
+ global keypress_lookup
-test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
- set script {
- after 1000 error hello
- after 2000 set a 0
- vwait a
+ if {! [info exists keypress_lookup]} {
+ _init_keypress_lookup
}
- list [catch {exec [interpreter] << $script} errMsg] $errMsg
-} {1 {hello
- while executing
-"error hello"
- ("after" script)}}
+ if {$char == ""} {
+ error "empty char"
+ }
+ if {[info exists keypress_lookup($char)]} {
+ return $keypress_lookup($char)
+ } else {
+ return $char
+ }
+}
-# someday : add a test checking that
-# when there is no bgerror, an error msg goes to stderr
-# ideally one would use sub interp and transfer a fake stderr
-# to it, unfortunatly the current interp tcl API does not allow
-# that. the other option would be to use fork a test but it
-# then becomes more a file/exec test than a bgerror test.
-# end of bgerror tests
-catch {rename bgerror {}}
+# Lookup and generate a pair of KeyPress and KeyRelease events
+proc _keypress { win key } {
+ set keysym [_keypress_lookup $key]
-test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [interpreter]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; exit"
- flush $child
- set result [read $child]
- close $child
- set result
-} {even 6
-even 4
-odd 41
+ event generate $win <KeyPress-$keysym>
+ _pause 50
+ event generate $win <KeyRelease-$keysym>
+ _pause 50
}
-test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [interpreter]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; testexithandler delete 41"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
-} {even 16
-even 6
-even 4
-}
-test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [interpreter]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; testexithandler delete 4"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
- } {even 16
-even 6
-odd 41
+# Call _keypress for each character in the given string
+
+proc _keypress_string { win string } {
+ foreach letter [split $string ""] {
+ _keypress $win $letter
+ }
}
-test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [interpreter]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; testexithandler delete 6"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
-} {even 16
-even 4
-odd 41
+
+# Delay script execution for a given amount of time
+
+proc _pause { {msecs 1000} } {
+ global _pause
+
+ if {! [info exists _pause(number)]} {
+ set _pause(number) 0
+ }
+
+ set num [incr _pause(number)]
+ set _pause($num) 0
+
+ after $msecs "set _pause($num) 1"
+ vwait _pause($num)
+ unset _pause($num)
}
-test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [interpreter]] r+]
- puts $child "testexithandler create 41; testexithandler delete 41"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
-} {even 16
+
+# Helper proc to convert index to x y position
+
+proc _text_ind_to_x_y { text ind } {
+ foreach {x1 y1 width height} [$text bbox $ind] break
+ set middle_y [expr {$y1 + ($height / 2)}]
+ return [list $x1 $middle_y]
}
-test event-10.1 {Tcl_Exit procedure} {stdio} {
- set child [open |[list [interpreter]] r+]
- puts $child "exit 3"
- list [catch {close $child} msg] $msg [lindex $errorCode 0] \
- [lindex $errorCode 2]
-} {1 {child process exited abnormally} CHILDSTATUS 3}
-
-test event-11.1 {Tcl_VwaitCmd procedure} {
- list [catch {vwait} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.2 {Tcl_VwaitCmd procedure} {
- list [catch {vwait a b} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.3 {Tcl_VwaitCmd procedure} {
- catch {unset x}
- set x 1
- list [catch {vwait x(1)} msg] $msg
-} {1 {can't trace "x(1)": variable isn't array}}
-test event-11.4 {Tcl_VwaitCmd procedure} {} {
- foreach i [after info] {
- after cancel $i
+# Return selection only if owned by the given widget
+
+proc _get_selection { widget } {
+ if {[string compare $widget [selection own]] != 0} {
+ return ""
+ }
+ if {[catch {selection get} sel]} {
+ return ""
}
- after 10; update; # On Mac make sure update won't take long
- after 100 {set x x-done}
- after 200 {set y y-done}
- after 300 {set z z-done}
- after idle {set q q-done}
- set x before
- set y before
- set z before
- set q before
- list [vwait y] $x $y $z $q
-} {{} x-done y-done before q-done}
-
-foreach i [after info] {
- after cancel $i
+ return $sel
}
-test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
- set test1file [makeFile "" test1]
- set f1 [open $test1file w]
- proc accept {s args} {
- puts $s foobar
- close $s
- }
- catch {set s1 [socket -server accept 0]}
- after 1000
- catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
- close $s1
- set x 0
- set y 0
- set z 0
- fileevent $s2 readable {incr z}
- vwait z
- fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
- fileevent $s2 readable {incr y; if {$x == 3} {set z done}}
- vwait z
- close $f1
- close $s2
- removeFile $test1file
- list $x $y $z
-} {3 3 done}
-test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
- set test1file [makeFile "" test1]
- set test2file [makeFile "" test2]
- set f1 [open $test1file w]
- set f2 [open $test2file w]
- set x 0
- set y 0
- set z 0
+# Begining of the actual tests
+
+test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
+ button .b -text Test
+ pack .b
+ bindtags .b .b
update
- fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
- fileevent $f2 writable {incr y; if {$x == 3} {set z done}}
- vwait z
- close $f1
- close $f2
- removeFile $test1file
- removeFile $test2file
- list $x $y $z
-} {3 3 done}
-
-
-test event-12.1 {Tcl_UpdateCmd procedure} {
- list [catch {update a b} msg] $msg
-} {1 {wrong # args: should be "update ?idletasks?"}}
-test event-12.2 {Tcl_UpdateCmd procedure} {
- list [catch {update bogus} msg] $msg
-} {1 {bad option "bogus": must be idletasks}}
-test event-12.3 {Tcl_UpdateCmd procedure} {
- foreach i [after info] {
- after cancel $i
+ bind .b <Destroy> {
+ lappend x destroy
+ event generate .b <1>
+ event generate .b <ButtonRelease-1>
}
- after 500 {set x after}
- after idle {set y after}
- after idle {set z "after, y = $y"}
- set x before
- set y before
- set z before
- update idletasks
- list $x $y $z
-} {before after {after, y = after}}
-test event-12.4 {Tcl_UpdateCmd procedure} {
- foreach i [after info] {
- after cancel $i
+ bind .b <1> {
+ lappend x button
}
- after 10; update; # On Mac make sure update won't take long
- after 200 {set x x-done}
- after 600 {set y y-done}
- after idle {set z z-done}
- set x before
- set y before
- set z before
- after 300
- update
- list $x $y $z
-} {x-done before z-done}
+ set x {}
+ destroy .b
+ set x
+} {destroy}
-test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 readable 0]
- update
- testfilehandler close
- list $result $x
-} {{} {no timeout}}
-test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
- foreach i [after info] {
- after cancel $i
+test event-1.2 {event generate <Alt-z>} {
+ catch {destroy .e}
+ catch {unset ::event12result}
+ set ::event12result 0
+ pack [entry .e]
+ update
+ bind .e <Alt-z> {set ::event12result "1"}
+ focus -force .e ; event generate .e <Alt-z>
+ destroy .e
+ set ::event12result
+} 1
+
+
+
+test event-keypress-1.1 { type into entry widget and hit Return } {
+ destroy .t
+ set t [toplevel .t]
+ set e [entry $t.e]
+ pack $e
+ set return_binding 0
+ bind $e <Return> {set return_binding 1}
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e HELLO\n
+ list [$e get] $return_binding
+} {HELLO 1}
+
+
+test event-keypress-1.2 { type into entry widget and then delete some text } {
+ destroy .t
+ set t [toplevel .t]
+ set e [entry $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e MELLO
+ _keypress $e BackSpace
+ _keypress $e BackSpace
+ $e get
+} MEL
+
+test event-keypress-1.3 { type into entry widget, triple click,
+ hit Delete key, and then type some more } {
+ destroy .t
+ set t [toplevel .t]
+ set e [entry $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e JUMP
+
+ set result [$e get]
+
+ event generate $e <Enter>
+ for {set i 0} {$i < 3} {incr i} {
+ _pause 100
+ event generate $e <ButtonPress-1>
+ _pause 100
+ event generate $e <ButtonRelease-1>
}
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 readable 100]
- update
- testfilehandler close
- list $result $x
-} {{} timeout}
-test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
- foreach i [after info] {
- after cancel $i
+
+ _keypress $e Delete
+ _keypress_string $e UP
+ lappend result [$e get]
+} {JUMP UP}
+
+
+test event-keypress-1.4 { type into text widget and hit Return } {
+ destroy .t
+ set t [toplevel .t]
+ set e [text $t.e]
+ pack $e
+ set return_binding 0
+ bind $e <Return> {set return_binding 1}
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e HELLO\n
+ list [$e get 1.0 end] $return_binding
+} [list "HELLO\n\n" 1]
+
+test event-keypress-1.5 { type into text widget and then delete some text } {
+ destroy .t
+ set t [toplevel .t]
+ set e [text $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e MELLO
+ _keypress $e BackSpace
+ _keypress $e BackSpace
+ $e get 1.0 1.end
+} MEL
+
+test event-keypress-1.6 { type into text widget, triple click,
+ hit Delete key, and then type some more } {
+ destroy .t
+ set t [toplevel .t]
+ set e [text $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e JUMP
+
+ set result [$e get 1.0 1.end]
+
+ event generate $e <Enter>
+ for {set i 0} {$i < 3} {incr i} {
+ _pause 100
+ event generate $e <ButtonPress-1>
+ _pause 100
+ event generate $e <ButtonRelease-1>
}
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fillpartial 1
- set x "no timeout"
- set result [testfilehandler wait 1 readable 100]
- update
- testfilehandler close
- list $result $x
-} {readable {no timeout}}
-test event-13.4 {Tcl_WaitForFile procedure, writable} \
- {testfilehandler nonPortable} {
- foreach i [after info] {
- after cancel $i
+
+ _keypress $e Delete
+ _keypress_string $e UP
+ lappend result [$e get 1.0 1.end]
+} {JUMP UP}
+
+
+
+test event-click-drag-1.1 { click and drag in a text widget, this
+ tests tkTextSelectTo in text.tcl } {
+ destroy .t
+ set t [toplevel .t]
+ set e [text $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e "A Tcl/Tk selection test!"
+ set anchor 1.6
+ set selend 1.18
+
+ set result [list]
+ lappend result [$e get 1.0 1.end]
+
+ # Get the x,y coords of the second T in "Tcl/Tk"
+ foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
+
+ # Click down to set the insert cursor position
+ event generate $e <Enter>
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+
+ # Save the position of the insert cursor
+ lappend result [$e index insert]
+
+ # Now drag until selend is highlighted, then click up
+
+ set current $anchor
+ while {[$e compare $current <= $selend]} {
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ set current [$e index [list $current + 1 char]]
+ _pause 50
}
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fill 1
- set x "no timeout"
- set result [testfilehandler wait 1 writable 0]
- update
- testfilehandler close
- list $result $x
-} {{} {no timeout}}
-test event-13.5 {Tcl_WaitForFile procedure, writable} \
- {testfilehandler nonPortable} {
- foreach i [after info] {
- after cancel $i
+
+ event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+ _pause 200
+
+ # Save the position of the insert cursor
+ lappend result [$e index insert]
+
+ # Save the highlighted text
+ lappend result [_get_selection $e]
+
+ # Now click and click and drag to the left, over "Tcl/Tk selection"
+
+ event generate $e <ButtonPress-1> -x $current_x -y $current_y
+
+ while {[$e compare $current >= [list $anchor - 4 char]]} {
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ set current [$e index [list $current - 1 char]]
+ _pause 50
}
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fill 1
- set x "no timeout"
- set result [testfilehandler wait 1 writable 100]
- update
- testfilehandler close
- list $result $x
-} {{} timeout}
-test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
- foreach i [after info] {
- after cancel $i
+
+ event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+ _pause 200
+
+ # Save the position of the insert cursor
+ lappend result [$e index insert]
+
+ # Save the highlighted text
+ lappend result [_get_selection $e]
+
+} {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}}
+
+
+
+
+test event-click-drag-1.2 { click and drag in an entry widget, this
+ tests tkEntryMouseSelect in entry.tcl } {
+ destroy .t
+ set t [toplevel .t]
+ set e [entry $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e "A Tcl/Tk selection!"
+ set anchor 6
+ set selend 18
+
+ set result [list]
+ lappend result [$e get]
+
+ # Get the x,y coords of the second T in "Tcl/Tk"
+ foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
+
+ # Click down to set the insert cursor position
+ event generate $e <Enter>
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+
+ # Save the position of the insert cursor
+ lappend result [$e index insert]
+
+ # Now drag until selend is highlighted, then click up
+
+ set current $anchor
+ while {$current <= $selend} {
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ incr current
+ _pause 50
}
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 writable 100]
- update
- testfilehandler close
- list $result $x
-} {writable {no timeout}}
-test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
- foreach i [after info] {
- after cancel $i
+
+ event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+ _pause 200
+
+ # Save the position of the insert cursor
+ lappend result [$e index insert]
+
+ # Save the highlighted text
+ lappend result [_get_selection $e]
+
+ # Now click and click and drag to the left, over "Tcl/Tk selection"
+
+ event generate $e <ButtonPress-1> -x $current_x -y $current_y
+
+ while {$current >= ($anchor - 4)} {
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ incr current -1
+ _pause 50
}
- after 100 lappend x timeout
- after idle lappend x idle
- testfilehandler close
- testfilehandler create 1 off off
- set x ""
- set result [list [testfilehandler wait 1 readable 200] $x]
- update
- testfilehandler close
- lappend result $x
-} {{} {} {timeout idle}}
-
-test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
- set f [open "|sleep 2" r]
- set result ""
- lappend result [testfilewait $f readable 100]
- lappend result [testfilewait $f readable -1]
- close $f
+
+ event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+ _pause 200
+
+ # Save the position of the insert cursor
+ lappend result [$e index insert]
+
+ # Save the highlighted text
+ lappend result [_get_selection $e]
+
+} {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}}
+
+
+
+test event-double-click-drag-1.1 { click down, click up, click down again,
+ then drag in a text widget } {
+ destroy .t
+ set t [toplevel .t]
+ set e [text $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e "Word select test"
+ set anchor 1.8
+
+ # Get the x,y coords of the second e in "select"
+ foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
+
+ # Click down, release, then click down again
+ event generate $e <Enter>
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+ _pause 50
+ event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
+ _pause 50
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+ _pause 50
+
+ # Save the highlighted text
+ set result [list]
+ lappend result [_get_selection $e]
+
+ # Insert cursor should be at end of "select"
+ lappend result [$e index insert]
+
+ # Move mouse one character to the left
+ set current [$e index [list $anchor - 1 char]]
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 50
+
+ # Insert cursor should be before the l in "select"
+ lappend result [$e index insert]
+
+ # Selection should still be the word "select"
+ lappend result [_get_selection $e]
+
+ # Move mouse to the space before the word "select"
+ set current [$e index [list $current - 3 char]]
+
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 200
+
+ lappend result [$e index insert]
+ lappend result [_get_selection $e]
+
+ # Move mouse to the r in "Word"
+ set current 1.2
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 50
+
+ # Selection should now be "Word select"
+ lappend result [_get_selection $e]
+
+ # Insert cursor should be before the r in "Word"
+ lappend result [$e index insert]
+
+ set result
+} {select 1.11 1.7 select 1.4 { select} {Word select} 1.2}
+
+
+
+test event-double-click-drag-1.2 { click down, click up, click down again,
+ then drag in an entry widget } {
+ destroy .t
+ set t [toplevel .t]
+ set e [entry $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e "Word select test"
+
+ set anchor 8
+
+ # Get the x,y coords of the second e in "select"
+ foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
+
+ # Click down, release, then click down again
+ event generate $e <Enter>
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+ _pause 50
+ event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
+ _pause 50
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+ _pause 50
+
+ set result [list]
+ lappend result [_get_selection $e]
+
+ # Insert cursor should be at the end of "select"
+ lappend result [$e index insert]
+
+ # Move mouse one character to the left
+ set current [expr {$anchor - 1}]
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 50
+
+ # Insert cursor should be before the l in "select"
+ lappend result [$e index insert]
+
+ # Selection should still be the word "select"
+ lappend result [_get_selection $e]
+
+ # Move mouse to the space before the word "select"
+ set current [expr {$current - 3}]
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 50
+
+ lappend result [$e index insert]
+ lappend result [_get_selection $e]
+
+ # Move mouse to the r in "Word"
+ set current [expr {$current - 2}]
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 50
+
+ # Selection should now be "Word select"
+ lappend result [_get_selection $e]
+
+ # Insert cursor should be before the r in "Word"
+ lappend result [$e index insert]
+
set result
-} {{} readable}
+} {select 11 7 select 4 { select} {Word select} 2}
+
+
+test event-triple-click-drag-1.1 { Triple click and drag across lines in
+ a text widget, this should extend the selection to the new line } {
+ destroy .t
+ set t [toplevel .t]
+ set e [text $t.e]
+ pack $e
+ tkwait visibility $e
+ focus -force $e
+ _keypress_string $e "LINE ONE\nLINE TWO\nLINE THREE"
+
+ set anchor 3.2
+
+ # Triple click one third line leaving mouse down
+
+ foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
+
+ event generate $e <Enter>
+
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+ _pause 50
+ event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
+ _pause 50
+
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+ _pause 50
+ event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
+ _pause 50
+
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+ _pause 50
+
+ set result [list]
+ lappend result [_get_selection $e]
+
+ # Drag up to second line
+
+ set current [$e index [list $anchor - 1 line]]
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 50
+
+ lappend result [_get_selection $e]
+
+ # Drag up to first line
+
+ set current [$e index [list $current - 1 line]]
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ _pause 50
+
+ lappend result [_get_selection $e]
+
+ set result
+
+} [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \
+ "LINE ONE\nLINE TWO\nLINE THREE\n"]
+
# cleanup
-foreach i [after info] {
- after cancel $i
-}
+
+destroy .t
+
+unset -nocomplain keypress_lookup
+rename _init_keypress_lookup {}
+rename _keypress_lookup {}
+rename _keypress {}
+rename _pause {}
+rename _text_ind_to_x_y {}
+rename _get_selection {}
+
::tcltest::cleanupTests
return
+
diff --git a/tcl/tests/filebox.test b/tcl/tests/filebox.test
new file mode 100644
index 00000000000..26e4209c546
--- /dev/null
+++ b/tcl/tests/filebox.test
@@ -0,0 +1,404 @@
+# This file is a Tcl script to test out Tk's "tk_getOpenFile" and
+# "tk_getSaveFile" commands. It is organized in the standard fashion
+# for Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+#
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+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 ::tk::dialog::file::__tk_filedialog 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 ::tk::dialog::file::__tk_filedialog 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 {$tcl_platform(platform) == "unix"} {
+ set modes "0 1"
+} else {
+ set modes 1
+}
+
+set unknownOptionsMsg(tk_getOpenFile) {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
+set unknownOptionsMsg(tk_getSaveFile) {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+
+set tmpFile "filebox.tmp"
+makeFile {
+ # this file can be empty!
+} $tmpFile
+
+array set filters {
+ 1 {}
+ 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" *}
+ }
+ 3 {
+ {"Text files" {.txt .doc} TEXT}
+ {"Foo" {""} TEXT}
+ }
+}
+
+foreach mode $modes {
+
+ #
+ # Test both the motif version and the "tk" version of the file dialog
+ # box on Unix.
+ #
+ # Note that this can use the same test number twice!
+ #
+
+ set addedExtensions {}
+ if {$tcl_platform(platform) == "unix"} {
+ set tk_strictMotif $mode
+ # Extension adding is only done when using the non-motif file
+ # box with an extension-less filename
+ if {!$mode} {
+ set addedExtensions {NONE {} .txt .txt}
+ }
+ }
+
+ test filebox-1.1 "tk_getOpenFile command" {
+ list [catch {tk_getOpenFile -foo} msg] $msg
+ } $unknownOptionsMsg(tk_getOpenFile)
+
+ catch {tk_getOpenFile -foo 1} msg
+ regsub -all , $msg "" options
+ regsub \"-foo\" $options "" options
+
+ foreach option $options {
+ if {[string index $option 0] == "-"} {
+ test filebox-1.2 "tk_getOpenFile command" {
+ list [catch {tk_getOpenFile $option} msg] $msg
+ } [list 1 "value for \"$option\" missing"]
+ }
+ }
+
+ test filebox-1.3 "tk_getOpenFile command" {
+ list [catch {tk_getOpenFile -foo bar} msg] $msg
+ } $unknownOptionsMsg(tk_getOpenFile)
+
+ test filebox-1.4 "tk_getOpenFile command" {
+ list [catch {tk_getOpenFile -initialdir} msg] $msg
+ } {1 {value for "-initialdir" missing}}
+
+ test filebox-1.5 "tk_getOpenFile command" {
+ list [catch {tk_getOpenFile -parent foo.bar} msg] $msg
+ } {1 {bad window path name "foo.bar"}}
+
+ test filebox-1.6 "tk_getOpenFile command" {
+ list [catch {tk_getOpenFile -filetypes {Foo}} msg] $msg
+ } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
+
+ if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
+ set isNative 1
+ } else {
+ set isNative 0
+ }
+
+ set parent .
+
+ set verylongstring longstring:
+ set verylongstring $verylongstring$verylongstring
+ set verylongstring $verylongstring$verylongstring
+ set verylongstring $verylongstring$verylongstring
+ set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+
+ set color #404040
+ test filebox-2.1 "tk_getOpenFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent cancel
+ tk_getOpenFile -title "Press Cancel ($verylongstring)" -parent $parent
+ } ""
+
+ set fileName $tmpFile
+ set fileDir [pwd]
+ set pathName [file join $fileDir $fileName]
+
+ test filebox-2.2 "tk_getOpenFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getOpenFile -title "Press Ok" \
+ -parent $parent -initialfile $fileName -initialdir $fileDir]
+ } $pathName
+
+ test filebox-2.3 "tk_getOpenFile command" {nonUnixUserInteraction} {
+ ToEnterFileByKey $parent $fileName $fileDir
+ set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
+ -parent $parent -initialdir $fileDir]
+ } $pathName
+
+ test filebox-2.4 "tk_getOpenFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
+ -parent $parent -initialdir . \
+ -initialfile $fileName]
+ } $pathName
+
+ test filebox-2.5 "tk_getOpenFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
+ -parent $parent -initialdir /badpath \
+ -initialfile $fileName]
+ } $pathName
+
+ test filebox-2.6 "tk_getOpenFile command" {nonUnixUserInteraction} {
+ toplevel .t1; toplevel .t2
+ wm geometry .t1 +0+0
+ wm geometry .t2 +0+0
+ ToPressButton .t1 ok
+ set choice {}
+ lappend choice [tk_getOpenFile \
+ -title "Enter \"$fileName\" and press Ok" \
+ -parent .t1 -initialdir $fileDir \
+ -initialfile $fileName]
+ ToPressButton .t2 ok
+ lappend choice [tk_getOpenFile \
+ -title "Enter \"$fileName\" and press Ok" \
+ -parent .t2 -initialdir $fileDir \
+ -initialfile $fileName]
+ ToPressButton .t1 ok
+ lappend choice [tk_getOpenFile \
+ -title "Enter \"$fileName\" and press Ok" \
+ -parent .t1 -initialdir $fileDir \
+ -initialfile $fileName]
+ destroy .t1
+ destroy .t2
+ set choice
+ } [list $pathName $pathName $pathName]
+
+ foreach x [lsort -integer [array names filters]] {
+ test filebox-3.$x "tk_getOpenFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getOpenFile -title "Press Ok" -filetypes $filters($x)\
+ -parent $parent -initialfile $fileName -initialdir $fileDir]
+ } $pathName
+ }
+
+ test filebox-4.1 "tk_getSaveFile command" {
+ list [catch {tk_getSaveFile -foo} msg] $msg
+ } $unknownOptionsMsg(tk_getSaveFile)
+
+ catch {tk_getSaveFile -foo 1} msg
+ regsub -all , $msg "" options
+ regsub \"-foo\" $options "" options
+
+ foreach option $options {
+ if {[string index $option 0] == "-"} {
+ test filebox-4.2 "tk_getSaveFile command" {
+ list [catch {tk_getSaveFile $option} msg] $msg
+ } [list 1 "value for \"$option\" missing"]
+ }
+ }
+
+ test filebox-4.3 "tk_getSaveFile command" {
+ list [catch {tk_getSaveFile -foo bar} msg] $msg
+ } $unknownOptionsMsg(tk_getSaveFile)
+
+ test filebox-4.4 "tk_getSaveFile command" {
+ list [catch {tk_getSaveFile -initialdir} msg] $msg
+ } {1 {value for "-initialdir" missing}}
+
+ test filebox-4.5 "tk_getSaveFile command" {
+ list [catch {tk_getSaveFile -parent foo.bar} msg] $msg
+ } {1 {bad window path name "foo.bar"}}
+
+ test filebox-4.6 "tk_getSaveFile command" {
+ list [catch {tk_getSaveFile -filetypes {Foo}} msg] $msg
+ } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
+
+ if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
+ set isNative 1
+ } else {
+ set isNative 0
+ }
+
+ set parent .
+
+ set verylongstring longstring:
+ set verylongstring $verylongstring$verylongstring
+ set verylongstring $verylongstring$verylongstring
+ set verylongstring $verylongstring$verylongstring
+ set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+ # set verylongstring $verylongstring$verylongstring
+
+ set color #404040
+ test filebox-5.1 "tk_getSaveFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent cancel
+ tk_getSaveFile -title "Press Cancel ($verylongstring)" -parent $parent
+ } ""
+
+ set fileName "12x 455"
+ set fileDir [pwd]
+ set pathName [file join [pwd] $fileName]
+
+ test filebox-5.2 "tk_getSaveFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getSaveFile -title "Press Ok" \
+ -parent $parent -initialfile $fileName -initialdir $fileDir]
+ } $pathName
+
+ test filebox-5.3 "tk_getSaveFile command" {nonUnixUserInteraction} {
+ ToEnterFileByKey $parent $fileName $fileDir
+ set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
+ -parent $parent -initialdir $fileDir]
+ } $pathName
+
+ test filebox-5.4 "tk_getSaveFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
+ -parent $parent -initialdir . \
+ -initialfile $fileName]
+ } $pathName
+
+ test filebox-5.5 "tk_getSaveFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
+ -parent $parent -initialdir /badpath \
+ -initialfile $fileName]
+ } $pathName
+
+ test filebox-5.6 "tk_getSaveFile command" {nonUnixUserInteraction} {
+ toplevel .t1; toplevel .t2
+ wm geometry .t1 +0+0
+ wm geometry .t2 +0+0
+ ToPressButton .t1 ok
+ set choice {}
+ lappend choice [tk_getSaveFile \
+ -title "Enter \"$fileName\" and press Ok" \
+ -parent .t1 -initialdir $fileDir \
+ -initialfile $fileName]
+ ToPressButton .t2 ok
+ lappend choice [tk_getSaveFile \
+ -title "Enter \"$fileName\" and press Ok" \
+ -parent .t2 -initialdir $fileDir \
+ -initialfile $fileName]
+ ToPressButton .t1 ok
+ lappend choice [tk_getSaveFile \
+ -title "Enter \"$fileName\" and press Ok" \
+ -parent .t1 -initialdir $fileDir \
+ -initialfile $fileName]
+ destroy .t1
+ destroy .t2
+ set choice
+ } [list $pathName $pathName $pathName]
+
+ foreach x [lsort -integer [array names filters]] {
+ test filebox-6.$x "tk_getSaveFile command" {nonUnixUserInteraction} {
+ ToPressButton $parent ok
+ set choice [tk_getSaveFile -title "Press Ok" -filetypes $filters($x)\
+ -parent $parent -initialfile $fileName -initialdir $fileDir]
+ } $pathName[lindex $addedExtensions $x]
+ }
+
+ # 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.
+}
+
+set tk_strictMotif $tk_strictMotif_old
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/focus.test b/tcl/tests/focus.test
new file mode 100644
index 00000000000..abad7e8a300
--- /dev/null
+++ b/tcl/tests/focus.test
@@ -0,0 +1,660 @@
+# This file is a Tcl script to test out the "focus" command and the
+# other procedures in the file tkFocus.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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)
+ 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
+catch {fixfocus}
+
+# The following procedure ensures that there is no input focus
+# in this application. It does it by arranging for another
+# application to grab the focus. The "after" and "update" stuff
+# is needed to wait long enough for pending actions to get through
+# the X server and possibly also the window manager.
+
+setupbg
+proc focusClear {} {
+ global x;
+ after 200 {set x 1}
+ tkwait variable x
+ dobg {focus -force .; update}
+ update
+}
+
+focusSetup
+if {[testConstraint altDisplay]} {
+ focusSetupAlt
+}
+update
+
+bind all <FocusIn> {
+ append focusInfo "in %W %d\n"
+}
+bind all <FocusOut> {
+ append focusInfo "out %W %d\n"
+}
+bind all <KeyPress> {
+ append focusInfo "press %W %K"
+}
+
+test focus-1.1 {Tk_FocusCmd procedure} {unixOnly} {
+ focusClear
+ focus
+} {}
+test focus-1.2 {Tk_FocusCmd procedure} {unixOnly altDisplay} {
+ focus .alt.b
+ focus
+} {}
+test focus-1.3 {Tk_FocusCmd procedure} {unixOnly} {
+ focusClear
+ focus .t.b3
+ focus
+} {}
+test focus-1.4 {Tk_FocusCmd procedure} {unixOnly} {
+ list [catch {focus ""} msg] $msg
+} {0 {}}
+test focus-1.5 {Tk_FocusCmd procedure} {unixOnly} {
+ focusClear
+ focus -force .t
+ focus .t.b3
+ focus
+} {.t.b3}
+test focus-1.6 {Tk_FocusCmd procedure} {unixOnly} {
+ list [catch {focus .gorp} msg] $msg
+} {1 {bad window path name ".gorp"}}
+test focus-1.7 {Tk_FocusCmd procedure} {unixOnly} {
+ list [catch {focus .gorp a} msg] $msg
+} {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}}
+test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {unixOnly} {
+ toplevel .t2
+ wm geom .t2 +10+10
+ frame .t2.f -width 200 -height 100 -bd 2 -relief raised
+ frame .t2.f2 -width 200 -height 100 -bd 2 -relief raised
+ pack .t2.f .t2.f2
+ bind .t2.f <Destroy> {focus .t2.f}
+ bind .t2.f2 <Destroy> {focus .t2}
+ focus -force .t2.f2
+ tkwait visibility .t2.f2
+ update
+ set x [focus]
+ destroy .t2.f2
+ lappend x [focus]
+ destroy .t2.f
+ lappend x [focus]
+ destroy .t2
+ set x
+} {.t2.f2 .t2 .t2}
+test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
+ list [catch {focus -displayof} msg] $msg
+} {1 {wrong # args: should be "focus -displayof window"}}
+test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
+ list [catch {focus -displayof a b} msg] $msg
+} {1 {wrong # args: should be "focus -displayof window"}}
+test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
+ list [catch {focus -displayof .lousy} msg] $msg
+} {1 {bad window path name ".lousy"}}
+test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
+ focusClear
+ focus .t
+ focus -displayof .t.b3
+} {}
+test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
+ focusClear
+ focus -force .t
+ focus -displayof .t.b3
+} {.t}
+test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unixOnly altDisplay} {
+ focus -force .alt.c
+ focus -displayof .alt
+} {.alt.c}
+test focus-1.15 {Tk_FocusCmd procedure, -force option} {unixOnly} {
+ list [catch {focus -force} msg] $msg
+} {1 {wrong # args: should be "focus -force window"}}
+test focus-1.16 {Tk_FocusCmd procedure, -force option} {unixOnly} {
+ list [catch {focus -force a b} msg] $msg
+} {1 {wrong # args: should be "focus -force window"}}
+test focus-1.17 {Tk_FocusCmd procedure, -force option} {unixOnly} {
+ list [catch {focus -force foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test focus-1.18 {Tk_FocusCmd procedure, -force option} {unixOnly} {
+ list [catch {focus -force ""} msg] $msg
+} {0 {}}
+test focus-1.19 {Tk_FocusCmd procedure, -force option} {unixOnly} {
+ focusClear
+ focus .t.b1
+ set x [list [focus]]
+ focus -force .t.b1
+ lappend x [focus]
+} {{} .t.b1}
+test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
+ list [catch {focus -lastfor} msg] $msg
+} {1 {wrong # args: should be "focus -lastfor window"}}
+test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
+ list [catch {focus -lastfor 1 2} msg] $msg
+} {1 {wrong # args: should be "focus -lastfor window"}}
+test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
+ list [catch {focus -lastfor who_knows?} msg] $msg
+} {1 {bad window path name "who_knows?"}}
+test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
+ focus .b
+ focus .t.b1
+ list [focus -lastfor .] [focus -lastfor .t.b3]
+} {.b .t.b1}
+test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
+ destroy .t
+ focusSetup
+ update
+ focus -lastfor .t.b2
+} {.t}
+test focus-1.25 {Tk_FocusCmd procedure} {unixOnly} {
+ list [catch {focus -unknown} msg] $msg
+} {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}}
+
+test focus-2.1 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
+ focus -force .b
+ destroy .t
+ focusSetup
+ update
+ set focusInfo {}
+ event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \
+ -sendevent 0x54217567
+ list $focusInfo
+} {{}}
+test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
+ focus -force .b
+ destroy .t
+ focusSetup
+ update
+ set focusInfo {}
+ event gen .t <FocusIn> -detail NotifyAncestor -sendevent 0x547321ac
+ list $focusInfo [focus]
+} {{in .t NotifyAncestor
+} .b}
+test focus-2.3 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
+ focus -force .b
+ destroy .t
+ focusSetup
+ update
+ set focusInfo {}
+ event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
+ update
+ list $focusInfo [focus -lastfor .t]
+} {{out .b NotifyNonlinear
+out . NotifyNonlinearVirtual
+in .t NotifyNonlinear
+} .t}
+test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \
+ {unixOnly nonPortable testwrapper} {
+ set result {}
+ focus .t.b1
+ # Important to end with NotifyAncestor, which is an
+ # event that is processed normally. This has a side
+ # effect on text 2.5
+ foreach detail {NotifyAncestor NotifyNonlinear
+ NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot
+ 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} \
+ {unixOnly nonPortable testwrapper} {
+ focusSetup
+ focus .t.b1
+ update
+ event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
+ list $focusInfo [focus]
+} {{out . NotifyNonlinear
+in .t NotifyNonlinearVirtual
+in .t.b1 NotifyNonlinear
+} .t.b1}
+test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \
+ {unixOnly testwrapper} {
+ focus .t.b1
+ focus .
+ update
+ event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
+ set focusInfo {}
+ set x [focus]
+ event gen . <KeyPress-x>
+ list $x $focusInfo
+} {.t.b1 {press .t.b1 x}}
+test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \
+ {unixOnly testwrapper} {
+ set result {}
+ foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
+ NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot
+ NotifyVirtual} {
+ focus -force .t.b1
+ event gen [testwrapper .t] <FocusOut> -detail $detail
+ update
+ lappend result [focus]
+ }
+ set result
+} {{} .t.b1 {} {} .t.b1 .t.b1 {}}
+test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \
+ {unixOnly testwrapper} {
+ focus -force .t.b1
+ event gen .t.b1 <FocusOut> -detail NotifyAncestor
+ focus
+} {.t.b1}
+test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \
+ {unixOnly testwrapper} {
+ focus .t.b1
+ event gen [testwrapper .] <FocusOut> -detail NotifyAncestor
+ focus
+} {}
+test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \
+ {unixOnly testwrapper} {
+ set result {}
+ focus .t.b1
+ focusClear
+ foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
+ NotifyNonlinearVirtual NotifyVirtual} {
+ event gen [testwrapper .t] <Enter> -detail $detail -focus 1
+ update
+ lappend result [focus]
+ event gen [testwrapper .t] <Leave> -detail NotifyAncestor
+ update
+ }
+ set result
+} {.t.b1 {} .t.b1 .t.b1 .t.b1}
+test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \
+ {unixOnly testwrapper} {
+ focusClear
+ set focusInfo {}
+ event gen [testwrapper .t] <Enter> -detail NotifyAncestor
+ update
+ set focusInfo
+} {}
+test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \
+ {unixOnly testwrapper} {
+ focus -force .b
+ update
+ set focusInfo {}
+ event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
+ update
+ set focusInfo
+} {}
+test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \
+ {unixOnly testwrapper} {
+ focus .t.b1
+ focusClear
+ event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
+ set focusInfo {}
+ update
+ set focusInfo
+} {in .t NotifyVirtual
+in .t.b1 NotifyAncestor
+}
+test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unixOnly testwrapper} {
+ focusClear
+ catch {destroy .t2}
+ toplevel .t2
+ wm withdraw .t2
+ update
+ set focusInfo {}
+ event gen [testwrapper .t2] <Enter> -detail NotifyAncestor -focus 1
+ update
+ destroy .t2
+} {}
+test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \
+ {unixOnly testwrapper} {
+ set result {}
+ focus .t.b1
+ foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
+ NotifyNonlinearVirtual NotifyVirtual} {
+ focusClear
+ event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
+ update
+ event gen [testwrapper .t] <Leave> -detail $detail
+ update
+ lappend result [focus]
+ }
+ set result
+} {{} .t.b1 {} {} {}}
+test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \
+ {unixOnly testwrapper} {
+ set result {}
+ focus .t.b1
+ event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
+ update
+ set focusInfo {}
+ event gen [testwrapper .t] <Leave> -detail NotifyAncestor
+ update
+ set focusInfo
+} {out .t.b1 NotifyAncestor
+out .t NotifyVirtual
+}
+test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \
+ {unixOnly testwrapper} {
+ set result {}
+ focus .t.b1
+ event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
+ update
+ set focusInfo {}
+ event gen .t.b1 <Leave> -detail NotifyAncestor
+ event gen [testwrapper .] <Leave> -detail NotifyAncestor
+ update
+ list $focusInfo [focus]
+} {{out .t.b1 NotifyAncestor
+out .t NotifyVirtual
+} {}}
+
+test focus-3.1 {SetFocus procedure, create record on focus} \
+ {unixOnly testwrapper} {
+ toplevel .t2 -width 250 -height 100
+ wm geometry .t2 +0+0
+ update
+ focus -force .t2
+ update
+ focus
+} {.t2}
+catch {destroy .t2}
+# This test produces no result, but it will generate a protocol
+# error if Tk forgets to make the window exist before focussing
+# on it.
+test focus-3.2 {SetFocus procedure, making window exist} \
+ {unixOnly testwrapper} {
+ update
+ button .b2 -text "Another button"
+ focus .b2
+ update
+} {}
+catch {destroy .b2}
+update
+# The following test doesn't produce a check-able result, but if
+# there are bugs it may generate an X protocol error.
+test focus-3.3 {SetFocus procedure, delaying claim of X focus} \
+ {unixOnly testwrapper} {
+ focusSetup
+ focus -force .t.b2
+ update
+} {}
+test focus-3.4 {SetFocus procedure, delaying claim of X focus} \
+ {unixOnly testwrapper} {
+ focusSetup
+ wm withdraw .t
+ focus -force .t.b2
+ toplevel .t2 -width 250 -height 100
+ wm geometry .t2 +10+10
+ focus -force .t2
+ wm withdraw .t2
+ update
+ wm deiconify .t2
+ wm deiconify .t
+} {}
+catch {destroy .t2}
+test focus-3.5 {SetFocus procedure, generating events} \
+ {unixOnly testwrapper} {
+ focusSetup
+ focusClear
+ set focusInfo {}
+ focus -force .t.b2
+ update
+ set focusInfo
+} {in .t NotifyVirtual
+in .t.b2 NotifyAncestor
+}
+test focus-3.6 {SetFocus procedure, generating events} \
+ {unixOnly testwrapper} {
+ focusSetup
+ focus -force .b
+ update
+ set focusInfo {}
+ focus .t.b2
+ update
+ set focusInfo
+} {out .b NotifyNonlinear
+out . NotifyNonlinearVirtual
+in .t NotifyNonlinearVirtual
+in .t.b2 NotifyNonlinear
+}
+test focus-3.7 {SetFocus procedure, generating events} \
+ {unixOnly nonPortable testwrapper} {
+ # Non-portable because some platforms generate extra events.
+
+ focusSetup
+ focusClear
+ set focusInfo {}
+ focus .t.b2
+ update
+ set focusInfo
+} {}
+
+test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
+ focusSetup
+ update
+ focus -force .b
+ update
+ destroy .t
+ focus
+} {.b}
+test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
+ focusSetup
+ update
+ focus -force .t.b2
+ focus .b
+ update
+ destroy .t.b2
+ update
+ focus
+} {.b}
+
+# Non-portable due to wm-specific redirection of input focus when
+# windows are deleted:
+
+test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} {
+ focusSetup
+ update
+ focus .t
+ update
+ destroy .t
+ update
+ focus
+} {}
+test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
+ focusSetup
+ focus -force .t.b2
+ update
+ destroy .t.b2
+ focus
+} {.t}
+
+# I don't know how to test most of the remaining procedures of this file
+# explicitly; they've already been exercised by the preceding tests.
+
+setupbg
+test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \
+ {unixOnly testwrapper secureserver} {
+ focusSetup
+ focus -force .t
+ update
+ set result [focus]
+ send [dobg {tk appname}] {focus -force .; update}
+ lappend result [focus]
+ focus .t.b2
+ update
+ lappend result [focus]
+} {.t {} {}}
+
+catch {destroy .t}
+bind all <FocusIn> {}
+bind all <FocusOut> {}
+bind all <KeyPress> {}
+cleanupbg
+fixfocus
+
+test focus-6.1 {miscellaneous - embedded application in same process} \
+ {unixOnly testwrapper} {
+ eval interp delete [interp slaves]
+ catch {destroy .t}
+ toplevel .t
+ wm geometry .t +0+0
+ frame .t.f1 -container 1
+ frame .t.f2
+ pack .t.f1 .t.f2
+ 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 testwrapper} {
+ eval interp delete [interp slaves]
+ catch {destroy .t}
+ setupbg
+ toplevel .t
+ wm geometry .t +0+0
+ frame .t.f1 -container 1
+ frame .t.f2
+ 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}}}
+
+deleteWindows
+bind all <FocusIn> {}
+bind all <FocusOut> {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/focusTcl.test b/tcl/tests/focusTcl.test
new file mode 100644
index 00000000000..d7e41dfd1f4
--- /dev/null
+++ b/tcl/tests/focusTcl.test
@@ -0,0 +1,296 @@
+# This file is a Tcl script to test out the features of the script
+# file focus.tcl, which includes the procedures tk_focusNext and
+# tk_focusPrev, among other things. This file is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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
+ }
+ if {![winfo ismapped $w.b.z]} {
+ 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} {
+ deleteWindows
+ setup1 .
+ update
+ . configure -takefocus 0
+ tk_focusNext .d
+} {.a}
+. configure -takefocus 1
+
+deleteWindows
+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}
+
+deleteWindows
+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
+} {.}
+
+deleteWindows
+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}
+
+deleteWindows
+test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} {
+ deleteWindows
+ setup1 .
+ .b.x configure -takefocus 0
+ tk_focusNext .b
+} {.b.y}
+test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} {
+ deleteWindows
+ 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
+ }
+ deleteWindows
+ 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 ""} {
+ deleteWindows
+ setup1 .
+ .b.x configure -takefocus ""
+ update
+ tk_focusNext .b
+} {.b.x}
+test focusTcl-5.5 {tkFocusOK procedure, -takefocus "", not mapped} {
+ deleteWindows
+ setup1 .
+ .b.x configure -takefocus ""
+ pack unpack .b.x
+ update
+ tk_focusNext .b
+} {.b.y}
+test focusTcl-5.6 {tkFocusOK procedure, -takefocus "", not mapped} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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}
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/font.test b/tcl/tests/font.test
new file mode 100644
index 00000000000..65fd00ac849
--- /dev/null
+++ b/tcl/tests/font.test
@@ -0,0 +1,1380 @@
+# This file is a Tcl script to test out Tk's "font" command
+# plus the procedures in tkFont.c. It is organized in the
+# standard white-box fashion for Tcl tests.
+#
+# Copyright (c) 1996-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+catch {destroy .b}
+toplevel .b
+wm geom .b +0+0
+update idletasks
+
+proc setup {} {
+ catch {destroy .b.f}
+ catch {eval font delete [font names]}
+ label .b.f
+ pack .b.f
+ update
+}
+
+label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Courier -12"
+pack .b.l
+canvas .b.c -closeenough 0
+.b.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+pack .b.c
+update
+
+set ax [winfo reqwidth .b.l]
+set ay [winfo reqheight .b.l]
+proc getsize {} {
+ update
+ 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 {TkFontPkgInit} {
+ catch {interp delete foo}
+ interp create foo
+ foo eval {
+ load {} Tk
+ wm geometry . +0+0
+ update
+ }
+ interp delete foo
+} {}
+
+test font-2.1 {TkFontPkgFree} {
+ catch {interp delete foo}
+ interp create foo
+ set x {}
+
+ # Makes sure that named font was visible only to child interp.
+
+ foo eval {
+ load {} Tk
+ wm geometry . +0+0
+ button .b -font {times 16} -text "hi"
+ pack .b
+ font create wiggles -family courier -underline 1
+ update
+ }
+ lappend x [catch {font configure wiggles} msg; set msg]
+
+ # Tests cancelling the idle handler for TheWorldHasChanged,
+ # because app goes away before idle serviced.
+
+ foo eval {
+ .b config -font wiggles
+ font config wiggles -size 24
+ destroy .
+ }
+ lappend x [foo eval {catch {font families} msg; set msg}]
+
+ interp delete foo
+ set x
+} {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}}
+
+
+test font-3.1 {font command: general} {
+ list [catch {font} msg] $msg
+} {1 {wrong # args: should be "font option ?arg?"}}
+test font-3.2 {font command: general} {
+ list [catch {font xyz} msg] $msg
+} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
+
+test font-4.1 {font command: actual: arguments} {
+ # (skip < 0)
+ list [catch {font actual xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-4.2 {font command: actual: arguments} {
+ # (objc < 3)
+ list [catch {font actual} msg] $msg
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+test font-4.3 {font command: actual: arguments} {
+ # (objc - skip > 4) when skip == 0
+ list [catch {font actual xyz abc def} msg] $msg
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+test font-4.4 {font command: actual: displayof specified, so skip to next} {
+ catch {font actual xyz -displayof . -size}
+} {0}
+test font-4.5 {font command: actual: displayof specified, so skip to next} {
+ lindex [font actual xyz -displayof .] 0
+} {-family}
+test font-4.6 {font command: actual: arguments} {
+ # (objc - skip > 4) when skip == 2
+ list [catch {font actual xyz -displayof . abc def} msg] $msg
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+test font-4.7 {font command: actual: arguments} {noExceed} {
+ # (tkfont == NULL)
+ list [catch {font actual "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-4.8 {font command: actual: all attributes} {
+ # not (objc > 3) so objPtr = NULL
+ lindex [font actual {-family times}] 0
+} {-family}
+test font-4.9 {font command: actual} {macOrUnix noExceed} {
+ # (objc > 3) so objPtr = objv[3 + skip]
+ string tolower [font actual {-family times} -family]
+} {times}
+test font-4.10 {font command: actual} {pcOnly} {
+ # (objc > 3) so objPtr = objv[3 + skip]
+ font actual {-family times} -family
+} {Times New Roman}
+test font-4.11 {font command: bad option} {
+ list [catch {font actual xyz -style} msg] $msg
+} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+
+test font-5.1 {font command: configure} {
+ # (objc < 3)
+ list [catch {font configure} msg] $msg
+} {1 {wrong # args: should be "font configure fontname ?options?"}}
+test font-5.2 {font command: configure: non-existent font} {
+ # (namedHashPtr == NULL)
+ list [catch {font configure xyz} msg] $msg
+} {1 {named font "xyz" doesn't exist}}
+test font-5.3 {font command: configure: "deleted" font} {
+ # (nfPtr->deletePending != 0)
+ setup
+ font create xyz
+ .b.f configure -font xyz
+ font delete xyz
+ list [catch {font configure xyz} msg] $msg
+} {1 {named font "xyz" doesn't exist}}
+test font-5.4 {font command: configure: get all options} {
+ # (objc == 3) so objPtr = NULL
+ setup
+ font create xyz -family xyz
+ lindex [font configure xyz] 1
+} xyz
+test font-5.5 {font command: configure: get one option} {
+ # (objc == 4) so objPtr = objv[3]
+ setup
+ font create xyz -family xyz
+ font configure xyz -family
+} xyz
+test font-5.6 {font command: configure: update existing font} {
+ # else result = ConfigAttributesObj()
+ setup
+ font create xyz
+ font configure xyz -family xyz
+ update
+ font configure xyz -family
+} xyz
+test font-5.7 {font command: configure: bad option} {
+ setup
+ font create xyz
+ list [catch {font configure xyz -style} msg] $msg
+} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+
+test font-6.1 {font command: create: make up name} {
+ # (objc < 3) so name = NULL
+ setup
+ font create
+ font names
+} {font1}
+test font-6.2 {font command: create: name specified} {
+ # not (objc < 3)
+ setup
+ font create xyz
+ font names
+} {xyz}
+test font-6.3 {font command: create: name not really specified} {
+ # (name[0] == '-') so name = NULL
+ setup
+ font create -family xyz
+ font names
+} {font1}
+test font-6.4 {font command: create: generate name} {
+ # (name == NULL)
+ setup
+ font create -family one
+ font create -family two
+ font create -family three
+ font delete font2
+ font create -family four
+ font configure font2 -family
+} {four}
+test font-6.5 {font command: create: bad option creating new font} {
+ # name was specified so skip = 3
+ setup
+ list [catch {font create xyz -xyz times} msg] $msg
+} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+test font-6.6 {font command: create: bad option creating new font} {
+ # name was not specified so skip = 2
+ setup
+ list [catch {font create -xyz times} msg] $msg
+} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+test font-6.7 {font command: create: already exists} {
+ # (CreateNamedFont() != TCL_OK)
+ setup
+ font create xyz
+ list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
+
+test font-7.1 {font command: delete: arguments} {
+ # (objc < 3)
+ list [catch {font delete} msg] $msg
+} {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
+test font-7.2 {font command: delete: loop test} {
+ # for (i = 2; i < objc; i++)
+ setup
+ set x {}
+ font create a -underline 1
+ font create b -underline 1
+ font create c -underline 1
+ font create d -underline 1
+ font create e -underline 1
+ lappend x [lsort [font names]]
+ font delete a e c b
+ lappend x [lsort [font names]]
+} {{a b c d e} d}
+test font-7.3 {font command: delete: loop test} {
+ # (namedHashPtr == NULL) in middle of loop
+ setup
+ set x {}
+ font create a -underline 1
+ font create b -underline 1
+ font create c -underline 1
+ font create d -underline 1
+ font create e -underline 1
+ lappend x [lsort [font names]]
+ catch {font delete a d q c e b}
+ lappend x [lsort [font names]]
+} {{a b c d e} {b c e}}
+test font-7.4 {font command: delete: non-existent} {
+ # (namedHashPtr == NULL)
+ setup
+ list [catch {font delete xyz} msg] $msg
+} {1 {named font "xyz" doesn't exist}}
+test font-7.5 {font command: delete: mark for later deletion} {
+ # (nfPtr->refCount != 0)
+ setup
+ font create xyz
+ .b.f configure -font xyz
+ font delete xyz
+ font actual xyz
+ list [catch {font configure xyz} msg] $msg [.b.f cget -font]
+} {1 {named font "xyz" doesn't exist} xyz}
+test font-7.6 {font command: delete: actually delete} {
+ # not (nfPtr->refCount != 0)
+ setup
+ font create xyz -underline 1
+ font delete xyz
+ catch {font config xyz}
+} {1}
+setup
+
+test font-8.1 {font command: families: arguments} {
+ # (skip < 0)
+ list [catch {font families -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-8.2 {font command: families: arguments} {
+ # (objc - skip != 2) when skip == 0
+ list [catch {font families xyz} msg] $msg
+} {1 {wrong # args: should be "font families ?-displayof window?"}}
+test font-8.3 {font command: families: arguments} {
+ # (objc - skip != 2) when skip == 2
+ list [catch {font families -displayof . xyz} msg] $msg
+} {1 {wrong # args: should be "font families ?-displayof window?"}}
+test font-8.4 {font command: families} {
+ # TkpGetFontFamilies()
+ regexp -nocase times [font families]
+} {1}
+
+test font-9.1 {font command: measure: arguments} {
+ # (skip < 0)
+ list [catch {font measure xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-9.2 {font command: measure: arguments} {
+ # (objc - skip != 4)
+ list [catch {font measure} msg] $msg
+} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
+test font-9.3 {font command: measure: arguments} {
+ # (objc - skip != 4)
+ list [catch {font measure xyz abc def} msg] $msg
+} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
+test font-9.4 {font command: measure: arguments} {noExceed} {
+ # (tkfont == NULL)
+ list [catch {font measure "\{xyz" abc} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-9.5 {font command: measure} {
+ # Tk_TextWidth()
+ expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
+} {1}
+
+test font-10.1 {font command: metrics: arguments} {
+ list [catch {font metrics xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-10.2 {font command: metrics: arguments} {
+ # (skip < 0)
+ list [catch {font metrics xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-10.3 {font command: metrics: arguments} {
+ # (objc < 3)
+ list [catch {font metrics} msg] $msg
+} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
+test font-10.4 {font command: metrics: arguments} {
+ # (objc - skip) > 4) when skip == 0
+ list [catch {font metrics xyz abc def} msg] $msg
+} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
+test font-10.5 {font command: metrics: arguments} {
+ # (objc - skip) > 4) when skip == 2
+ list [catch {font metrics xyz -displayof . abc} msg] $msg
+} {1 {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}}
+test font-10.6 {font command: metrics: bad font} {noExceed} {
+ # (tkfont == NULL)
+ list [catch {font metrics "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-10.7 {font command: metrics: get all metrics} {
+ # (objc == 3)
+ catch {unset a}
+ array set a [font metrics {-family xyz}]
+ set x [lsort [array names a]]
+ unset a
+ set x
+} {-ascent -descent -fixed -linespace}
+test font-10.8 {font command: metrics: bad metric} {
+ # (Tcl_GetIndexFromObj() != TCL_OK)
+ list [catch {font metrics $fixed -xyz} msg] $msg
+} {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}
+test font-10.9 {font command: metrics: get individual metrics} {
+ font metrics $fixed -ascent
+ font metrics $fixed -descent
+ font metrics $fixed -linespace
+ font metrics $fixed -fixed
+} {1}
+
+test font-11.1 {font command: names: arguments} {
+ # (objc != 2)
+ list [catch {font names xyz} msg] $msg
+} {1 {wrong # args: should be "font names"}}
+test font-11.2 {font command: names: loop test: no passes} {
+ setup
+ font names
+} {}
+test font-11.3 {font command: names: loop test: one pass} {
+ setup
+ font create
+ font names
+} {font1}
+test font-11.4 {font command: names: loop test: multiple passes} {
+ setup
+ font create xyz
+ font create abc
+ font create def
+ lsort [font names]
+} {abc def xyz}
+test font-11.5 {font command: names: skip deletePending fonts} {
+ # (nfPtr->deletePending == 0)
+ setup
+ set x {}
+ font create xyz
+ font create abc
+ lappend x [lsort [font names]]
+ .b.f config -font xyz
+ font delete xyz
+ lappend x [font names]
+} {{abc xyz} abc}
+
+test font-12.1 {UpdateDependantFonts procedure: no users} {
+ # (nfPtr->refCount == 0)
+ setup
+ font create xyz
+ font configure xyz -family times
+} {}
+test font-12.2 {UpdateDependantFonts procedure: pings the widgets} {
+ setup
+ font create xyz -family times -size 20
+ .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
+ set a1 [font measure xyz "abcd"]
+ update
+ set b1 [winfo reqwidth .b.f]
+ font configure xyz -family helvetica -size 20
+ set a2 [font measure xyz "abcd"]
+ update
+ set b2 [winfo reqwidth .b.f]
+ expr {$a1==$b1 && $a2==$b2}
+} {1}
+
+test font-13.1 {CreateNamedFont: new named font} {
+ # not (new == 0)
+ setup
+ set x {}
+ lappend x [font names]
+ font create xyz
+ lappend x [font names]
+} {{} xyz}
+test font-13.2 {CreateNamedFont: named font already exists} {
+ # (new == 0)
+ setup
+ font create xyz
+ list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
+test font-13.3 {CreateNamedFont: named font already exists} {
+ # (nfPtr->deletePending == 0)
+ setup
+ font create xyz
+ list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
+test font-13.4 {CreateNamedFont: recreate "deleted" font} {
+ # not (nfPtr->deletePending == 0)
+ setup
+ font create xyz -family times
+ .b.f configure -font xyz
+ font delete xyz
+ font create xyz -family courier
+ font configure xyz -family
+} {courier}
+
+test font-14.1 {Tk_GetFont procedure} {
+} {}
+
+test font-15.1 {Tk_AllocFontFromObj - converting internal reps} testfont {
+ set x {Times 16}
+ lindex $x 0
+ destroy .b1 .b2
+ button .b1 -font $x
+ lindex $x 0
+ testfont counts {Times 16}
+} {{1 0}}
+test font-15.2 {Tk_AllocFontFromObj - discard stale font} testfont {
+ set x {Times 16}
+ destroy .b1 .b2
+ button .b1 -font $x
+ destroy .b1
+ set result {}
+ lappend result [testfont counts {Times 16}]
+ button .b2 -font $x
+ lappend result [testfont counts {Times 16}]
+} {{} {{1 1}}}
+test font-15.3 {Tk_AllocFontFromObj - reuse existing font} testfont {
+ set x {Times 16}
+ destroy .b1 .b2
+ button .b1 -font $x
+ set result {}
+ lappend result [testfont counts {Times 16}]
+ button .b2 -font $x
+ pack .b1 .b2 -side top
+ lappend result [testfont counts {Times 16}]
+} {{{1 1}} {{2 1}}}
+test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} {
+ # (new == 0)
+ setup
+ .b.f config -font {-family fixed}
+ lindex [font actual {-family fixed}] 0
+} {-family}
+test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
+ # (namedHashPtr != NULL)
+ setup
+ font create xyz
+ .b.f config -font xyz
+} {}
+test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
+ # not (namedHashPtr != NULL)
+ setup
+ .b.f config -font {times 20}
+} {}
+test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} {
+ # not (fontPtr == NULL)
+ setup
+ .b.f config -font fixed
+} {}
+test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
+ # not (fontPtr == NULL)
+ setup
+ .b.f config -font oemfixed
+} {}
+test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
+ # not (fontPtr == NULL)
+ setup
+ .b.f config -font application
+} {}
+test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
+ # (fontPtr == NULL)
+ list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
+} {1 {expected integer but got "yyy"}}
+test font-15.11 {Tk_AllocFontFromObj procedure: no match} {noExceed} {
+ # (ParseFontNameObj() != TCL_OK)
+ list [catch {font actual "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-15.12 {Tk_AllocFontFromObj procedure: get attribute font} {
+ # not (ParseFontNameObj() != TCL_OK)
+ lindex [font actual {plan 9}] 0
+} {-family}
+test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} {
+ # Tk_MeasureChars(fontPtr, "0", ...)
+ label .l -bd 0 -padx 0 -highlightthickness 0 -font $fixed -text "a\tb"
+ update
+ set x [winfo reqwidth .l]
+ destroy .l
+ set x
+} [expr [font measure $fixed "0"]*9]
+test font-15.14 {Tk_AllocFontFromObj procedure: underline position} {
+ # (fontPtr->underlineHeight == 0) because size was < 10
+ setup
+ .b.f config -text "underline" -font "times -8 underline"
+ update
+} {}
+
+test font-16.1 {Tk_NameOfFont procedure} {
+ setup
+ .b.f config -font -family\ fixed
+ .b.f cget -font
+} {-family fixed}
+
+test font-17.1 {Tk_FreeFontFromObj - reference counts} testfont {
+ set x {Courier 12}
+ destroy .b1 .b2 .b3
+ button .b1 -font $x
+ button .b3 -font $x
+ button .b2 -font $x
+ set result {}
+ lappend result [testfont counts {Courier 12}]
+ destroy .b1
+ lappend result [testfont counts {Courier 12}]
+ destroy .b2
+ lappend result [testfont counts {Courier 12}]
+ destroy .b3
+ lappend result [testfont counts {Courier 12}]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+test font-17.2 {Tk_FreeFont procedure: one ref} {
+ # (fontPtr->refCount == 0)
+ setup
+ .b.f config -font {-family fixed}
+ destroy .b.f
+} {}
+test font-17.3 {Tk_FreeFont procedure: multiple ref} {
+ # not (fontPtr->refCount == 0)
+ setup
+ .b.f config -font {-family fixed}
+ button .b.b -font {-family fixed}
+ destroy .b.f
+ set x [.b.b cget -font]
+ destroy .b.b
+ set x
+} {-family fixed}
+test font-17.4 {Tk_FreeFont procedure: named font} {
+ # (fontPtr->namedHashPtr != NULL)
+ setup
+ font create xyz
+ .b.f config -font xyz
+ destroy .b.f
+ font names
+} {xyz}
+test font-17.5 {Tk_FreeFont procedure: named font} {
+ # not (fontPtr->refCount == 0)
+ setup
+ font create xyz -underline 1
+ .b.f config -font xyz
+ font delete xyz
+ set x [font actual xyz -underline]
+ destroy .b.f
+ list [font actual xyz -underline] $x
+} {0 1}
+test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
+ setup
+ font create xyz
+ .b.f config -font xyz
+ button .b.b -font xyz
+ font delete xyz
+ set x [font actual xyz]
+ destroy .b.b
+ list [lindex [font actual xyz] 0] [lindex $x 0]
+} {-family -family}
+
+test font-18.1 {FreeFontObjProc} testfont {
+ destroy .b1
+ set x [format {Courier 12}]
+ button .b1 -font $x
+ set y [format {Courier 12}]
+ .b1 configure -font $y
+ set z [format {Courier 12}]
+ .b1 configure -font $z
+ set result {}
+ lappend result [testfont counts {Courier 12}]
+ set x red
+ lappend result [testfont counts {Courier 12}]
+ set z 32
+ lappend result [testfont counts {Courier 12}]
+ destroy .b1
+ lappend result [testfont counts {Courier 12}]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+test font-19.1 {Tk_FontId} {
+ .b.f config -font "times 20"
+ update
+} {}
+
+test font-20.1 {Tk_GetFontMetrics procedure} {
+ button .b.w1 -text abc
+ entry .b.w2 -text abcd
+ update
+ destroy .b.w1 .b.w2
+} {}
+
+proc psfontname {name} {
+ set a [.b.c itemcget text -font]
+ .b.c itemconfig text -text "We need text" -font $name
+ set post [.b.c postscript]
+ .b.c itemconfig text -font $a
+ set end [string first "findfont" $post]
+ incr end -2
+ set post [string range $post [expr $end-70] $end]
+ set start [string first "gsave" $post]
+ return [string range $post [expr $start+7] end]
+}
+test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
+ set x [font actual {{itc avant garde} 10} -family]
+ if {[string match *avant*garde $x]} {
+ psfontname "{itc avant garde} 10"
+ } else {
+ set x {AvantGarde-Book}
+ }
+} {AvantGarde-Book}
+test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+ psfontname "arial 10"
+} {Helvetica}
+test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+ psfontname "{times new roman} 10"
+} {Times-Roman}
+test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+ psfontname "{courier new} 10"
+} {Courier}
+test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
+ psfontname "geneva 10"
+} {Helvetica}
+test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
+ psfontname "{new york} 10"
+} {Times-Roman}
+test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
+ psfontname "monaco 10"
+} {Courier}
+test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+ set x [font actual {{lucida bright} 10} -family]
+ if {[string match lucida*bright $x]} {
+ psfontname "{lucida bright} 10"
+ } else {
+ set x {LucidaBright}
+ }
+} {LucidaBright}
+test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+ psfontname "{new century schoolbook} 10"
+} {NewCenturySchlbk-Roman}
+set i 10
+foreach p {
+ {"avantgarde" AvantGarde-Book AvantGarde-Demi AvantGarde-BookOblique AvantGarde-DemiOblique}
+ {"bookman" Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
+ {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
+ {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+ {"new century schoolbook" NewCenturySchlbk-Roman NewCenturySchlbk-Bold NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
+ {"palatino" Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
+ {"symbol" Symbol Symbol Symbol Symbol}
+ {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
+ {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
+ {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
+} {
+ test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
+ set family [lindex $p 0]
+ set x {}
+ set i 1
+ foreach slant {roman italic} {
+ foreach weight {normal bold} {
+ set name [list $family 12 $slant $weight]
+ if {[font actual $name -family] == $family} {
+ 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-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
+ set family [lindex $p 0]
+ set x {}
+ foreach slant {roman italic} {
+ foreach weight {normal bold} {
+ lappend x [psfontname [list $family 12 "$slant $weight"]]
+ }
+ }
+ incr i
+ set x
+ } [lrange $p 1 end]
+}
+foreach p {
+ {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
+ {"geneva" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+ {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+ {"monaco" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
+ {"new york" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
+ {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
+ {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
+} {
+ test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
+ set family [lindex $p 0]
+ set x {}
+ foreach slant {roman italic} {
+ foreach weight {normal bold} {
+ lappend x [psfontname [list $family 12 $slant $weight]]
+ }
+ }
+ incr i
+ set x
+ } [lrange $p 1 end]
+}
+
+test font-22.1 {Tk_TextWidth procedure} {
+ font measure [.b.l cget -font] "000"
+} [expr $ax*3]
+
+test font-23.1 {Tk_UnderlineChars procedure} {
+ text .b.t
+ .b.t insert 1.0 abc\tdefg
+ .b.t tag config sel -underline 1
+ .b.t tag add sel 1.0 end
+ update
+} {}
+
+setup
+test font-24.1 {Tk_ComputeTextLayout: empty string} {
+ .b.l config -text ""
+} {}
+test font-24.2 {Tk_ComputeTextLayout: simple string} {
+ .b.l config -text "000"
+ getsize
+} "[expr $ax*3] $ay"
+test font-24.3 {Tk_ComputeTextLayout: find special chars} {
+ .b.l config -text "000\n000"
+ getsize
+} "[expr $ax*3] [expr $ay*2]"
+test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
+ .b.l config -text "000\n000"
+ getsize
+} "[expr $ax*3] [expr $ay*2]"
+test font-24.5 {Tk_ComputeTextLayout: break line} {
+ .b.l config -text "000\t00000" -wrap [expr 9*$ax]
+ set x [getsize]
+ .b.l config -wrap 0
+ set x
+} "[expr 8*$ax] [expr 2*$ay]"
+test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
+ .b.l config -text "000\n000"
+} {}
+test font-24.7 {Tk_ComputeTextLayout: special char was \n} {
+ .b.l config -text "000\n0000"
+ getsize
+} "[expr $ax*4] [expr $ay*2]"
+test font-24.8 {Tk_ComputeTextLayout: special char was \t} {
+ .b.l config -text "000\t00"
+ getsize
+} "[expr $ax*10] $ay"
+test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
+ set x {}
+ .b.l config -text "000\t000"
+ lappend x [getsize]
+ .b.l config -text "000\t000" -wrap [expr 100*$ax]
+ lappend x [getsize]
+ .b.l config -wrap 0
+ set x
+} "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
+test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
+ set x {}
+ .b.l config -text "000\t"
+ lappend x [getsize]
+ .b.l config -text "000\t00" -wrap [expr $ax*6]
+ lappend x [getsize]
+ .b.l config -wrap 0
+ set x
+} "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
+test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
+ set x {}
+ .b.l config -text "000 000" -wrap [expr $ax*5]
+ lappend x [getsize]
+ .b.l config -text "000 "
+ lappend x [getsize]
+ .b.l config -wrap 0
+ set x
+} "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
+test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
+ set x {}
+ .b.l config -text "000 0000" -wrap [expr $ax*5]
+ lappend x [getsize]
+ .b.l config -text "000\t00 0000" -wrap [expr $ax*12]
+ lappend x [getsize]
+ .b.l config -wrap 0
+ set x
+} "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
+test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
+ .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
+ getsize
+} "1 [expr $ay*129]"
+test font-24.14 {Tk_ComputeTextLayout: text ended with \n} {
+ list [.b.l config -text "0000"; getsize] [.b.l config -text "0000\n"; getsize]
+} "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}"
+test font-24.15 {Tk_ComputeTextLayout: justification} {
+ csetup "000\n00000"
+ set x {}
+ .b.c itemconfig text -just left
+ lappend x [.b.c index text @[expr $ax*2],0]
+ .b.c itemconfig text -just center
+ lappend x [.b.c index text @[expr $ax*2],0]
+ .b.c itemconfig text -just right
+ lappend x [.b.c index text @[expr $ax*2],0]
+ .b.c itemconfig text -just left
+ set x
+} {2 1 0}
+
+test font-25.1 {Tk_FreeTextLayout procedure} {
+ setup
+ .b.f config -text foo
+ .b.f config -text boo
+} {}
+
+test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
+ .b.f config -text foo
+} {}
+test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
+ csetup "000\t00\n000"
+} {}
+test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
+ csetup "000\t00"
+ .b.c select from text 3
+ .b.c select to text 5
+} {}
+test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
+ .b.c select from text 3
+ .b.c select to text 5
+} {}
+test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
+ .b.c select from text 2
+ .b.c select to text 2
+} {}
+test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
+ .b.c select from text 4
+ .b.c select to text 4
+} {}
+
+test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
+ .b.f config -text "foo" -under -1
+} {}
+test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
+ .b.f config -text "000 00000" -wrap [expr $ax*7] -under 10
+} {}
+test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
+ .b.f config -text "000 00000" -wrap [expr $ax*7] -under 5
+ .b.f config -wrap -1 -under -1
+} {}
+
+test font-28.1 {Tk_PointToChar procedure: above all lines} {
+ csetup "000"
+ .b.c index text @-1,0
+} {0}
+test font-28.2 {Tk_PointToChar procedure: no chars} {
+ # After fixing the following bug:
+ #
+ # In canvas text item, it was impossible to click to position the
+ # insertion point just after the last character.
+ #
+ # introduced another bug that Tk_PointToChar() would return a character
+ # index of 1 if TextLayout contained 0 characters.
+
+ csetup ""
+ .b.c index text @100,100
+} {0}
+test font-28.3 {Tk_PointToChar procedure: loop test} {
+ csetup "000\n000\n000\n000"
+ .b.c index text @10000,0
+} {3}
+test font-28.4 {Tk_PointToChar procedure: intersect line} {
+ csetup "000\n000\n000"
+ .b.c index text @0,$ay
+} {4}
+test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
+ .b.c index text @-100,$ay
+} {4}
+test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
+ .b.c index text @100000,$ay
+} {7}
+test font-28.7 {Tk_PointToChar procedure: which chunk on this line} {
+ csetup "000\n000\t000\t000\n000"
+ .b.c index text @[expr $ax*2],$ay
+} {6}
+test font-28.8 {Tk_PointToChar procedure: which chunk on this line} {
+ csetup "000\n000\t000\t000\n000"
+ .b.c index text @[expr $ax*10],$ay
+} {10}
+test font-28.9 {Tk_PointToChar procedure: in special chunk} {
+ csetup "000\n000\t000\t000\n000"
+ .b.c index text @[expr $ax*6],$ay
+} {7}
+test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} {
+ csetup "000 0000000"
+ .b.c itemconfig text -width [expr $ax*5]
+ set x [.b.c index text @[expr $ax*5],0]
+ .b.c itemconfig text -width 0
+ set x
+} {3}
+test font-28.11 {Tk_PointToChar procedure: below all chunks} {
+ csetup "000 0000000"
+ .b.c index text @0,1000000
+} {11}
+
+test font-29.1 {Tk_CharBBox procedure: index < 0} {
+ .b.f config -text "000" -underline -1
+} {}
+test font-29.2 {Tk_CharBBox procedure: loop} {
+ .b.f config -text "000\t000\t000\t000" -underline 9
+} {}
+test font-29.3 {Tk_CharBBox procedure: special char} {
+ .b.f config -text "000\t000\t000" -underline 7
+} {}
+test font-29.4 {Tk_CharBBox procedure: normal char} {
+ .b.f config -text "000" -underline 1
+} {}
+test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
+ .b.f config -text "0 0000" -wrap [expr $ax*4] -under 2
+ .b.f config -wrap 0
+} {}
+test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
+ .b.f config -text "0 0000" -wrap [expr $ax*4] -under 3
+ .b.f config -wrap 0
+} {}
+
+.b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}
+
+test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} {
+ csetup "000\n000\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x 0 -y 0
+ set x
+} {0}
+test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} {
+ csetup "000\n000\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x $ax -y $ay
+ set x
+} {5}
+test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} {
+ csetup "000\n0\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x [expr $ax*2] -y $ay
+ set x
+} {}
+test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} {
+ csetup "000\t000\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x [expr $ax*6] -y 0
+ set x
+} {3}
+test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} {
+ csetup "000\n0\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x [expr $ax*2] -y $ay
+ set x
+} {}
+test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} {
+ csetup "000\n000 000000000"
+ .b.c itemconfig text -width [expr $ax*10]
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x [expr $ax*5] -y $ay
+ .b.c itemconfig text -width 0
+ set x
+} {}
+.b.c itemconfig text -justify center
+test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} {
+ csetup "0\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x 0 -y 0
+ set x
+} {}
+test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} {
+ csetup "0\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x [expr $ax*2] -y 0
+ set x
+} {}
+test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} {
+ csetup "0\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x $ax -y 0
+ set x
+} {0}
+test font-30.10 {Tk_DistanceToTextLayout procedure: above line} {
+ csetup "0\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x 0 -y 0
+ set x
+} {}
+test font-30.11 {Tk_DistanceToTextLayout procedure: below line} {
+ csetup "000\n0"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x 0 -y $ay
+ set x
+} {}
+test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
+ csetup "0\n000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x $ax -y $ay
+ set x
+} {3}
+.b.c itemconfig text -justify left
+test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
+ csetup "000"
+ set x {}
+ event generate .b.c <Leave>
+ event generate .b.c <Enter> -x $ax -y 0
+ set x
+} {1}
+
+test font-31.1 {Tk_IntersectTextLayout procedure: loop once} {
+ csetup "000\n000\n000"
+ .b.c find overlapping 0 0 0 0
+} [.b.c find withtag text]
+test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} {
+ csetup "000\t000\t000"
+ .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
+} [.b.c find withtag text]
+test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} {
+ csetup "0\n000"
+ .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
+} {}
+test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} {
+ csetup "000\t000"
+ .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
+} [.b.c find withtag text]
+test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} {
+ csetup "000\n0\n000"
+ .b.c find overlapping $ax $ay $ax $ay
+} {}
+test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} {
+ csetup "000\n000 000000000"
+ .b.c itemconfig text -width [expr $ax*10]
+ set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
+ .b.c itemconfig text -width 0
+ set x
+} {}
+
+test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
+ # If there were a whole bunch of returns or tabs in a row, then the
+ # temporary buffer could overflow and write on the stack.
+
+ csetup "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
+ .b.c itemconfig text -width 800
+ .b.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
+ .b.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
+ .b.c insert text end "end"
+ set x [.b.c postscript]
+ set i [string first "(qwerty" $x]
+ string range $x $i [expr {$i + 278}]
+} {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
+[(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[()]
+[(end)]
+}
+
+test font-33.1 {Tk_TextWidth procedure} {
+} {}
+
+test font-33.2 {ConfigAttributesObj procedure: arguments} {
+ # (Tcl_GetIndexFromObj() != TCL_OK)
+ setup
+ list [catch {font create xyz -xyz} msg] $msg
+} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+test font-34.1 {ConfigAttributesObj procedure: arguments} {
+ # (objc & 1)
+ setup
+ list [catch {font create xyz -family} msg] $msg
+} {1 {value for "-family" option missing}}
+set i 3
+foreach p {
+ {family xyz times}
+ {size 20 40}
+ {weight normal bold}
+ {slant roman italic}
+ {underline 0 1}
+ {overstrike 0 1}
+} {
+ set opt [lindex $p 0]
+ test font-34.$i "ConfigAttributesObj procedure: $opt" {
+ setup
+ set x {}
+ font create xyz -$opt [lindex $p 1]
+ lappend x [font config xyz -$opt]
+ font config xyz -$opt [lindex $p 2]
+ lappend x [font config xyz -$opt]
+ } [lrange $p 1 2]
+ incr i
+}
+foreach p {
+ {size xyz {1 {expected integer but got "xyz"}}}
+ {weight xyz {1 {bad -weight value "xyz": must be normal, or bold}}}
+ {slant xyz {1 {bad -slant value "xyz": must be roman, or italic}}}
+ {underline xyz {1 {expected boolean value but got "xyz"}}}
+ {overstrike xyz {1 {expected boolean value but got "xyz"}}}
+} {
+ test font-34.$i "ConfigAttributesObj procedure: [lindex $p 0]" {
+ setup
+ list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
+ } [lindex $p 2]
+ incr i
+}
+
+test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
+ # (objPtr != NULL)
+ setup
+ font create xyz -family xyz
+ font config xyz -family
+} {xyz}
+test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} {
+ # (Tcl_GetIndexFromObj() != TCL_OK)
+ setup
+ font create xyz
+ list [catch {font config xyz -xyz} msg] $msg
+} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
+ # not (objPtr != NULL)
+ setup
+ font create xyz -family xyz
+ font config xyz
+} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
+set i 4
+foreach p {
+ {family xyz xyz}
+ {size 20 20}
+ {weight normal normal}
+ {slant italic italic}
+ {underline yes 1}
+ {overstrike false 0}
+} {
+ test font-31.$i "GetAttributeInfo procedure: [lindex $p 0]" {
+ setup
+ font create xyz -[lindex $p 0] [lindex $p 1]
+ font config xyz -[lindex $p 0]
+ } [lindex $p 2]
+ incr i
+}
+
+# In tests below, one field is set to "xyz" so that font name doesn't
+# look like a native X font, so that ParseFontNameObj or TkParseXLFD will
+# be called.
+
+setup
+
+test font-38.1 {ParseFontNameObj procedure: begins with -} {
+ lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-38.2 {ParseFontNameObj procedure: begins with -*} {
+ lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} {
+ lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
+ lindex [font actual {-family times}] 1
+} $times
+test font-38.5 {ParseFontNameObj procedure: begins with *} {
+ lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-38.6 {ParseFontNameObj procedure: begins with *} {
+ font actual *-times-xyz -family
+} $times
+test font-38.7 {ParseFontNameObj procedure: arguments} {noExceed} {
+ list [catch {font actual "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-38.8 {ParseFontNameObj procedure: arguments} {noExceed} {
+ list [catch {font actual ""} msg] $msg
+} {1 {font "" doesn't exist}}
+test font-38.9 {ParseFontNameObj procedure: arguments} {
+ list [catch {font actual {times 20 xyz xyz}} msg] $msg
+} {1 {unknown font style "xyz"}}
+test font-38.10 {ParseFontNameObj procedure: arguments} {
+ list [catch {font actual {times xyz xyz}} msg] $msg
+} {1 {expected integer but got "xyz"}}
+test font-38.11 {ParseFontNameObj procedure: stylelist loop} {macOnly} {
+ lrange [font actual {times 12 bold italic overstrike underline}] 4 end
+} {-weight bold -slant italic -underline 1 -overstrike 0}
+test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} {
+ lrange [font actual {times 12 bold italic overstrike underline}] 4 end
+} {-weight bold -slant italic -underline 1 -overstrike 1}
+test font-38.13 {ParseFontNameObj procedure: stylelist error} {
+ list [catch {font actual {times 12 bold xyz}} msg] $msg
+} {1 {unknown font style "xyz"}}
+
+test font-39.1 {NewChunk procedure: test realloc} {
+ .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
+} {}
+
+test font-40.1 {TkFontParseXLFD procedure: initial dash} {
+ font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
+} $times
+test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
+ font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
+} $times
+test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
+ font actual -xyz-times-*-*-* -family
+} $times
+test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
+ lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
+} {-family}
+test font-40.5 {TkFontParseXLFD procedure: all fields specified} {
+ lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
+} $times
+test font-41.1 {TkParseXLFD procedure: arguments} {
+ # XLFD with bad pointsize: fallback to some system font.
+ font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
+ set x {}
+} {}
+test font-42.1 {TkFontParseXLFD procedure: arguments} {
+ # XLFD with bad pixelsize: fallback to some system font.
+ font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
+ set x {}
+} {}
+test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
+ font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
+ set x {}
+} {}
+test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} {
+ font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
+ set x {}
+} {}
+test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
+ font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
+ set x {}
+} {}
+test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} {
+ font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
+ set x {}
+} {}
+
+test font-43.1 {FieldSpecified procedure: specified vs. non-specified} {
+ font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
+ font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
+ font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
+ lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+
+set oldscale [tk scaling]
+tk scaling 0.5
+test font-44.1 {TkFontGetPixels: size < 0} {
+ font actual {times -12} -size
+} {24}
+test font-44.2 {TkFontGetPoints: size >= 0} {noExceed} {
+ font actual {times 12} -size
+} {12}
+
+tk scaling $oldscale
+
+test font-45.1 {TkFontGetAliasList: no match} {
+ font actual {snarky 10} -family
+} [font actual {-size 10} -family]
+test font-45.2 {TkFontGetAliasList: match} {macOnly} {
+ # Result could be either "Times" or "New York"
+ font actual {{times new roman} 10} -family
+} [font actual {times 10} -family]
+test font-45.3 {TkFontGetAliasList: match} {pcOnly} {
+ font actual {times 10} -family
+} {Times New Roman}
+test font-45.4 {TkFontGetAliasList: match} {unixOnly noExceed} {
+ # can fail on Unix systems that have a real "times new roman" font
+ font actual {{times new roman} 10} -family
+} [font actual {times 10} -family]
+
+setup
+
+destroy .b
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/frame.test b/tcl/tests/frame.test
new file mode 100644
index 00000000000..a78cda1fcab
--- /dev/null
+++ b/tcl/tests/frame.test
@@ -0,0 +1,878 @@
+# This file is a Tcl script to test out the "frame" and "toplevel"
+# commands of Tk. It is organized in the standard fashion for Tcl
+# tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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} {
+ frame .f -colormap new
+ list [.f configure -colormap] [catch {.f configure -colormap .} msg] $msg
+} {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}}
+catch {destroy .f}
+test frame-1.3 {frame configuration options} {
+ frame .f -visual default
+ list [.f configure -visual] [catch {.f configure -visual best} msg] $msg
+} {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}}
+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"}}
+ {-padx 3 3 badValue {bad screen distance "badValue"}}
+ {-pady 4 4 badValue {bad screen distance "badValue"}}
+ {-relief ridge ridge badValue {bad relief "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"}}
+test frame-2.10 {toplevel configuration options} {
+ catch {destroy .t}
+ catch {destroy .x}
+ toplevel .t -container 1 -width 300 -height 120
+ wm geometry .t +0+0
+ set result [list \
+ [catch {toplevel .x -container 1 -use [winfo id .t]} msg] $msg]
+ destroy .t .x
+ set result
+} {1 {A window cannot have both the -use and the -container option set.}}
+
+catch {destroy .t}
+toplevel .t -width 300 -height 150
+wm geometry .t +0+0
+update
+set i 11
+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"}}
+ {-padx 3 3 badValue {bad screen distance "badValue"}}
+ {-pady 4 4 badValue {bad screen distance "badValue"}}
+ {-relief ridge ridge badValue {bad relief "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 {toplevel 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 {toplevel 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 frame-5.2 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget} msg] $msg
+} {1 {wrong # args: should be ".f cget option"}}
+test frame-5.3 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget a b} msg] $msg
+} {1 {wrong # args: should be ".f cget option"}}
+test frame-5.4 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test frame-5.5 {FrameWidgetCommand procedure, cget option} {
+ .f cget -highlightcolor
+} {black}
+test frame-5.6 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget -screen} msg] $msg
+} {1 {unknown option "-screen"}}
+test frame-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]
+} {18}
+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-5.13 {FrameWidgetCommand procedure, configure option} {
+ llength [. configure]
+} {21}
+
+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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ frame .f1
+ rename .f1 {}
+ list [info command .f*] [winfo children .]
+} {{} {}}
+test frame-8.2 {FrameCmdDeletedProc procedure} {
+ deleteWindows
+ toplevel .f1 -menu .m
+ wm geometry .f1 +0+0
+ update
+ rename .f1 {}
+ update
+ list [info command .f*] [winfo children .]
+} {{} {}}
+#
+# This one fails with the dash-patch!!!! Still don't know why :-(
+#
+#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]
+deleteWindows
+
+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]
+} {{} {} {} {}}
+
+test frame-12.1 {FrameWorldChanged procedure} {
+ # Test -bd -padx and -pady
+ destroy .f
+ frame .f -borderwidth 2 -padx 3 -pady 4
+ place .f -x 0 -y 0 -width 40 -height 40
+ pack [frame .f.f] -fill both -expand 1
+ update
+ set result [list [winfo x .f.f] [winfo y .f.f] \
+ [winfo width .f.f] [winfo height .f.f]]
+ destroy .f
+ set result
+} {5 6 30 28}
+test frame-12.2 {FrameWorldChanged procedure} {
+ # Test all -labelanchor positions
+ destroy .f
+ set font {helvetica 12}
+ labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \
+ -text "Mupp"
+ set fh [expr {[font metrics $font -linespace] + 2 - 3}]
+ set fw [expr {[font measure $font "Mupp"] + 2 - 3}]
+ if {$fw < 0} {set fw 0}
+ if {$fh < 0} {set fh 0}
+ place .f -x 0 -y 0 -width 100 -height 100
+ pack [frame .f.f] -fill both -expand 1
+
+ set result {}
+ foreach lp {nw n ne en e es se s sw ws w wn} {
+ .f configure -labelanchor $lp
+ update
+ set expx 5
+ set expy 6
+ set expw 90
+ set exph 88
+ switch -glob $lp {
+ n* {incr expy $fh ; incr exph -$fh}
+ s* {incr exph -$fh}
+ w* {incr expx $fw ; incr expw -$fw}
+ e* {incr expw -$fw}
+ }
+ lappend result [expr {\
+ [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&\
+ [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}]
+ }
+ destroy .f
+ set result
+} {1 1 1 1 1 1 1 1 1 1 1 1}
+test frame-12.3 {FrameWorldChanged procedure} {
+ # Check reaction on font change
+ destroy .f
+ font create myfont -family courier -size 10
+ labelframe .f -font myfont -text Mupp
+ place .f -x 0 -y 0 -width 40 -height 40
+ pack [frame .f.f] -fill both -expand 1
+ update
+ set h1 [font metrics myfont -linespace]
+ set y1 [winfo y .f.f]
+ font configure myfont -size 20
+ update
+ set h2 [font metrics myfont -linespace]
+ set y2 [winfo y .f.f]
+ destroy .f
+ font delete myfont
+ expr {($h2 - $h1) - ($y2 - $y1)}
+} {0}
+
+test frame-13.1 {labelframe configuration options} {
+ labelframe .f -class NewFrame
+ list [.f configure -class] [catch {.f configure -class Different} msg] $msg
+} {{-class class Class Labelframe NewFrame} 1 {can't modify -class option after widget is created}}
+catch {destroy .f}
+test frame-13.2 {labelframe configuration options} {
+ list [catch {labelframe .f -colormap new} msg] $msg
+} {0 .f}
+catch {destroy .f}
+test frame-13.3 {labelframe configuration options} {
+ list [catch {labelframe .f -visual default} msg] $msg
+} {0 .f}
+catch {destroy .f}
+test frame-13.4 {labelframe configuration options} {
+ list [catch {labelframe .f -screen bogus} msg] $msg
+} {1 {unknown option "-screen"}}
+test frame-13.5 {labelframe configuration options} {
+ set result [list [catch {labelframe .f -container true} msg] $msg \
+ [.f configure -container]]
+ destroy .f
+ set result
+} {0 .f {-container container Container 0 1}}
+test frame-13.6 {labelframe configuration options} {
+ list [catch {labelframe .f -container bogus} msg] $msg
+} {1 {expected boolean value but got "bogus"}}
+test frame-13.7 {labelframe configuration options} {
+ labelframe .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}}
+labelframe .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"}}
+ {-fg #0000ff #0000ff non-existent
+ {unknown color name "non-existent"}}
+ {-font {courier 8} {courier 8} {} {}}
+ {-foreground #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-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"}}
+ {-labelanchor se se badValue {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}}
+ {-padx 3 3 badValue {bad screen distance "badValue"}}
+ {-pady 4 4 badValue {bad screen distance "badValue"}}
+ {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-takefocus "any string" "any string" {} {}}
+ {-text "any string" "any string" {} {}}
+ {-width 32 32 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test frame-13.$i {labelframe configuration options} {
+ .f configure $name [lindex $test 1]
+ lindex [.f configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test frame-13.$i {labelframe 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
+
+test frame-14.1 {labelframe labelwidget option} {
+ # Test that label is moved in stacking order
+ destroy .f .l
+ label .l -text Mupp
+ labelframe .f -labelwidget .l
+ pack .f
+ frame .f.f -width 50 -height 50
+ pack .f.f
+ update
+ set res [list [winfo children .] [winfo width .f] \
+ [expr {[winfo height .f] - [winfo height .l]}]]
+ destroy .f .l
+ set res
+} {{.f .l} 54 52}
+test frame-14.2 {labelframe labelwidget option} {
+ # Test the labelframe's reaction if the label is destroyed
+ destroy .f .l
+ label .l -text Aratherlonglabel
+ labelframe .f -labelwidget .l
+ pack .f
+ label .f.l -text Mupp
+ pack .f.l
+ update
+ set res [list [.f cget -labelwidget]]
+ lappend res [expr {[winfo width .f] - [winfo width .l]}]
+ destroy .l
+ lappend res [.f cget -labelwidget]
+ update
+ lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
+ destroy .f
+ set res
+} {.l 12 {} 4}
+test frame-14.3 {labelframe labelwidget option} {
+ # Test the labelframe's reaction if the label is stolen
+ destroy .f .l
+ label .l -text Aratherlonglabel
+ labelframe .f -labelwidget .l
+ pack .f
+ label .f.l -text Mupp
+ pack .f.l
+ update
+ set res [list [.f cget -labelwidget]]
+ lappend res [expr {[winfo width .f] - [winfo width .l]}]
+ pack .l
+ lappend res [.f cget -labelwidget]
+ update
+ lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
+ destroy .f .l
+ set res
+} {.l 12 {} 4}
+test frame-14.4 {labelframe labelwidget option} {
+ # Test the label's reaction if the labelframe is destroyed
+ destroy .f .l
+ label .l -text Mupp
+ labelframe .f -labelwidget .l
+ pack .f
+ update
+ set res [list [winfo manager .l]]
+ destroy .f
+ lappend res [winfo manager .l]
+ destroy .l
+ set res
+} {labelframe {}}
+test frame-14.5 {labelframe labelwidget option} {
+ # Test that the labelframe reacts on changes in label
+ destroy .f .l
+ label .l -text Aratherlonglabel
+ labelframe .f -labelwidget .l
+ pack .f
+ label .f.l -text Mupp
+ pack .f.l
+ update
+ set first [winfo width .f]
+ set res [expr {[winfo width .f] - [winfo width .l]}]
+ .l configure -text Shorter
+ update
+ lappend res [expr {[winfo width .f] - [winfo width .l]}]
+ lappend res [expr {[winfo width .f] < $first}]
+ .l configure -text Alotlongerthananytimebefore
+ update
+ lappend res [expr {[winfo width .f] - [winfo width .l]}]
+ lappend res [expr {[winfo width .f] > $first}]
+ destroy .f .l
+ set res
+} {12 12 1 12 1}
+test frame-14.6 {labelframe labelwidget option} {
+ # Destroying a labelframe with a child label caused a crash
+ # when not handling mapping of the label correctly.
+ # This test does not test anything directly, it's just ment
+ # to catch if the same mistake is made again.
+ destroy .f
+ labelframe .f
+ pack .f
+ label .f.l -text Mupp
+ .f configure -labelwidget .f.l
+ update
+ destroy .f
+} {}
+
+catch {destroy .f}
+rename eatColors {}
+rename colorsFree {}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/geometry.test b/tcl/tests/geometry.test
new file mode 100644
index 00000000000..ca7cfa7d983
--- /dev/null
+++ b/tcl/tests/geometry.test
@@ -0,0 +1,267 @@
+# This file is a Tcl script to test the procedures in the file
+# tkGeometry.c (generic support for geometry managers). It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/get.test b/tcl/tests/get.test
index 8a87201e60e..3adabbba65e 100644
--- a/tcl/tests/get.test
+++ b/tcl/tests/get.test
@@ -1,98 +1,82 @@
-# Commands covered: none
+# This file is a Tcl script to test out the procedures in the file
+# tkGet.c. It is organized in the standard fashion for Tcl
+# white-box tests.
#
-# This file contains a collection of tests for the procedures in the
-# file tclGet.c. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-test get-1.1 {Tcl_GetInt procedure} {
- set x 44
- incr x { 22}
-} {66}
-test get-1.2 {Tcl_GetInt procedure} {
- set x 44
- incr x -3
-} {41}
-test get-1.3 {Tcl_GetInt procedure} {
- set x 44
- incr x +8
-} {52}
-test get-1.4 {Tcl_GetInt procedure} {
- set x 44
- list [catch {incr x foo} msg] $msg
-} {1 {expected integer but got "foo"}}
-test get-1.5 {Tcl_GetInt procedure} {
- set x 44
- list [catch {incr x {16 }} msg] $msg
-} {0 60}
-test get-1.6 {Tcl_GetInt procedure} {
- set x 44
- list [catch {incr x {16 x}} msg] $msg
-} {1 {expected integer but got "16 x"}}
-
-# The following tests are non-portable because they depend on
-# word size.
-
-if {wide(0x80000000) > wide(0)} {
- test get-1.7 {Tcl_GetInt procedure} {
- set x 44
- list [catch {eval incr x 18446744073709551616} msg] $msg $errorCode
- } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
- test get-1.8 {Tcl_GetInt procedure} {
- set x 0
- list [catch {incr x 18446744073709551614} msg] $msg
- } {0 -2}
- test get-1.9 {Tcl_GetInt procedure} {
- set x 0
- list [catch {incr x +18446744073709551614} msg] $msg
- } {0 -2}
- test get-1.10 {Tcl_GetInt procedure} {
- set x 0
- list [catch {incr x -18446744073709551614} msg] $msg
- } {0 2}
-} else {
- test get-1.11 {Tcl_GetInt procedure} {
- set x 44
- list [catch {incr x 4294967296} msg] $msg $errorCode
- } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
- test get-1.12 {Tcl_GetInt procedure} {
- set x 0
- list [catch {incr x 4294967294} msg] $msg
- } {0 -2}
- test get-1.13 {Tcl_GetInt procedure} {
- set x 0
- list [catch {incr x +4294967294} msg] $msg
- } {0 -2}
- test get-1.14 {Tcl_GetInt procedure} {
- set x 0
- list [catch {incr x -4294967294} msg] $msg
- } {0 2}
-}
-
-test get-2.1 {Tcl_GetInt procedure} {
- format %g 1.23
-} {1.23}
-test get-2.2 {Tcl_GetInt procedure} {
- format %g { 1.23 }
-} {1.23}
-test get-2.3 {Tcl_GetInt procedure} {
- list [catch {format %g clip} msg] $msg
-} {1 {expected floating-point number but got "clip"}}
-test get-2.4 {Tcl_GetInt procedure} {nonPortable} {
- list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode
-} {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+button .b
+test get-1.1 {Tk_GetAnchorFromObj} {
+ .b configure -anchor n
+ .b cget -anchor
+} {n}
+test get-1.2 {Tk_GetAnchorFromObj} {
+ .b configure -anchor ne
+ .b cget -anchor
+} {ne}
+test get-1.3 {Tk_GetAnchorFromObj} {
+ .b configure -anchor e
+ .b cget -anchor
+} {e}
+test get-1.4 {Tk_GetAnchorFromObj} {
+ .b configure -anchor se
+ .b cget -anchor
+} {se}
+test get-1.5 {Tk_GetAnchorFromObj} {
+ .b configure -anchor s
+ .b cget -anchor
+} {s}
+test get-1.6 {Tk_GetAnchorFromObj} {
+ .b configure -anchor sw
+ .b cget -anchor
+} {sw}
+test get-1.7 {Tk_GetAnchorFromObj} {
+ .b configure -anchor w
+ .b cget -anchor
+} {w}
+test get-1.8 {Tk_GetAnchorFromObj} {
+ .b configure -anchor nw
+ .b cget -anchor
+} {nw}
+test get-1.9 {Tk_GetAnchorFromObj} {
+ .b configure -anchor n
+ .b cget -anchor
+} {n}
+test get-1.10 {Tk_GetAnchorFromObj} {
+ .b configure -anchor center
+ .b cget -anchor
+} {center}
+test get-1.11 {Tk_GetAnchorFromObj - error} {
+ list [catch {.b configure -anchor unknown} msg] $msg
+} {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}}
+
+catch {destroy .b}
+button .b
+test get-2.1 {Tk_GetJustifyFromObj} {
+ .b configure -justify left
+ .b cget -justify
+} {left}
+test get-2.2 {Tk_GetJustifyFromObj} {
+ .b configure -justify right
+ .b cget -justify
+} {right}
+test get-2.3 {Tk_GetJustifyFromObj} {
+ .b configure -justify center
+ .b cget -justify
+} {center}
+test get-2.4 {Tk_GetJustifyFromObj - error} {
+ list [catch {.b configure -justify stupid} msg] $msg
+} {1 {bad justification "stupid": must be left, right, or center}}
# cleanup
::tcltest::cleanupTests
@@ -109,3 +93,4 @@ return
+
diff --git a/tcl/tests/grab.test b/tcl/tests/grab.test
new file mode 100644
index 00000000000..c8e87071e01
--- /dev/null
+++ b/tcl/tests/grab.test
@@ -0,0 +1,185 @@
+# Tests for the grab command.
+#
+# This file contains a collection of tests for one or more of the Tk
+# built-in commands. Sourcing this file runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# There's currently no way to test the actual grab effect, per se,
+# in an automated test. Therefore, this test suite only covers the
+# interface to the grab command (ie, error messages, etc.)
+
+test grab-1.1 {Tk_GrabObjCmd} {
+ list [catch {grab} msg] $msg
+} [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""]
+test grab-1.2 {Tk_GrabObjCmd} {
+ rename grab grabTest1.2
+ set res [list [catch {grabTest1.2} msg] $msg]
+ rename grabTest1.2 grab
+ set res
+} [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""]
+
+test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ list [catch {grab .foo bar baz} msg] $msg
+} [list 1 "wrong # args: should be \"grab ?-global? window\""]
+test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ list [catch {grab -foo bar} msg] $msg
+} [list 1 "bad option \"-foo\": must be -global"]
+test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab -global .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-1.7 {Tk_GrabObjCmd} {
+ list [catch {grab foo} msg] $msg
+} [list 1 "bad option \"foo\": must be current, release, set, or status"]
+
+test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} {
+ list [catch {grab current foo bar} msg] $msg
+} [list 1 "wrong # args: should be \"grab current ?window?\""]
+test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} {
+ catch {destroy .foo}
+ list [catch {grab current .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-1.10 {Tk_GrabObjCmd, "grab release window"} {
+ list [catch {grab release} msg] $msg
+} [list 1 "wrong # args: should be \"grab release window\""]
+test grab-1.11 {Tk_GrabObjCmd, "grab release window"} {
+ catch {destroy .foo}
+ list [catch {grab release .foo} msg] $msg
+} [list 0 ""]
+test grab-1.12 {Tk_GrabObjCmd, "grab release window"} {
+ list [catch {grab release foo} msg] $msg
+} [list 0 ""]
+
+test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ list [catch {grab set} msg] $msg
+} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
+test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ list [catch {grab set foo bar baz} msg] $msg
+} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
+test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab set .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ list [catch {grab set -foo bar} msg] $msg
+} [list 1 "bad option \"-foo\": must be -global"]
+test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab set -global .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-1.18 {Tk_GrabObjCmd, "grab status window"} {
+ list [catch {grab status} msg] $msg
+} [list 1 "wrong # args: should be \"grab status window\""]
+test grab-1.19 {Tk_GrabObjCmd, "grab status window"} {
+ list [catch {grab status foo bar} msg] $msg
+} [list 1 "wrong # args: should be \"grab status window\""]
+test grab-1.20 {Tk_GrabObjCmd, "grab status window"} {
+ catch {destroy .foo}
+ list [catch {grab status .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ set result [grab status .]
+ grab release .
+ set result
+} "none"
+test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab .
+ set result [grab status .]
+ grab release .
+ set result
+} "local"
+test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab -global .
+ set result [grab status .]
+ grab release .
+ set result
+} "global"
+
+test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ set curr
+} ""
+test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab .
+ set curr [grab current]
+ grab release .
+ set curr
+} "."
+
+test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab .
+ set result [grab status .]
+ grab release .
+ lappend result [grab status .]
+ grab -global .
+ lappend result [grab status .]
+ grab release .
+ lappend result [grab status .]
+} [list "local" "none" "global" "none"]
+
+test grab-5.1 {Tk_GrabObjCmd, grab set} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab set .
+ set result [list [grab current .] [grab status .]]
+ grab release .
+ set result
+} [list "." "local"]
+test grab-5.2 {Tk_GrabObjCmd, grab set} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab set -global .
+ set result [list [grab current .] [grab status .]]
+ grab release .
+ set result
+} [list "." "global"]
+
+tcltest::cleanupTests
+return
diff --git a/tcl/tests/grid.test b/tcl/tests/grid.test
new file mode 100644
index 00000000000..ddd398f8775
--- /dev/null
+++ b/tcl/tests/grid.test
@@ -0,0 +1,1502 @@
+# This file is a Tcl script to test out the *NEW* "grid" command
+# of Tk. It is (almost) organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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 -uniform ""
+ }
+ for {set i 0} {$i <= $rows} {incr i} {
+ grid rowconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform ""
+ }
+ 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-1.7 {basic argument checking} {
+ list [catch {grid configure x} msg] $msg
+} {1 {can't determine master window}}
+
+test grid-1.8 {basic argument checking} {
+ button .b
+ list [catch {grid x .b} msg] $msg
+} {0 {}}
+grid_reset 1.8
+
+test grid-1.9 {basic argument checking} {
+ button .b
+ list [catch {grid configure x .b} msg] $msg
+} {0 {}}
+grid_reset 1.9
+
+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 # args: should 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-3.8 {configure: basic argument checking} {
+ button .b
+ grid configure x .b
+ grid slaves .
+} {.b}
+grid_reset 3.8
+
+test grid-3.9 {configure: basic argument checking} {
+ button .b
+ list [catch {grid configure y .b} msg] $msg
+} {1 {invalid window shortcut, "y" should be '-', 'x', or '^'}}
+grid_reset 3.9
+
+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.3.1 {forget} {
+ button .c
+ grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx {3 5} -pady {4 7} -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.1
+
+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 300 -height 100 -highlightthickness 0 -bg red
+ frame .a
+ grid .a
+ grid .f -in .a
+ grid rowconfigure .f 0 -weight 1
+ grid columnconfigure .f 0 -weight 1
+ grid propagate .a 0
+ .a configure -width 200 -height 15
+ update
+ set got ""
+ set result ""
+ for {set y -10} { $y < 210} { incr y} {
+ set a [grid location . $y $y]
+ if {$a != $got} {
+ lappend result $y->$a
+ set got $a
+ }
+ }
+ set result
+} {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}}
+grid_reset 6.8
+
+test grid-6.9 {location: check updates pending} {nonPortable} {
+ set a ""
+ foreach i {0 1 2} {
+ frame .$i -width 120 -height 75 -bg red
+ lappend a [grid location . 150 90]
+ grid .$i -row $i -column $i
+ }
+ set a
+} {{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-7.7 {propagate} {
+ grid propagate . 1
+ set res [list [grid propagate .]]
+ grid propagate . 0
+ lappend res [grid propagate .]
+ grid propagate . 0
+ lappend res [grid propagate .]
+ set res
+} [list 1 0 0]
+grid_reset 7.7
+
+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 {bad option "a": must be -column or -row}}
+
+test grid-9.5 {slaves} {
+ list [catch {grid slaves . -column x} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test grid-9.6 {slaves} {
+ list [catch {grid slaves . -row -3} msg] $msg
+} {1 {-row is an invalid value: should NOT be < 0}}
+
+test grid-9.7 {slaves} {
+ list [catch {grid slaves . -foo 3} msg] $msg
+} {1 {bad option "-foo": must be -column or -row}}
+
+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 -uniform {} -weight 0}}
+grid_reset 10.6
+
+test grid-10.7 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -foo} msg] $msg
+} {1 {bad option "-foo": must be -minsize, -pad, -uniform, 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.11
+
+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.12
+
+test grid-10.13 {column/row configure} {
+ grid columnconfigure . 0 -weight 3
+ grid columnconfigure . 0 -weight
+} {3}
+grid_reset 10.13
+
+test grid-10.14 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -pad foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+grid_reset 10.14
+
+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.15
+
+test grid-10.16 {column/row configure} {
+ grid columnconfigure . 0 -pad 3
+ grid columnconfigure . 0 -pad
+} {3}
+grid_reset 10.16
+
+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.17
+
+test grid-10.18 {column/row configure} {
+ frame .f
+ grid columnconfigure .f {0 2} -minsize 10 -weight 1
+ list [grid columnconfigure .f 0 -minsize] \
+ [grid columnconfigure .f 1 -minsize] \
+ [grid columnconfigure .f 2 -minsize] \
+ [grid columnconfigure .f 0 -weight] \
+ [grid columnconfigure .f 1 -weight] \
+ [grid columnconfigure .f 2 -weight]
+} {10 0 10 1 0 1}
+grid_reset 10.18
+
+test grid-10.19 {column/row configure} {
+ list [catch {grid columnconfigure . {0 -1 2} -weight 1} msg] $msg
+} {1 {grid columnconfigure: "-1" is out of range}}
+grid_reset 10.19
+
+test grid-10.20 {column/row configure} {
+ grid columnconfigure . 0 -uniform foo
+ grid columnconfigure . 0 -uniform
+} {foo}
+grid_reset 10.20
+
+# 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 60 -height 60 -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,30 60,60} {60,0 60,60} {60,60 60,60}}
+grid_reset 11.14
+
+test grid-11.15 {^ ^ test with multiple windows} {
+ foreach i {1 2 3 4} {
+ frame .f$i -width 50 -height 50 -bd 1 -relief solid
+ }
+ grid .f1 .f2 .f3 -sticky ns
+ grid .f4 ^ ^
+ 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]"
+ }
+ set a
+} {{0,0 50,50} {50,0 50,100} {100,0 50,100} {0,50 50,50}}
+grid_reset 11.15
+
+test grid-11.16 {default widget placement} {
+ foreach l {a b c d e} {
+ frame .$l -width 50 -height 50
+ }
+ grid .a .b .c .d -sticky news
+ grid x ^ x .e -sticky news
+ update
+ set res ""
+ lappend res [winfo height .a]
+ lappend res [winfo height .b]
+ lappend res [winfo height .c]
+} {50 100 50}
+grid_reset 11.16
+
+test grid-11.17 {default widget placement} {
+ foreach l {a b c d e} {
+ frame .$l -width 50 -height 50
+ }
+ grid .a .b .c .d -sticky news
+ grid ^ x ^ .e -sticky news
+ update
+ set res ""
+ lappend res [winfo height .a]
+ lappend res [winfo height .b]
+ lappend res [winfo height .c]
+} {100 50 100}
+grid_reset 11.17
+
+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.4.1 {-ipadx} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -ipadx {5 5}" msg] $msg
+} {1 {bad ipadx value "5 5": must be positive screen distance}}
+grid_reset 13.4.1
+
+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.6.1 {-ipady} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -ipady {5 5}" msg] $msg
+} {1 {bad ipady value "5 5": must be positive screen distance}}
+grid_reset 13.6.1
+
+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 pad value "x": must be positive screen distance}}
+grid_reset 13.8
+
+test grid-13.8.1 {-padx} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -padx {10 x}" msg] $msg
+} {1 {bad 2nd pad value "x": must be positive screen distance}}
+grid_reset 13.8.1
+
+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 .] [winfo x .f]"
+} {{200 200} {200 202 1}}
+grid_reset 13.9
+
+test grid-13.9.1 {-padx} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set a "[winfo width .f] [winfo width .]"
+ grid .f -padx {10 5}
+ update
+ list $a "[winfo width .f] [winfo width .] [winfo x .f]"
+} {{200 200} {200 215 10}}
+grid_reset 13.9.1
+
+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 pad value "x": must be positive screen distance}}
+grid_reset 13.10
+
+test grid-13.10.1 {-pady} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -pady {10 x}" msg] $msg
+} {1 {bad 2nd pad value "x": must be positive screen distance}}
+grid_reset 13.10.1
+
+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 .] [winfo y .f]"
+} {{100 100} {100 102 1}}
+grid_reset 13.11
+
+test grid-13.11.1 {-pady} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set a "[winfo height .f] [winfo height .]"
+ grid .f -pady {4 16}
+ update
+ list $a "[winfo height .f] [winfo height .] [winfo y .f]"
+} {{100 100} {100 120 4}}
+grid_reset 13.11.1
+
+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: bug 1648} {nonPortable} {
+ # This test is nonPortable because the number of times
+ # A(.) will be incremented is unspecified--the behavior
+ # is different accross window managers.
+ global A
+ catch {unset A}
+ bind . <Configure> {incr A(%W)}
+ set A(.) 0
+ foreach i {0 1 2} {
+ frame .$i -width 100 -height 75
+ set A(.$i) 0
+ }
+ grid .0 .1 .2
+ update
+ bind <Configure> .1 {destroy .0}
+ .2 configure -bd 10
+ update
+ bind . <Configure> {}
+ array get A
+} {.2 2 .0 1 . 2 .1 1}
+grid_reset 14.3
+
+test grid-15.1 {lost slave} {
+ button .b
+ grid .b
+ set a [grid slaves .]
+ pack .b
+ 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 }
+grid_reset 16.8
+
+test grid-16.9 {layout uniform} {
+ frame .f1 -width 75 -height 50
+ frame .f2 -width 60 -height 25
+ frame .f3 -width 95 -height 75
+ frame .f4 -width 135 -height 100
+ frame .f5 -width 80 -height 40
+ for {set t 1} {$t <= 5} {incr t} {
+ grid .f$t
+ }
+ grid rowconfigure . {0 2} -uniform a
+ grid rowconfigure . {1 3} -uniform b
+ update
+ list [grid bbox . 0 0] [grid bbox . 0 1] [grid bbox . 0 2] \
+ [grid bbox . 0 3] [grid bbox . 0 4]
+} {{0 0 135 75} {0 75 135 100} {0 175 135 75} {0 250 135 100} {0 350 135 40}}
+grid_reset 16.9
+
+test grid-16.10 {layout uniform} {
+ grid [frame .f1 -width 75 -height 50] -row 0 -column 0
+ grid [frame .f2 -width 60 -height 30] -row 1 -column 2
+ grid [frame .f3 -width 95 -height 90] -row 2 -column 1
+ grid [frame .f4 -width 60 -height 100] -row 3 -column 4
+ grid [frame .f5 -width 60 -height 40] -row 4 -column 3
+
+ grid rowconfigure . {0 1} -uniform a
+ grid rowconfigure . {2 4} -uniform b
+ grid rowconfigure . {0 2} -weight 2
+ grid columnconfigure . {0 2} -uniform a
+ grid columnconfigure . {3 4} -uniform b
+ grid columnconfigure . {2 4} -weight 2
+ grid columnconfigure . 3 -minsize 70
+ grid columnconfigure . 4 -minsize 130
+ update
+ list [grid bbox . 0 0] [grid bbox . 2 1] [grid bbox . 1 2] \
+ [grid bbox . 4 3] [grid bbox . 3 4]
+} {{0 0 75 60} {170 60 150 30} {75 90 95 90} {390 180 140 100} {320 280 70 45}}
+grid_reset 16.10
+
+test grid-16.11 {layout uniform (shrink)} {
+ frame .f1 -width 75 -height 50
+ frame .f2 -width 100 -height 95
+ grid .f1 .f2 -sticky news
+ grid columnconfigure . {0 1} -uniform a
+ grid columnconfigure . 0 -weight 1
+ update
+ set res {}
+ lappend res [grid bbox . 0 0] [grid bbox . 1 0]
+ grid propagate . 0
+ . configure -width 150 -height 95
+ update
+ lappend res [grid bbox . 0 0] [grid bbox . 1 0]
+} {{0 0 100 95} {100 0 100 95} {0 0 50 95} {50 0 100 95}}
+grid_reset 16.11
+
+test grid-16.12 {layout uniform (grow)} {
+ frame .f1 -width 40 -height 50
+ frame .f2 -width 50 -height 95
+ frame .f3 -width 60 -height 50
+ frame .f4 -width 70 -height 95
+ grid .f1 .f2 .f3 .f4 -sticky news
+ grid columnconfigure . {0 1 2} -uniform a
+ # Put weight 2 on the biggest in the group to see that the groups
+ # adapts to one of the smaller.
+ grid columnconfigure . 2 -weight 2
+ grid columnconfigure . {0 3} -weight 1
+ update
+ set res {}
+ lappend res [grid bbox . 0 0] [grid bbox . 1 0]
+ lappend res [grid bbox . 2 0] [grid bbox . 3 0]
+
+ grid propagate . 0
+ . configure -width 350 -height 95
+ update
+ lappend res [grid bbox . 0 0] [grid bbox . 1 0]
+ lappend res [grid bbox . 2 0] [grid bbox . 3 0]
+} [list {0 0 50 95} {50 0 50 95} {100 0 100 95} {200 0 70 95} \
+ {0 0 70 95} {70 0 50 95} {120 0 140 95} {260 0 90 95}]
+grid_reset 16.12
+
+test grid-17.1 {forget and pending idle handlers} {
+ # This test is intended to detect a crash caused by a failure to remove
+ # pending idle handlers when grid forget is invoked.
+
+ toplevel .t
+ wm geometry .t +0+0
+ frame .t.f
+ label .t.f.l -text foobar
+ grid .t.f.l
+ grid .t.f
+ update
+ grid forget .t.f.l
+ grid forget .t.f
+ destroy .t
+
+ toplevel .t
+ frame .t.f
+ label .t.f.l -text foobar
+ grid .t.f.l
+ destroy .t
+ set result ok
+} ok
+
+test grid-18.1 {test respect for internalborder} {
+ toplevel .pack
+ wm geometry .pack 200x200
+ frame .pack.l -width 15 -height 10
+ labelframe .pack.lf -labelwidget .pack.l
+ pack .pack.lf -fill both -expand 1
+ frame .pack.lf.f
+ grid .pack.lf.f -sticky news
+ grid columnconfigure .pack.lf 0 -weight 1
+ grid rowconfigure .pack.lf 0 -weight 1
+ update
+ set res [list [winfo geometry .pack.lf.f]]
+ .pack.lf configure -labelanchor e -padx 3 -pady 5
+ update
+ lappend res [winfo geometry .pack.lf.f]
+ destroy .pack
+ set res
+} {196x188+2+10 177x186+5+7}
+test grid-18.2 {test support for minreqsize} {
+ toplevel .pack
+ wm geometry .pack {}
+ frame .pack.l -width 150 -height 100
+ labelframe .pack.lf -labelwidget .pack.l
+ pack .pack.lf -fill both -expand 1
+ frame .pack.lf.f -width 20 -height 25
+ grid .pack.lf.f
+ update
+ set res [list [winfo geometry .pack.lf]]
+ .pack.lf configure -labelanchor ws
+ update
+ lappend res [winfo geometry .pack.lf]
+ destroy .pack
+ set res
+} {162x127+0+0 172x112+0+0}
+
+test grid-19.1 {uniform realloc} {
+ # Use a lot of uniform groups to test the reallocation mechanism
+ for {set t 0} {$t < 100} {incr t 2} {
+ frame .fa$t -width 5 -height 20
+ frame .fb$t -width 6 -height 20
+ grid .fa$t .fb$t -row 0 -column $t -sticky news
+ grid columnconfigure . [list $t [expr {$t + 1}]] -uniform a$t
+ }
+ update
+ grid bbox .
+} {0 0 600 20}
+grid_reset 19.1
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/id.test b/tcl/tests/id.test
new file mode 100644
index 00000000000..c5a19f98fed
--- /dev/null
+++ b/tcl/tests/id.test
@@ -0,0 +1,109 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkId.c, which recycle X resource identifiers. It is organized in
+# the standard fashion for Tcl tests.
+#
+# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly testwrapper} {
+ 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> {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/image.test b/tcl/tests/image.test
new file mode 100644
index 00000000000..4ef07e0b03e
--- /dev/null
+++ b/tcl/tests/image.test
@@ -0,0 +1,379 @@
+# This file is a Tcl script to test out the "image" command and the
+# other procedures in the file tkImage.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+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, inuse, 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} testImageType {
+ list [image create test myimage] [image names]
+} {myimage myimage}
+test image-1.6 {Tk_ImageCmd procedure, "create" option} testImageType {
+ 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} testImageType {
+ 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} testImageType {
+ .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} testImageType {
+ .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-1.10 {Tk_ImageCmd procedure, "create" option with "." as name} {
+ set script [makeFile {
+ update
+ puts [list [catch {image create photo .} msg] $msg]
+ exit
+ } script]
+ set x [list [catch {exec [interpreter] <$script} msg] $msg]
+ removeFile script
+ set x
+} {0 {1 {this isn't a Tk applicationNULL main window}}}
+# I don't like the error message!
+
+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} testImageType {
+ .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} testImageType {
+ .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} testImageType {
+ 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} testImageType {
+ .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} testImageType {
+ image create test myimage
+ image type myimage
+} {test}
+test image-5.5 {Tk_ImageCmd procedure, "type" option} testImageType {
+ 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} testImageType {
+ 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} testImageType {
+ 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_ImageCmd procedure, "inuse" option} testImageType {
+ catch {image delete myimage2}
+ image create test myimage2
+ set res {}
+ lappend res [image inuse myimage2]
+ catch {destroy .b}
+ button .b -image myimage2
+ lappend res [image inuse myimage2]
+ catch {destroy .b}
+ image delete myimage2
+ set res
+} [list 0 1]
+
+
+test image-9.1 {Tk_ImageChanged procedure} testImageType {
+ .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-9.2 {Tk_ImageChanged procedure} testImageType {
+ .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-10.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-10.2 {Tk_GetImage procedure} testImageType {
+ 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-11.1 {Tk_FreeImage procedure} testImageType {
+ .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-11.2 {Tk_FreeImage procedure} testImageType {
+ .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-12.1 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {testImageType 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-12.2 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {testImageType 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-12.3 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {testImageType 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-12.4 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {testImageType 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-12.5 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {testImageType 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-12.6 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {testImageType 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-13.1 {Tk_SizeOfImage procedure} testImageType {
+ 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-13.2 {DeleteImage procedure} testImageType {
+ .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-14.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]
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/imgBmap.test b/tcl/tests/imgBmap.test
new file mode 100644
index 00000000000..d44c1e5536d
--- /dev/null
+++ b/tcl/tests/imgBmap.test
@@ -0,0 +1,490 @@
+# This file is a Tcl script to test out images of type "bitmap" (i.e.,
+# the procedures in the file tkImgBmap.c). It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+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]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/imgPPM.test b/tcl/tests/imgPPM.test
new file mode 100644
index 00000000000..c96d53314b9
--- /dev/null
+++ b/tcl/tests/imgPPM.test
@@ -0,0 +1,172 @@
+# This file is a Tcl script to test out the code in tkImgFmtPPM.c,
+# which reads and write PPM-format image files for photo widgets.
+# The files is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+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 -format ppm 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]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/imgPhoto.test b/tcl/tests/imgPhoto.test
new file mode 100644
index 00000000000..5e71b41cbb5
--- /dev/null
+++ b/tcl/tests/imgPhoto.test
@@ -0,0 +1,661 @@
+# This file is a Tcl script to test out the "photo" image type and the
+# other procedures in the file tkImgPhoto.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Australian National University
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# Author: Paul Mackerras (paulus@cs.anu.edu.au)
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+eval image delete [image names]
+
+canvas .c
+pack .c
+update
+
+set README [makeFile {
+README -- Tk test suite design document.
+} README-imgPhotot]
+
+# find the teapot.ppm file for use in these tests
+# first look in $tk_library/demos/images/teapot.ppm
+# then look in <this file>/../../library/demos/images/teapot.ppm
+testConstraint hasTeapotPhoto 1
+set teapotPhotoFile [file join $tk_library demos images teapot.ppm]
+if {![file exists $teapotPhotoFile]} {
+ set newLib [file dirname [testsDirectory]]
+ set teapotPhotoFile [file join $newLib library demos images teapot.ppm]
+ if {![file exists $teapotPhotoFile]} {
+ testConstraint hasTeapotPhoto
+ }
+}
+
+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} hasTeapotPhoto {
+ list [catch {image create photo p1 -file $teapotPhotoFile \
+ -format no.such.format} err] $err
+} {1 {image file format "no.such.format" is not supported}}
+test imgPhoto-1.4 {options for photo images} hasTeapotPhoto {
+ image create photo p1 -file $teapotPhotoFile
+ list [image width p1] [image height p1]
+} {256 256}
+test imgPhoto-1.5 {options for photo images} hasTeapotPhoto {
+ image create photo p1 -file $teapotPhotoFile \
+ -format ppm -width 79 -height 83
+ list [image width p1] [image height p1] \
+ [lindex [p1 configure -file] 4] [lindex [p1 configure -format] 4]
+} [list 79 83 $teapotPhotoFile ppm]
+test imgPhoto-1.6 {options for photo images} {
+ image create photo p1 -palette 2/2/2 -gamma 2.2
+ list [format %.1f [lindex [p1 configure -gamma] 4]] \
+ [lindex [p1 configure -palette] 4]
+} {2.2 2/2/2}
+test imgPhoto-1.7 {options for photo images} {
+ list [catch {image create photo p1 -file $README} err] $err
+} [subst {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} hasTeapotPhoto {
+ image create photo p1 -file $teapotPhotoFile
+ p1 configure -file $teapotPhotoFile
+} {}
+test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} hasTeapotPhoto {
+ image create photo p1 -file $teapotPhotoFile
+ list [catch {p1 configure -file bogus} err] [string tolower $err] \
+ [image width p1] [image height p1]
+} {1 {couldn't open "bogus": no such file or directory} 256 256}
+test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} hasTeapotPhoto {
+ image create photo p1
+ .c create image 10 10 -image p1 -tags p1.1 -anchor nw
+ .c create image 300 10 -image p1 -tags p1.2 -anchor nw
+ update
+ p1 configure -file $teapotPhotoFile
+ update
+ list [image width p1] [image height p1] [.c bbox p1.1] [.c bbox p1.2]
+} {256 256 {10 10 266 266} {300 10 556 266}}
+
+eval image delete [image names]
+image create photo p1
+.c create image 10 10 -image p1
+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, data, get, put, read, redither, transparency, 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} hasTeapotPhoto {
+ image create photo p2 -file $teapotPhotoFile
+ p1 configure -width 0 -height 0 -palette {} -gamma 1
+ p1 copy p2
+ list [image width p1] [image height p1] [p1 get 100 100]
+} {256 256 {169 117 90}}
+test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} {
+ list [catch {p1 copy} msg] $msg
+} {1 {wrong # args: should be "p1 copy source-image ?-compositingrule rule? ?-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 -compositingrule, -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} hasTeapotPhoto {
+ p1 read $teapotPhotoFile
+ list [p1 get 100 100] [p1 get 150 100] [p1 get 100 150]
+} {{169 117 90} {172 115 84} {35 35 35}}
+test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} {
+ list [catch {p1 get 256 0} err] $err
+} {1 {p1 get: coordinates out of range}}
+test imgPhoto-4.24 {ImgPhotoCmd procedure: get option} {
+ list [catch {p1 get 0 -1} err] $err
+} {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 ?options?"}}
+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 ?options?"}}
+test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} hasTeapotPhoto {
+ list [catch {p1 read $teapotPhotoFile -zoom 2} err] $err
+} {1 {unrecognized option "-zoom": must be -format, -from, -shrink, or -to}}
+test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} {
+ list [catch {p1 read bogus} err] [string tolower $err]
+} {1 {couldn't open "bogus": no such file or directory}}
+test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} hasTeapotPhoto {
+ list [catch {p1 read $teapotPhotoFile -format bogus} err] $err
+} {1 {image file format "bogus" is not supported}}
+test imgPhoto-4.34 {ImgPhotoCmd procedure: read option} {
+ list [catch {p1 read $README} err] $err
+} [subst {1 {couldn't recognize data in image file "$README"}}]
+test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} hasTeapotPhoto {
+ p1 read $teapotPhotoFile
+ list [image width p1] [image height p1] [p1 get 120 120]
+} {256 256 {161 109 82}}
+test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} hasTeapotPhoto {
+ p1 read $teapotPhotoFile -from 0 70 60 120 -to 10 10 -shrink
+ list [image width p1] [image height p1] [p1 get 29 19]
+} {70 60 {244 180 144}}
+test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} {
+ p1 redither
+ list [catch {p1 redither x} err] $err
+} {1 {wrong # args: should be "p1 redither"}}
+test imgPhoto-4.38 {ImgPhotoCmd procedure: write option} {
+ list [catch {p1 write} err] $err
+} {1 {wrong # args: should be "p1 write fileName ?options?"}}
+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}}
+eval image delete [image names]
+image create photo p1
+test imgPhoto-4.40 {ImgPhotoCmd procedure: transparency option} {
+ list [catch {p1 transparency} err] $err
+} {1 {wrong # args: should be "p1 transparency option ?arg arg ...?"}}
+test imgPhoto-4.41 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get} err] $err
+} {1 {wrong # args: should be "p1 transparency get x y"}}
+test imgPhoto-4.42 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get 0} err] $err
+} {1 {wrong # args: should be "p1 transparency get x y"}}
+test imgPhoto-4.43 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get 0 0 0} err] $err
+} {1 {wrong # args: should be "p1 transparency get x y"}}
+test imgPhoto-4.44 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get bogus 0} err] $err
+} {1 {expected integer but got "bogus"}}
+test imgPhoto-4.45 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get 0 bogus} err] $err
+} {1 {expected integer but got "bogus"}}
+test imgPhoto-4.46 {ImgPhotoCmd procedure: transparency get option} {
+ p1 put white
+ p1 transparency get 0 0
+} 0
+test imgPhoto-4.47 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get 1 0} err] $err
+} {1 {p1 transparency get: coordinates out of range}}
+test imgPhoto-4.48 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get -1 0} err] $err
+} {1 {p1 transparency get: coordinates out of range}}
+test imgPhoto-4.49 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get 0 1} err] $err
+} {1 {p1 transparency get: coordinates out of range}}
+test imgPhoto-4.50 {ImgPhotoCmd procedure: transparency get option} {
+ list [catch {p1 transparency get 0 -1} err] $err
+} {1 {p1 transparency get: coordinates out of range}}
+test imgPhoto-4.51 {ImgPhotoCmd procedure: transparency get option} {
+ p1 blank
+ p1 transparency get 0 0
+} 1
+test imgPhoto-4.52 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set} err] $err
+} {1 {wrong # args: should be "p1 transparency set x y boolean"}}
+test imgPhoto-4.53 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 0} err] $err
+} {1 {wrong # args: should be "p1 transparency set x y boolean"}}
+test imgPhoto-4.54 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 0 0} err] $err
+} {1 {wrong # args: should be "p1 transparency set x y boolean"}}
+test imgPhoto-4.55 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 0 0 0 0} err] $err
+} {1 {wrong # args: should be "p1 transparency set x y boolean"}}
+test imgPhoto-4.56 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set bogus 0 0} err] $err
+} {1 {expected integer but got "bogus"}}
+test imgPhoto-4.57 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 0 bogus 0} err] $err
+} {1 {expected integer but got "bogus"}}
+test imgPhoto-4.58 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 0 0 bogus} err] $err
+} {1 {expected boolean value but got "bogus"}}
+test imgPhoto-4.59 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 1 0 0} err] $err
+} {1 {p1 transparency set: coordinates out of range}}
+test imgPhoto-4.60 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set -1 0 0} err] $err
+} {1 {p1 transparency set: coordinates out of range}}
+test imgPhoto-4.61 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 0 1 0} err] $err
+} {1 {p1 transparency set: coordinates out of range}}
+test imgPhoto-4.62 {ImgPhotoCmd procedure: transparency set option} {
+ list [catch {p1 transparency set 0 -1 0} err] $err
+} {1 {p1 transparency set: coordinates out of range}}
+test imgPhoto-4.63 {ImgPhotoCmd procedure: transparency set option} {
+ p1 transparency set 0 0 false
+ p1 transparency get 0 0
+} 0
+test imgPhoto-4.64 {ImgPhotoCmd procedure: transparency set option} {
+ p1 transparency set 0 0 true
+ p1 transparency get 0 0
+} 1
+# Now for some heftier testing, checking that setting and resetting of
+# pixels' transparency status doesn't "leak" with any one-off errors.
+proc checkImgTrans {img width height} {
+ set result {}
+ for {set x 0} {$x<$width} {incr x} {
+ for {set y 0} {$y<$height} {incr y} {
+ if {[$img transparency get $x $y]} {
+ lappend result $x $y
+ }
+ }
+ }
+ return $result
+}
+test imgPhoto-4.65 {ImgPhotoCmd procedure: transparency get option} {
+ p1 put white -to 0 0 3 3
+ checkImgTrans p1 3 3
+} {}
+test imgPhoto-4.66 {ImgPhotoCmd procedure: transparency get option} {
+ p1 blank
+ checkImgTrans p1 3 3
+} {0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2}
+proc checkImgTransLoopSetReset {img width height} {
+ set result {}
+ for {set x 0} {$x<$width} {incr x} {
+ for {set y 0} {$y<$height} {incr y} {
+ $img put white -to 0 0 3 3
+ $img transparency set $x $y 1
+ set result [concat $result [checkImgTrans $img $width $height]]
+ lappend result ,
+ $img transparency set $x $y 0
+ set result [concat $result [checkImgTrans $img $width $height]]
+ lappend result .
+ }
+ }
+ return $result
+}
+test imgPhoto-4.67 {ImgPhotoCmd procedure: transparency set option} {
+ checkImgTransLoopSetReset p1 3 3
+} {0 0 , . 0 1 , . 0 2 , . 1 0 , . 1 1 , . 1 2 , . 2 0 , . 2 1 , . 2 2 , .}
+proc checkImgTransLoopResetSet {img width height} {
+ set result {}
+ for {set x 0} {$x<$width} {incr x} {
+ for {set y 0} {$y<$height} {incr y} {
+ $img blank
+ $img transparency set $x $y 0
+ set result [concat $result [checkImgTrans $img $width $height]]
+ lappend result ,
+ $img transparency set $x $y 1
+ set result [concat $result [checkImgTrans $img $width $height]]
+ lappend result .
+ }
+ }
+ return $result
+}
+test imgPhoto-4.68 {ImgPhotoCmd procedure: transparency set option} {
+ checkImgTransLoopResetSet p1 3 3
+} {0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 2 1 0 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 1 0 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 1 2 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 .}
+catch {rename checkImgTransLoopSetReset {}}
+catch {rename checkImgTransLoopResetSet {}}
+# Test the compositing rules for copying images
+image create photo p1 -width 3 -height 3
+image create photo p2 -width 2 -height 2
+test imgPhoto-4.68 {ImgPhotoCmd procedure: copy with -compositingrule} {
+ list [catch {p1 copy p2 -to 1 1 -compositingrule} msg] $msg
+} {1 {the "-compositingrule" option requires a value}}
+test imgPhoto-4.69 {ImgPhotoCmd procedure: copy with -compositingrule} {
+ list [catch {p1 copy p2 -to 1 1 -compositingrule BAD} msg] $msg
+} {1 {bad compositing rule "BAD": must be overlay or set}}
+test imgPhoto-4.70 {ImgPhotoCmd procedure: copy with -compositingrule} {
+ # Tests default compositing rule
+ p1 blank
+ p2 blank
+ p1 put white -to 0 0 2 2
+ p2 put white -to 0 0 2 2
+ p2 transparency set 0 0 true
+ p1 copy p2 -to 1 1
+ checkImgTrans p1 3 3
+} {0 2 2 0}
+test imgPhoto-4.71 {ImgPhotoCmd procedure: copy with -compositingrule} {
+ p1 blank
+ p2 blank
+ p1 put white -to 0 0 2 2
+ p2 put white -to 0 0 2 2
+ p2 transparency set 0 0 true
+ p1 copy p2 -to 1 1 -compositingrule overlay
+ checkImgTrans p1 3 3
+} {0 2 2 0}
+test imgPhoto-4.72 {ImgPhotoCmd procedure: copy with -compositingrule} {
+ p1 blank
+ p2 blank
+ p1 put white -to 0 0 2 2
+ p2 put white -to 0 0 2 2
+ p2 transparency set 0 0 true
+ p1 copy p2 -to 1 1 -compositingrule set
+ checkImgTrans p1 3 3
+} {0 2 1 1 2 0}
+catch {rename checkImgTrans {}}
+
+test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} hasTeapotPhoto {
+ eval image delete [image names]
+ .c delete all
+ image create photo p1 -file $teapotPhotoFile
+ .c create image 0 0 -image p1 -tags p1.1
+ .c create image 256 0 -image p1 -tags p1.2
+ .c create image 0 256 -image p1 -tags p1.3
+ update
+ .c delete i1.1
+ p1 configure -width 1
+ update
+ .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} hasTeapotPhoto {
+ eval image delete [image names]
+ .c delete all
+ image create photo p1 -file $teapotPhotoFile
+ .c create image 0 0 -image p1 -anchor nw
+ update
+ .c delete all
+ image delete p1
+} {}
+test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} hasTeapotPhoto {
+ image create photo p1 -file $teapotPhotoFile
+ .c create image 10 10 -image p1 -anchor nw
+ button .b1 -image p1
+ button .b2 -image p1
+ button .b3 -image p1
+ pack .b1 .b2 .b3
+ update
+ destroy .b2
+ update
+ destroy .b3
+ update
+ destroy .b1
+ update
+ .c delete all
+} {}
+test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} hasTeapotPhoto {
+ image create photo p1 -file $teapotPhotoFile
+ button .b1 -image p1
+ frame .f -visual best
+ button .f.b2 -image p1
+ pack .f.b2
+ pack .b1 .f
+ update
+ destroy .b1
+ update
+ .f.b2 configure -image {}
+ update
+ destroy .f
+ image delete p1
+} {}
+
+test imgPhoto-8.1 {ImgPhotoDelete procedure} hasTeapotPhoto {
+ image create photo p2 -file $teapotPhotoFile
+ image delete p2
+} {}
+test imagePhoto-8.2 {ImgPhotoDelete procedure} hasTeapotPhoto {
+ image create photo p2 -file $teapotPhotoFile
+ rename p2 newp2
+ set x [list [info command p2] [info command new*] [newp2 cget -file]]
+ image delete p2
+ append x [info command new*]
+} [list {} newp2 $teapotPhotoFile]
+test imagePhoto-8.3 {ImgPhotoDelete procedure, name cleanup} {
+ image create photo p1
+ image create photo p2 -width 10 -height 10
+ image delete p2
+ list [catch {p1 copy p2} msg] $msg
+} {1 {image "p2" doesn't exist or is not a photo image}}
+
+test imagePhoto-9.1 {ImgPhotoCmdDeletedProc procedure} hasTeapotPhoto {
+ image create photo p2 -file $teapotPhotoFile
+ rename p2 {}
+ list [lsearch -exact [image names] p2] [catch {p2 foo} msg] $msg
+} {-1 1 {invalid command name "p2"}}
+
+test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} {
+ eval image delete [image names]
+ image create photo p1
+ 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} hasTeapotPhoto {
+ image create photo p3 -file $teapotPhotoFile
+ set result [list [p3 get 50 50] [p3 get 100 100]]
+ p3 copy p3 -zoom 2
+ lappend result [image width p3] [image height p3] [p3 get 100 100]
+ image delete p3
+ set result
+} {{19 92 192} {169 117 90} 512 512 {19 92 192}}
+
+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
+} {}
+
+
+test imgPhoto-14.1 {GIF writes work correctly} {
+ set data "R0lGODlhYwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgAysnGy8hKzM
+hASs3MTcjAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMDAwP8AAAD/
+AP//AAAA//8A/wD//////ywAAAAAYwA5AAAI/wAZCBxIsKDBgwgTKlzIsKHD
+hxAjSpxIsaLFixgzatzIsaPHjyBDihxJsqTJkyhTqlzJsqXLlzBjypxJs6bN
+mzhz6tzJs6fPn0CDCh1KtKhRiwoSKEXAtGlTpUqPGkyagOmCq1edNsWalWkC
+BUSXIuDqFepBqFWtZv3KU+zYrkrBSqT6dgECtjOTbu16NwFHvV3lshRLti/J
+qlgRCE6ZuO9ik4Dt+k0ZVyZiyVIvXr77ODPEy5g9T4zMWfTEzXdNz1VbWvXn
+uqldP1TAOrbshqBb314Y2W7n3Qdpv7UNPCHpycUVbv6dnODy5sqzQldIe8H0
+hciva9/Ovbv37+BzBgEEADs=
+"
+ set photo [image create photo -data $data]
+ set filename [makeFile {} imgPhoto-14.1.gif]
+ removeFile imgPhoto-14.1.gif
+ $photo write $filename -format gif
+ set photo2 [image create photo -file $filename]
+ set result [string equal [$photo data] [$photo2 data]]
+ image delete $photo $photo2
+ catch {file delete -force $filename}
+ set result
+} 1
+
+test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} \
+ {nonPortable} {
+ # This is not portable to very large machines with more around
+ # 3GB of free memory available...
+ list [catch {image create photo -width 32000 -height 32000} msg] $msg
+} {1 {not enough free memory for image buffer}}
+
+destroy .c
+eval image delete [image names]
+
+# cleanup
+removeFile README-imgPhoto
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/license.terms b/tcl/tests/license.terms
index f1dcaa5245c..03ca6fcb319 100644
--- a/tcl/tests/license.terms
+++ b/tcl/tests/license.terms
@@ -1,8 +1,7 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
+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
@@ -37,4 +36,4 @@ 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.
+terms specified in this license.
diff --git a/tcl/tests/listbox.test b/tcl/tests/listbox.test
new file mode 100644
index 00000000000..800655e51fd
--- /dev/null
+++ b/tcl/tests/listbox.test
@@ -0,0 +1,2141 @@
+# This file is a Tcl script to test out the "listbox" command
+# of Tk. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1993-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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 {
+ {-activestyle under underline foo {bad activestyle "foo": must be dotbox, none, or underline}}
+ {-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"}}
+ {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-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 "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"}}
+ {-state disabled disabled foo {bad state "foo": must be disabled or normal}}
+ {-takefocus "any string" "any string" {} {}}
+ {-width 45 45 3p {expected integer but got "3p"}}
+ {-xscrollcommand {Some command} {Some command} {} {}}
+ {-yscrollcommand {Another command} {Another command} {} {}}
+ {-listvar testVariable testVariable {} {}}
+} {
+ 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]
+} {27}
+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 firstIndex ?lastIndex?"}}
+test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} {
+ list [catch {.l get a b c} msg] $msg
+} {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}}
+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 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 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, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l c} msg] $msg
+} {1 {ambiguous option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l in} msg] $msg
+} {1 {ambiguous option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l s} msg] $msg
+} {1 {ambiguous option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l se} msg] $msg
+} {1 {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, 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}}
+test listbox-4.9 {ConfigureListbox procedure, -listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l get 0 end
+} [list a b c d]
+test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l
+ .l insert end 1 2 3 4
+ .l configure -listvar x
+ .l get 0 end
+} [list a b c d]
+test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar {}
+ .l insert end 1 2 3 4
+ list $x [.l get 0 end]
+} [list [list a b c d] [list a b c d 1 2 3 4]]
+test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ set y [list 1 2 3 4]
+ listbox .l
+ .l configure -listvar x
+ .l configure -listvar y
+ .l insert end 5 6 7 8
+ list $x $y
+} [list [list a b c d] [list 1 2 3 4 5 6 7 8]]
+test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l
+ .l insert end a b c d
+ .l configure -listvar x
+ set x
+} [list a b c d]
+test listbox-4.14 {ConfigureListbox, non-existant listvar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ list [info exists x] $x
+} [list 1 {}]
+test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} {
+ catch {destroy .l}
+ catch {unset y}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar y
+ list [info exists y] $y
+} [list 1 [list a b c d]]
+test listbox-4.16 {ConfigureListbox, listvar -> same listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar x
+ set x
+} [list a b c d]
+test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l configure -listvar {}
+ .l get 0 end
+} [list a b c d]
+test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ set x "this is a \" bad list"
+ catch {.l configure -listvar x} result
+ list [.l get 0 end] [.l cget -listvar] $result
+} [list [list a b c d] {} \
+ "unmatched open quote in list: invalid -listvariable value"]
+test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} {
+ catch {destroy .l}
+ listbox .l -listvar foo
+ .l insert end a b c d
+ catch {.l configure -listvar ::zoo::bar::foo} result
+ list [.l get 0 end] [.l cget -listvar] $foo $result
+} [list [list a b c d] foo [list a b c d] \
+ {can't set "::zoo::bar::foo": parent namespace doesn't exist}]
+
+# 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-6.13 {InsertEls procedure, check -listvar update} {
+ catch {destroy .l2}
+ set x [list a b c d]
+ listbox .l2 -listvar x
+ .l2 insert 0 1 2 3 4
+ set x
+} [list 1 2 3 4 a b c d]
+test listbox-6.14 {InsertEls procedure, check selection update} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 0 1 2 3 4
+ .l2 selection set 2 4
+ .l2 insert 0 a
+ .l2 curselection
+} [list 3 4 5]
+
+
+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-7.21 {DeleteEls procedure, check -listvar update} {
+ catch {destroy .l2}
+ set x [list a b c d]
+ listbox .l2 -listvar x
+ .l2 delete 0 1
+ set x
+} [list c d]
+
+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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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]
+deleteWindows
+
+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]
+
+# tests for ListboxListVarProc
+test listbox-21.1 {ListboxListVarProc} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ set x [list a b c d]
+ .l get 0 end
+} [list a b c d]
+test listbox-21.2 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ unset x
+ set x
+} [list a b c d]
+test listbox-21.3 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar {}
+ unset x
+ info exists x
+} 0
+test listbox-21.4 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ lappend x e f g
+ .l size
+} 7
+test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d e f g]
+ listbox .l -listvar x
+ .l selection set end
+ set x [list a b c d]
+ set x [list 0 1 2 3 4 5 6]
+ .l curselection
+} {}
+test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 3
+ lappend x e f g
+ .l curselection
+} 3
+test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 0
+ set x [linsert $x 0 1 2 3 4]
+ .l curselection
+} 0
+test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 2
+ set x [list a b c]
+ .l curselection
+} 2
+test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} {
+ catch {destroy .l}
+ catch {unset x}
+ set log {}
+ listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x
+ pack .l
+ update
+ lappend x "0000000000"
+ update
+ lappend x "00000000000000000000"
+ update
+ set log
+} [list {x 0 1} {x 0 1} {x 0 0.5}]
+test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} {
+ catch {destroy .l}
+ catch {unset x}
+ set log {}
+ listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x
+ pack .l
+ update
+ lappend x "0000000000"
+ update
+ lappend x "00000000000000000000"
+ update
+ set x [list "0000000000"]
+ update
+ set log
+} [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}]
+test listbox-21.11 {ListboxListVarProc, bad list} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ set x [list a b c d]
+ catch {set x "this is a \" bad list"} result
+ set result
+} {can't set "x": invalid listvar value}
+test listbox-21.12 {ListboxListVarProc, cleanup item attributes} {
+ catch {destroy .l}
+ set x [list a b c d e f g]
+ listbox .l -listvar x
+ .l itemconfigure end -fg red
+ set x [list a b c d]
+ set x [list 0 1 2 3 4 5 6]
+ .l itemcget end -fg
+} {}
+test listbox-21.12 {ListboxListVarProc, cleanup item attributes} {
+ catch {destroy .l}
+ set x [list a b c d e f g]
+ listbox .l -listvar x
+ .l itemconfigure end -fg red
+ set x [list a b c d]
+ set x [list 0 1 2 3 4 5 6]
+ .l itemcget end -fg
+} {}
+test listbox-21.13 {listbox item configurations and listvar based deletions} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ .l insert end a b c
+ .l itemconfigure 1 -fg red
+ set x [list b c]
+ .l itemcget 1 -fg
+} red
+test listbox-21.14 {listbox item configurations and listvar based inserts} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ .l insert end a b c
+ .l itemconfigure 0 -fg red
+ set x [list 1 2 3 4 a b c]
+ .l itemcget 0 -fg
+} red
+test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} {
+ catch {destroy .l}
+ catch {unset x}
+ set log {}
+ listbox .l -listvar x -yscrollcommand "record y" -font fixed -height 3
+ pack .l
+ update
+ lappend x a b c d e f
+ update
+ set log
+} [list {y 0 1} {y 0 0.5}]
+test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x -height 3
+ pack .l
+ update
+ set x [list 0 1 2 3 4 5]
+ .l yview scroll 3 units
+ update
+ set result {}
+ lappend result [.l yview]
+ set x [lreplace $x 3 3]
+ set x [lreplace $x 3 3]
+ set x [lreplace $x 3 3]
+ update
+ lappend result [.l yview]
+ set result
+} [list {0.5 1} {0 1}]
+
+# UpdateHScrollbar
+test listbox-22.1 {UpdateHScrollbar} {
+ catch {destroy .l}
+ set log {}
+ listbox .l -font $fixed -width 10 -xscrollcommand "record x"
+ pack .l
+ update
+ .l insert end "0000000000"
+ update
+ .l insert end "00000000000000000000"
+ update
+ set log
+} [list {x 0 1} {x 0 1} {x 0 0.5}]
+
+# ConfigureListboxItem
+test listbox-23.1 {ConfigureListboxItem} {
+ catch {destroy .l}
+ listbox .l
+ catch {.l itemconfigure 0} result
+ set result
+} {item number "0" out of range}
+test listbox-23.2 {ConfigureListboxItem} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemconfigure 0
+} [list {-background background Background {} {}} \
+ {-bg -background} \
+ {-fg -foreground} \
+ {-foreground foreground Foreground {} {}} \
+ {-selectbackground selectBackground Foreground {} {}} \
+ {-selectforeground selectForeground Background {} {}}]
+test listbox-23.3 {ConfigureListboxItem, itemco shortcut} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemco 0 -background
+} {-background background Background {} {}}
+test listbox-23.4 {ConfigureListboxItem, wrong num args} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a
+ catch {.l itemco} result
+ set result
+} {wrong # args: should be ".l itemconfigure index ?option? ?value? ?option value ...?"}
+test listbox-23.5 {ConfigureListboxItem, multiple calls} {
+ catch {destroy .l}
+ listbox .l
+ set i 0
+ foreach color {red orange yellow green blue white violet} {
+ .l insert end $color
+ .l itemconfigure $i -bg $color
+ incr i
+ }
+ pack .l
+ update
+ list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \
+ [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \
+ [.l itemcget 6 -bg]
+} {red orange yellow green blue white violet}
+catch {destroy .l}
+listbox .l
+.l insert end a b c d
+set i 6
+foreach test {
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
+ {-fg #110022 #110022 bogus {unknown color name "bogus"}}
+ {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
+} {
+ set name [lindex $test 0]
+ test listbox-23.$i {configuration options} {
+ .l itemconfigure 0 $name [lindex $test 1]
+ list [lindex [.l itemconfigure 0 $name] 4] [.l itemcget 0 $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test listbox-23.$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
+}
+
+# ListboxWidgetObjCmd, itemcget
+test listbox-24.1 {itemcget} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemcget 0 -fg
+} {}
+test listbox-24.2 {itemcget} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemconfigure 0 -fg red
+ .l itemcget 0 -fg
+} red
+test listbox-24.3 {itemcget} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ catch {.l itemcget 0} result
+ set result
+} {wrong # args: should be ".l itemcget index option"}
+test listbox-24.3 {itemcget, itemcg shortcut} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ catch {.l itemcg 0} result
+ set result
+} {wrong # args: should be ".l itemcget index option"}
+
+# General item configuration issues
+test listbox-25.1 {listbox item configurations and widget based deletions} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a
+ .l itemconfigure 0 -fg red
+ .l delete 0 end
+ .l insert end a
+ .l itemcget 0 -fg
+} {}
+test listbox-25.2 {listbox item configurations and widget based inserts} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c
+ .l itemconfigure 0 -fg red
+ .l insert 0 1 2 3 4
+ list [.l itemcget 0 -fg] [.l itemcget 4 -fg]
+} [list {} red]
+
+# state issues
+test listbox-26.1 {listbox disabled state disallows inserts} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c
+ .l configure -state disabled
+ .l insert end d e f
+ .l get 0 end
+} [list a b c]
+test listbox-26.2 {listbox disabled state disallows deletions} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c
+ .l configure -state disabled
+ .l delete 0 end
+ .l get 0 end
+} [list a b c]
+test listbox-26.3 {listbox disabled state disallows selection modification} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c
+ .l selection set 0
+ .l selection set 2
+ .l configure -state disabled
+ .l selection clear 0 end
+ .l selection set 1
+ .l curselection
+} [list 0 2]
+test listbox-26.4 {listbox disabled state disallows anchor modification} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c
+ .l selection anchor 0
+ .l configure -state disabled
+ .l selection anchor 2
+ .l index anchor
+} 0
+test listbox-26.5 {listbox disabled state disallows active modification} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c
+ .l activate 0
+ .l configure -state disabled
+ .l activate 2
+ .l index active
+} 0
+
+test listbox-27.1 {widget deletion while active} {
+ destroy .l
+ pack [listbox .l]
+ update
+ .l configure -cursor xterm -xscrollcommand { destroy .l }
+ update idle
+ winfo exists .l
+} 0
+
+test listbox-28.1 {listbox -activestyle} {
+ catch {destroy .l}
+ listbox .l -activ non
+ .l cget -activestyle
+} none
+test listbox-28.2 {listbox -activestyle} {
+ catch {destroy .l}
+ listbox .l
+ .l cget -activestyle
+} underline
+test listbox-28.3 {listbox -activestyle} {
+ catch {destroy .l}
+ listbox .l -activestyle dot
+ .l cget -activestyle
+} dotbox
+
+resetGridInfo
+deleteWindows
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/macEmbed.test b/tcl/tests/macEmbed.test
new file mode 100644
index 00000000000..61eecc6429c
--- /dev/null
+++ b/tcl/tests/macEmbed.test
@@ -0,0 +1,269 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkMacEmbed.c. It is organized in the standard fashion for Tcl
+# tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
+ catch {destroy .t}
+ list [catch {toplevel .t -use xyz} msg] $msg
+} {1 {expected integer but got "xyz"}}
+test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} {
+ catch {destroy .t}
+ list [catch {toplevel .t -use 47} msg] $msg
+} {1 {The window ID 47 does not correspond to a valid Tk Window.}}
+
+test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {testembed macOnly} {
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ set w1 [winfo id .f1]
+ set x [testembed]
+ toplevel .t1 -use $w1
+ wm withdraw .t1
+ list $x [testembed]
+} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
+test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
+ {macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ set w1 [winfo id .f1]
+ toplevel .t1 -use $w1 -bd 2 -relief raised
+ update
+ wm geometry .t1 +30+40
+ update
+ wm geometry .t1
+} {200x200+0+0}
+test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
+ {macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ set w1 [winfo id .f1]
+ toplevel .t1 -use $w1
+ update
+ wm geometry .t1 300x100+30+40
+ update
+ wm geometry .t1
+} {300x100+0+0}
+test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
+ deleteWindows
+ toplevel .t1 -container 1 -width 200 -height 50
+ set w1 [winfo id .t1]
+ toplevel .t2 -use $w1
+ update
+ .t1 configure -width 300 -height 80
+ update
+ list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
+} {300 80 300x80+0+0}
+test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ set w1 [winfo id .f1]
+ toplevel .t1 -use $w1
+ set x unmapped
+ bind .t1 <Map> {set x mapped}
+ update
+ after 100
+ update
+ set x
+} {mapped}
+test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ set w1 [winfo id .f1]
+ bind .f1 <Destroy> {set x dead}
+ set x alive
+ toplevel .t1 -use $w1
+ update
+ destroy .t1
+ update
+ list $x [winfo exists .f1]
+} {dead 0}
+
+test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ set w1 [winfo id .f1]
+ toplevel .t1 -use $w1
+ update
+ set x [testembed]
+ destroy .f1
+ list $x [testembed]
+} {{{XXX .f1 XXX .t1}} {}}
+
+# Can't think up any tests for TkpGetOtherWindow procedure.
+
+test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
+ catch {interp delete child}
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ 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} {testembed macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ set w1 [winfo id .f1]
+ toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
+ set x {}
+ lappend x [testembed]
+ destroy .t1
+ update
+ lappend x [testembed]
+} {{{XXX .f1 XXX .t1}} {}}
+
+test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ toplevel .t1 -use [winfo id .f1] -width 150 -height 80
+ update
+ wm geometry .t1 +40+50
+ update
+ wm geometry .t1
+} {150x80+0+0}
+test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
+ deleteWindows
+ 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}
+
+
+
+deleteWindows
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/macFont.test b/tcl/tests/macFont.test
new file mode 100644
index 00000000000..667f2f7afa4
--- /dev/null
+++ b/tcl/tests/macFont.test
@@ -0,0 +1,286 @@
+# This file is a Tcl script to test out the procedures in tkMacFont.c.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Some of these tests are visually oriented and cannot be checked
+# programmatically (such as "does an underlined font appear to be
+# underlined?"); these tests attempt to exercise the code in question,
+# but there are no results that can be checked.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+catch {destroy .b}
+toplevel .b
+update idletasks
+
+set courier {Courier 12}
+set cx [font measure $courier 0]
+
+set fixed {Monaco 12}
+label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font $fixed
+pack .b.l
+canvas .b.c -closeenough 0
+
+set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
+pack .b.c
+update
+
+set ax [winfo reqwidth .b.l]
+set ay [winfo reqheight .b.l]
+proc getsize {} {
+ update
+ return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
+}
+
+testConstraint gothic 0
+set gothic {gothic 12}
+set mx [font measure $gothic \u4e4e]
+if {[font actual $gothic -family] != [font actual system -family]} {
+ testConstraint gothic 1
+}
+
+test macFont-1.1 {TkpFontPkgInit} {macOnly} {
+} {}
+
+test macfont-2.1 {TkpGetNativeFont: not native} {macOnly} {
+ list [catch {font measure {} xyz} msg] $msg
+} {1 {font "" doesn't exist}}
+test macFont-2.2 {TkpGetNativeFont: native} {macOnly} {
+ font measure system "0"
+ font measure application "0"
+ set x {}
+} {}
+
+test macFont-3.1 {TkpGetFontFromAttributes: no family} {macOnly} {
+ font actual {-underline 1} -family
+} [font actual system -family]
+test macFont-3.2 {TkpGetFontFromAttributes: long family name} {macOnly} {
+ set x "12345678901234567890123456789012345678901234567890"
+ set x "$x$x$x$x$x$x"
+ font actual "-family $x" -family
+} [font actual system -family]
+test macFont-3.3 {TkpGetFontFromAttributes: family} {macOnly} {
+ font actual {-family Courier} -family
+} {Courier}
+test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {macOnly} {
+ set x {}
+ lappend x [font actual {-family "Times"} -family]
+ lappend x [font actual {-family "Times New Roman"} -family]
+} {Times Times}
+test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {macOnly} {
+ set x {}
+ lappend x [font actual {-family "Courier"} -family]
+ lappend x [font actual {-family "Courier New"} -family]
+} {Courier Courier}
+test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {macOnly} {
+ set x {}
+ lappend x [font actual {-family "Geneva"} -family]
+ lappend x [font actual {-family "Helvetica"} -family]
+ lappend x [font actual {-family "Arial"} -family]
+} {Geneva Helvetica Helvetica}
+test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {macOnly} {
+ font actual {arial 10} -family
+} {Helvetica}
+test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {macOnly} {
+ font actual {{ms sans serif} 10} -family
+} {Chicago}
+test macFont-3.9 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-weight normal} -weight
+} {normal}
+test macFont-3.10 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-weight bold} -weight
+} {bold}
+test macFont-3.11 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-slant roman} -slant
+} {roman}
+test macFont-3.12 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-slant italic} -slant
+} {italic}
+test macFont-3.13 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-underline false} -underline
+} {0}
+test macFont-3.14 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-underline true} -underline
+} {1}
+test macFont-3.15 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-overstrike false} -overstrike
+} {0}
+test macFont-3.16 {TkpGetFontFromAttributes: styles} {macOnly} {
+ font actual {-overstrike true} -overstrike
+} {0}
+
+test macFont-4.1 {TkpDeleteFont} {macOnly} {
+ font actual {-family xyz}
+ set x {}
+} {}
+
+test macFont-5.1 {TkpGetFontFamilies} {macOnly} {
+ expr {[lsearch [font families] Geneva] > 0}
+} {1}
+
+test macFont-6.1 {TkpGetSubFonts} {testfont gothic macOnly} {
+ .b.l config -text "abc\u4e4e"
+ update
+ set x [testfont subfonts $fixed]
+} "Monaco [font actual $gothic -family]"
+
+test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {macOnly} {
+ .b.l config -wrap 0 -text "000000"
+ getsize
+} "[expr $ax*6] $ay"
+test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {macOnly} {
+ .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+ getsize
+} "[expr $ax*256] $ay"
+test macFont-7.3 {Tk_MeasureChars: all chars did fit} {macOnly} {
+ .b.l config -wrap [expr $ax*10] -text "00000000"
+ getsize
+} "[expr $ax*8] $ay"
+test macFont-7.4 {Tk_MeasureChars: not all chars fit} {macOnly} {
+ .b.l config -wrap [expr $ax*6] -text "00000000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+test macFont-7.5 {Tk_MeasureChars: already saw space in line} {macOnly} {
+ .b.l config -wrap [expr $ax*12] -text "000000 0000000"
+ getsize
+} "[expr $ax*7] [expr $ay*2]"
+test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {macOnly} {
+ .b.l config -wrap [expr $ax*12] -text "000 00 00000"
+ getsize
+} "[expr $ax*7] [expr $ay*2]"
+test macFont-7.7 {Tk_MeasureChars: include last partial char} {macOnly} {
+ .b.c dchars $t 0 end
+ .b.c insert $t 0 "0000"
+ .b.c index $t @[expr int($ax*2.5)],1
+} {2}
+test macFont-7.8 {Tk_MeasureChars: at least one char on line} { macOnly} {
+ .b.l config -text "000000" -wrap 1
+ getsize
+} "$ax [expr $ay*6]"
+test macFont-7.9 {Tk_MeasureChars: whole words} {macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "000000 0000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {macOnly} {
+ .b.l config -wrap [expr $ax*12] -text "0000000000000000"
+ getsize
+} "[expr $ax*12] [expr $ay*2]"
+test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {macOnly} {
+ font measure system {}
+} {0}
+test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {macOnly} {
+ font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.13 {Tk_MeasureChars: loop on each char} {macOnly} {
+ font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.14 {Tk_MeasureChars: p == end} {macOnly} {
+ font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.15 {Tk_MeasureChars: p > end} {macOnly} {
+ font measure $courier abc\xc2
+} "[expr $cx*4]"
+test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} {
+ font measure $courier abc\u4e4edef
+} [expr $cx*6+$mx]
+test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} {
+ font measure $courier \u4e4edef
+} [expr $mx+$cx*3]
+test macFont-7.18 {Tk_MeasureChars: final measure} {gothic macOnly} {
+ font measure $courier \u4e4edef
+} [expr $mx+$cx*3]
+test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} {
+ font measure $courier \u4e4e
+} [expr $mx]
+test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "000"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.21 {Tk_MeasureChars: loop on each char} {macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "000"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.22 {Tk_MeasureChars: p == end} {macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "000"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.23 {Tk_MeasureChars: p > end} {macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "00\xc2"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "00\u4e4e00"
+ getsize
+} "[expr $ax*4+$mx] $ay"
+test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
+ getsize
+} "[expr $mx+$ax*2] $ay"
+test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic macOnly} {
+ .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00"
+ getsize
+} "[expr $ax*8+$mx*2] $ay"
+test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic macOnly} {
+ .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00"
+ getsize
+} "[expr $ax*5] [expr $ay*3]"
+test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic macOnly} {
+ # even some of the "0"s would fit after \u4e4d, they should all wrap to next line.
+ .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00"
+ getsize
+} "[expr $ax*6+$mx] [expr $ay*3]"
+test macFont-7.29 {Tk_MeasureChars: final measure} {gothic macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
+ getsize
+} "[expr $mx+$ax*2] $ay"
+test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} {
+ .b.l config -wrap [expr $ax*8] -text "\u4e4e"
+ getsize
+} "$mx $ay"
+test macFont-7.31 {Tk_MeasureChars: rest == NULL} {macOnly} {
+ .b.l config -wrap [expr $ax*1000] -text 0000
+ getsize
+} "[expr $ax*4] $ay"
+test macFont-7.32 {Tk_MeasureChars: rest != NULL} {macOnly} {
+ .b.l config -wrap [expr $ax*6] -text "00000000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+
+test macFont-8.1 {Tk_DrawChars procedure} {macOnly} {
+ .b.l config -text "a"
+ update
+} {}
+
+test macFont-9.1 {AllocMacFont: use old font} {macOnly} {
+ font create xyz
+ button .c -font xyz
+ font configure xyz -family times
+ update
+ destroy .c
+ font delete xyz
+} {}
+test macFont-9.2 {AllocMacFont: extract info from style} {macOnly} {
+ font actual {Monaco 9 bold italic underline overstrike}
+} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
+test macFont-9.3 {AllocMacFont: extract text metrics} {macOnly} {
+ font metric {Geneva 10} -fixed
+} {0}
+test macFont-9.4 {AllocMacFont: extract text metrics} {macOnly} {
+ font metric "Monaco 9" -fixed
+} {1}
+
+destroy .b
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/macMenu.test b/tcl/tests/macMenu.test
new file mode 100644
index 00000000000..fd2cfbf9a0e
--- /dev/null
+++ b/tcl/tests/macMenu.test
@@ -0,0 +1,1549 @@
+# This file is a Tcl script to test menus in Tk. It is
+# organized in the standard fashion for Tcl tests. This
+# file tests the Macintosh-specific features of the menu
+# system.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test macMenu-1.0 {TkMacUseMenuID} {macOnly} {
+ # Can't really test TkMacUseMenuID; it's only called on startup.
+} {}
+
+test macMenu-2.1 {GetNewID} {macOnly} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test macMenu-2.2 {GetNewID - cascade menu} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test macMenu-5.2 {TkpDestroyMenu - help menu} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ update idletasks
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+
+test macMenu-6.1 {SetMenuCascade} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test macMenu-8.2 {GetEntryText} {macOnly testImageType} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.4 {GetEntryText} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.5 {GetEntryText} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-10.3 {SetMenuIndicator - indiatorOn false} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add checkbutton -label foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-10.5 {SetMenuIndicator - checkbutton} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Control+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.5 {TkpConfigureMenuEntry - Ctrl} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Ctrl+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.6 {TkpConfigureMenuEntry - Shift} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Shift+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.7 {TkpConfigureMenuEntry - Option} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Opt+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.8 {TkpConfigureMenuEntry - Command} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Command+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.9 {TkpConfigureMenuEntry - Cmd} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Cmd+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.10 {TkpConfigureMenuEntry - Alt} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Alt+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.11 {TkpConfigureMenuEntry - Meta} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.5 {ReconfigureIndividualMenu - disabled} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1 -postcommand "destroy .m1"
+ list [catch {.m1 post 40 40} msg] $msg
+} {0 {}}
+test macMenu-16.2 {TkpPostMenu} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label test} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-17.2 {TkpMenuNewEntry - idle pending} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""]
+} {0 {} {}}
+test macMenu-18.5 {DrawMenuBarWhenIdle - menu there} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ . configure -menu ""
+ raise .
+ list [catch {update} msg] $msg
+} {0 {}}
+
+test macMenu-21.1 {TkpSetMainMenubar - not front window} {macOnly} {
+ 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} {macOnly} {
+ . configure -menu ""
+ raise .
+ list [catch {update} msg] $msg
+} {0 {}}
+test macMenu-21.3 {TkpSetMainMenubar - different interps} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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
+ tk::TearOffMenu .t2.m1.foo 100 100
+ list [catch {update} msg] $msg [destroy .t2]
+} {0 {} {}}
+
+test macMenu-22.1 {TkSetWindowMenuBar} {macOnly} {
+} {}
+
+test macMenu-23.1 {TkMacDispatchMenuEvent} {macOnly} {
+ # needs to be interactive.
+} {}
+
+test macMenu-24.1 {GetMenuIndicatorGeometry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test macMenu-25.1 {GetMenuAccelGeometry - cascade entry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.2 {GetMenuAccelGeometry - no accel} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.3 {GetMenuAccelGeometry - no special chars - arbitrary string} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -accel "Test"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.4 {GetMenuAccelGeometry - Command} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+S"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.5 {GetMenuAccelGeometry - Control} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+S"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.6 {GetMenuAccelGeometry - Shift} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Shift+S"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.7 {GetMenuAccelGeometry - Option} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Opt+S"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.8 {GetMenuAccelGeometry - Combination} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+Shift+S"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.9 {GetMenuAccelGeometry - extra text} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Command+Delete"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test macMenu-26.1 {GetTearoffEntryGeometry} {macOnly} {
+ # can't call this on power mac.
+} {}
+
+test macMenu-27.1 {GetMenuSeparatorGeometry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test macMenu-28.1 {DrawMenuEntryIndicator - non-checkbutton} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -indicatoron 0
+ .m1 invoke foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.3 {DrawMenuEntryIndicator - not selected} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ .m1 invoke foo
+ set tearoff [tk::TearOffMenu .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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+S"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+# Cannot reproduce resources missing
+test macMenu-30.1 {DrawMenuEntryAccelerator - cascade entry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.2 {DrawMenuEntryAccelerator - no accel string} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.3 {DrawMenuEntryAccelerator - random accel string} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.4 {DrawMenuEntryAccelerator - Command} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+S"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.5 {DrawMenuEntryAccelerator - Option} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Opt+S"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.6 {DrawMenuEntryAccelerator - Shift} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Shift+S"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.7 {DrawMenuEntryAccelerator - Control} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+S"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.8 {DrawMenuEntryAccelerator - combination} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+Shift+S"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-31.1 {DrawMenuSeparator} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-32.1 {TkpDrawMenuEntryLabel} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activeforeground red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.3 {TkpDrawMenuEntry - gc for active and strict motif} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ set tk_strictMotif 1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground blue
+ .m1 add command -label foo -state disabled -background red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {macOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground blue
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {macOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground ""
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.7 {TkpDrawMenuEntry - gc for normal - custom entry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -foreground red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.8 {TkpDrawMenuEntry - gc for normal} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -selectcolor orange
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.10 {TkpDrawMenuEntry - gc for indicator} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.11 {TkpDrawMenuEntry - border - custom entry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activebackground green
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.12 {TkpDrawMenuEntry - border} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.13 {TkpDrawMenuEntry - active border - strict motif} {macOnly} {
+ catch {destroy .m1}
+ set tk_strictMotif 1
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activeforeground yellow
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.15 {TkpDrawMenuEntry - active border} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.16 {TkpDrawMenuEntry - font - custom entry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -font "Helvectica 72"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.17 {TkpDrawMenuEntry - font} {macOnly} {
+ catch {destroy .m1}
+ menu .m1 -font "Courier 72"
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.18 {TkpDrawMenuEntry - separator} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.19 {TkpDrawMenuEntry - standard} {macOnly} {
+ catch {destroy .mb}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.20 {TkpDrawMenuEntry - disabled cascade item} {macOnly} {
+ 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 [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.21 {TkpDrawMenuEntry - indicator} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label macMenu-40.20
+ .m1 invoke 0
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label macMenu-40.21 -hidemargin 1
+ .m1 invoke 0
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test macMenu-41.1 {TkpComputeStandardMenuGeometry - no entries} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.2 {TkpComputeStandardMenuGeometry - one entry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.3 {TkpComputeStandardMenuGeometry - more than one entry} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.5 {TkpComputeStandardMenuGeometry - standard label geometry} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.6 {TkpComputeStandardMenuGeometry - different font for entry} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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 } {macOnly testImageType} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.16 {TkpComputeStandardMenuGeometry - first column bigger} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ set tearoff [tk::TearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testImageType} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ image create test image1
+ menu .m1
+ .m1 add command -image image1
+ set tearoff [tk::TearOffMenu .m1]
+ list [update idletasks] [destroy .m1] [image delete image1]
+} {{} {} {}}
+test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {macOnly testImageType} {
+ 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 [tk::TearOffMenu .m1]
+ list [update idletasks] [destroy .m1] [eval image delete [image names]]
+} {{} {} {}}
+test macMenu-42.4 {DrawMenuEntryLabel - drawing a bitmap} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -bitmap questhead
+ set tearoff [tk::TearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.5 {DrawMenuEntryLabel - drawing null label} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ set tearoff [tk::TearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.6 {DrawMenuEntryLabel - drawing real label} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a long label" -underline 3
+ set tearoff [tk::TearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} {macOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground ""
+ .m1 add command -label "This is a long label" -state disabled
+ set tearoff [tk::TearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testImageType} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ image create test image1
+ menu .m1
+ .m1 add command -image image1 -state disabled
+ set tearoff [tk::TearOffMenu .m1 100 100]
+ list [update idletasks] [destroy .m1] [image delete image1]
+} {{} {} {}}
+
+test macMenu-43.1 {GetMenuLabelGeometry - image} {macOnly testImageType} {
+ 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} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -bitmap questhead
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-43.3 {GetMenuLabelGeometry - no text} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-43.4 {GetMenuLabelGeometry - text} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a test."
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+
+test macMenu-44.1 {DrawMenuEntryBackground} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-44.2 {DrawMenuEntryBackground} {macOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ $tearoff activate 0
+ list [update] [destroy .m1]
+} {{} {}}
+
+test macMenu-45.1 {TkpMenuInit - called at boot time} {macOnly} {
+} {}
+
+# cleanup
+deleteWindows
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/macWinMenu.test b/tcl/tests/macWinMenu.test
new file mode 100644
index 00000000000..23919b3b7a8
--- /dev/null
+++ b/tcl/tests/macWinMenu.test
@@ -0,0 +1,105 @@
+# This file is a Tcl script to test menus in Tk. It is
+# organized in the standard fashion for Tcl tests. It tests
+# the common implementation of Macintosh and Windows menus.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test macWinMenu-1.1 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
+ catch {destroy .m1}
+ menu .m1 -postcommand "destroy .m1"
+ .m1 add command -label "macWinMenu-1.1: Hit Escape"
+ list [catch {.m1 post 40 40} msg] $msg
+} {0 {}}
+test macWinMenu-1.2 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ set foo1 foo
+ set foo2 foo
+ menu .m1 -postcommand "set foo1 .m1"
+ .m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape"
+ menu .m2 -postcommand "set foo2 .m2"
+ update idletasks
+ list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] \
+ [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}]
+} {0 .m2 .m1 .m2 {} 0 0}
+
+test macWinMenu-1.3 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
+ catch {destroy .l1}
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ label .l1 -text "Preparing menus..."
+ pack .l1
+ update idletasks
+ menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
+ menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
+ menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
+ .m1 add cascade -menu .m2 -label "macWinMenu-1.3: Hit Escape (.m2)"
+ .m1 add cascade -menu .m3 -label ".m3"
+ update idletasks
+ list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3]
+} {0 {} {}}
+test macWinMenu-1.4 {PreprocessMenu} {macOrPc} {
+ catch {destroy .l1}
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ label .l1 -text "Preparing menus..."
+ pack .l1
+ update idletasks
+ menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
+ .m1 add cascade -menu .m2 -label "macWinMenu-1.4: Hit Escape (.m2)"
+ .m1 add cascade -menu .m3 -label ".m3"
+ menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
+ .m2 add cascade -menu .m4 -label ".m4"
+ menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
+ menu .m4 -postcommand ".l1 configure -text \"Destroying .m4...\"; update idletasks; destroy .m4"
+ update idletasks
+ list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3 .m4]
+} {0 {} {}}
+test macWinMenu-1.5 {PreprocessMenu} {macOrPc} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -menu .m2 -label "You may need to hit Escape to get this menu to go away."
+ menu .m2 -postcommand glorp
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1 .m2]
+} {1 {invalid command name "glorp"} {}}
+
+test macWinMenu-2.1 {TkPreprocessMenu} {macOrPc nonUnixUserInteraction} {
+ catch {destroy .m1}
+ set foo test
+ menu .m1 -postcommand "set foo 2.1"
+ .m1 add command -label "macWinMenu-2.1: Hit Escape"
+ list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo]
+} {0 2.1 2.1 {} {}}
+
+# cleanup
+deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/macscrollbar.test b/tcl/tests/macscrollbar.test
new file mode 100644
index 00000000000..9c0006ae008
--- /dev/null
+++ b/tcl/tests/macscrollbar.test
@@ -0,0 +1,95 @@
+# This file is a Tcl script to test out scrollbar widgets and
+# the "scrollbar" command of Tk. This file only tests Macintosh
+# specific features. It is organized in the standard fashion for
+# Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+update
+
+# Tests for display and layout
+wm geometry . 50x300
+scrollbar .s
+pack .s -fill y -expand 1
+update
+test macscroll-1.1 {TkpDisplayScrollbar procedure} {macOnly} {
+ list [.s configure -width] [.s configure -bd]
+} {{-width width Width 16 16} {-borderwidth borderWidth BorderWidth 0 0}}
+test macscroll-1.2 {TkpDisplayScrollbar procedure} {macOnly} {
+ # 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ 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} {macOnly} {
+ # 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} {macOnly} {
+ 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
+} {}
+
+deleteWindows
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/main.test b/tcl/tests/main.test
index 1c8799967cb..dc828b2c18c 100644
--- a/tcl/tests/main.test
+++ b/tcl/tests/main.test
@@ -1,1181 +1,52 @@
-# This file contains a collection of tests for generic/tclMain.c.
+# This file contains tests for the tkMain.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[catch {package require tcltest 2.0.2}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
- return
-}
-
-namespace eval ::tcl::test::main {
-
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::interpreter
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::temporaryDirectory
- namespace import ::tcltest::workingDirectory
-
- # Is [exec] defined?
- testConstraint exec [llength [info commands exec]]
-
- # Is the Tcltest package loaded?
- # - that is, the special C-coded testing commands in tclTest.c
- # - tests use testing commands introduced in Tcltest 8.4
- testConstraint Tcltest [expr {
- [llength [package provide Tcltest]]
- && [package vsatisfies [package provide Tcltest] 8.4]}]
-
- # Procedure to simulate interactive typing of commands, line by line
- proc type {chan script} {
- foreach line [split $script \n] {
- if {[catch {
- puts $chan $line
- flush $chan
- }]} {
- return
- }
- # Grrr... Behavior depends on this value.
- after 1000
- }
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+test main-1.1 {StdinProc} {unix} {
+ set script [makeFile {
+ close stdin; exit
+ } script]
+ if {[catch {exec [interpreter] <$script} msg]} {
+ set error 1
+ } else {
+ set error 0
}
+ removeFile script
+ list $error $msg
+} {0 {}}
- cd [temporaryDirectory]
- # Tests Tcl_Main-1.*: variable initializations
-
- test Tcl_Main-1.1 {
- Tcl_Main: startup script - normal
- } -constraints {
- stdio
- } -setup {
- makeFile {puts [list $argv0 $argv $tcl_interactive]} script
- catch {set f [open "|[list [interpreter] script]" r]}
- } -body {
- read $f
- } -cleanup {
- close $f
- removeFile script
- } -result [list script {} 0]\n
-
- test Tcl_Main-1.2 {
- Tcl_Main: startup script - can't begin with '-'
- } -constraints {
- stdio
- } -setup {
- makeFile {puts [list $argv0 $argv $tcl_interactive]} -script
- catch {set f [open "|[list [interpreter] -script]" w+]}
- } -body {
- puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}
- flush $f
- read $f
- } -cleanup {
- close $f
- removeFile -script
- } -result [list [interpreter] -script 0]\n
-
- test Tcl_Main-1.3 {
- Tcl_Main: encoding of arguments: done by system encoding
- Note the shortcoming explained in Tcl Patch 491789
- } -constraints {
- stdio
- } -setup {
- makeFile {puts [list $argv0 $argv $tcl_interactive]} script
- catch {set f [open "|[list [interpreter] script \u00c0]" r]}
- } -body {
- read $f
- } -cleanup {
- close $f
- removeFile script
- } -result [list script [list [encoding convertfrom [encoding system] \
- [encoding convertto [encoding system] \u00c0]]] 0]\n
-
- test Tcl_Main-1.4 {
- Tcl_Main: encoding of arguments: done by system encoding
- Note the shortcoming explained in Tcl Patch 491789
- } -constraints {
- stdio
- } -setup {
- makeFile {puts [list $argv0 $argv $tcl_interactive]} script
- catch {set f [open "|[list [interpreter] script \u20ac]" r]}
- } -body {
- read $f
- } -cleanup {
- close $f
- removeFile script
- } -result [list script [list [encoding convertfrom [encoding system] \
- [encoding convertto [encoding system] \u20ac]]] 0]\n
-
- test Tcl_Main-1.5 {
- Tcl_Main: encoding of script name: system encoding loss
- Note the shortcoming explained in Tcl Patch 491789
- } -constraints {
- stdio
- } -setup {
- makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0
- catch {set f [open "|[list [interpreter] \u00c0]" r]}
- } -body {
- read $f
- } -cleanup {
- close $f
- removeFile \u00c0
- } -result [list [list [encoding convertfrom [encoding system] \
- [encoding convertto [encoding system] \u00c0]]] {} 0]\n
-
- test Tcl_Main-1.6 {
- Tcl_Main: encoding of script name: system encoding loss
- Note the shortcoming explained in Tcl Patch 491789
- } -constraints {
- stdio
- } -setup {
- makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
- catch {set f [open "|[list [interpreter] \u20ac]" r]}
- } -body {
- read $f
- } -cleanup {
- close $f
- removeFile \u20ac
- } -result [list [list [encoding convertfrom [encoding system] \
- [encoding convertto [encoding system] \u20ac]]] {} 0]\n
-
- # Tests Tcl_Main-2.*: application-initialization procedure
-
- test Tcl_Main-2.1 {
- Tcl_Main: appInitProc returns error
- } -constraints {
- exec Tcltest
- } -setup {
- makeFile {puts "In script"} script
- } -body {
- exec [interpreter] script -appinitprocerror >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result "application-specific initialization failed: \nIn script\n"
-
- test Tcl_Main-2.2 {
- Tcl_Main: appInitProc returns error
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {puts "In script"} -appinitprocerror >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "application-specific initialization failed: \nIn script\n"
-
- test Tcl_Main-2.3 {
- Tcl_Main: appInitProc deletes interp
- } -constraints {
- exec Tcltest
- } -setup {
- makeFile {puts "In script"} script
- } -body {
- exec [interpreter] script -appinitprocdeleteinterp >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result "application-specific initialization failed: \n"
-
- test Tcl_Main-2.4 {
- Tcl_Main: appInitProc deletes interp
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {puts "In script"} \
- -appinitprocdeleteinterp >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "application-specific initialization failed: \n"
-
- test Tcl_Main-2.5 {
- Tcl_Main: appInitProc closes stderr
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {puts "In script"} \
- -appinitprocclosestderr >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "In script\n"
-
- # Tests Tcl_Main-3.*: startup script evaluation
-
- test Tcl_Main-3.1 {
- Tcl_Main: startup script does not exist
- } -constraints {
- exec
- } -setup {
- catch {removeFile no-such-file}
- } -body {
- set code [catch {exec [interpreter] no-such-file >& result} result]
- set f [open result]
- list $code $result [read $f]
- } -cleanup {
- close $f
- file delete result
- } -match glob -result [list 1 {child process exited abnormally} \
- {couldn't read file "no-such-file":*}]
-
- test Tcl_Main-3.2 {
- Tcl_Main: startup script raises error
- } -constraints {
- exec
- } -setup {
- makeFile {error ERROR} script
- } -body {
- set code [catch {exec [interpreter] script >& result} result]
- set f [open result]
- list $code $result [read $f]
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -match glob -result [list 1 {child process exited abnormally} \
- "ERROR\n while executing*"]
-
- test Tcl_Main-3.3 {
- Tcl_Main: startup script closes stderr
- } -constraints {
- exec
- } -setup {
- makeFile {close stderr; error ERROR} script
- } -body {
- set code [catch {exec [interpreter] script >& result} result]
- set f [open result]
- list $code $result [read $f]
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result [list 1 {child process exited abnormally} {}]
-
- test Tcl_Main-3.4 {
- Tcl_Main: startup script holds incomplete script
- } -constraints {
- exec
- } -setup {
- makeFile "if 1 \{" script
- } -body {
- set code [catch {exec [interpreter] script >& result} result]
- set f [open result]
- list $code $result [read $f]
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -match glob -result [list 1 {child process exited abnormally}\
- "missing close-brace\n while executing*"]
-
- test Tcl_Main-3.5 {
- Tcl_Main: startup script sets main loop
- } -constraints {
- exec Tcltest
- } -setup {
- makeFile {
- rename exit _exit
- proc exit {code} {
- puts "In exit"
- _exit $code
- }
- after 0 {
- puts event
- testexitmainloop
- }
- testexithandler create 0
- testsetmainloop
- } script
- } -body {
- exec [interpreter] script >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result "event\nExit MainLoop\nIn exit\neven 0\n"
-
- test Tcl_Main-3.6 {
- Tcl_Main: startup script sets main loop and closes stdin
- } -constraints {
- exec Tcltest
- } -setup {
- makeFile {
- close stdin
- testsetmainloop
- rename exit _exit
- proc exit {code} {
- puts "In exit"
- _exit $code
- }
- after 0 {
- puts event
- testexitmainloop
- }
- testexithandler create 0
- } script
- } -body {
- exec [interpreter] script >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result "event\nExit MainLoop\nIn exit\neven 0\n"
-
- test Tcl_Main-3.7 {
- Tcl_Main: startup script deletes interp
- } -constraints {
- exec Tcltest
- } -setup {
- makeFile {
- rename exit _exit
- proc exit {code} {
- puts "In exit"
- _exit $code
- }
- testexithandler create 0
- testinterpdelete {}
- } script
- } -body {
- exec [interpreter] script >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result "even 0\n"
-
- test Tcl_Main-3.8 {
- Tcl_Main: startup script deletes interp and sets mainloop
- } -constraints {
- exec Tcltest
- } -setup {
- makeFile {
- testsetmainloop
- rename exit _exit
- proc exit {code} {
- puts "In exit"
- _exit $code
- }
- testexitmainloop
- testexithandler create 0
- testinterpdelete {}
- } script
- } -body {
- exec [interpreter] script >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result "Exit MainLoop\neven 0\n"
-
- test Tcl_Main-3.9 {
- Tcl_Main: startup script can set tcl_interactive without limit
- } -constraints {
- exec
- } -setup {
- makeFile {set tcl_interactive foo} script
- } -body {
- exec [interpreter] script >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile script
- } -result {}
-
- # Tests Tcl_Main-4.*: rc file evaluation
-
- test Tcl_Main-4.1 {
- Tcl_Main: rcFile evaluation deletes interp
- } -constraints {
- exec Tcltest
- } -setup {
- set rc [makeFile {testinterpdelete {}} rc]
- } -body {
- exec [interpreter] << {puts "In script"} \
- -appinitprocsetrcfile $rc >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile rc
- } -result "application-specific initialization failed: \n"
-
- test Tcl_Main-4.2 {
- Tcl_Main: rcFile evaluation closes stdin
- } -constraints {
- exec Tcltest
- } -setup {
- set rc [makeFile {close stdin} rc]
- } -body {
- exec [interpreter] << {puts "In script"} \
- -appinitprocsetrcfile $rc >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile rc
- } -result "application-specific initialization failed: \n"
-
- test Tcl_Main-4.3 {
- Tcl_Main: rcFile evaluation closes stdin and sets main loop
- } -constraints {
- exec Tcltest
- } -setup {
- set rc [makeFile {
- close stdin
- testsetmainloop
- after 0 testexitmainloop
- testexithandler create 0
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- } rc]
- } -body {
- exec [interpreter] << {puts "In script"} \
- -appinitprocsetrcfile $rc >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile rc
- } -result "application-specific initialization failed:\
- \nExit MainLoop\nIn exit\neven 0\n"
-
- test Tcl_Main-4.4 {
- Tcl_Main: rcFile evaluation sets main loop
- } -constraints {
- exec Tcltest
- } -setup {
- set rc [makeFile {
- testsetmainloop
- after 0 testexitmainloop
- testexithandler create 0
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- } rc]
- } -body {
- exec [interpreter] << {puts "In script"} \
- -appinitprocsetrcfile $rc >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- removeFile rc
- } -result "application-specific initialization failed:\
- \nIn script\nExit MainLoop\nIn exit\neven 0\n"
-
- # Tests Tcl_Main-5.*: interactive operations
-
- test Tcl_Main-5.1 {
- Tcl_Main: tcl_interactive must be boolean
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {set tcl_interactive foo} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "can't set \"tcl_interactive\":\
- variable must have boolean value\n"
-
- test Tcl_Main-5.2 {
- Tcl_Main able to handle non-blocking stdin
- } -constraints {
- exec
- } -setup {
- catch {set f [open "|[list [interpreter]]" w+]}
- } -body {
- type $f {
- fconfigure stdin -blocking 0
- puts SUCCESS
- }
- list [catch {gets $f} line] $line
- } -cleanup {
- close $f
- } -result [list 0 SUCCESS]
-
- test Tcl_Main-5.3 {
- Tcl_Main handles stdin EOF in mid-command
- } -constraints {
- exec
- } -setup {
- catch {set f [open "|[list [interpreter]]" w+]}
- catch {fconfigure $f -blocking 0}
- } -body {
- type $f "fconfigure stdin -eofchar \\032
- if 1 \{\n\032"
- variable wait
- fileevent $f readable \
- [list set [namespace which -variable wait] "child exit"]
- set id [after 2000 [list set [namespace which -variable wait] timeout]]
- vwait [namespace which -variable wait]
- after cancel $id
- set wait
- } -cleanup {
- if {[string equal timeout $wait]
- && [string equal unix $::tcl_platform(platform)]} {
- exec kill [pid $f]
- }
- close $f
- } -result {child exit}
-
- test Tcl_Main-5.4 {
- Tcl_Main handles stdin EOF in mid-command
- } -constraints {
- exec
- } -setup {
- set cmd {makeFile "if 1 \{" script}
- catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}
- catch {fconfigure $f -blocking 0}
- } -body {
- variable wait
- fileevent $f readable \
- [list set [namespace which -variable wait] "child exit"]
- set id [after 2000 [list set [namespace which -variable wait] timeout]]
- vwait [namespace which -variable wait]
- after cancel $id
- set wait
- } -cleanup {
- if {[string equal timeout $wait]
- && [string equal unix $::tcl_platform(platform)]} {
- exec kill [pid $f]
- }
- close $f
- removeFile script
- } -result {child exit}
-
- test Tcl_Main-5.5 {
- Tcl_Main: error raised in interactive mode
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {error foo} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "foo\n"
-
- test Tcl_Main-5.6 {
- Tcl_Main: interactive mode: errors don't stop command loop
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- error foo
- puts bar
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "foo\nbar\n"
-
- test Tcl_Main-5.7 {
- Tcl_Main: interactive mode: closed stderr
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- close stderr
- error foo
- puts bar
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "bar\n"
-
- test Tcl_Main-5.8 {
- Tcl_Main: interactive mode: close stdin
- -> main loop & [exit] & exit handlers
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- testsetmainloop
- testexitmainloop
- testexithandler create 0
- close stdin
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\nIn exit\neven 0\n"
-
- test Tcl_Main-5.9 {
- Tcl_Main: interactive mode: delete interp
- -> main loop & exit handlers, but no [exit]
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- testsetmainloop
- testexitmainloop
- testexithandler create 0
- testinterpdelete {}
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\neven 0\n"
-
- test Tcl_Main-5.10 {
- Tcl_Main: exit main loop in mid-interactive command
- } -constraints {
- exec Tcltest
- } -setup {
- catch {set f [open "|[list [interpreter]]" w+]}
- catch {fconfigure $f -blocking 0}
- } -body {
- type $f "testsetmainloop
- after 2000 testexitmainloop
- puts \{1 2"
- after 4000
- type $f "3 4\}"
- set code1 [catch {gets $f} line1]
- set code2 [catch {gets $f} line2]
- set code3 [catch {gets $f} line3]
- list $code1 $line1 $code2 $line2 $code3 $line3
- } -cleanup {
- close $f
- } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]
-
- test Tcl_Main-5.11 {
- Tcl_Main: EOF in interactive main loop
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- testexithandler create 0
- after 0 testexitmainloop
- testsetmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\nIn exit\neven 0\n"
-
- test Tcl_Main-5.12 {
- Tcl_Main: close stdin in interactive main loop
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- testexithandler create 0
- after 100 testexitmainloop
- testsetmainloop
- close stdin
- puts "don't reach this"
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\nIn exit\neven 0\n"
-
- # Tests Tcl_Main-6.*: interactive operations with prompts
-
- test Tcl_Main-6.1 {
- Tcl_Main: enable prompts with tcl_interactive
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {set tcl_interactive 1} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% "
-
- test Tcl_Main-6.2 {
- Tcl_Main: prompt deletes interp
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- set tcl_prompt1 {testinterpdelete {}}
- set tcl_interactive 1
- puts "not reached"
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n"
-
- test Tcl_Main-6.3 {
- Tcl_Main: prompt closes stdin
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- set tcl_prompt1 {close stdin}
- set tcl_interactive 1
- puts "not reached"
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n"
-
- test Tcl_Main-6.4 {
- Tcl_Main: interactive output, closed stdout
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- set tcl_interactive 1
- close stdout
- set a NO
- puts stderr YES
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% YES\n"
-
- test Tcl_Main-6.5 {
- Tcl_Main: interactive entry to main loop
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- set tcl_interactive 1
- testsetmainloop
- testexitmainloop} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% % % Exit MainLoop\n"
-
- test Tcl_Main-6.6 {
- Tcl_Main: number of prompts during stdin close exit
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- set tcl_interactive 1
- close stdin} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% "
-
- # Tests Tcl_Main-7.*: exiting
-
- test Tcl_Main-7.1 {
- Tcl_Main: [exit] defined as no-op -> still have exithandlers
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- proc exit args {}
- testexithandler create 0
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "even 0\n"
-
- test Tcl_Main-7.2 {
- Tcl_Main: [exit] defined as no-op -> still have exithandlers
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- proc exit args {}
- testexithandler create 0
- after 0 testexitmainloop
- testsetmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\neven 0\n"
-
- # Tests Tcl_Main-8.*: StdinProc operations
-
- test Tcl_Main-8.1 {
- StdinProc: handles non-blocking stdin
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- fconfigure stdin -blocking 0
- testexitmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\n"
-
- test Tcl_Main-8.2 {
- StdinProc: handles stdin EOF
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- testexithandler create 0
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- after 100 testexitmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\nIn exit\neven 0\n"
-
- test Tcl_Main-8.3 {
- StdinProc: handles interactive stdin EOF
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- testexithandler create 0
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- set tcl_interactive 1} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% even 0\n"
-
- test Tcl_Main-8.4 {
- StdinProc: handles stdin close
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- after 100 testexitmainloop
- after 0 puts 1
- close stdin
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\nExit MainLoop\nIn exit\n"
-
- test Tcl_Main-8.5 {
- StdinProc: handles interactive stdin close
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- set tcl_interactive 1
- rename exit _exit
- proc exit code {
- puts "In exit"
- _exit $code
- }
- after 100 testexitmainloop
- after 0 puts 1
- close stdin
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"
-
- test Tcl_Main-8.6 {
- StdinProc: handles event loop re-entry
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- after 100 {puts 1; set delay 1}
- vwait delay
- puts 2
- testexitmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n2\nExit MainLoop\n"
-
- test Tcl_Main-8.7 {
- StdinProc: handling of errors
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- error foo
- testexitmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "foo\nExit MainLoop\n"
+# cleanup
+::tcltest::cleanupTests
+return
- test Tcl_Main-8.8 {
- StdinProc: handling of errors, closed stderr
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- close stderr
- error foo
- testexitmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "Exit MainLoop\n"
- test Tcl_Main-8.9 {
- StdinProc: interactive output
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- set tcl_interactive 1
- testexitmainloop} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% % Exit MainLoop\n"
- test Tcl_Main-8.10 {
- StdinProc: interactive output, closed stdout
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- close stdout
- set tcl_interactive 1
- testexitmainloop
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result {}
- test Tcl_Main-8.11 {
- StdinProc: prompt deletes interp
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- set tcl_prompt1 {testinterpdelete {}}
- set tcl_interactive 1} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n"
- test Tcl_Main-8.12 {
- StdinProc: prompt closes stdin
- } -constraints {
- exec Tcltest
- } -body {
- exec [interpreter] << {
- testsetmainloop
- set tcl_prompt1 {close stdin}
- after 100 testexitmainloop
- set tcl_interactive 1
- puts "not reached"
- } >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\nExit MainLoop\n"
- # Tests Tcl_Main-9.*: Prompt operations
- test Tcl_Main-9.1 {
- Prompt: custom prompt variables
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- set tcl_prompt1 {puts -nonewline stdout "one "}
- set tcl_prompt2 {puts -nonewline stdout "two "}
- set tcl_interactive 1
- puts {This is
- a test}} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\none two This is\n\t\ta test\none "
- test Tcl_Main-9.2 {
- Prompt: error in custom prompt variables
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- set tcl_prompt1 {error foo}
- set tcl_interactive 1
- set errorInfo} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\nfoo\n% foo\n while executing\n\"error foo\"\n (script\
- that generates prompt)\nfoo\n% "
- test Tcl_Main-9.3 {
- Prompt: error in custom prompt variables, closed stderr
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- set tcl_prompt1 {close stderr; error foo}
- set tcl_interactive 1} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\n% "
- test Tcl_Main-9.4 {
- Prompt: error in custom prompt variables, closed stdout
- } -constraints {
- exec
- } -body {
- exec [interpreter] << {
- set tcl_prompt1 {close stdout; error foo}
- set tcl_interactive 1} >& result
- set f [open result]
- read $f
- } -cleanup {
- close $f
- file delete result
- } -result "1\nfoo\n"
- cd [workingDirectory]
- cleanupTests
-}
-namespace delete ::tcl::test::main
-return
diff --git a/tcl/tests/menu.test b/tcl/tests/menu.test
new file mode 100644
index 00000000000..6d5aa8b2bb4
--- /dev/null
+++ b/tcl/tests/menu.test
@@ -0,0 +1,2492 @@
+# This file is a Tcl script to test menus in Tk. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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 configTest {
+ {-activebackground #012345 #012345 non-existent
+ {unknown color name "non-existent"}}
+ {-activeborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
+ {-activeforeground #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-bg #110022 #110022 bogus {unknown color name "bogus"}}
+ {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
+ {-fg #110022 #110022 bogus {unknown color name "bogus"}}
+ {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
+ -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
+ {font "" doesn't exist}}
+ {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-postcommand "any old string" "any old string" {} {}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
+ {-takefocus "any string" "any string" {} {}}
+ {-tearoff 0 0}
+ {-tearoff 1 1}
+ {-tearoffcommand "any old string" "any old string" {} {}}
+} {
+ set name [lindex $configTest 0]
+ set value [lindex $configTest 1]
+ set result [lindex $configTest 2]
+ test menu-2.$i [list configuration options $name $value $result] {
+ .m1 configure $name $value
+ lindex [.m1 configure $name] 4
+ } $result
+ incr i
+ if {[lindex $configTest 3] != ""} {
+ set value [lindex $configTest 3]
+ set result [lindex $configTest 4]
+ test menu-2.$i [list configuration options $name $value $result] {
+ list [catch {.m1 configure $name $value} msg] $msg
+ } [list 1 $result]
+ }
+ .m1 configure $name [lindex [.m1 configure $name] 3]
+ incr i
+}
+destroy .m1
+
+# We need to test all of the options with all of the different types of
+# 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 configTest {
+ {-activebackground
+ {{#012345
+ {{unknown option "-activebackground"} #012345 #012345
+ {unknown option "-activebackground"} #012345 #012345
+ }
+ }
+ {non-existent
+ {{unknown option "-activebackground"}
+ {unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ {unknown option "-activebackground"}
+ {unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ }
+ }}
+ }
+ {-activeforeground
+ {{#ff0000
+ {{unknown option "-activeforeground"}
+ #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
+ }
+ }
+ {non-existent
+ {{unknown option "-activeforeground"}
+ {unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ {unknown option "-activeforeground"}
+ {unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ }
+ }}
+ }
+ {-accelerator
+ {{"Ctrl+S"
+ {{unknown option "-accelerator"}
+ "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"}
+ "Ctrl+S" "Ctrl+S"
+ }
+ }}
+ }
+ {-background
+ {{#ff0000
+ {#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 $configTest 0]
+ foreach attempt [lindex $configTest 1] {
+ set value [lindex $attempt 0]
+ set options [lindex $attempt 1]
+ foreach item {0 1 2 3 4 5} {
+ catch {unset msg}
+ test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] {
+ set result [catch {.m1 entryconfigure $item $name $value} msg]
+ if {$result == 1} {
+ set msg
+ } else {
+ lindex [.m1 entryconfigure $item $name] 4
+ }
+ } [lindex $options $item]
+ 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} {nonUnixUserInteraction } {
+ catch {destroy .m1}
+ menu .m1 -postcommand "destroy .m1"
+ .m1 add command -label "menu-3.2: Hit Escape"
+ list [catch {.m1 post 40 40} msg] $msg
+} {0 {}}
+test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 activate} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 activate index"} {}}
+test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.5 {MenuWidgetCmd procedure, "activate" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add separator
+ list [catch {.m1 activate 2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.6 {MenuWidgetCmd procedure, "activate" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 entryconfigure 1 -state disabled
+ list [catch {.m1 activate 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 activate 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
+ catch {destroy .m1}
+ 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 15 {}}
+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} {nonUnixUserInteraction } {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 postcascade} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 postcascade index"} {}}
+test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add command -label "menu-3.56 - hit Escape"
+ menu .m2
+ .m1 post 40 40
+ .m1 add cascade -menu .m2
+ 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} {nonUnixUserInteraction } {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "menu-3.68 - hit Escape"
+ .m1 post 40 40
+ list [catch {.m1 unpost} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} {
+ 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-3.68 {MenuWidgetCmd procedure, fix for bug#508988} {
+ set t .t
+ set m1 .t.m1
+ set c1 .t.c1
+ set c2 .t.c2
+ toplevel .t
+ menu $m1 -tearoff 1
+ menu $c1 -tearoff 1
+ $c1 add command -label c1
+ menu $c2 -tearoff 1
+ $c2 add command -label c2
+ $m1 add cascade -label c1 -menu $c1
+ $t configure -menu $m1
+ $m1 entryconfigure 1 -menu $c2 -label c2
+ $t configure -menu ""
+ set l [list [winfo exists $c1] [winfo exists $c2]]
+ destroy $t;
+ set l;
+} {1 1}
+
+test menu-4.1 {TkInvokeMenu: disabled} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \
+ -state disabled
+ list [catch {.m1 invoke 1} msg] [destroy .m1] $foo
+} {0 {} off}
+test menu-4.2 {TkInvokeMenu: tearoff} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 invoke 0} msg] [destroy .m1]
+} {0 {}}
+test menu-4.3 {TkInvokeMenu: checkbutton -on} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
+ list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 on 0 {} {}}
+test menu-4.4 {TkInvokeMenu: checkbutton -off} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
+ .m1 invoke 1
+ list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 off 0 {} {}}
+test menu-4.5 {TkInvokeMenu: checkbutton array element} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -label "test" -variable foo(1) -onvalue on
+ list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 on 0 {} {}}
+test menu-4.6 {TkInvokeMenu: radiobutton} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add radiobutton -label "1" -variable foo -value one
+ .m1 add radiobutton -label "2" -variable foo -value two
+ .m1 add radiobutton -label "3" -variable foo -value three
+ list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 one 0 {} {}}
+test menu-4.7 {TkInvokeMenu: radiobutton} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add radiobutton -label "1" -variable foo -value one
+ .m1 add radiobutton -label "2" -variable foo -value two
+ .m1 add radiobutton -label "3" -variable foo -value three
+ list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 two 0 {} {}}
+test menu-4.8 {TkInvokeMenu: radiobutton} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add radiobutton -label "1" -variable foo -value one
+ .m1 add radiobutton -label "2" -variable foo -value two
+ .m1 add radiobutton -label "3" -variable foo -value three
+ list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 three 0 {} {}}
+test menu-4.9 {TkInvokeMenu: radiobutton array element} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add radiobutton -label "1" -variable foo(2) -value one
+ .m1 add radiobutton -label "2" -variable foo(2) -value two
+ .m1 add radiobutton -label "3" -variable foo(2) -value three
+ list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 three 0 {} {}}
+test menu-4.10 {TkInvokeMenu} {
+ catch {destroy .m1}
+ catch {unset menu_test}
+ menu .m1
+ .m1 add command -label "test" -command "set menu_test menu-4.8"
+ list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
+} {0 menu-4.8 0 menu-4.8 0 {} {}}
+test menu-4.11 {TkInvokeMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label "test" -menu .m1.m2
+ list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-4.12 {TkInvokeMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test" -command ".m1 delete 1"
+ list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1]
+} {0 {} 1 {bad menu entry index "test"} {}}
+
+test menu-5.1 {DestroyMenuInstance} {
+ 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 [tk::TearOffMenu .m1]
+ list [catch {destroy $tearoff} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-5.8 {DestroyMenuInstance - multiple clones} {
+ catch {destroy .m1}
+ menu .m1
+ set tearoff1 [tk::TearOffMenu .m1]
+ set tearoff2 [tk::TearOffMenu .m1]
+ list [catch {destroy $tearoff1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-5.9 {DestroyMenuInstace - master menu} {
+ catch {destroy .m1}
+ menu .m1
+ tk::TearOffMenu .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 [tk::TearOffMenu .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} testImageType {
+ 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 {PostProcessEntry: array variable} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ set foo(1) on
+ .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
+ list [catch {set foo(1)} msg] $msg [destroy .m1]
+} {0 on {}}
+test menu-10.2 {PostProcessEntry: array variable} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
+ list [catch {set foo(1)} msg] $msg [destroy .m1]
+} {0 off {}}
+
+test menu-11.1 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
+ list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
+} {0 {} bar {}}
+test menu-11.2 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
+} {0 {} {} {}}
+test menu-11.3 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
+} {0 {} test {}}
+test menu-11.4 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
+} {0 {} S {}}
+test menu-11.5 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
+} {0 {} test {}}
+test menu-11.6 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-11.7 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m2
+ menu .m1
+ .m1 add cascade
+ list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test menu-11.8 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade
+ list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-11.9 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m3
+ list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-11.10 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade
+ list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-11.11 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-11.12 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ catch {destroy .m5}
+ menu .m1
+ menu .m2
+ .m2 add cascade -menu .m1
+ menu .m3
+ .m3 add cascade -menu .m1
+ menu .m4
+ .m4 add cascade -menu .m1
+ menu .m5
+ .m5 add cascade
+ list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
+} {0 {} {}}
+test menu-11.13 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ menu .m1
+ menu .m2
+ .m2 add cascade -menu .m1
+ menu .m3
+ .m3 add cascade -menu .m1
+ menu .m4
+ .m4 add cascade -menu .m1
+ list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
+} {0 {} {}}
+test menu-11.14 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton
+ list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
+} {0 {} test {}}
+test menu-11.15 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
+} {0 {} test {}}
+test menu-11.16 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-11.17 {ConfigureMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton
+ list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
+} {0 {} test {}}
+test menu-11.18 {ConfigureMenuEntry} testImageType {
+ catch {destroy .m1}
+ catch {image delete image1}
+ menu .m1
+ .m1 add command
+ image create test image1
+ list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
+} {0 {} {} {}}
+test menu-11.19 {ConfigureMenuEntry} testImageType {
+ catch {destroy .m1}
+ catch {image delete image1}
+ catch {image delete image2}
+ image create test image1
+ image create photo image2 -file [file join $tk_library demos images earth.gif]
+ menu .m1
+ .m1 add command -image image1
+ list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
+} {0 {} {} {} {}}
+test menu-11.20 {ConfigureMenuEntry} testImageType {
+ catch {destroy .m1}
+ catch {image delete image1}
+ catch {image delete image2}
+ image create photo image1 -file [file join $tk_library demos images earth.gif]
+ image create test image2
+ menu .m1
+ .m1 add checkbutton -image image1
+ list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
+} {0 {} {} {} {}}
+test menu-11.21 {ConfigureMenuEntry} testImageType {
+ catch {destroy .m1}
+ catch {image delete image1}
+ catch {image delete image2}
+ catch {image delete image3}
+ image create photo image1 -file [file join $tk_library demos images earth.gif]
+ image create test image2
+ image create test image3
+ menu .m1
+ .m1 add checkbutton -image image1 -selectimage image2
+ list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
+} {0 {} {} {} {} {}}
+
+test menu-12.1 {ConfigureMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 clone .m2
+ .m2 configure -tearoff 0
+ .m1 clone .m3
+ .m1 add command -label "test"
+ .m1 add command -label "test2"
+ list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
+} {{1 {unknown option "-gork"}} {}}
+test menu-12.2 {ConfigureMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ menu .m1
+ .m1 clone .m2
+ menu .m3
+ .m1 add cascade -menu .m3
+ menu .m4
+ list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
+} {0 {} {} {} {}}
+test menu-12.3 {ConfigureMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 clone .m2
+ .m1 add cascade -label dummy
+ list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test menu-12.4 {ConfigureMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -label File -menu .m1.foo
+ menu .m1.foo
+ .m1.foo add command -label bar
+ .m1 clone .m2
+ list [catch {.m1 entryconfigure File -state disabled} msg1] $msg1 [destroy .m1]
+} {0 {} {}}
+
+test menu-13.1 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "active"
+ .m1 add command -label "test2"
+ .m1 add command -label "test3"
+ .m1 activate 2
+ list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
+} {0 test2 {}}
+test menu-13.2 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "last"
+ .m1 add command -label "test2"
+ .m1 add command -label "test3"
+ .m1 activate 2
+ list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
+} {0 test3 {}}
+test menu-13.3 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "last"
+ .m1 add command -label "test2"
+ .m1 add command -label "test3"
+ .m1 activate 2
+ list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
+} {0 test3 {}}
+test menu-13.4 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
+} {0 {} test2 {}}
+test menu-13.5 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
+} {0 {} test2 {}}
+test menu-13.6 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "active"
+ .m1 add command -label "test2"
+ .m1 add command -label "test3"
+ .m1 activate 2
+ list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
+} {0 {} {}}
+#test menu-13.7 - Need to add @test here.
+test menu-13.7 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "active"
+ .m1 add command -label "test2"
+ .m1 add command -label "test3"
+ list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
+} {0 active {}}
+test menu-13.8 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "active"
+ list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "-1"} {}}
+test menu-13.9 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "test2"
+ list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
+} {0 test2 {}}
+test menu-13.10 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 insert 999 command -label "test"
+ list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
+} {0 test {}}
+test menu-13.11 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "1test"
+ list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
+} {0 1test {}}
+test menu-13.12 {TkGetMenuIndex} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "test2" -command "beep"
+ .m1 add command -label "test3"
+ list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
+} {0 beep {}}
+
+test menu-14.1 {MenuCmdDeletedProc} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-14.2 {MenuCmdDeletedProc} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 clone .m2
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+
+test menu-15.1 {MenuNewEntry} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-15.2 {MenuNewEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "test3"
+ list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-15.3 {MenuNewEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-15.4 {MenuNewEntry} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test menu-16.1 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-16.2 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-16.3 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "-1"} {}}
+test menu-16.4 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 insert 0 command -label "test2"
+ list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
+} {0 test2 {}}
+test menu-16.5 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add cascade} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-16.6 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-16.7 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-16.8 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-16.9 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add separator} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-16.10 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add blork} msg] $msg [destroy .m1]
+} {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
+test menu-16.11 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-16.12 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 clone .m2
+ .m2 clone .m3
+ list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
+} {0 {} 0 test 0 test {}}
+test menu-16.13 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 clone .m2
+ .m2 clone .m3
+ list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
+} {0 {} 0 test 0 test {}}
+test menu-16.14 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
+} {1 {unknown option "-blork"} {}}
+test menu-16.15 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ catch {destroy .container}
+ menu .m1
+ .m1 add command -label "File"
+ menu .container
+ . configure -menu .container
+ list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
+} {0 {} {} {}}
+test menu-16.16 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ set tearoff [tk::TearOffMenu .m2]
+ list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
+} {0 {} {} 0 {} 0 {}}
+test menu-16.17 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ catch {destroy .container}
+ menu .m1
+ menu .container
+ . configure -menu .container
+ set tearoff [tk::TearOffMenu .container]
+ list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
+} {0 {} {} {}}
+test menu-16.18 {MenuAddOrInsert} {
+ catch {destroy .m1}
+ catch {destroy .container}
+ menu .m1
+ menu .container
+ .container add cascade -menu .m1
+ . configure -menu .container
+ list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
+} {0 {} {} {}}
+test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
+ catch {destroy .menubar}
+ menu .menubar
+ menu .menubar.test -tearoff 0
+ .menubar add cascade -label Test -underline 0 -menu .menubar.test
+ menu .menubar.test.cascade -tearoff 0
+ .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
+ . configure -menu .menubar
+ list [catch {.menubar.test add cascade -label SubMenu \
+ -menu .menubar.test.cascade} msg] \
+ [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \
+ [. configure -menu ""] [destroy .menubar]
+} {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
+
+test menu-17.1 {MenuVarProc} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ set foo "hello"
+ list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
+} {0 {} 0 {} {}}
+# menu-17.2 - Don't know how to generate the flags in the if
+test menu-17.2 {MenuVarProc} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
+} {0 {} {} {}}
+test menu-17.3 {MenuVarProc} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ set foo "hello"
+ list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
+} {0 {} hello {} 0 {}}
+test menu-17.4 {MenuVarProc} {
+ catch {destroy .m1}
+ menu .m1
+ set foo "goodbye"
+ list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
+} {0 {} hello {} 0 {}}
+test menu-17.5 {MenuVarProc} {
+ catch {destroy .m1}
+ menu .m1
+ set foo "hello"
+ list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
+} {0 {} goodbye {} 0 {}}
+
+test menu-18.1 {TkActivateMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 activate 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-18.2 {TkActivateMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 activate 0} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-18.3 {TkActivateMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "test2"
+ .m1 activate 1
+ list [catch {.m1 activate 2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-18.4 {TkActivateMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "test2"
+ .m1 activate 1
+ list [catch {.m1 activate 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } {
+ catch {destroy .m1}
+ menu .m1 -postcommand "set menu_test menu-19.1"
+ .m1 add command -label "menu-19.1 - hit Escape"
+ list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
+} {0 menu-19.1 {} menu-19.1 {}}
+test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "menu-19.2 - hit Escape"
+ list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
+} {0 {} {} {}}
+
+test menu-20.1 {CloneMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
+} {0 {} {}}
+test menu-20.2 {CloneMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
+} {0 {} {}}
+test menu-20.3 {CloneMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
+} {0 {} {}}
+test menu-20.4 {CloneMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
+} {0 {} {}}
+test menu-20.5 {CloneMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
+} {1 {bad menu type "foo": must be normal, tearoff, or menubar} {}}
+test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
+ } {0 {} {}}
+ test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 clone .m2
+ list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
+ } {0 {} {}}
+ test menu-20.8 {CloneMenu - cascade entries} {
+ catch {destroy .m1}
+ catch {destroy .foo}
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
+ } {0 {} {}}
+ test menu-20.9 {CloneMenu - cascades entries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .foo}
+ menu .m1
+ .m1 add cascade -menu .m2
+ menu .m2
+ list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
+ } {0 {} {}}
+test menu-20.10 {CloneMenu - tearoff fields} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
+} {0 {} 0 1 {}}
+test menu-20.11 {CloneMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
+} {1 {window name "m2" already exists in parent} {}}
+
+test menu-21.1 {MenuDoYPosition} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "glorp"} {}}
+test menu-21.2 {MenuDoYPosition} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "Test"
+ list [catch {.m1 yposition 1}] [destroy .m1]
+} {0 {}}
+
+test menu-22.1 {GetIndexFromCoords} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 configure -tearoff 0
+ list [catch {.m1 index @5} msg] $msg [destroy .m1]
+} {0 0 {}}
+test menu-22.2 {GetIndexFromCoords} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 configure -tearoff 0
+ list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
+} {0 0 {}}
+
+test menu-23.1 {RecursivelyDeleteMenu} {
+ catch {destroy .m1}
+ menu .m1
+ . configure -menu .m1
+ list [catch {. configure -menu ""} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-23.2 {RecursivelyDeleteMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m2
+ .m2 add command -label "test2"
+ menu .m1
+ .m1 add cascade -label "test1" -menu .m2
+ . configure -menu .m1
+ list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+
+test menu-24.1 {TkNewMenuName} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test menu-24.2 {TkNewMenuName} {
+ catch {destroy .m1}
+ catch {destroy .m1\#0}
+ menu .m1
+ menu .m1\#0
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test menu-24.3 {TkNewMenuName} {
+ catch {destroy .#m}
+ menu .#m
+ rename .#m hideme
+ list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
+} {0 {} {} {} {}}
+
+test menu-25.1 {TkSetWindowMenuBar} {
+ . configure -menu ""
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
+} {0 {} {}}
+test menu-25.2 {TkSetWindowMenuBar} {
+ . configure -menu ""
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
+} {0 {} {}}
+test menu-25.3 {TkSetWindowMenuBar} {
+ . configure -menu ""
+ catch {destroy .m1}
+ menu .m1
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test menu-25.4 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ . configure -menu ""
+ menu .m1
+ . configure -menu .m1
+ menu .m2
+ list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
+} {0 {} {} {}}
+test menu-25.5 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ . configure -menu ""
+ menu .m1
+ . configure -menu .m1
+ .m1 clone .m2
+ menu .m3
+ list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
+} {0 {} {} {}}
+test menu-25.6 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ . configure -menu ""
+ menu .m1
+ .m1 clone .m2
+ . configure -menu .m2
+ menu .m3
+ list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
+} {0 {} {} {}}
+test menu-25.7 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ . configure -menu ""
+ menu .m1
+ menu .m2
+ . configure -menu .m1
+ toplevel .t2
+ .t2 configure -menu .m1
+ list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
+} {0 {} {} {}}
+test menu-25.8 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .t2}
+ . configure -menu ""
+ menu .m1
+ menu .m2
+ . configure -menu .m1
+ toplevel .t2
+ wm geometry .t2 +0+0
+ .t2 configure -menu .m1
+ list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
+} {0 {} {} {}}
+test menu-25.9 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .t2}
+ catch {destroy .t3}
+ . configure -menu ""
+ menu .m1
+ menu .m2
+ . configure -menu .m1
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
+} {0 {} {} {}}
+test menu-25.10 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .t2}
+ catch {destroy .t3}
+ . configure -menu ""
+ menu .m1
+ menu .m2
+ . configure -menu .m1
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
+} {0 {} {} {}}
+test menu-25.11 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .t2}
+ catch {destroy .t3}
+ . configure -menu ""
+ menu .m1
+ menu .m2
+ . configure -menu .m1
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
+} {0 {} {} {}}
+test menu-25.12 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test menu-25.13 {TkSetWindowMenuBar} {
+ . configure -menu ""
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
+} {0 {} {}}
+test menu-25.14 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test menu-25.15 {TkSetWindowMenuBar} {
+ . configure -menu ""
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
+} {0 {} {}}
+test menu-25.16 {TkSetWindowMenuBar} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ . configure -menu .m1
+ list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
+} {0 .t2 {} {}}
+
+test menu-26.1 {DestroyMenuHashTable} {
+ catch {interp destroy testinterp}
+ interp create testinterp
+ load {} Tk testinterp
+ interp eval testinterp {menu .m1}
+ list [catch {interp delete testinterp} msg] $msg
+} {0 {}}
+
+test menu-27.1 {GetMenuHashTable} {
+ catch {interp destroy testinterp}
+ interp create testinterp
+ load {} Tk testinterp
+ list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
+} {0 .m1 {}}
+
+test menu-28.1 {TkCreateMenuReferences - not there before} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test menu-28.2 {TkCreateMenuReferences - there already} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
+} {0 .m2 {}}
+
+test menu-29.1 {TkFindMenuReferences - not there} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test menu-30.1 {TkFindMenuReferences - there already} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ . configure -menu ""
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .m2
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
+} {0 {} {} {}}
+
+test menu-31.1 {TkFreeMenuReferences - menuPtr} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-31.2 {TkFreeMenuReferences - cascadePtr} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} {
+ . configure -menu .m1
+ list [catch {. configure -menu ""} msg] $msg
+} {0 {}}
+test menu-31.4 {TkFreeMenuReferences - not empty} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -menu .m3
+ menu .m2
+ .m2 add cascade -menu .m3
+ list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+
+test menu-32.1 {DeleteMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add command -label foo
+ .m1 clone .m2
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-32.2 {DeleteMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add command -label one
+ .m1 add command -label two
+ .m1 add command -label three
+ .m1 add command -label four
+ .m1 clone .m2
+ list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-32.3 {DeleteMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1 -tearoff 0
+ .m1 add command -label one
+ .m1 add command -label two
+ .m1 add command -label three
+ .m1 add command -label four
+ .m1 clone .m2
+ .m2 configure -tearoff 1
+ list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-32.4 {DeleteMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add command -label one
+ .m1 add command -label two
+ .m1 add command -label three
+ .m1 add command -label four
+ .m1 clone .m2
+ .m2 configure -tearoff 0
+ list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-32.5 {DeleteMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add command -label one
+ .m1 add command -label two
+ .m1 clone .m2
+ .m1 activate one
+ list [catch {.m1 delete one} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
+ list [catch {.m1 invoke test} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-32.7 {DeleteMenuCloneEntries - one entry} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello
+ list [catch {.m1 delete Hello} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-32.8 {Ensure all menu clone commands are deleted} {knownBug} {
+ # SF bug #465324
+ catch {destroy .menubar}
+ catch {destroy .menubar.test}
+ menu .menubar
+ . configure -menu .menubar
+ menu .menubar.test
+ .menubar.test add command -label "hi"
+ for {set i 0} {$i < 10} {incr i} {
+ .menubar add cascade -menu .menubar.test -label "Test"
+ .menubar delete Test
+ }
+
+ info commands .#menubar*test*
+} {}
+test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} {
+ catch {destroy .menubar}
+ catch {destroy .menubar.test}
+
+ menu .menubar
+ . configure -menu .menubar
+ menu .menubar.test
+ .menubar add cascade -menu .menubar.test -label "Test"
+ menu .menubar.cascade
+
+ .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
+ set res {}
+ lappend res [.menubar.test entrycget 1 -menu]
+ lappend res [.#menubar.#menubar#test entrycget 1 -menu]
+ destroy .menubar.test
+ menu .menubar.test
+ .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
+ lappend res [.menubar.test entrycget 1 -menu]
+ lappend res [.#menubar.#menubar#test entrycget 1 -menu]
+ set res
+} {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade}
+
+set l [interp hidden]
+deleteWindows
+
+test menu-33.1 {menu vs command hiding} {
+ catch {destroy .m}
+ menu .m
+ interp hide {} .m
+ destroy .m
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+# menu-34 MenuInit only called at boot time
+
+# creating menus on two different screens then deleting the
+# menu from the first screen crashes Tk8.3.1
+#
+test menu-35.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} \
+ {altDisplay} {
+ toplevel .one
+ menu .one.m
+ toplevel .two -screen $::env(TK_ALT_DISPLAY)
+ menu .two.m
+ destroy .one
+ destroy .two
+} {}
+
+# cleanup
+deleteWindows
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/menuDraw.test b/tcl/tests/menuDraw.test
new file mode 100644
index 00000000000..61e6afa9a4f
--- /dev/null
+++ b/tcl/tests/menuDraw.test
@@ -0,0 +1,537 @@
+# This file is a Tcl script to test drawing of menus in Tk. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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 "foo": must be active, normal, or disabled} {}}
+test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} {
+ catch {destroy .m1}
+ 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 [tk::TearOffMenu .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 [tk::TearOffMenu .m1]
+ list [.m1 entryconfigure 1 -label "foo"] [destroy .m1]
+} {{} {}}
+
+
+test menuDraw-8.1 {TkRecomputeMenu} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 configure -postcommand [.m1 add command -label foo]
+ .m1 add command -label "Hit ESCAPE to make this menu go away."
+ list [.m1 post 0 0] [destroy .m1]
+} {{} {}}
+
+
+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
+ tk::TearOffMenu .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 {tk::TearOffMenu .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} testImageType {
+ 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 [tk::TearOffMenu .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} testImageType {
+ 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 [tk::TearOffMenu .m1 40 40]
+ list [image delete image2] [destroy .m1] [eval image delete [image names]]
+} {{} {} {}}
+test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} testImageType {
+ 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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .m1 40 40]
+ set tearoff2 [tk::TearOffMenu .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 [tk::TearOffMenu .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
+ tk::TearOffMenu .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} testImageType {
+ 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} testImageType {
+ 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 {tk::TearOffMenu .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 [tk::TearOffMenu .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 {tk::TearOffMenu .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 {tk::TearOffMenu .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 {tk::TearOffMenu .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 {tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .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 [tk::TearOffMenu .m1 40 40]
+ list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2]
+} {1 {invalid command name "glorp"} {} {}}
+test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -label test -menu .m2
+ menu .m2
+ .m2 add command -label "Hit ESCAPE to get rid of this menu"
+ set tearoff [tk::TearOffMenu .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} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -label test -menu .m2
+ menu .m2
+ .m2 add command -label "Hit ESCAPE to make this menu go away"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
+} {{} {} {}}
+
+# cleanup
+deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/menubut.test b/tcl/tests/menubut.test
new file mode 100644
index 00000000000..d927bc18984
--- /dev/null
+++ b/tcl/tests/menubut.test
@@ -0,0 +1,359 @@
+# This file is a Tcl script to test menubuttons in Tk. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+# 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.
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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]
+if {[testConstraint testImageType]} {
+ 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 "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-bd 4 4 badValue {bad screen distance "badValue"}}
+ {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
+ {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
+ {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-direction below below badValue {bad direction "badValue": must be above, below, flush, left, or right}}
+ {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
+ {-fg #110022 #110022 bogus {unknown color name "bogus"}}
+ {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
+ {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-height 18 18 20.0 {expected integer but got "20.0"}}
+ {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
+ {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
+ {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
+ {-image image1 image1 bogus {image "bogus" doesn't exist}}
+ {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
+ {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
+ {-menu "any old string" "any old string" {} {}}
+ {-padx 12 12 420x {bad screen distance "420x"}}
+ {-pady 12 12 420x {bad screen distance "420x"}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal}}
+ {-takefocus "any string" "any string" {} {}}
+ {-text "Sample text" {Sample text} {} {}}
+ {-textvariable i i {} {}}
+ {-underline 5 5 3p {expected integer but got "3p"}}
+ {-width 402 402 3p {expected integer but got "3p"}}
+ {-wraplength 100 100 6x {bad screen distance "6x"}}
+} {
+ set name [lindex $test 0]
+ test menubutton-1.$i {configuration options} testImageType {
+ .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 {ambiguous option "c": must be cget or configure}}
+test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} {
+ list [catch {.mb cget} msg] $msg
+} {1 {wrong # args: should be ".mb cget option"}}
+test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} {
+ list [catch {.mb cget a b} msg] $msg
+} {1 {wrong # args: should be ".mb cget option"}}
+test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} {
+ 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]
+} {33}
+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} testImageType {
+ 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} {nonPortable 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 "badValue": must be above, below, flush, left, or right} below {}}
+
+# XXX Need to add tests for several procedures here. XXX
+
+test menubutton-5.1 {MenuButtonEventProc procedure} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ menubutton .mb1
+ rename .mb1 {}
+ list [info command .mb*] [winfo children .]
+} {{} {}}
+
+test menubutton-7.1 {ComputeMenuButtonGeometry procedure} testImageType {
+ 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} testImageType {
+ 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} testImageType {
+ 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} testImageType {
+ 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} testImageType {
+ 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} {nonPortable 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} {testImageType unixOnly nonPortable} {
+ # The following test is non-portable because the indicator's pixel
+ # size varies to maintain constant absolute size.
+
+ catch {destroy .mb}
+ menubutton .mb -image image1 -bd 2 -relief raised \
+ -highlightthickness 2 -indicatoron 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {64 23}
+test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {testImageType pcOnly nonPortable} {
+ # The following test is non-portable because the indicator's pixel
+ # size varies to maintain constant absolute size.
+
+ catch {destroy .mb}
+ menubutton .mb -image image1 -bd 2 -relief raised \
+ -highlightthickness 2 -indicatoron 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {65 23}
+
+set l [interp hidden]
+deleteWindows
+
+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]
+deleteWindows
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/message.test b/tcl/tests/message.test
new file mode 100644
index 00000000000..fa2a08621f2
--- /dev/null
+++ b/tcl/tests/message.test
@@ -0,0 +1,125 @@
+# This file is a Tcl script to test out the "message" command
+# of Tk. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+option add *Message.borderWidth 2
+option add *Message.highlightThickness 2
+option add *Message.font {Helvetica -12 bold}
+
+message .m
+pack .m
+update
+set i 0
+foreach test {
+ {-anchor w w bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
+ {-aspect 3 3 bogus {expected integer but got "bogus"}}
+ {-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"}}
+ {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
+ {-font fixed fixed {} {font "" doesn't exist}}
+ {-foreground green green badValue {unknown color name "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"}}
+ {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
+ {-padx 12m 12m 420x {bad screen distance "420x"}}
+ {-pady 12m 12m 420x {bad screen distance "420x"}}
+ {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-text "Sample text" {Sample text} {} {} {1 1 1 1}}
+ {-textvariable i i {} {} {1 1 1 1}}
+ {-width 32 32 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test message-1.$i {configuration options} {
+ .m configure $name [lindex $test 1]
+ lindex [.m configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test message-1.$i {configuration options} {
+ list [catch {.m configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .m configure $name [lindex [.m configure $name] 3]
+ incr i
+}
+destroy .m
+
+test message-2.1 {Tk_MessageObjCmd procedure} {
+ list [catch {message} msg] $msg
+} {1 {wrong # args: should be "message pathName ?options?"}}
+test message-2.2 {Tk_MessageObjCmd procedure} {
+ list [catch {message foo} msg] $msg [winfo child .]
+} {1 {bad window path name "foo"} {}}
+test message-2.3 {Tk_MessageObjCmd procedure} {
+ list [catch {message .s -gorp dumb} msg] $msg [winfo child .]
+} {1 {unknown option "-gorp"} {}}
+
+test message-3.1 {MessageWidgetObjCmd procedure} {
+ message .m
+ set result [list [catch {.m} msg] $msg]
+ destroy .m
+ set result
+} {1 {wrong # args: should be ".m option ?arg arg ...?"}}
+test message-3.2 {MessageWidgetObjCmd procedure, "cget"} {
+ message .m
+ set result [list [catch {.m cget} msg] $msg]
+ destroy .m
+ set result
+} {1 {wrong # args: should be ".m cget option"}}
+test message-3.3 {MessageWidgetObjCmd procedure, "cget"} {
+ message .m
+ set result [list [catch {.m cget -gorp} msg] $msg]
+ destroy .m
+ set result
+} {1 {unknown option "-gorp"}}
+test message-3.4 {MessageWidgetObjCmd procedure, "cget"} {
+ message .m
+ .m configure -text foobar
+ set result [.m cget -text]
+ destroy .m
+ set result
+} "foobar"
+test message-3.5 {MessageWidgetObjCmd procedure, "configure"} {
+ message .m
+ set result [llength [.m configure]]
+ destroy .m
+ set result
+} 21
+test message-3.6 {MessageWidgetObjCmd procedure, "configure"} {
+ message .m
+ set result [list [catch {.m configure -foo} msg] $msg]
+ destroy .m
+ set result
+} {1 {unknown option "-foo"}}
+test message-3.7 {MessageWidgetObjCmd procedure, "configure"} {
+ message .m
+ .m configure -bd 4
+ .m configure -bg #ffffff
+ set result [lindex [.m configure -bd] 4]
+ destroy .m
+ set result
+} {4}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/msgbox.test b/tcl/tests/msgbox.test
new file mode 100644
index 00000000000..4f7d6a15fd2
--- /dev/null
+++ b/tcl/tests/msgbox.test
@@ -0,0 +1,185 @@
+# This file is a Tcl script to test out Tk's "tk_messageBox" command.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+#
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test msgbox-1.1 {tk_messageBox command} {
+ list [catch {tk_messageBox -foo} msg] $msg
+} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}}
+test msgbox-1.2 {tk_messageBox command} {
+ list [catch {tk_messageBox -foo bar} msg] $msg
+} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}}
+
+catch {tk_messageBox -foo bar} msg
+regsub -all , $msg "" options
+regsub \"-foo\" $options "" options
+
+foreach option $options {
+ if {[string index $option 0] == "-"} {
+ test msgbox-1.3 {tk_messageBox command} {
+ list [catch {tk_messageBox $option} msg] $msg
+ } [list 1 "value for \"$option\" missing"]
+ }
+}
+
+test msgbox-1.4 {tk_messageBox command} {
+ list [catch {tk_messageBox -default} msg] $msg
+} {1 {value for "-default" missing}}
+
+test msgbox-1.5 {tk_messageBox command} {
+ list [catch {tk_messageBox -type foo} msg] $msg
+} {1 {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}}
+
+proc createPlatformMsg {val} {
+ global tcl_platform
+ if {$tcl_platform(platform) == "unix"} {
+ return "invalid default button \"$val\""
+ }
+ return "bad -default value \"$val\": must be abort, retry, ignore, ok, cancel, no, or yes"
+}
+
+test msgbox-1.6 {tk_messageBox command} {
+ list [catch {tk_messageBox -default 1.1} msg] $msg
+} [list 1 [createPlatformMsg "1.1"]]
+
+test msgbox-1.7 {tk_messageBox command} {
+ list [catch {tk_messageBox -default foo} msg] $msg
+} [list 1 [createPlatformMsg "foo"]]
+
+test msgbox-1.8 {tk_messageBox command} {
+ list [catch {tk_messageBox -type yesno -default 3} msg] $msg
+} [list 1 [createPlatformMsg "3"]]
+
+test msgbox-1.9 {tk_messageBox command} {
+ list [catch {tk_messageBox -icon foo} msg] $msg
+} {1 {bad -icon value "foo": must be error, info, question, or warning}}
+
+test msgbox-1.10 {tk_messageBox command} {
+ list [catch {tk_messageBox -parent foo.bar} msg] $msg
+} {1 {bad window path name "foo.bar"}}
+
+if {[info commands tk::MessageBox] == ""} {
+ set isNative 1
+} else {
+ set isNative 0
+}
+
+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).
+#
+set count 1
+foreach spec $specs {
+ set type [lindex $spec 0]
+ set buttons [lindex $spec 3]
+
+ set button [lindex $buttons 0]
+ test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
+ ChooseMsg $parent $button
+ tk_messageBox -title Hi -message "Please press $button" \
+ -type $type
+ } $button
+ incr count
+
+ foreach icon {warning error info question} {
+ test msgbox-2.$count {tk_messageBox command -icon option} \
+ {nonUnixUserInteraction} {
+ ChooseMsg $parent $button
+ tk_messageBox -title Hi -message "Please press $button" \
+ -type $type -icon $icon
+ } $button
+ incr count
+ }
+
+ foreach button $buttons {
+ test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
+ ChooseMsg $parent $button
+ tk_messageBox -title Hi -message "Please press $button" \
+ -type $type -default $button
+ } "$button"
+ incr count
+ }
+}
+
+# These tests will hang your test suite if they fail.
+test msgbox-3.1 {tk_messageBox handles withdrawn parent} {nonUnixUserInteraction} {
+ wm withdraw .
+ ChooseMsg . "ok"
+ tk_messageBox -title Hi -message "Please press ok" \
+ -type ok -default ok
+} "ok"
+wm deiconify .
+
+test msgbox-3.2 {tk_messageBox handles iconified parent} {nonUnixUserInteraction} {
+ wm iconify .
+ ChooseMsg . "ok"
+ tk_messageBox -title Hi -message "Please press ok" \
+ -type ok -default ok
+} "ok"
+wm deiconify .
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/obj.test b/tcl/tests/obj.test
index 2f26ed36acc..bf983855cde 100644
--- a/tcl/tests/obj.test
+++ b/tcl/tests/obj.test
@@ -1,604 +1,49 @@
-# Functionality covered: this file contains a collection of tests for the
-# procedures in tclObj.c that implement Tcl's basic type support and the
-# type managers for the types boolean, double, and integer.
+# This file is a Tcl script to test new object types in Tk.
+# It is organized in the standard fashion for Tcl tests.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-if {[info commands testobj] == {}} {
- puts "This application hasn't been compiled with the \"testobj\""
- puts "command, so I can't test the Tcl type and object support."
- ::tcltest::cleanupTests
- return
-}
-
-test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
- set r 1
- foreach {t} {
- {array search}
- boolean
- bytearray
- bytecode
- double
- end-offset
- index
- int
- list
- nsName
- procbody
- string
- } {
- set first [string first $t [testobj types]]
- set r [expr {$r && ($first != -1)}]
- }
- set result $r
-} {1}
-
-test obj-2.1 {Tcl_GetObjType error} {
- list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
-} {0 1 {no type foo found}}
-test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testintobj set 1 12]
- lappend result [testobj convert 1 double]
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 12 12 double 3}
-
-test obj-3.1 {Tcl_ConvertToType error} {
- list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
-} {12.34 1 {expected integer but got "12.34"}}
-test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
- list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
-} {{} 1 {expected integer but got ""}}
-
-test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testobj newobj 1]
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} {} string 2}
-
-test obj-5.1 {Tcl_FreeObj} {
- set result ""
- lappend result [testintobj set 1 12345]
- lappend result [testobj freeallvars]
- lappend result [catch {testintobj get 1} msg]
- lappend result $msg
-} {12345 {} 1 {variable 1 is unset (NULL)}}
-
-test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testintobj set 1 47]
- lappend result [testobj duplicate 1 2]
- lappend result [testintobj get 2]
- lappend result [testobj refcount 1]
- lappend result [testobj refcount 2]
-} {{} 47 47 47 2 3}
-test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testobj newobj 1]
- lappend result [testobj duplicate 1 2]
- lappend result [testintobj get 2]
- lappend result [testobj refcount 1]
- lappend result [testobj refcount 2]
-} {{} {} {} {} 2 3}
-
-test obj-7.1 {Tcl_GetString, return existing string rep} {
- set result ""
- lappend result [testintobj set 1 47]
- lappend result [testintobj get2 1]
-} {47 47}
-test obj-7.2 {Tcl_GetString, "empty string" object} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [teststringobj append 1 abc -1]
- lappend result [teststringobj get2 1]
-} {{} abc abc}
-test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} {
- set result ""
- lappend result [teststringobj set 1 xyz]
- lappend result [teststringobj append 1 abc -1]
- lappend result [teststringobj get2 1]
-} {xyz xyzabc xyzabc}
-test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} {
- set result ""
- lappend result [testintobj set 1 77]
- lappend result [testintobj mult10 1]
- lappend result [teststringobj get2 1]
-} {77 770 770}
-
-test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} {
- set result ""
- lappend result [testintobj set 1 47]
- lappend result [testintobj get 1]
-} {47 47}
-test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [teststringobj append 1 abc -1]
- lappend result [teststringobj get 1]
-} {{} abc abc}
-test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
- set result ""
- lappend result [teststringobj set 1 xyz]
- lappend result [teststringobj append 1 abc -1]
- lappend result [teststringobj get 1]
-} {xyz xyzabc xyzabc}
-test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
- set result ""
- lappend result [testintobj set 1 77]
- lappend result [testintobj mult10 1]
- lappend result [teststringobj get 1]
-} {77 770 770}
-
-test obj-9.1 {Tcl_NewBooleanObj} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testbooleanobj set 1 0]
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 0 boolean 2}
-
-test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testobj newobj 1]
- lappend result [testbooleanobj set 1 0] ;# makes existing obj boolean
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} {} 0 boolean 2}
-test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testintobj set 1 98765]
- lappend result [testbooleanobj set 1 1] ;# makes existing obj boolean
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 98765 1 boolean 2}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
-test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} {
- set result ""
- lappend result [testbooleanobj set 1 1]
- lappend result [testbooleanobj not 1] ;# gets existing boolean rep
-} {1 0}
-test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} {
- set result ""
- lappend result [testintobj set 1 47]
- lappend result [testbooleanobj not 1] ;# must convert to bool
- lappend result [testobj type 1]
-} {47 0 boolean}
-test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
- set result ""
- lappend result [teststringobj set 1 abc]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
-} {abc 1 {expected boolean value but got "abc"}}
-test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
-} {{} 1 {expected boolean value but got ""}}
-test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} {
- set result ""
- lappend result [teststringobj set 1 0xac]
- lappend result [testbooleanobj not 1]
- lappend result [testobj type 1]
-} {0xac 0 boolean}
-test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} {
- set result ""
- lappend result [teststringobj set 1 5.42]
- lappend result [testbooleanobj not 1]
- lappend result [testobj type 1]
-} {5.42 0 boolean}
+test obj-1.1 {TkGetPixelsFromObj} {
+} {}
-test obj-12.1 {DupBooleanInternalRep} {
- set result ""
- lappend result [testbooleanobj set 1 1]
- lappend result [testobj duplicate 1 2] ;# uses DupBooleanInternalRep
- lappend result [testbooleanobj get 2]
-} {1 1 1}
+test obj-2.1 {FreePixelInternalRep} {
+} {}
-test obj-13.1 {SetBooleanFromAny, int to boolean special case} {
- set result ""
- lappend result [testintobj set 1 1234]
- lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
- lappend result [testobj type 1]
-} {1234 0 boolean}
-test obj-13.2 {SetBooleanFromAny, double to boolean special case} {
- set result ""
- lappend result [testdoubleobj set 1 3.14159]
- lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
- lappend result [testobj type 1]
-} {3.14159 0 boolean}
-test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
- set result ""
- foreach s {yes no true false on off} {
- teststringobj set 1 $s
- lappend result [testbooleanobj not 1]
- }
- lappend result [testobj type 1]
-} {0 1 0 1 0 1 boolean}
-test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} {
- set result ""
- lappend result [testintobj set 1 456]
- lappend result [testintobj div10 1]
- lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
- lappend result [testobj type 1]
-} {456 45 0 boolean}
-test obj-13.5 {SetBooleanFromAny, error parsing string} {
- set result ""
- lappend result [teststringobj set 1 abc]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
-} {abc 1 {expected boolean value but got "abc"}}
-test obj-13.6 {SetBooleanFromAny, error parsing string} {
- set result ""
- lappend result [teststringobj set 1 x1.0]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
-} {x1.0 1 {expected boolean value but got "x1.0"}}
-test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
-} {{} 1 {expected boolean value but got ""}}
-test obj-13.8 {SetBooleanFromAny, unicode strings} {
- set result ""
- lappend result [teststringobj set 1 1\u7777]
- lappend result [catch {testbooleanobj not 1} msg]
- lappend result $msg
-} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"
+test obj-3.1 {DupPixelInternalRep} {
+} {}
-test obj-14.1 {UpdateStringOfBoolean} {
- set result ""
- lappend result [testbooleanobj set 1 0]
- lappend result [testbooleanobj not 1]
- lappend result [testbooleanobj get 1] ;# must update string rep
-} {0 1 1}
+test obj-4.1 {SetPixelFromAny} {
+} {}
-test obj-15.1 {Tcl_NewDoubleObj} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testdoubleobj set 1 3.1459]
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 3.1459 double 2}
-test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testobj newobj 1]
- lappend result [testdoubleobj set 1 0.123] ;# makes existing obj boolean
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} {} 0.123 double 2}
-test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testintobj set 1 98765]
- lappend result [testdoubleobj set 1 27.56] ;# makes existing obj double
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 98765 27.56 double 2}
-test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} {
- set result ""
- lappend result [testdoubleobj set 1 16.1]
- lappend result [testdoubleobj mult10 1] ;# gets existing double rep
-} {16.1 161.0}
-test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} {
- set result ""
- lappend result [testintobj set 1 477]
- lappend result [testdoubleobj div10 1] ;# must convert to bool
- lappend result [testobj type 1]
-} {477 47.7 double}
-test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} {
- set result ""
- lappend result [teststringobj set 1 abc]
- lappend result [catch {testdoubleobj mult10 1} msg]
- lappend result $msg
-} {abc 1 {expected floating-point number but got "abc"}}
-test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [catch {testdoubleobj div10 1} msg]
- lappend result $msg
-} {{} 1 {expected floating-point number but got ""}}
+deleteWindows
-test obj-18.1 {DupDoubleInternalRep} {
- set result ""
- lappend result [testdoubleobj set 1 17.1]
- lappend result [testobj duplicate 1 2] ;# uses DupDoubleInternalRep
- lappend result [testdoubleobj get 2]
-} {17.1 17.1 17.1}
-
-test obj-19.1 {SetDoubleFromAny, int to double special case} {
- set result ""
- lappend result [testintobj set 1 1234]
- lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
- lappend result [testobj type 1]
-} {1234 12340.0 double}
-test obj-19.2 {SetDoubleFromAny, boolean to double special case} {
- set result ""
- lappend result [testbooleanobj set 1 1]
- lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
- lappend result [testobj type 1]
-} {1 10.0 double}
-test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} {
- set result ""
- lappend result [testintobj set 1 456]
- lappend result [testintobj div10 1]
- lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
- lappend result [testobj type 1]
-} {456 45 450.0 double}
-test obj-19.4 {SetDoubleFromAny, error parsing string} {
- set result ""
- lappend result [teststringobj set 1 abc]
- lappend result [catch {testdoubleobj mult10 1} msg]
- lappend result $msg
-} {abc 1 {expected floating-point number but got "abc"}}
-test obj-19.5 {SetDoubleFromAny, error parsing string} {
- set result ""
- lappend result [teststringobj set 1 x1.0]
- lappend result [catch {testdoubleobj mult10 1} msg]
- lappend result $msg
-} {x1.0 1 {expected floating-point number but got "x1.0"}}
-test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [catch {testdoubleobj div10 1} msg]
- lappend result $msg
-} {{} 1 {expected floating-point number but got ""}}
-
-test obj-20.1 {UpdateStringOfDouble} {
- set result ""
- lappend result [testdoubleobj set 1 3.14159]
- lappend result [testdoubleobj mult10 1]
- lappend result [testdoubleobj get 1] ;# must update string rep
-} {3.14159 31.4159 31.4159}
-
-test obj-21.1 {Tcl_NewIntObj} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testintobj set 1 55]
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 55 int 2}
-
-test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testobj newobj 1]
- lappend result [testintobj set 1 77] ;# makes existing obj int
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} {} 77 int 2}
-test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testdoubleobj set 1 12.34]
- lappend result [testintobj set 1 77] ;# makes existing obj int
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 12.34 77 int 2}
-
-test obj-23.1 {Tcl_GetIntFromObj, existing int object} {
- set result ""
- lappend result [testintobj set 1 22]
- lappend result [testintobj mult10 1] ;# gets existing int rep
-} {22 220}
-test obj-23.2 {Tcl_GetIntFromObj, convert to int} {
- set result ""
- lappend result [testintobj set 1 477]
- lappend result [testintobj div10 1] ;# must convert to bool
- lappend result [testobj type 1]
-} {477 47 int}
-test obj-23.3 {Tcl_GetIntFromObj, error converting to int} {
- set result ""
- lappend result [teststringobj set 1 abc]
- lappend result [catch {testintobj mult10 1} msg]
- lappend result $msg
-} {abc 1 {expected integer but got "abc"}}
-test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [catch {testintobj div10 1} msg]
- lappend result $msg
-} {{} 1 {expected integer but got ""}}
-test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [testintobj inttoobigtest 1]
-} {{} 1}
-
-test obj-24.1 {DupIntInternalRep} {
- set result ""
- lappend result [testintobj set 1 23]
- lappend result [testobj duplicate 1 2] ;# uses DupIntInternalRep
- lappend result [testintobj get 2]
-} {23 23 23}
-
-test obj-25.1 {SetIntFromAny, int to int special case} {
- set result ""
- lappend result [testintobj set 1 1234]
- lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
- lappend result [testobj type 1]
-} {1234 12340 int}
-test obj-25.2 {SetIntFromAny, boolean to int special case} {
- set result ""
- lappend result [testbooleanobj set 1 1]
- lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
- lappend result [testobj type 1]
-} {1 10 int}
-test obj-25.3 {SetIntFromAny, recompute string rep then parse it} {
- set result ""
- lappend result [testintobj set 1 456]
- lappend result [testintobj div10 1]
- lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
- lappend result [testobj type 1]
-} {456 45 450 int}
-test obj-25.4 {SetIntFromAny, error parsing string} {
- set result ""
- lappend result [teststringobj set 1 abc]
- lappend result [catch {testintobj mult10 1} msg]
- lappend result $msg
-} {abc 1 {expected integer but got "abc"}}
-test obj-25.5 {SetIntFromAny, error parsing string} {
- set result ""
- lappend result [teststringobj set 1 x17]
- lappend result [catch {testintobj mult10 1} msg]
- lappend result $msg
-} {x17 1 {expected integer but got "x17"}}
-test obj-25.6 {SetIntFromAny, integer too large} {nonPortable} {
- set result ""
- lappend result [teststringobj set 1 123456789012345678901]
- lappend result [catch {testintobj mult10 1} msg]
- lappend result $msg
-} {123456789012345678901 1 {integer value too large to represent}}
-test obj-25.7 {SetIntFromAny, error converting from "empty string"} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [catch {testintobj div10 1} msg]
- lappend result $msg
-} {{} 1 {expected integer but got ""}}
+# cleanup
+::tcltest::cleanupTests
+return
-test obj-26.1 {UpdateStringOfInt} {
- set result ""
- lappend result [testintobj set 1 512]
- lappend result [testintobj mult10 1]
- lappend result [testintobj get 1] ;# must update string rep
-} {512 5120 5120}
-test obj-27.1 {Tcl_NewLongObj} {
- set result ""
- lappend result [testobj freeallvars]
- testintobj setmaxlong 1
- lappend result [testintobj ismaxlong 1]
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 1 int 1}
-test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testobj newobj 1]
- lappend result [testintobj setlong 1 77] ;# makes existing obj long int
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} {} 77 int 2}
-test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testdoubleobj set 1 12.34]
- lappend result [testintobj setlong 1 77] ;# makes existing obj long int
- lappend result [testobj type 1]
- lappend result [testobj refcount 1]
-} {{} 12.34 77 int 2}
-test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} {
- set result ""
- lappend result [testintobj setlong 1 22]
- lappend result [testintobj mult10 1] ;# gets existing long int rep
-} {22 220}
-test obj-29.2 {Tcl_GetLongFromObj, convert to long} {
- set result ""
- lappend result [testintobj setlong 1 477]
- lappend result [testintobj div10 1] ;# must convert to bool
- lappend result [testobj type 1]
-} {477 47 int}
-test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} {
- set result ""
- lappend result [teststringobj set 1 abc]
- lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
- lappend result $msg
-} {abc 1 {expected integer but got "abc"}}
-test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
- set result ""
- lappend result [testobj newobj 1]
- lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
- lappend result $msg
-} {{} 1 {expected integer but got ""}}
-test obj-30.1 {Ref counting and object deletion, simple types} {
- set result ""
- lappend result [testobj freeallvars]
- lappend result [testintobj set 1 1024]
- lappend result [testobj assign 1 2] ;# vars 1 and 2 share the int obj
- lappend result [testobj type 2]
- lappend result [testobj refcount 1]
- lappend result [testobj refcount 2]
- lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
- lappend result [testobj type 2]
- lappend result [testobj refcount 1]
- lappend result [testobj refcount 2]
-} {{} 1024 1024 int 4 4 0 boolean 3 2}
-test obj-31.1 {regenerate string rep of "end"} {
- testobj freeallvars
- teststringobj set 1 end
- testobj convert 1 end-offset
- testobj invalidateStringRep 1
-} end
-test obj-31.2 {regenerate string rep of "end-1"} {
- testobj freeallvars
- teststringobj set 1 end-0x1
- testobj convert 1 end-offset
- testobj invalidateStringRep 1
-} end-1
-test obj-31.3 {regenerate string rep of "end--1"} {
- testobj freeallvars
- teststringobj set 1 end--0x1
- testobj convert 1 end-offset
- testobj invalidateStringRep 1
-} end--1
-test obj-31.4 {regenerate string rep of "end-bigInteger"} {
- testobj freeallvars
- teststringobj set 1 end-0x7fffffff
- testobj convert 1 end-offset
- testobj invalidateStringRep 1
-} end-2147483647
-test obj-31.5 {regenerate string rep of "end--bigInteger"} {
- testobj freeallvars
- teststringobj set 1 end--0x7fffffff
- testobj convert 1 end-offset
- testobj invalidateStringRep 1
-} end--2147483647
-
-test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} {
- testobj freeallvars
- teststringobj set 1 end--0x80000000
- testobj convert 1 end-offset
- testobj invalidateStringRep 1
-} end--2147483648
-testobj freeallvars
-# cleanup
-::tcltest::cleanupTests
-return
diff --git a/tcl/tests/oldpack.test b/tcl/tests/oldpack.test
new file mode 100644
index 00000000000..b916d6605ad
--- /dev/null
+++ b/tcl/tests/oldpack.test
@@ -0,0 +1,527 @@
+# This file is a Tcl script to test out the old syntax of Tk's
+# "pack" command (before release 3.3). It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1991-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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 "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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/option.file1 b/tcl/tests/option.file1
new file mode 100644
index 00000000000..e64b6cc38ef
--- /dev/null
+++ b/tcl/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/tcl/tests/option.file2 b/tcl/tests/option.file2
new file mode 100644
index 00000000000..f1d020a89a1
--- /dev/null
+++ b/tcl/tests/option.file2
@@ -0,0 +1,2 @@
+*foo1: magenta
+foo2 missing colon
diff --git a/tcl/tests/option.test b/tcl/tests/option.test
new file mode 100644
index 00000000000..7952c7bac5e
--- /dev/null
+++ b/tcl/tests/option.test
@@ -0,0 +1,248 @@
+# This file is a Tcl script to test out the option-handling facilities
+# of Tk. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+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"}}
+
+set option1 [file join [testsDirectory] option.file1]
+set option2 [file join [testsDirectory] option.file2]
+
+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 option3 [makeFile {} option.file3]
+ 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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/pack.test b/tcl/tests/pack.test
new file mode 100644
index 00000000000..e9bd74ab674
--- /dev/null
+++ b/tcl/tests/pack.test
@@ -0,0 +1,1109 @@
+# This file is a Tcl script to test out the "pack" command
+# of Tk. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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.1.1 {x padding and filling} {
+ pack1 -side right -padx {10 30}
+} {20x40+250+80 240x200+0+0}
+test pack-2.1.2 {x padding and filling} {
+ pack1 -side right -padx {35 5}
+} {20x40+275+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.4.1 {x padding and filling} {
+ pack1 -side right -padx {9 31} -fill x
+} {20x40+249+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.6.1 {x padding and filling} {
+ pack1 -side right -ipadx 5 -padx {5 15} -fill x
+} {30x40+255+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.7.1 {x padding and filling} {
+ pack1 -side top -padx {0 40}
+} {20x40+120+0 300x160+0+40}
+test pack-2.7.2 {x padding and filling} {
+ pack1 -side top -padx {31 9}
+} {20x40+151+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.9.1 {x padding and filling} {
+ pack1 -side top -ipadx 5 -padx {5 15}
+} {30x40+130+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.10.1 {x padding and filling} {
+ pack1 -side top -padx {25 15} -fill x
+} {260x40+25+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}
+test pack-2.12 {x padding and filling} {
+ pack1 -side top -ipadx 5 -padx {5 15} -fill x
+} {280x40+5+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.1.1 {y padding and filling} {
+ pack1 -side right -pady {5 35}
+} {20x40+280+65 280x200+0+0}
+test pack-3.1.2 {y padding and filling} {
+ pack1 -side right -pady {40 0}
+} {20x40+280+100 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.3.1 {y padding and filling} {
+ pack1 -side right -ipady 5 -pady {5 15}
+} {20x50+280+70 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.4.1 {y padding and filling} {
+ pack1 -side right -pady {35 5} -fill y
+} {20x160+280+35 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.6.1 {y padding and filling} {
+ pack1 -side right -ipady 5 -pady {0 20} -fill y
+} {20x180+280+0 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.7.1 {y padding and filling} {
+ pack1 -side top -pady {40 0}
+} {20x40+140+40 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.9.1 {y padding and filling} {
+ pack1 -side top -ipady 5 -pady {3 17}
+} {20x50+140+3 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.10.1 {y padding and filling} {
+ pack1 -side top -pady {39 1} -fill y
+} {20x40+140+39 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}
+test pack-3.12.1 {y padding and filling} {
+ pack1 -side top -ipady 5 -pady {1 19} -fill y
+} {20x50+140+1 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.12.1 {info option} {
+ pack4 -padx {2 9}
+} {2 9}
+test pack-11.13 {info option} {
+ pack4 -pady 3
+} 3
+test pack-11.13.1 {info option} {
+ pack4 -pady {3 11}
+} {3 11}
+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 "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.15.1 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -padx {5 abc}} msg] $msg
+} {1 {bad 2nd 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.16.1 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -padx {5 -1}} msg] $msg
+} {1 {bad 2nd 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.17.1 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -pady {0 abc}} msg] $msg
+} {1 {bad 2nd 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.18.1 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -pady {0 -1}} msg] $msg
+} {1 {bad 2nd 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 ipadx 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 ipadx value "-1": must be positive screen distance}}
+test pack-12.20.1 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -ipadx {5 5}} msg] $msg
+} {1 {bad ipadx value "5 5": 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 ipady 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 ipady value "-1": must be positive screen distance}}
+test pack-12.22.1 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -ipady {5 5}} msg] $msg
+} {1 {bad ipady value "5 5": 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 {bad 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 {bad 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} {
+
+ # adjust the position of .pack before test to avoid a screen switch
+ # that occurs with window managers that have desktops four times as big
+ # as the screen (screen switch causes scale and other tests to fail).
+
+ wm geometry .pack +100+100
+
+ # 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} {
+
+ # adjust the position of .pack before test to avoid a screen switch
+ # that occurs with window managers that have desktops four times as big
+ # as the screen (screen switch causes scale and other tests to fail).
+
+ wm geometry .pack +100+100
+ 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}
+
+test pack-19.1 {test respect for internalborder} {
+ catch {eval pack forget [pack slaves .pack]}
+ destroy .pack.l .pack.lf
+ wm geometry .pack 200x200
+ frame .pack.l -width 15 -height 10
+ labelframe .pack.lf -labelwidget .pack.l
+ pack .pack.lf -fill both -expand 1
+ frame .pack.lf.f
+ pack .pack.lf.f -fill both -expand 1
+ update
+ set res [list [winfo geometry .pack.lf.f]]
+ .pack.lf configure -labelanchor e -padx 3 -pady 5
+ update
+ lappend res [winfo geometry .pack.lf.f]
+ destroy .pack.l .pack.lf
+ set res
+} {196x188+2+10 177x186+5+7}
+test pack-19.2 {test support for minreqsize} {
+ catch {eval pack forget [pack slaves .pack]}
+ destroy .pack.l .pack.lf
+ wm geometry .pack {}
+ frame .pack.l -width 150 -height 100
+ labelframe .pack.lf -labelwidget .pack.l
+ pack .pack.lf -fill both -expand 1
+ frame .pack.lf.f -width 20 -height 25
+ pack .pack.lf.f
+ update
+ set res [list [winfo geometry .pack.lf]]
+ .pack.lf configure -labelanchor ws
+ update
+ lappend res [winfo geometry .pack.lf]
+ destroy .pack.l .pack.lf
+ set res
+} {162x127+0+0 172x112+0+0}
+
+destroy .pack
+foreach i {pack1 pack2 pack3 pack4} {
+ rename $i {}
+}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/panedwindow.test b/tcl/tests/panedwindow.test
new file mode 100644
index 00000000000..7f7a98fdb85
--- /dev/null
+++ b/tcl/tests/panedwindow.test
@@ -0,0 +1,2392 @@
+# This file is a Tcl script to test entry widgets in Tk. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+set i 1
+panedwindow .p
+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"}}
+ {-handlesize 20 20 badValue {bad screen distance "badValue"}}
+ {-height 20 20 badValue {bad screen distance "badValue"}}
+ {-opaqueresize true 1 foo {expected boolean value but got "foo"}}
+ {-orient horizontal horizontal badValue
+ {bad orient "badValue": must be horizontal or vertical}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-sashcursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-sashpad 1.3 1 badValue {bad screen distance "badValue"}}
+ {-sashrelief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-sashwidth 10 10 badValue {bad screen distance "badValue"}}
+ {-showhandle true 1 foo {expected boolean value but got "foo"}}
+ {-width 402 402 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test panedwindow-1.$i {configuration options} {
+ .p configure $name [lindex $test 1]
+ list [lindex [.p configure $name] 4] [.p cget $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test entry-1.$i {configuration options} {
+ list [catch {.p configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .p configure $name [lindex [.p configure $name] 3]
+ incr i
+}
+.p add [button .b]
+.p add [button .c]
+foreach test {
+ {-after .c .c badValue {bad window path name "badValue"}}
+ {-before .c .c badValue {bad window path name "badValue"}}
+ {-height 10 10 badValue {bad screen distance "badValue"}}
+ {-minsize 10 10 badValue {bad screen distance "badValue"}}
+ {-padx 1.3 1 badValue {bad screen distance "badValue"}}
+ {-pady 1.3 1 badValue {bad screen distance "badValue"}}
+ {-sticky nsew nesw abcd {bad stickyness value "abcd": must be a string containing zero or more of n, e, s, and w}}
+ {-width 10 10 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test panedwindow-1.$i {configuration options} {
+ .p paneconfigure .b $name [lindex $test 1]
+ list [lindex [.p paneconfigure .b $name] 4] [.p panecget .b $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test entry-1.$i {configuration options} {
+ list [catch {.p paneconfigure .b $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .p paneconfigure .b $name [lindex [.p paneconfigure .b $name] 3]
+ incr i
+}
+destroy .p .b .c
+
+test panedwindow-2.1 {panedwindow widget command} {
+ panedwindow .p
+ set result [list [catch {.p foo} msg] $msg]
+ destroy .p
+ set result
+} {1 {bad command "foo": must be add, cget, configure, forget, identify, panecget, paneconfigure, panes, proxy, or sash}}
+
+test panedwindow-3.1 {panedwindow panes subcommand} {
+ panedwindow .p
+ .p add [button .b]
+ .p add [button .c]
+ set result [list [.p panes]]
+ .p forget .b
+ lappend result [.p panes]
+ destroy .p .b .c
+ set result
+} [list [list .b .c] [list .c]]
+
+test panedwindow-4.1 {forget subcommand} {
+ panedwindow .p
+ set result [list [catch {.p forget} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "wrong # args: should be \".p forget widget ?widget ...?\""]
+test panedwindow-4.2 {forget subcommand, forget one from start} {
+ panedwindow .p
+ .p add [button .b]
+ .p add [button .c]
+ set result [list [.p panes]]
+ .p forget .b
+ lappend result [.p panes]
+ destroy .p .b .c
+ set result
+} [list {.b .c} .c]
+test panedwindow-4.3 {forget subcommand, forget one from end} {
+ panedwindow .p
+ .p add [button .b]
+ .p add [button .c]
+ .p add [button .d]
+ set result [list [.p panes]]
+ .p forget .d
+ update
+ lappend result [.p panes]
+ destroy .p .b .c .d
+ set result
+} [list {.b .c .d} {.b .c}]
+test panedwindow-4.4 {forget subcommand, forget multiple} {
+ panedwindow .p
+ .p add [button .b]
+ .p add [button .c]
+ .p add [button .d]
+ set result [list [.p panes]]
+ .p forget .b .c
+ update
+ lappend result [.p panes]
+ destroy .p .b .c .d
+ set result
+} [list {.b .c .d} .d]
+test panedwindow-4.5 {forget subcommand, panes are unmapped} {
+ panedwindow .p
+ .p add [button .b]
+ .p add [button .c]
+ pack .p
+ update
+
+ set result [list [winfo ismapped .b] [winfo ismapped .c]]
+ .p forget .b
+ update
+
+ lappend result [winfo ismapped .b] [winfo ismapped .c]
+ destroy .p .b .c
+
+ set result
+} [list 1 1 0 1]
+test panedwindow-4.6 {forget subcommand, changes reqsize of panedwindow} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false
+ .p add [frame .f -width 20 -height 20] [frame .g -width 20 -height 20]
+ set result [list [winfo reqwidth .p]]
+ .p forget .f
+ lappend result [winfo reqwidth .p]
+ destroy .p .f .g
+ set result
+} [list 44 20]
+
+test panedwindow-5.1 {sash subcommand} {
+ panedwindow .p
+ set result [list [catch {.p sash} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "wrong # args: should be \".p sash option ?arg ...?\""]
+test panedwindow-5.2 {sash subcommand} {
+ panedwindow .p
+ set result [list [catch {.p sash foo} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "bad option \"foo\": must be coord, dragto, mark, or place"]
+
+test panedwindow-6.1 {sash coord subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash coord} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "wrong # args: should be \".p sash coord index\""]
+test panedwindow-6.2 {sash coord subcommand, errors} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4
+ set result [list [catch {.p sash coord 0} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "invalid sash index"]
+test panedwindow-6.3 {sash coord subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash coord foo} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-6.4 {sash coord subcommand sashes correctly placed} {
+ panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -showhandle false
+ .p add [frame .p.f -width 20 -height 20] \
+ [frame .p.f2 -width 20 -height 20] \
+ [frame .p.f3 -width 20 -height 20]
+ set result [.p sash coord 0]
+ destroy .p .p.f .p.f2 .p.f3
+ set result
+} [list 22 0]
+test panedwindow-6.5 {sash coord subcommand sashes correctly placed} {
+ panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -showhandle false
+ .p add [frame .p.f -width 20 -height 20] \
+ [frame .p.f2 -width 20 -height 20] \
+ [frame .p.f3 -width 20 -height 20]
+ set result [.p sash coord 1]
+ destroy .p .p.f .p.f2 .p.f3
+ set result
+} [list 50 0]
+test panedwindow-6.6 {sash coord subcommand, sashes correctly placed} {
+ panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -orient vertical \
+ -showhandle false
+ .p add [frame .p.f -width 20 -height 20] \
+ [frame .p.f2 -width 20 -height 20] \
+ [frame .p.f3 -width 20 -height 20]
+ set result [.p sash coord 0]
+ destroy .p .p.f .p.f2 .p.f3
+ set result
+} [list 0 22]
+test panedwindow-6.7 {sash coord subcommand, sashes correctly placed} {
+ panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -orient vertical \
+ -showhandle false
+ .p add [frame .p.f -width 20 -height 20] \
+ [frame .p.f2 -width 20 -height 20] \
+ [frame .p.f3 -width 20 -height 20]
+ set result [.p sash coord 1]
+ destroy .p .p.f .p.f2 .p.f3
+ set result
+} [list 0 50]
+test panedwindow-6.8 {sash coord subcommand, errors} {
+ panedwindow .p
+ set result [list \
+ [catch {.p sash coord -1} msg] $msg \
+ [catch {.p sash coord 0} msg] $msg \
+ [catch {.p sash coord 1} msg] $msg \
+ ]
+ destroy .p
+ set result
+} [list 1 "invalid sash index" 1 "invalid sash index" 1 "invalid sash index"]
+test panedwindow-6.9 {sash coord subcommand, errors} {
+ panedwindow .p
+ .p add [frame .p.f]
+ set result [list \
+ [catch {.p sash coord -1} msg] $msg \
+ [catch {.p sash coord 0} msg] \
+ [catch {.p sash coord 1} msg] $msg \
+ ]
+ destroy .p
+ set result
+} [list 1 "invalid sash index" 0 1 "invalid sash index"]
+
+test panedwindow-8.1 {sash mark subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash mark} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "wrong # args: should be \".p sash mark index ?x y?\""]
+test panedwindow-8.2 {sash mark subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash mark foo} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-8.3 {sash mark subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash mark 0 foo bar} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "invalid sash index"]
+test panedwindow-8.4 {sash mark subcommand, errors} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [list [catch {.p sash mark 0 foo bar} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-8.5 {sash mark subcommand, errors} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [list [catch {.p sash mark 0 0 bar} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "expected integer but got \"bar\""]
+test panedwindow-8.6 {sash mark subcommand, mark defaults to 0 0} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [.p sash mark 0]
+ destroy .p .b .c
+ set result
+} [list 0 0]
+test panedwindow-8.7 {sash mark subcommand, set mark} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ .p sash mark 0 10 10
+ set result [.p sash mark 0]
+ destroy .p .b .c
+ set result
+} [list 10 10]
+
+test panedwindow-9.1 {sash dragto subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash dragto} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "wrong # args: should be \".p sash dragto index x y\""]
+test panedwindow-9.2 {sash dragto subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash dragto foo bar baz} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-9.3 {sash dragto subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash dragto 0 foo bar} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "invalid sash index"]
+test panedwindow-9.4 {sash dragto subcommand, errors} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [list [catch {.p sash dragto 0 foo bar} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-9.5 {sash dragto subcommand, errors} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [list [catch {.p sash dragto 0 0 bar} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "expected integer but got \"bar\""]
+
+test panedwindow-10.1 {sash mark/sash dragto interaction} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false
+ .p add [frame .f -width 20 -height 20] [button .c -text foobar]
+ .p sash mark 0 10 10
+ .p sash dragto 0 20 10
+ set result [.p sash coord 0]
+ destroy .p .f .c
+ set result
+} [list 30 0]
+test panedwindow-10.2 {sash mark/sash dragto interaction} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -orient vertical \
+ -showhandle false
+ .p add [frame .p.f -width 20 -height 20] [button .p.c -text foobar]
+ .p sash mark 0 10 10
+ .p sash dragto 0 10 20
+ set result [.p sash coord 0]
+ destroy .p .p.f .p.c
+ set result
+} [list 0 30]
+test panedwindow-10.3 {sash mark/sash dragto, respects minsize} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false
+ .p add [frame .f -width 20 -height 20] [button .c] -minsize 15
+ .p sash mark 0 20 10
+ .p sash dragto 0 10 10
+ set result [.p sash coord 0]
+ destroy .p .f .c
+ set result
+} [list 15 0]
+
+test panedwindow-11.1 {sash place subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash place} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "wrong # args: should be \".p sash place index x y\""]
+test panedwindow-11.2 {sash place subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash place foo bar baz} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-11.3 {sash place subcommand, errors} {
+ panedwindow .p
+ set result [list [catch {.p sash place 0 foo bar} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "invalid sash index"]
+test panedwindow-11.4 {sash place subcommand, errors} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [list [catch {.p sash place 0 foo bar} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-11.5 {sash place subcommand, errors} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [list [catch {.p sash place 0 0 bar} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "expected integer but got \"bar\""]
+test panedwindow-11.6 {sash place subcommand, moves sash} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 20] [button .c]
+ .p sash place 0 10 0
+ set result [.p sash coord 0]
+ destroy .p .f .c
+ set result
+} [list 10 0]
+test panedwindow-11.7 {sash place subcommand, moves sash} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -orient vertical
+ .p add [frame .f -width 20 -height 20] [button .c]
+ .p sash place 0 0 10
+ set result [.p sash coord 0]
+ destroy .p .f .c
+ set result
+} [list 0 10]
+test panedwindow-11.8 {sash place subcommand, respects minsize} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false
+ .p add [frame .f -width 20 -height 20] [button .c] -minsize 15
+ .p sash place 0 10 0
+ set result [.p sash coord 0]
+ destroy .p .f .c
+ set result
+} [list 15 0]
+
+test panedwindow-12.1 {moving sash changes size of pane to left} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false
+ .p add [frame .f -width 20 -height 20] [button .c -text foobar] -sticky nsew
+ .p sash place 0 30 0
+ pack .p
+ update
+ set result [winfo width .f]
+ destroy .p .f .c
+ set result
+} 30
+test panedwindow-12.2 {moving sash changes size of pane to right} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 20] [frame .f2 -width 20 -height 20]
+ pack .p
+ update
+ set result [winfo width .f2]
+ .p sash place 0 30 0
+ update
+ lappend result [winfo width .f2]
+ destroy .p .f .f2
+ set result
+} {20 10}
+test panedwindow-12.3 {moving sash does not change reqsize of panedwindow} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 20] [frame .f2 -width 20 -height 20]
+ .p sash place 0 30 0
+ set result [winfo reqwidth .p]
+ destroy .p .f .f2
+ set result
+} 44
+test panedwindow-12.4 {moving sash changes size of pane above} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ .p add [frame .f -width 20 -height 10] [button .c -text foobar] -sticky nsew
+ .p sash place 0 0 20
+ pack .p
+ update
+ set result [winfo height .f]
+ destroy .p .f .c
+ set result
+} 20
+test panedwindow-12.5 {moving sash changes size of pane below} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10]
+ pack .p
+ update
+ set result [winfo height .f2]
+ .p sash place 0 0 15
+ update
+ lappend result [winfo height .f2]
+ destroy .p .f .f2
+ set result
+} {10 5}
+test panedwindow-12.6 {moving sash does not change reqsize of panedwindow} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10]
+ set result [winfo reqheight .p]
+ .p sash place 0 0 20
+ lappend result [winfo reqheight .p]
+ destroy .p .f .f2
+ set result
+} [list 24 24]
+test panedwindow-12.7 {moving sash does not alter reqsize of widget} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10]
+ set result [winfo reqheight .f]
+ .p sash place 0 0 20
+ lappend result [winfo reqheight .f]
+ destroy .p .f .f2
+ set result
+} [list 10 10]
+test panedwindow-12.8 {moving sash restricted to minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 20] [button .c] -minsize 15
+ .p sash place 0 10 0
+ pack .p
+ update
+ set result [winfo width .f]
+ destroy .p .f .c
+ set result
+} 15
+test panedwindow-12.10 {moving sash restricted to minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ .p add [frame .f -width 20 -height 30] [button .c] -minsize 10
+ .p sash place 0 0 5
+ pack .p
+ update
+ set result [winfo height .f]
+ destroy .p .f .c
+ set result
+} 10
+test panedwindow-12.12 {moving sash in unmapped window restricted to reqsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20]
+ set result [list [.p sash coord 0]]
+ .p sash place 0 100 0
+ lappend result [.p sash coord 0]
+ destroy .p .f .f2
+ set result
+} [list {20 0} {40 0}]
+test panedwindow-12.13 {moving sash right pushes other sashes} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \
+ [frame .f3 -width 20 -height 30]
+ .p sash place 0 80 0
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+ destroy .p .f .f2 .f3
+ set result
+} {{60 0} {64 0}}
+test panedwindow-12.14 {moving sash left pushes other sashes} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \
+ [frame .f3 -width 20 -height 30]
+ .p sash place 1 0 0
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+ destroy .p .f .f2 .f3
+ set result
+} {{0 0} {4 0}}
+test panedwindow-12.15 {move sash in mapped window restricted to visible win} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \
+ [frame .f3 -width 20 -height 30]
+ place .p -width 50
+ update
+ .p sash place 1 100 0
+ update
+ set result [.p sash coord 1]
+ destroy .p .f .f2 .f3
+ set result
+} {46 0}
+test panedwindow-12.16 {move sash in mapped window restricted to visible win} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \
+ [frame .f3 -width 20 -height 30]
+ place .p -width 100
+ update
+ .p sash place 1 200 0
+ update
+ set result [.p sash coord 1]
+ destroy .p .f .f2 .f3
+ set result
+} {96 0}
+test panedwindow-12.17 {moving sash into "virtual" space on \
+ last pane increases reqsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \
+ [frame .f3 -width 20 -height 30]
+ place .p -width 100
+ set result [winfo reqwidth .p]
+ update
+ .p sash place 1 200 0
+ update
+ lappend result [winfo reqwidth .p]
+ destroy .p .f .f2 .f3
+ set result
+} {68 100}
+
+test panedwindow-13.1 {horizontal panedwindow lays out widgets properly} {
+ panedwindow .p -showhandle false -borderwidth 2 -sashpad 2 -sashwidth 2
+ foreach win {.p.f .p.f2 .p.f3} {.p add [frame $win -width 20 -height 10]}
+ pack .p
+ update
+ set result {}
+ foreach w [.p panes] {lappend result [winfo x $w] [winfo y $w]}
+ destroy .p .p.f .p.f2 .p.f3
+ set result
+} [list 2 2 28 2 54 2]
+test panedwindow-13.2 {vertical panedwindow lays out widgets properly} {
+ panedwindow .p -showhandle false -borderwidth 2 -sashpad 2 -sashwidth 2 \
+ -orient vertical
+ foreach win {.p.f .p.f2 .p.f3} {.p add [frame $win -width 20 -height 10]}
+ pack .p
+ update
+ set result {}
+ foreach w [.p panes] {lappend result [winfo x $w] [winfo y $w]}
+ destroy .p .p.f .p.f2 .p.f3
+ set result
+} [list 2 2 2 18 2 34]
+test panedwindow-13.3 {horizontal panedwindow lays out widgets properly} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ foreach {win color} {.p.f blue .p.f2 green} {
+ .p add [frame $win -width 20 -height 20 -bg $color] -padx 10 -pady 5 \
+ -sticky ""
+ }
+ pack .p
+ update
+ set result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]}
+ .p paneconfigure .p.f -padx 0 -pady 0
+ update
+ lappend result [winfo reqwidth .p] [winfo reqheight .p]
+ foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]}
+ destroy .p .p.f .p.f2
+ set result
+} [list 80 30 10 5 50 5 60 30 0 5 30 5]
+test panedwindow-13.4 {vertical panedwindow lays out widgets properly} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \
+ -orient vertical
+ foreach win {.p.f .p.f2} {
+ .p add [frame $win -width 20 -height 20] -padx 10 -pady 5 -sticky ""
+ }
+ pack .p
+ update
+ set result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]}
+ .p paneconfigure .p.f -padx 0 -pady 0
+ update
+ lappend result [winfo reqwidth .p] [winfo reqheight .p]
+ foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]}
+ destroy .p .p.f .p.f2
+ set result
+} [list 40 60 10 5 10 35 40 50 10 0 10 25]
+test panedwindow-13.5 {panedwindow respects reqsize of panes when possible} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ .p add [frame .p.f -width 20 -height 20] -sticky ""
+ place .p -width 40
+ update
+ set result [list [winfo width .p.f]]
+ .p.f configure -width 30
+ update
+ lappend result [winfo width .p.f]
+ destroy .p .p.f
+ set result
+} [list 20 30]
+test panedwindow-13.6 {panedwindow takes explicit widget width over reqwidth} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ .p add [frame .p.f -width 20 -height 20] -width 20 -sticky ""
+ place .p -width 40
+ update
+ set result [list [winfo width .p.f]]
+ .p.f configure -width 30
+ update
+ lappend result [winfo width .p.f]
+ destroy .p .p.f
+ set result
+} [list 20 20]
+test panedwindow-13.7 {horizontal panedwindow reqheight is max slave height} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ .p add [frame .p.f -width 20 -height 20] [frame .p.f2 -width 20 -height 20]
+ set result [winfo reqheight .p]
+ .p.f config -height 40
+ lappend result [winfo reqheight .p]
+ destroy .p .p.f .p.f2
+ set result
+} {20 40}
+test panedwindow-13.8 {horizontal panedwindow reqheight is max slave height} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]}
+ .p paneconfigure .p.f -height 15
+ set result [winfo reqheight .p]
+ .p.f config -height 40
+ lappend result [winfo reqheight .p]
+ destroy .p .p.f .p.f2
+ set result
+} {20 20}
+test panedwindow-13.9 {panedwindow pane width overrides widget width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4
+ foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]}
+ .p sash place 0 10 0
+ pack .p
+ update
+ set result [winfo width .p.f]
+ .p paneconfigure .p.f -width 30
+ lappend result [winfo width .p.f]
+ destroy .p .p.f .p.f2
+ set result
+} [list 10 10]
+test panedwindow-13.10 {panedwindow respects reqsize of panes when possible} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ .p add [frame .p.f -width 20 -height 20] -sticky ""
+ place .p -height 40
+ update
+ set result [list [winfo height .p.f]]
+ .p.f configure -height 30
+ update
+ lappend result [winfo height .p.f]
+ destroy .p .p.f
+ set result
+} [list 20 30]
+test panedwindow-13.11 {panedwindow takes explicit height over reqheight} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ .p add [frame .p.f -width 20 -height 20] -height 20 -sticky ""
+ place .p -height 40
+ update
+ set result [list [winfo height .p.f]]
+ .p.f configure -height 30
+ update
+ lappend result [winfo height .p.f]
+ destroy .p .p.f
+ set result
+} [list 20 20]
+test panedwindow-13.12 {vertical panedwindow reqwidth is max slave width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ .p add [frame .p.f -width 20 -height 20] [frame .p.f2 -width 20 -height 20]
+ set result [winfo reqwidth .p]
+ .p.f config -width 40
+ lappend result [winfo reqwidth .p]
+ destroy .p .p.f .p.f2
+ set result
+} {20 40}
+test panedwindow-13.13 {vertical panedwindow reqwidth is max slave width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]}
+ .p paneconfigure .p.f -width 15
+ set result [winfo reqwidth .p]
+ .p.f config -width 40
+ lappend result [winfo reqwidth .p]
+ destroy .p .p.f .p.f2
+ set result
+} {20 20}
+test panedwindow-13.14 {panedwindow pane height overrides widget width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \
+ -orient vertical
+ foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]}
+ .p sash place 0 0 10
+ pack .p
+ update
+ set result [winfo height .p.f]
+ .p paneconfigure .p.f -height 30
+ lappend result [winfo height .p.f]
+ destroy .p .p.f .p.f2
+ set result
+} [list 10 10]
+
+
+test panedwindow-14.1 {PanestructureProc, widget yields managements} {
+ # Check that the panedwindow correctly yields geometry management of
+ # a slave when the slave is destroyed.
+
+ # This test should not cause a core dump, and it should not cause
+ # a memory leak.
+ panedwindow .p
+ .p add [button .b]
+ destroy .p
+ pack .b
+ destroy .b
+ set result ""
+} ""
+test panedwindow-14.2 {PanedWindowLostSlaveProc, widget yields management} {
+ # Check that the paned window correctly yields geometry management of
+ # a slave when some other geometry manager steals the slave from us.
+
+ # This test should not cause a core dump, and it should not cause a
+ # memory leak.
+ panedwindow .p
+ .p add [button .b]
+ pack .p
+ update
+ pack .b
+ update
+ set result [.p panes]
+ destroy .p .b
+ set result
+} {}
+
+set stickysets [list n s e w sn ns en ne wn nw esn nse nsw nsew ""]
+set stickygets [list n s e w ns ns ne ne nw nw nes nes nsw nesw ""]
+set i 0
+foreach s $stickysets g $stickygets {
+ test panedwindow-15.[incr i] {panedwindow sticky settings} {
+ panedwindow .p -showhandle false
+ .p add [button .b]
+ .p paneconfigure .b -sticky $s
+ set result [.p panecget .b -sticky]
+ destroy .p .b
+ set result
+ } $g
+}
+
+set i 0
+foreach s [list {} n s e w ns ew nw ne se sw nse nsw sew new news] \
+ x [list 10 10 10 20 0 10 0 0 20 20 0 20 0 0 0 0] \
+ y [list 10 0 20 10 10 0 10 0 0 20 20 0 0 20 0 0] \
+ w [list 20 20 20 20 20 20 40 20 20 20 20 20 20 40 40 40] \
+ h [list 20 20 20 20 20 40 20 20 20 20 20 40 40 20 20 40] {
+ test panedwindow-16.[incr i] {panedwindow sticky works} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ .p add [frame .p.f -height 20 -width 20 -bg red] -sticky $s
+ place .p -width 40 -height 40
+ update
+ set result [list $s [winfo x .p.f] [winfo y .p.f] \
+ [winfo width .p.f] [winfo height .p.f]]
+ destroy .p .p.f
+ set result
+ } [list $s $x $y $w $h]
+}
+
+test panedwindow-17.1 {setting minsize when pane is too small snaps width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .p.f -height 20 -width 20 -bg red]
+ set result [winfo reqwidth .p]
+ .p paneconfigure .p.f -minsize 40
+ lappend result [winfo reqwidth .p]
+ destroy .p .p.f .p.f2
+ set result
+} [list 20 40]
+
+test panedwindow-18.1 {MoveSash, move right} {
+ set result {}
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Get the requested width of the paned window
+ lappend result [winfo reqwidth .p]
+
+ .p sash place 0 30 0
+
+ # Get the reqwidth again, to make sure it hasn't changed
+ lappend result [winfo reqwidth .p]
+
+ # Check that the sash moved
+ lappend result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 42 42 {30 0}]
+test panedwindow-18.2 {MoveSash, move right (unmapped) clipped by reqwidth} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 0 100 0
+
+ # Get the new sash coord; it should be clipped by the reqwidth of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 40 0]
+test panedwindow-18.3 {MoveSash, move right (mapped, width < reqwidth) clipped by width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Put the panedwindow up on the display and give it a width < reqwidth
+ place .p -x 0 -y 0 -width 32
+ update
+
+ .p sash place 0 100 0
+
+ # Get the new sash coord; it should be clipped by the visible width of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 30 0]
+test panedwindow-18.4 {MoveSash, move right (mapped, width > reqwidth) clipped by width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Put the panedwindow up on the display and give it a width > reqwidth
+ place .p -x 0 -y 0 -width 102
+ update
+
+ .p sash place 0 200 0
+
+ # Get the new sash coord; it should be clipped by the visible width of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 100 0]
+test panedwindow-18.5 {MoveSash, move right respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 100 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 30 0]
+test panedwindow-18.6 {MoveSash, move right respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 100 0
+
+ # Get the new sash coord; it should have moved as far as possible.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 40 0]
+test panedwindow-18.7 {MoveSash, move right pushes other sashes} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 0 100 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 62 0]
+test panedwindow-18.8 {MoveSash, move right pushes other sashes, respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 100 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 52 0]
+test panedwindow-18.9 {MoveSash, move right respects minsize, exludes pad} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize 10 -padx 5
+ }
+
+ .p sash place 0 100 0
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 50 0]
+test panedwindow-18.10 {MoveSash, move right, negative minsize becomes 0} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize -50
+ }
+
+ .p sash place 0 50 0
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list [list 50 0] [list 52 0]]
+test panedwindow-18.11 {MoveSash, move left} {
+ set result {}
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Get the requested width of the paned window
+ lappend result [winfo reqwidth .p]
+
+ .p sash place 0 10 0
+
+ # Get the reqwidth again, to make sure it hasn't changed
+ lappend result [winfo reqwidth .p]
+
+ # Check that the sash moved
+ lappend result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 42 42 {10 0}]
+test panedwindow-18.12 {MoveSash, move left, can't move outside of window} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 0 -100 0
+
+ # Get the new sash coord; it should be clipped by the reqwidth of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 0 0]
+test panedwindow-18.13 {MoveSash, move left respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 0 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 10 0]
+test panedwindow-18.14 {MoveSash, move left respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 22 0]
+test panedwindow-18.15 {MoveSash, move left pushes other sashes} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 0]
+test panedwindow-18.16 {MoveSash, move left pushes other sashes, respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 10 0]
+test panedwindow-18.17 {MoveSash, move left respects minsize, exludes pad} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize 10 -padx 5
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 42 0]
+test panedwindow-18.18 {MoveSash, move left, negative minsize becomes 0} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ foreach w {.f1 .f2 .f3} c {red blue green} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize -50
+ }
+
+ .p sash place 1 10 0
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list [list 8 0] [list 10 0]]
+
+test panedwindow-19.1 {MoveSash, move down} {
+ set result {}
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Get the requested width of the paned window
+ lappend result [winfo reqheight .p]
+
+ .p sash place 0 0 30
+
+ # Get the reqwidth again, to make sure it hasn't changed
+ lappend result [winfo reqheight .p]
+
+ # Check that the sash moved
+ lappend result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 42 42 {0 30}]
+test panedwindow-19.2 {MoveSash, move down (unmapped) clipped by reqheight} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 0 0 100
+
+ # Get the new sash coord; it should be clipped by the reqheight of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 0 40]
+test panedwindow-19.3 {MoveSash, move down (mapped, height < reqheight) clipped by height} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Put the panedwindow up on the display and give it a height < reqheight
+ place .p -x 0 -y 0 -height 32
+ update
+
+ .p sash place 0 0 100
+
+ # Get the new sash coord; it should be clipped by the visible height of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 0 30]
+test panedwindow-19.4 {MoveSash, move down (mapped, height > reqheight) clipped by height} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Put the panedwindow up on the display and give it a width > reqwidth
+ place .p -x 0 -y 0 -height 102
+ update
+
+ .p sash place 0 0 200
+
+ # Get the new sash coord; it should be clipped by the visible width of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 0 100]
+test panedwindow-19.5 {MoveSash, move down respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 0 100
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 0 30]
+test panedwindow-19.6 {MoveSash, move down respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 0 100
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 40]
+test panedwindow-19.7 {MoveSash, move down pushes other sashes} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 0 0 100
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 62]
+test panedwindow-19.8 {MoveSash, move down pushes other sashes, respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 0 100
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 52]
+test panedwindow-19.9 {MoveSash, move down respects minsize, exludes pad} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize 10 -pady 5
+ }
+
+ .p sash place 0 0 100
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 50]
+test panedwindow-19.10 {MoveSash, move right, negative minsize becomes 0} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize -50
+ }
+
+ .p sash place 0 0 50
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list [list 0 50] [list 0 52]]
+test panedwindow-19.11 {MoveSash, move up} {
+ set result {}
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ # Get the requested width of the paned window
+ lappend result [winfo reqheight .p]
+
+ .p sash place 0 0 10
+
+ # Get the reqwidth again, to make sure it hasn't changed
+ lappend result [winfo reqheight .p]
+
+ # Check that the sash moved
+ lappend result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 42 42 {0 10}]
+test panedwindow-19.12 {MoveSash, move up, can't move outside of window} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 0 0 -100
+
+ # Get the new sash coord; it should be clipped by the reqwidth of
+ # the panedwindow.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 0 0]
+test panedwindow-19.13 {MoveSash, move up respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 0 0 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2
+
+ set result
+} [list 0 10]
+test panedwindow-19.14 {MoveSash, move up respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 22]
+test panedwindow-19.15 {MoveSash, move up pushes other sashes} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 0]
+test panedwindow-19.16 {MoveSash, move up pushes other sashes, respects minsize} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible while
+ # respecting minsizes.
+ set result [.p sash coord 0]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 10]
+test panedwindow-19.17 {MoveSash, move up respects minsize, exludes pad} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize 10 -pady 5
+ }
+
+ .p sash place 1 0 0
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [.p sash coord 1]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list 0 42]
+test panedwindow-19.18 {MoveSash, move up, negative minsize becomes 0} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} c {red blue green} {
+ .p add [frame $w -height 20 -width 20 -bg $c] \
+ -sticky nsew -minsize -50
+ }
+
+ .p sash place 1 0 10
+
+ # Get the new sash coord; it should have moved as far as possible,
+ # respecting minsizes.
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+
+ # Cleanup
+ destroy .p .f1 .f2 .f3
+
+ set result
+} [list [list 0 8] [list 0 10]]
+
+# The following tests check that the panedwindow is correctly computing its
+# geometry based on the various configuration options that can affect the
+# geometry.
+
+test panedwindow-20.1 {ComputeGeometry, reqheight taken from widgets} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue]
+ }
+ set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]]
+ .f3 configure -height 40
+ lappend result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f1 .f2 .f3
+ set result
+} [list [list 60 20] [list 60 40]]
+test panedwindow-20.2 {ComputeGeometry, reqheight taken from widgets} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue]
+ }
+ set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]]
+ .p paneconfigure .f3 -height 40
+ lappend result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f1 .f2 .f3
+ set result
+} [list [list 60 20] [list 60 40]]
+test panedwindow-20.3 {ComputeGeometry, reqheight taken from widgets} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] -pady 20
+ }
+ set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]]
+ .p paneconfigure .f3 -height 40
+ lappend result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f1 .f2 .f3
+ set result
+} [list [list 60 60] [list 60 80]]
+test panedwindow-20.4 {ComputeGeometry, reqwidth taken from widgets} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue]
+ }
+ set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]]
+ .f3 configure -width 40
+ lappend result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f1 .f2 .f3
+ set result
+} [list [list 20 60] [list 40 60]]
+test panedwindow-20.5 {ComputeGeometry, reqwidth taken from widgets} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue]
+ }
+ set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]]
+ .p paneconfigure .f3 -width 40
+ lappend result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f1 .f2 .f3
+ set result
+} [list [list 20 60] [list 40 60]]
+test panedwindow-20.6 {ComputeGeometry, reqwidth taken from widgets} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] -padx 20
+ }
+ set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]]
+ .p paneconfigure .f3 -width 40
+ lappend result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f1 .f2 .f3
+ set result
+} [list [list 60 60] [list 80 60]]
+
+set i 6
+foreach bd {0 2} {
+ foreach sp {0 5} {
+ foreach sw {0 3} {
+ foreach h {0 1} {
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry, one slave, reqsize set properly} {
+ # With just one slave, sashpad and sashwidth should not
+ # affect the panedwindow's geometry, since no sash should
+ # ever be drawn.
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -sashwidth $sw -handlesize 6 -showhandle $h
+ .p add [frame .p.f -width 20 -height 20 -bg red] -padx $h \
+ -sticky ""
+ set result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .p.f
+ set result
+ } [list [expr {(2 * $bd) + 20 + (2 * $h)}] \
+ [expr {(2 * $bd) + 20}]]
+
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry, three panes, reqsize set properly} {
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -sashwidth $sw -handlesize 6 -showhandle $h
+ foreach w {.p.f1 .p.f2 .p.f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] \
+ -sticky ""
+ }
+ set result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .p.f1 .p.f2 .p.f3
+ set result
+ } [list [expr {(2 * $bd) + ($h?12:(2*$sw)) + (4*$sp) + 60}] \
+ [expr {(2 * $bd) + 20}]]
+
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry, sash coords} {
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -sashwidth $sw -handlesize 6 -showhandle $h
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] \
+ -sticky ""
+ }
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+ destroy .p .f1 .f2 .f3
+ set result
+ } [list [list [expr {$bd+20+($h?(6-$sw)/2:0)+$sp}] $bd] \
+ [list [expr {$bd+40+($h?6+(6-$sw)/2:$sw)+(3*$sp)}] \
+ $bd]]
+
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry/ArrangePanes, slave coords} {
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -sashwidth $sw -handlesize 6 -showhandle $h
+ foreach w {.p.f1 .p.f2 .p.f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] \
+ -sticky nsew -pady 3 -padx 11
+ }
+ pack .p
+ update
+ set result {}
+ foreach w {.p.f1 .p.f2 .p.f3} {
+ lappend result [list [winfo x $w] [winfo y $w] \
+ [winfo width $w] [winfo height $w]]
+ }
+ destroy .p .p.f1 .p.f2 .p.f3
+ set result
+ } [list [list [expr {$bd+11}] [expr {$bd+3}] 20 20] \
+ [list [expr {$bd+53+($h?6:$sw)+(2*$sp)}] \
+ [expr {$bd+3}] 20 20] \
+ [list [expr {$bd+95+($h?12:2*$sw)+(4*$sp)}] \
+ [expr {$bd+3}] 20 20]]
+
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry, one slave, vertical} {
+ # With just one slave, sashpad and sashwidth should not
+ # affect the panedwindow's geometry, since no sash should
+ # ever be drawn.
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -orient vertical -sashwidth $sw -handlesize 6 \
+ -showhandle $h
+ .p add [frame .f -width 20 -height 20 -bg red] -pady $h \
+ -sticky ""
+ set result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f
+ set result
+ } [list [expr {(2 * $bd) + 20}] \
+ [expr {(2 * $bd) + 20 + (2 * $h)}]]
+
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry, three panes, vertical} {
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -sashwidth $sw -handlesize 6 -showhandle $h \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] \
+ -sticky ""
+ }
+ set result [list [winfo reqwidth .p] [winfo reqheight .p]]
+ destroy .p .f1 .f2 .f3
+ set result
+ } [list [expr {(2 * $bd) + 20}] \
+ [expr {(2 * $bd) + ($h?12:(2*$sw)) + (4*$sp) + 60}]]
+
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry, sash coords, vertical} {
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -sashwidth $sw -handlesize 6 -showhandle $h \
+ -orient vertical
+ foreach w {.f1 .f2 .f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] \
+ -sticky ""
+ }
+ set result [list [.p sash coord 0] [.p sash coord 1]]
+ destroy .p .f1 .f2 .f3
+ set result
+ } [list [list $bd [expr {$bd+20+($h?(6-$sw)/2:0)+$sp}]] \
+ [list $bd \
+ [expr {$bd+40+($h?6+(6-$sw)/2:$sw)+(3*$sp)}]]]
+
+ test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \
+ {ComputeGeometry/ArrangePanes, slave coords, vert} {
+ panedwindow .p -borderwidth $bd -sashpad $sp \
+ -sashwidth $sw -handlesize 6 -showhandle $h \
+ -orient vertical
+ foreach w {.p.f1 .p.f2 .p.f3} {
+ .p add [frame $w -width 20 -height 20 -bg blue] \
+ -sticky nsew -pady 11 -padx 3
+ }
+ pack .p
+ update
+ set result {}
+ foreach w {.p.f1 .p.f2 .p.f3} {
+ lappend result [list [winfo x $w] [winfo y $w] \
+ [winfo width $w] [winfo height $w]]
+ }
+ destroy .p .p.f1 .p.f2 .p.f3
+ set result
+ } [list [list [expr {$bd+3}] [expr {$bd+11}] 20 20] \
+ [list [expr {$bd+3}] \
+ [expr {$bd+53+($h?6:$sw)+(2*$sp)}] 20 20] \
+ [list [expr {$bd+3}] \
+ [expr {$bd+95+($h?12:2*$sw)+(4*$sp)}] 20 20]]
+ }
+ }
+ }
+}
+
+test panedwindow-21.1 {destroyed widgets are removed from panedwindow} {
+ panedwindow .p
+ .p add [frame .f -width 20 -height 20 -bg blue]
+ destroy .f
+ set result [.p panes]
+ destroy .p
+ set result
+} {}
+test panedwindow-21.2 {destroyed slave causes geometry recomputation} {
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .f -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 20 -bg red]
+ destroy .f
+ set result [winfo reqwidth .p]
+ destroy .p .f2
+ set result
+} 20
+
+test panedwindow-22.1 {ArrangePanes, extra space is given to the last pane} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .f1 -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew
+ place .p -width 100 -x 0 -y 0
+ update
+ set result [winfo width .f2]
+ destroy .p .f1 .f2
+ set result
+} 78
+test panedwindow-22.2 {ArrangePanes, extra space is given to the last pane} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ .p add [frame .f1 -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew
+ place .p -height 100 -x 0 -y 0
+ update
+ set result [winfo height .f2]
+ destroy .p .f1 .f2
+ set result
+} 78
+test panedwindow-22.3 {ArrangePanes, explicit height/width are preferred} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .f1 -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 20 -bg red] -sticky ""
+ .p paneconfigure .f1 -width 10 -height 15
+ pack .p
+ update
+ set result [list [winfo width .f1] [winfo height .f1]]
+ destroy .p .f1 .f2
+ set result
+} {10 15}
+test panedwindow-22.4 {ArrangePanes, panes clipped by size of pane} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .f1 -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 20 -bg red]
+ .p sash place 0 10 0
+ pack .p
+ update
+ set result [list [winfo width .f1] [winfo height .f1]]
+ destroy .p .f1 .f2
+ set result
+} {10 20}
+test panedwindow-22.5 {ArrangePanes, panes clipped by size of pane} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ .p add [frame .f1 -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 20 -bg red]
+ .p sash place 0 0 10
+ pack .p
+ update
+ set result [list [winfo width .f1] [winfo height .f1]]
+ destroy .p .f1 .f2
+ set result
+} {20 10}
+test panedwindow-22.6 {ArrangePanes, height of pane taken from total height} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .p.f1 -width 20 -height 20 -bg blue] \
+ [frame .p.f2 -width 20 -height 40 -bg red] -sticky ""
+ pack .p
+ update
+ set result [list [winfo y .p.f1]]
+ destroy .p .p.f1 .p.f2
+ set result
+} 10
+test panedwindow-22.8 {ArrangePanes, width of pane taken from total width} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
+ -orient vertical
+ .p add [frame .p.f1 -width 20 -height 20 -bg blue] \
+ [frame .p.f2 -width 40 -height 40 -bg red] -sticky ""
+ pack .p
+ update
+ set result [list [winfo x .p.f1]]
+ destroy .p .p.f1 .p.f2
+ set result
+} 10
+test panedwindow-22.9 {ArrangePanes, panes with width <= 0 are unmapped} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .f1 -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 40 -bg red]
+ pack .p
+ update
+ set result [winfo ismapped .f1]
+ .p sash place 0 0 0
+ update
+ lappend result [winfo ismapped .f1]
+ destroy .p .f1 .f2
+ set result
+} {1 0}
+test panedwindow-22.10 {ArrangePanes, panes with width <= 0 are unmapped} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .p.f1 -width 20 -height 20 -bg blue] \
+ [frame .p.f2 -width 20 -height 40 -bg red]
+ pack .p
+ update
+ set result [winfo ismapped .p.f1]
+ .p sash place 0 0 0
+ update
+ lappend result [winfo ismapped .p.f1]
+ destroy .p .p.f1 .p.f2
+ set result
+} {1 0}
+test panedwindow-22.11 {ArrangePanes, panes with width <= 0 are unmapped} {
+ panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 -orient vertical
+ .p add [frame .p.f1 -width 20 -height 20 -bg blue] \
+ [frame .p.f2 -width 20 -height 40 -bg red]
+ pack .p
+ update
+ set result [winfo ismapped .p.f1]
+ .p sash place 0 0 0
+ update
+ lappend result [winfo ismapped .p.f1]
+ destroy .p .p.f1 .p.f2
+ set result
+} {1 0}
+
+test panedwindow-23.1 {PanedWindowReqProc, react to slave geometry changes} {
+ # Basically just want to make sure that the PanedWindowReqProc is called
+ panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2
+ .p add [frame .f1 -width 20 -height 20 -bg blue] \
+ [frame .f2 -width 20 -height 40 -bg red]
+ set result [winfo reqheight .p]
+ .f1 configure -height 80
+ lappend result [winfo reqheight .p]
+ destroy .p .f1 .f2
+ set result
+} {40 80}
+
+test panedwindow-24.1 {ConfigurePanes, can't add panedwindow to itself} {
+ panedwindow .p
+ set result [list [catch {.p add .p} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "can't add .p to itself"]
+test panedwindow-24.2 {ConfigurePanes, bad window throws error} {
+ panedwindow .p
+ set result [list [catch {.p add .b} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "bad window path name \".b\""]
+test panedwindow-24.3 {ConfigurePanes, bad window aborts processing} {
+ panedwindow .p
+ button .b
+ catch {.p add .b .a}
+ set result [.p panes]
+ destroy .p .b
+ set result
+} {}
+test panedwindow-24.4 {ConfigurePanes, bad option aborts processing} {
+ panedwindow .p
+ button .b
+ catch {.p add .b -sticky foobar}
+ set result [.p panes]
+ destroy .p .b
+ set result
+} {}
+test panedwindow-24.5 {ConfigurePanes, after win isn't managed by panedwin} {
+ panedwindow .p
+ button .b
+ button .c
+ set result [list [catch {.p add .b -after .c} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "window \".c\" is not managed by .p"]
+test panedwindow-24.6 {ConfigurePanes, before win isn't managed by panedwin} {
+ panedwindow .p
+ button .b
+ button .c
+ set result [list [catch {.p add .b -before .c} msg] $msg]
+ destroy .p .b .c
+ set result
+} [list 1 "window \".c\" is not managed by .p"]
+test panedwindow-24.7 {ConfigurePanes, -after {} is a no-op} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ .p paneconfigure .b -after {}
+ set result [.p panes]
+ destroy .p .b .c
+ set result
+} {.b .c}
+test panedwindow-24.8 {ConfigurePanes, -before {} is a no-op} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ .p paneconfigure .b -before {}
+ set result [.p panes]
+ destroy .p .b .c
+ set result
+} {.b .c}
+test panedwindow-24.9 {ConfigurePanes, new panes are added} {
+ panedwindow .p
+ .p add [button .b] [button .c]
+ set result [.p panes]
+ destroy .p .b .c
+ set result
+} {.b .c}
+test panedwindow-24.10 {ConfigurePanes, options applied to all panes} {
+ panedwindow .p
+ .p add [button .b] [button .c] -sticky ne -height 5 -width 5 -minsize 10
+ set result {}
+ foreach w {.b .c} {
+ set val {}
+ foreach option {-sticky -height -width -minsize} {
+ lappend val $option [.p panecget $w $option]
+ }
+ lappend result $w $val
+ }
+ destroy .p .b .c
+ set result
+} [list .b {-sticky ne -height 5 -width 5 -minsize 10} \
+ .c {-sticky ne -height 5 -width 5 -minsize 10}]
+test panedwindow-24.11 {ConfigurePanes, existing panes are reconfigured} {
+ panedwindow .p
+ .p add [button .b] -sticky nw -height 10
+ .p add .b [button .c] -sticky se -height 2
+ set result [list [.p panes] \
+ [.p panecget .b -sticky] [.p panecget .b -height] \
+ [.p panecget .c -sticky] [.p panecget .c -height]]
+ destroy .p .b .c
+ set result
+} [list {.b .c} es 2 es 2]
+test panedwindow-24.12 {ConfigurePanes, widgets added to end by default} {
+ panedwindow .p
+ .p add [button .b]
+ .p add [button .c]
+ .p add [button .d]
+ set result [.p panes]
+ destroy .p .b .c .d
+ set result
+} {.b .c .d}
+test panedwindow-24.13 {ConfigurePanes, -after, single addition} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+
+ .p add .a .b
+ .p add .c -after .a
+ set result [.p panes]
+ destroy .p .a .b .c
+ set result
+} {.a .c .b}
+test panedwindow-24.14 {ConfigurePanes, -after, multiple additions} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b
+ .p add .c .d -after .a
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.a .c .d .b}
+test panedwindow-24.15 {ConfigurePanes, -after, relocates existing widget} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b .c .d
+ .p add .d -after .a
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.a .d .b .c}
+test panedwindow-24.16 {ConfigurePanes, -after, relocates existing widgets} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b .c .d
+ .p add .b .d -after .a
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.a .b .d .c}
+test panedwindow-24.17 {ConfigurePanes, -after, relocates existing widgets} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b .c .d
+ .p add .d .a -after .b
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.b .d .a .c}
+test panedwindow-24.18 {ConfigurePanes, -after, relocates existing widgets} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b .c .d
+ .p add .d .a -after .a
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.d .a .b .c}
+test panedwindow-24.19 {ConfigurePanes, -after, after last window} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b .c
+ .p add .d -after .c
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.a .b .c .d}
+test panedwindow-24.20 {ConfigurePanes, -before, before first window} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b .c
+ .p add .d -before .a
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.d .a .b .c}
+test panedwindow-24.21 {ConfigurePanes, -before, relocate existing windows} {
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+ button .d
+
+ .p add .a .b .c
+ .p add .d .b -before .a
+ set result [.p panes]
+ destroy .p .a .b .c .d
+ set result
+} {.d .b .a .c}
+test panedwindow-24.22 {ConfigurePanes, slave specified multiple times} {
+ # This test should not cause a core dump
+
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+
+ .p add .a .a .b .c
+ set result [.p panes]
+ destroy .p .a .b .c
+ set result
+} {.a .b .c}
+test panedwindow-22.23 {ConfigurePanes, slave specified multiple times} {
+ # This test should not cause a core dump
+
+ panedwindow .p
+ button .a
+ button .b
+ button .c
+
+ .p add .a .a .b .c
+ .p add .a .b .a -after .c
+ set result [.p panes]
+ destroy .p .a .b .c
+ set result
+} {.c .a .b}
+test panedwindow-22.24 {ConfigurePanes, panedwindow cannot manage toplevels} {
+ panedwindow .p
+ toplevel .t
+ set result [list [catch {.p add .t} msg] $msg]
+ destroy .p .t
+ set result
+} [list 1 "can't add toplevel .t to .p"]
+test panedwindow-22.25 {ConfigurePanes, restrict possible panes} {
+ panedwindow .p
+ frame .f
+ button .f.b
+ set result [list [catch {.p add .f.b} msg] $msg]
+ destroy .p .f .f.b
+ set result
+} [list 1 "can't add .f.b to .p"]
+test panedwindow-22.26 {ConfigurePanes, restrict possible panes} {
+ frame .f
+ panedwindow .f.p
+ button .b
+ set result [list [catch {.f.p add .b} msg] $msg]
+ destroy .f.p .f .b
+ set result
+} [list 0 ""]
+test panedwindow-22.27 {ConfigurePanes, restrict possible panes} {
+ panedwindow .p
+ button .p.b
+ set result [list [catch {.p add .p.b} msg] $msg]
+ destroy .p .p.b
+ set result
+} [list 0 ""]
+test panedwindow-22.28 {ConfigurePanes, restrict possible panes} {
+ frame .f
+ frame .f.f
+ frame .f.f.f
+ panedwindow .f.f.f.p
+ button .b
+ set result [list [catch {.f.f.f.p add .b} msg] $msg]
+ destroy .f .f.f .f.f.f .f.f.f.p .b
+ set result
+} [list 0 ""]
+
+test panedwindow-26.1 {DestroyPanedWindow} {
+ # This test should not result in any memory leaks.
+ panedwindow .p
+ foreach w {.a .b .c .d .e .f .g .h .i .j .k .l .m .n .o .q .r .s .t} {
+ .p add [button $w]
+ }
+ foreach w {.a .b .c .d .e .f .g .h .i .j .k .l .m .n .o .p .q .r .s .t} {
+ destroy $w
+ }
+ set result {}
+} {}
+
+test panedwindow-27.1 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 0 0]
+ destroy .p .f .f2
+ set result
+} {}
+test panedwindow-27.2 {PanedWindowIdentifyCoords, padding is included} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 20 0]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.3 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 22 0]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.4 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 24 0]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.5 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 26 0]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.6 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 26 -1]
+ destroy .p .f .f2
+ set result
+} {}
+test panedwindow-27.7 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 26 100]
+ destroy .p .f .f2
+ set result
+} {}
+test panedwindow-27.8 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 6
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 22 4]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.9 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 6
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 22 5]
+ destroy .p .f .f2
+ set result
+} {0 handle}
+test panedwindow-27.10 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 8
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 20 5]
+ destroy .p .f .f2
+ set result
+} {0 handle}
+test panedwindow-27.11 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 8
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 20 0]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.12 {PanedWindowIdentifyCoords} {
+ panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20] \
+ [frame .f3 -bg green -width 20 -height 20]
+ set result [.p identify 48 0]
+ destroy .p .f .f2 .f3
+ set result
+} {1 sash}
+test panedwindow-27.13 {identify subcommand errors} {
+ panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4
+ set result [list [catch {.p identify} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "wrong # args: should be \".p identify x y\""]
+test panedwindow-27.14 {identify subcommand errors} {
+ panedwindow .p
+ set result [list [catch {.p identify foo bar} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "expected integer but got \"foo\""]
+test panedwindow-27.14 {identify subcommand errors} {
+ panedwindow .p
+ set result [list [catch {.p identify 0 bar} msg] $msg]
+ destroy .p
+ set result
+} [list 1 "expected integer but got \"bar\""]
+test panedwindow-27.15 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 0 0]
+ destroy .p .f .f2
+ set result
+} {}
+test panedwindow-27.16 {PanedWindowIdentifyCoords, padding is included} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 0 20]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.17 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 0 22]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.18 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 0 24]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.19 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 0 26]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.20 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify -1 26]
+ destroy .p .f .f2
+ set result
+} {}
+test panedwindow-27.21 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 100 26]
+ destroy .p .f .f2
+ set result
+} {}
+test panedwindow-27.22 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 6 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 4 22]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.23 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 6 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 5 22]
+ destroy .p .f .f2
+ set result
+} {0 handle}
+test panedwindow-27.24 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 8 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 5 20]
+ destroy .p .f .f2
+ set result
+} {0 handle}
+test panedwindow-27.25 {PanedWindowIdentifyCoords} {
+ panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \
+ -handlesize 8 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20]
+ set result [.p identify 0 20]
+ destroy .p .f .f2
+ set result
+} {0 sash}
+test panedwindow-27.26 {PanedWindowIdentifyCoords} {
+ panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2 -orient vertical
+ .p add [frame .f -bg red -width 20 -height 20] \
+ [frame .f2 -bg blue -width 20 -height 20] \
+ [frame .f3 -bg green -width 20 -height 20]
+ set result [.p identify 0 48]
+ destroy .p .f .f2 .f3
+ set result
+} {1 sash}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/place.test b/tcl/tests/place.test
new file mode 100644
index 00000000000..18c31af40ed
--- /dev/null
+++ b/tcl/tests/place.test
@@ -0,0 +1,374 @@
+# This file is a Tcl script to test out the "place" command. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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
+} [list 1 "can't place .t.f2 relative to itself"]
+test place-4.2 {ConfigureSlave procedure, bad -in option} {
+ place forget .t.f2
+ list [catch {place .t.f2 -in .} msg] $msg
+} [list 1 "can't place .t.f2 relative to ."]
+
+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}
+
+test place-9.1 {PlaceObjCmd} {
+ list [catch {place} msg] $msg
+} [list 1 "wrong # args: should be \"place option|pathName args\""]
+test place-9.2 {PlaceObjCmd} {
+ list [catch {place foo} msg] $msg
+} [list 1 "wrong # args: should be \"place option|pathName args\""]
+test place-9.3 {PlaceObjCmd} {
+ catch {destroy .foo}
+ list [catch {place .foo bar} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test place-9.4 {PlaceObjCmd} {
+ catch {destroy .foo}
+ list [catch {place bar .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test place-9.5 {PlaceObjCmd} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place badopt .foo} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "bad option \"badopt\": must be configure, forget, info, or slaves"]
+test place-9.6 {PlaceObjCmd, configure errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place configure .foo} msg] $msg]
+ destroy .foo
+ set res
+} [list 0 ""]
+test place-9.7 {PlaceObjCmd, configure errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place configure .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 0 ""]
+test place-9.8 {PlaceObjCmd, configure} {
+ catch {destroy .foo}
+ frame .foo
+ place .foo -x 0 -y 0
+ set res [place configure .foo]
+ destroy .foo
+ set res
+} [list {-anchor {} {} nw nw} {-bordermode {} {} inside inside} {-height {} {} {} {}} {-in {} {} {} .} {-relheight {} {} {} {}} {-relwidth {} {} {} {}} {-relx {} {} 0 0.0} {-rely {} {} 0 0.0} {-width {} {} {} {}} {-x {} {} 0 0} {-y {} {} 0 0}]
+test place-9.9 {PlaceObjCmd, configure} {
+ catch {destroy .foo}
+ frame .foo
+ place .foo -x 0 -y 0
+ set res [place configure .foo -x]
+ destroy .foo
+ set res
+} [list -x {} {} 0 0]
+test place-9.10 {PlaceObjCmd, forget errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place forget .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place forget pathName\""]
+test place-9.11 {PlaceObjCmd, info errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place info .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place info pathName\""]
+test place-9.12 {PlaceObjCmd, slaves errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place slaves .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place slaves pathName\""]
+
+test place-10.1 {ConfigureSlave} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place .foo -badopt} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "unknown option \"-badopt\""]
+test place-10.2 {ConfigureSlave} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place .foo -anchor} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "value for \"-anchor\" missing"]
+test place-10.3 {ConfigureSlave} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place .foo -bordermode j} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "bad bordermode \"j\": must be inside, outside, or ignore"]
+test place-10.4 {ConfigureSlave} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place configure .foo -x 0 -y} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "value for \"-y\" missing"]
+
+test place-11.1 {PlaceObjCmd, slaves command} {
+ catch {destroy .foo}
+ frame .foo
+ set res [place slaves .foo]
+ destroy .foo
+ set res
+} {}
+test place-11.2 {PlaceObjCmd, slaves command} {
+ catch {destroy .foo .bar}
+ frame .foo
+ frame .bar
+ place .bar -in .foo
+ set res [place slaves .foo]
+ destroy .foo
+ destroy .bar
+ set res
+} [list .bar]
+
+test place-12.1 {PlaceObjCmd, forget command} {
+ catch {destroy .foo}
+ frame .foo
+ place .foo -width 50 -height 50
+ update
+ set res [winfo ismapped .foo]
+ place forget .foo
+ update
+ lappend res [winfo ismapped .foo]
+ destroy .foo
+ set res
+} [list 1 0]
+
+test place-13.1 {test respect for internalborder} {
+ toplevel .pack
+ wm geometry .pack 200x200
+ frame .pack.l -width 15 -height 10
+ labelframe .pack.lf -labelwidget .pack.l
+ pack .pack.lf -fill both -expand 1
+ frame .pack.lf.f
+ place .pack.lf.f -x 0 -y 0 -relwidth 1.0 -relheight 1.0
+ update
+ set res [list [winfo geometry .pack.lf.f]]
+ .pack.lf configure -labelanchor e -padx 3 -pady 5
+ update
+ lappend res [winfo geometry .pack.lf.f]
+ destroy .pack
+ set res
+} {196x188+2+10 177x186+5+7}
+
+catch {destroy .t}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/raise.test b/tcl/tests/raise.test
new file mode 100644
index 00000000000..670213a8cb3
--- /dev/null
+++ b/tcl/tests/raise.test
@@ -0,0 +1,307 @@
+# This file is a Tcl script to test out Tk's "raise" and
+# "lower" commands, plus associated code to manage window
+# stacking order. It is organized in the standard fashion
+# for Tcl tests.
+#
+# Copyright (c) 1993-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint testmakeexist [llength [info commands testmakeexist]]
+
+# 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 {} {
+ deleteWindows
+ foreach i {.raise1 .raise2 .raise3} {
+ toplevel $i
+ wm geom $i 150x100+0+0
+ update
+ }
+}
+
+toplevel .raise
+wm geom .raise 250x200+0+0
+
+test raise-1.1 {preserve creation order} {
+ raise_setup
+ tkwait visibility .raise.e
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.2 {preserve creation order} testmakeexist {
+ raise_setup
+ testmakeexist .raise.a
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.3 {preserve creation order} testmakeexist {
+ raise_setup
+ testmakeexist .raise.c
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.4 {preserve creation order} testmakeexist {
+ raise_setup
+ testmakeexist .raise.e
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.5 {preserve creation order} testmakeexist {
+ 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} testmakeexist {
+ 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} testmakeexist {
+ 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} testmakeexist {
+ 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"}}
+
+deleteWindows
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/safe.test b/tcl/tests/safe.test
index 63b68f973e0..6296530cc16 100644
--- a/tcl/tests/safe.test
+++ b/tcl/tests/safe.test
@@ -1,524 +1,219 @@
-# safe.test --
+# This file is a Tcl script to test the Safe Tk facility. It is organized
+# in the standard fashion for Tk tests.
#
-# This file contains a collection of tests for safe Tcl, packages loading,
-# and using safe interpreters. Sourcing this file into tcl runs the tests
-# and generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-foreach i [interp slaves] {
- interp delete $i
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+## NOTE: Any time tests fail here with an error like:
+
+# Can't find a usable tk.tcl in the following directories:
+# {$p(:26:)}
+#
+# $p(:26:)/tk.tcl: script error
+# script error
+# invoked from within
+# "source {$p(:26:)/tk.tcl}"
+# ("uplevel" body line 1)
+# invoked from within
+# "uplevel #0 [list source $file]"
+#
+#
+# This probably means that tk wasn't installed properly.
+
+## it indicates that something went wrong sourcing tk.tcl.
+## Ensure that any changes that occured to tk.tcl will work or
+## are properly prevented in a safe interpreter. -- hobbs
+
+# The set of hidden commands is platform dependent:
+
+if {"$tcl_platform(platform)" == "macintosh"} {
+ set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm}
+} elseif {"$tcl_platform(platform)" == "windows"} {
+ set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+} else {
+ set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel wm}
}
-# Force actual loading of the safe package
-# because we use un exported (and thus un-autoindexed) APIs
-# in this test result arguments:
-catch {safe::interpConfigure}
-
-proc equiv {x} {return $x}
-
-test safe-1.1 {safe::interpConfigure syntax} {
- list [catch {safe::interpConfigure} msg] $msg;
-} {1 {no value given for parameter "slave" (use -help for full usage) :
- slave name () name of the slave}}
-
-test safe-1.2 {safe::interpCreate syntax} {
- list [catch {safe::interpCreate -help} msg] $msg;
-} {1 {Usage information:
- Var/FlagName Type Value Help
- ------------ ---- ----- ----
- ( -help gives this help )
- ?slave? name () name of the slave (optional)
- -accessPath list () access path for the slave
- -noStatics boolflag (false) prevent loading of statically linked pkgs
- -statics boolean (true) loading of statically linked pkgs
- -nestedLoadOk boolflag (false) allow nested loading
- -nested boolean (false) nested loading
- -deleteHook script () delete hook}}
-
-test safe-1.3 {safe::interpInit syntax} {
- list [catch {safe::interpInit -noStatics} msg] $msg;
-} {1 {bad value "-noStatics" for parameter
- slave name () name of the slave}}
-
-
-test safe-2.1 {creating interpreters, should have no aliases} {
- interp aliases
-} ""
-test safe-2.2 {creating interpreters, should have no aliases} {
+test safe-1.1 {Safe Tk loading into an interpreter} {
catch {safe::interpDelete a}
- interp create a
- set l [a aliases]
+ safe::loadTk [safe::interpCreate a]
safe::interpDelete a
- set l
-} ""
-test safe-2.3 {creating safe interpreters, should have no aliases} {
- catch {safe::interpDelete a}
- interp create a -safe
- set l [a aliases]
- interp delete a
- set l
+ set x {}
+ set x
} ""
-
-test safe-3.1 {calling safe::interpInit is safe} {
+test safe-1.2 {Safe Tk loading into an interpreter} {
catch {safe::interpDelete a}
- interp create a -safe
- safe::interpInit a
- catch {interp eval a exec ls} msg
+ safe::interpCreate a
+ safe::loadTk a
+ set l [lsort [interp hidden a]]
safe::interpDelete a
- set msg
-} {invalid command name "exec"}
-test safe-3.2 {calling safe::interpCreate on trusted interp} {
+ set l
+} $hidden_cmds
+test safe-1.3 {Safe Tk loading into an interpreter} {
catch {safe::interpDelete a}
safe::interpCreate a
- set l [lsort [a aliases]]
+ safe::loadTk a
+ set l [lsort [interp aliases a]]
safe::interpDelete a
set l
} {encoding exit file load source}
-test safe-3.3 {calling safe::interpCreate on trusted interp} {
+
+test safe-2.1 {Unsafe commands not available} {
catch {safe::interpDelete a}
safe::interpCreate a
- set x [interp eval a {source [file join $tcl_library init.tcl]}]
+ safe::loadTk a
+ set status broken
+ if {[catch {interp eval a {toplevel .t}} msg]} {
+ set status ok
+ }
safe::interpDelete a
- set x
-} ""
-test safe-3.4 {calling safe::interpCreate on trusted interp} {
+ set status
+} ok
+test safe-2.2 {Unsafe commands not available} {
catch {safe::interpDelete a}
safe::interpCreate a
- catch {set x \
- [interp eval a {source [file join $tcl_library init.tcl]}]} msg
+ safe::loadTk a
+ set status broken
+ if {[catch {interp eval a {menu .m}} msg]} {
+ set status ok
+ }
safe::interpDelete a
- list $x $msg
-} {{} {}}
-
-test safe-4.1 {safe::interpDelete} {
+ set status
+} ok
+test safe-2.3 {Unsafe subcommands not available} {
catch {safe::interpDelete a}
- interp create a
+ safe::interpCreate a
+ safe::loadTk a
+ set status broken
+ if {[catch {interp eval a {tk appname}} msg]} {
+ set status ok
+ }
safe::interpDelete a
-} ""
-test safe-4.2 {safe::interpDelete, indirectly} {
- catch {safe::interpDelete a}
- interp create a
- a alias exit safe::interpDelete a
- a eval exit
-} ""
-test safe-4.3 {safe::interpDelete, state array (not a public api)} {
- catch {safe::interpDelete a}
- namespace eval safe {set [InterpStateName a](foo) 33}
- # not an error anymore to call it if interp is already
- # deleted, to make trhings smooth if it's called twice...
- catch {safe::interpDelete a} m1
- catch {namespace eval safe {set [InterpStateName a](foo)}} m2
- list $m1 $m2
-} "{}\
- {can't read \"[safe::InterpStateName a](foo)\": no such variable}"
-
-
-test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} {
+ list $status $msg
+} {ok {appname not accessible in a safe interpreter}}
+test safe-2.4 {Unsafe subcommands not available} {
catch {safe::interpDelete a}
safe::interpCreate a
- namespace eval safe {set [InterpStateName a](foo) 33}
- a eval exit
- catch {namespace eval safe {set [InterpStateName a](foo)}} msg
-} 1
+ safe::loadTk a
+ set status broken
+ if {[catch {interp eval a {tk scaling}} msg]} {
+ set status ok
+ }
+ safe::interpDelete a
+ list $status $msg
+} {ok {scaling not accessible in a safe interpreter}}
-test safe-4.5 {safe::interpDelete} {
+test safe-3.1 {Unsafe commands are available hidden} {
catch {safe::interpDelete a}
safe::interpCreate a
- catch {safe::interpCreate a} msg
- set msg
-} {interpreter named "a" already exists, cannot create}
-test safe-4.6 {safe::interpDelete, indirectly} {
- catch {safe::interpDelete a}
- safe::interpCreate a
- a eval exit
-} ""
-
-# The following test checks whether the definition of tcl_endOfWord can be
-# obtained from auto_loading.
-
-test safe-5.1 {test auto-loading in safe interpreters} {
+ 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
- set r [catch {interp eval a {tcl_endOfWord "" 0}} msg]
+ safe::loadTk a
+ set status ok
+ if {[catch {interp invokehidden a menu .m} msg]} {
+ set status broken
+ }
safe::interpDelete a
- list $r $msg
-} {0 -1}
-
-# test safe interps 'information leak'
-proc SI {} {
- global I
- set I [interp create -safe];
-}
-proc DI {} {
- global I;
- interp delete $I;
-}
-test safe-6.1 {test safe interpreters knowledge of the world} {
- SI; set r [lsort [$I eval {info globals}]]; DI; set r
-} {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
-test safe-6.2 {test safe interpreters knowledge of the world} {
- SI; set r [$I eval {info script}]; DI; set r
+ 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 imply that the user has
+ # to position the window (if the wm does not do it automatically)
+ # and thus make the test suite not runable non interactively
+ safe::interpDelete $i
} {}
-test safe-6.3 {test safe interpreters knowledge of the world} {
- SI
- set r [lsort [$I eval {array names tcl_platform}]]
- DI
- # If running a windows-debug shell, remove the "debug" element from r.
- if {$tcl_platform(platform) == "windows" && \
- [lsearch $r "debug"] != -1} {
- set r [lreplace $r 1 1]
- }
- set threaded [lsearch $r "threaded"]
- if {$threaded != -1} {
- set r [lreplace $r $threaded $threaded]
- }
- set r
-} {byteOrder platform wordSize}
-# more test should be added to check that hostname, nameofexecutable,
-# aren't leaking infos, but they still do...
-
-# high level general test
-test safe-7.1 {tests that everything works at high level} {
- set i [safe::interpCreate];
- # no error shall occur:
- # (because the default access_path shall include 1st level sub dirs
- # so package require in a slave works like in the master)
- set v [interp eval $i {package require http 1}]
- # no error shall occur:
- interp eval $i {http_config};
+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
- set v
-} 1.0
-
-test safe-7.2 {tests specific path and interpFind/AddToAccessPath} {
- set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
- # should not add anything (p0)
- set token1 [safe::interpAddToAccessPath $i [info library]]
- # should add as p1
- set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"];
- # an error shall occur (http is not anymore in the secure 0-level
- # provided deep path)
- list $token1 $token2 \
- [catch {interp eval $i {package require http 1}} msg] $msg \
- [safe::interpConfigure $i]\
- [safe::interpDelete $i]
-} "{\$p(:0:)} {\$p(:1:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library /dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
-
-
-# test source control on file name
-test safe-8.1 {safe source control on file} {
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- list [catch {$i eval {source}} msg] \
- $msg \
- [safe::interpDelete $i] ;
-} {1 {wrong # args: should be "source fileName"} {}}
-
-# test source control on file name
-test safe-8.2 {safe source control on file} {
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- list [catch {$i eval {source}} msg] \
- $msg \
- [safe::interpDelete $i] ;
-} {1 {wrong # args: should be "source fileName"} {}}
-
-test safe-8.3 {safe source control on file} {
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- set log {};
- proc safe-test-log {str} {global log; lappend log $str}
- set prevlog [safe::setLogCmd];
- safe::setLogCmd safe-test-log;
- list [catch {$i eval {source .}} msg] \
- $msg \
- $log \
- [safe::setLogCmd $prevlog; unset log] \
- [safe::interpDelete $i] ;
-} {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}}
-
-
-test safe-8.4 {safe source control on file} {
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- set log {};
- proc safe-test-log {str} {global log; lappend log $str}
- set prevlog [safe::setLogCmd];
- safe::setLogCmd safe-test-log;
- list [catch {$i eval {source /abc/def}} msg] \
- $msg \
- $log \
- [safe::setLogCmd $prevlog; unset log] \
- [safe::interpDelete $i] ;
-} {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}}
-
-
-test safe-8.5 {safe source control on file} {
- # This tested filename == *.tcl or tclIndex, but that restriction
- # was removed in 8.4a4 - hobbs
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- set log {};
- proc safe-test-log {str} {global log; lappend log $str}
- set prevlog [safe::setLogCmd];
- safe::setLogCmd safe-test-log;
- list [catch {$i eval {source [file join [info lib] blah]}} msg] \
- $msg \
- $log \
- [safe::setLogCmd $prevlog; unset log] \
- [safe::interpDelete $i] ;
-} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"] {} {}]
-
-
-test safe-8.6 {safe source control on file} {
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- set log {};
- proc safe-test-log {str} {global log; lappend log $str}
- set prevlog [safe::setLogCmd];
- safe::setLogCmd safe-test-log;
- list [catch {$i eval {source [file join [info lib] blah.tcl]}} msg] \
- $msg \
- $log \
- [safe::setLogCmd $prevlog; unset log] \
- [safe::interpDelete $i] ;
-} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"] {} {}]
-
-
-test safe-8.7 {safe source control on file} {
- # This tested length of filename, but that restriction
- # was removed in 8.4a4 - hobbs
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- set log {};
- proc safe-test-log {str} {global log; lappend log $str}
- set prevlog [safe::setLogCmd];
- safe::setLogCmd safe-test-log;
- list [catch {$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}}\
- msg] \
- $msg \
- $log \
- [safe::setLogCmd $prevlog; unset log] \
- [safe::interpDelete $i] ;
-} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"] {} {}]
-
-test safe-8.8 {safe source forbids -rsrc} {
- set i "a";
- catch {safe::interpDelete $i}
- safe::interpCreate $i;
- list [catch {$i eval {source -rsrc Init}} msg] \
- $msg \
- [safe::interpDelete $i] ;
-} {1 {wrong # args: should be "source fileName"} {}}
-
-
-test safe-9.1 {safe interps' deleteHook} {
- set i "a";
- catch {safe::interpDelete $i}
- set res {}
- proc testDelHook {args} {
- global res;
- # the interp still exists at that point
- interp eval a {set delete 1}
- # mark that we've been here (successfully)
- set res $args;
- }
- safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
- list [interp eval $i exit] $res
-} {{} {arg1 arg2 a}}
-
-test safe-9.2 {safe interps' error in deleteHook} {
- set i "a";
- catch {safe::interpDelete $i}
- set res {}
- proc testDelHook {args} {
- global res;
- # the interp still exists at that point
- interp eval a {set delete 1}
- # mark that we've been here (successfully)
- set res $args;
- # create an exception
- error "being catched";
- }
- set log {};
- proc safe-test-log {str} {global log; lappend log $str}
- safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
- set prevlog [safe::setLogCmd];
- safe::setLogCmd safe-test-log;
- list [safe::interpDelete $i] $res \
- $log \
- [safe::setLogCmd $prevlog; unset log];
-} {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}}
-
-
-test safe-9.3 {dual specification of statics} {
- list [catch {safe::interpCreate -stat true -nostat} msg] $msg
-} {1 {conflicting values given for -statics and -noStatics}}
-
-test safe-9.4 {dual specification of statics} {
- # no error shall occur
- safe::interpDelete [safe::interpCreate -stat false -nostat]
+ destroy $w
} {}
-test safe-9.5 {dual specification of nested} {
- list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg
-} {1 {conflicting values given for -nested and -nestedLoadOk}}
-
-test safe-9.6 {interpConfigure widget like behaviour} {
- # this test shall work, don't try to "fix it" unless
- # you *really* know what you are doing (ie you are me :p) -- dl
- list [set i [safe::interpCreate \
- -noStatics \
- -nestedLoadOk \
- -deleteHook {foo bar}];
- safe::interpConfigure $i -accessPath /foo/bar ;
- safe::interpConfigure $i]\
- [safe::interpConfigure $i -aCCess]\
- [safe::interpConfigure $i -nested]\
- [safe::interpConfigure $i -statics]\
- [safe::interpConfigure $i -DEL]\
- [safe::interpConfigure $i -accessPath /blah -statics 1;
- safe::interpConfigure $i]\
- [safe::interpConfigure $i -deleteHook toto -nosta -nested 0;
- safe::interpConfigure $i]
-} {{-accessPath /foo/bar -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath /foo/bar} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath /blah -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath /blah -statics 0 -nested 0 -deleteHook toto}}
-
-
-# testing that nested and statics do what is advertised
-# (we use a static package : Tcltest)
-
-if {[catch {package require Tcltest} msg]} {
- puts "This application hasn't been compiled with Tcltest"
- puts "skipping remining safe test that relies on it."
-} else {
-
- # we use the Tcltest package , which has no Safe_Init
-
-test safe-10.1 {testing statics loading} {
- set i [safe::interpCreate]
- list \
- [catch {interp eval $i {load {} Tcltest}} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
-
-test safe-10.2 {testing statics loading / -nostatics} {
- set i [safe::interpCreate -nostatics]
- list \
- [catch {interp eval $i {load {} Tcltest}} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {permission denied (static package)} {}}
-
-
-
-test safe-10.3 {testing nested statics loading / no nested by default} {
- set i [safe::interpCreate]
- list \
- [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {permission denied (nested load)} {}}
-
-
-test safe-10.4 {testing nested statics loading / -nestedloadok} {
- set i [safe::interpCreate -nestedloadok]
- list \
- [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
-
-
-}
-
-test safe-11.1 {testing safe encoding} {
+test safe-5.1 {loading Tk in safe interps without master's clearance} {
set i [safe::interpCreate]
- list \
- [catch {interp eval $i encoding} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding option ?arg ...?"} {}}
-
-test safe-11.2 {testing safe encoding} {
- set i [safe::interpCreate]
- list \
- [catch {interp eval $i encoding system cp775} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding system"} {}}
-
-test safe-11.3 {testing safe encoding} {
- set i [safe::interpCreate]
- set result [catch {
- string match [encoding system] [interp eval $i encoding system]
- } msg]
- list $result $msg [safe::interpDelete $i]
-} {0 1 {}}
-
-test safe-11.4 {testing safe encoding} {
- set i [safe::interpCreate]
- set result [catch {
- string match [encoding names] [interp eval $i encoding names]
- } msg]
- list $result $msg [safe::interpDelete $i]
-} {0 1 {}}
-
-test safe-11.5 {testing safe encoding} {
- set i [safe::interpCreate]
- list \
- [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \
- $msg \
- [safe::interpDelete $i];
-} {0 foobar {}}
-
+ catch {interp eval $i {load {} Tk}} msg
+ safe::interpDelete $i
+ set msg
+} {not allowed to start Tk by master's safe::TkInit}
-test safe-11.6 {testing safe encoding} {
+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]
- list \
- [catch {interp eval $i encoding convertto cp1258 foobar} msg] \
- $msg \
- [safe::interpDelete $i];
-} {0 foobar {}}
+ 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-11.7 {testing safe encoding} {
- set i [safe::interpCreate]
- list \
- [catch {interp eval $i encoding convertfrom} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}}
+test safe-6.1 {loadTk -use windowPath} {
+ set w .safeTkFrame
+ catch {destroy $w}
+ frame $w -container 1;
+ pack .safeTkFrame
+ set i [safe::loadTk [safe::interpCreate] -use $w]
+ interp eval $i {button .b -text "hello world!"; pack .b}
+ safe::interpDelete $i
+ destroy $w
+} {}
+test safe-6.2 {loadTk -use windowPath, conflicting -display} {
+ set w .safeTkFrame
+ catch {destroy $w}
+ frame $w -container 1;
+ pack .safeTkFrame
+ set i [safe::interpCreate]
+ catch {safe::loadTk $i -use $w -display :23.56} msg
+ safe::interpDelete $i
+ destroy $w
+ string range $msg 0 36
+} {conflicting -display :23.56 and -use }
-test safe-11.8 {testing safe encoding} {
- set i [safe::interpCreate]
- list \
- [catch {interp eval $i encoding convertto} msg] \
- $msg \
- [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}}
+test safe-7.1 {canvas printing} {
+ set i [safe::loadTk [safe::interpCreate]]
+ set r [catch {interp eval $i {canvas .c; .c postscript}}]
+ safe::interpDelete $i
+ set r
+} 0
# cleanup
+unset hidden_cmds
::tcltest::cleanupTests
return
diff --git a/tcl/tests/scale.test b/tcl/tests/scale.test
new file mode 100644
index 00000000000..a6271ab7037
--- /dev/null
+++ b/tcl/tests/scale.test
@@ -0,0 +1,825 @@
+# This file is a Tcl script to test out the "scale" command
+# of Tk. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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 orient "badValue": must be horizontal or vertical}}
+ {-orient horizontal horizontal {} {}}
+ {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
+ {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
+ {-resolution 2.0 2.0 badValue
+ {expected floating-point number but got "badValue"}}
+ {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
+ {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
+ {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-state d disabled badValue
+ {bad state "badValue": must be active, disabled, or normal}}
+ {-state n 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] 6]
+} {33 {-command command Command {} {}}}
+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 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
+test scale-3.31 {ScaleWidgetCmd procedure} {
+ list [catch {.s co} msg] $msg
+} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
+test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
+ proc kill args {
+ destroy .s
+ }
+ catch {destroy .s}
+ scale .s -variable x -from 0 -to 100 -orient horizontal
+ pack .s
+ 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 orient "dumb": must be horizontal or vertical}}
+test scale-5.5 {ConfigureScale procedure} {
+ catch {destroy .s}
+ scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
+ list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \
+ [format %.1f [.s cget -tickinterval]]
+} {1.1 1.9 0.8}
+test scale-5.6 {ConfigureScale procedure} {
+ catch {destroy .s}
+ scale .s -from 1 -to 10 -tickinterval -2
+ pack .s
+ set result [lindex [.s configure -tickinterval] 4]
+ .s configure -from 10 -to 1 -tickinterval 2
+ lappend result [lindex [.s configure -tickinterval] 4]
+} {2.0 -2.0}
+test scale-5.7 {ConfigureScale procedure} {
+ catch {destroy .s}
+ list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
+} {1 {bad state "bogus": must be active, disabled, or normal}}
+
+catch {destroy .s}
+scale .s -orient horizontal -length 200
+pack .s
+test scale-6.1 {ComputeFormat procedure} {
+ .s configure -from 10 -to 100 -resolution 10
+ .s set 49.3
+ .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} {nonPortable 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} {nonPortable 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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]
+deleteWindows
+
+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]
+
+test scale-17.1 {bug fix 1786} {
+ # Perhaps x is set to {}, depending on what other tests have run.
+ # If x is unset, or set to something not convertable to a double,
+ # then the scale try to initialize its value with the contents
+ # of uninitialized memory. Sometimes that causes an FPE.
+
+ set x {}
+ scale .s -from 100 -to 300
+ pack .s
+ update
+ .s configure -variable x ;# CRASH! -> Floating point exception
+
+ # Bug 4833 changed the result to realize that x should pick up
+ # a value from the scale. In an FPE occurs, it is due to the
+ # lack of errno being set to 0 by some libc's. (see bug 4942)
+ set x
+} {100}
+
+test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
+ catch {destroy .s}
+ scale .s -cursor trek
+ destroy .s
+} {}
+
+catch {destroy .s}
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/scrollbar.test b/tcl/tests/scrollbar.test
new file mode 100644
index 00000000000..c8c4a6b93fd
--- /dev/null
+++ b/tcl/tests/scrollbar.test
@@ -0,0 +1,687 @@
+# This file is a Tcl script to test out scrollbar widgets and
+# the "scrollbar" command of Tk. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+## testmetrics is a win/mac only test command
+##
+testConstraint testmetrics [llength [info commands testmetrics]]
+
+update
+
+proc scroll args {
+ global scrollInfo
+ set scrollInfo $args
+}
+
+proc getTroughSize {w} {
+ if {[testConstraint testmetrics]} {
+ 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" {} {}}
+ {-troughcolor #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} {pcOnly} {
+ list [catch {.s2 cget -bd} msg] $msg
+} {0 0}
+test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
+ list [catch {.s2 cget -bd} msg] $msg
+} {0 2}
+test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
+ list [catch {.s2 cget -highlightthickness} msg] $msg
+} {0 0}
+test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
+ list [catch {.s2 cget -highlightthickness} msg] $msg
+} {0 1}
+destroy .s2
+test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} {
+ llength [.s configure]
+} {20}
+test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} {
+ 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} {testmetrics} {
+ .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} {testmetrics 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 {[testConstraint testmetrics]} {
+ 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} {testmetrics 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} {testmetrics pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll]
+} {trough1}
+test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics 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} {testmetrics pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \
+ + [testmetrics cyvscroll]]
+} {slider}
+test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics 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} {testmetrics pcOnly knownBug} {
+ # This asks for 8,21, which is actually the slider, but there is a
+ # bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value
+ # that is larger than the thumb displayed, skewing the ability to
+ # calculate the trough2 area correctly (Win2k). -- hobbs
+ .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \
+ + [testmetrics cyvscroll]]
+} {trough2}
+test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics 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} {testmetrics 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} {testmetrics 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
+ event generate .t <ButtonRelease> -button 1
+ 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
+ event generate .t.f <ButtonRelease> -button 1
+ update
+ lappend result [winfo exists .t.f.s] [winfo exists .t.f]
+ rename bgerror {}
+ set result
+} {1 0 1}
+
+set l [interp hidden]
+deleteWindows
+
+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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/select.test b/tcl/tests/select.test
new file mode 100644
index 00000000000..c31d0c8822f
--- /dev/null
+++ b/tcl/tests/select.test
@@ -0,0 +1,1061 @@
+# This file is a Tcl script to test out Tk's selection management code,
+# especially the "selection" command. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+#
+# Note: Multiple display selection handling will only be tested if the
+# environment variable TK_ALT_DISPLAY is set to an alternate display.
+#
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::interpreter
+
+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.1 {Tk_CreateSelHandler procedure} {unixOnly} {
+ 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 UTF8_STRING}
+test select-1.4.2 {Tk_CreateSelHandler procedure} {macOrPc} {
+ 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.1 {Tk_CreateSelHandler procedure} {unixOnly} {
+ 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 UTF8_STRING}}
+test select-1.6.2 {Tk_CreateSelHandler procedure} {macOrPc} {
+ 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.1 {Tk_CreateSelHandler procedure} {unixOnly} {
+ 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 UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-1.7.2 {Tk_CreateSelHandler procedure} {macOrPc} {
+ 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} {unixOnly} {
+ 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 UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}}
+test select-2.2 {Tk_DeleteSelHandler procedure} {unixOnly} {
+ 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 UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}}
+test select-2.3 {Tk_DeleteSelHandler procedure} {unixOnly} {
+ 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 UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-2.4 {Tk_DeleteSelHandler procedure} {macOrPc} {
+ 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.5 {Tk_DeleteSelHandler procedure} {macOrPc} {
+ 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.6 {Tk_DeleteSelHandler procedure} {macOrPc} {
+ 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.7 {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
+test select-3.10 {Tk_OwnSelection procedure} {altDisplay} {
+ 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} {altDisplay} {
+ 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
+test select-4.5 {Tk_ClearSelection procedure} {altDisplay} {
+ 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 altDisplay} {
+ 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 ""
+ lappend result [dobg {selection get TEST} 1]
+ cleanupbg
+ lappend result $selInfo
+} {{selection owner didn't respond} {}}
+
+# multiple display tests
+
+test select-5.11 {Tk_GetSelection procedure} {altDisplay} {
+ 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} {altDisplay} {
+ 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 altDisplay} {
+ 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 altDisplay} {
+ 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 {bad option "-badopt": must be -displayof or -selection}}
+test select-6.7 {Tk_SelectionCmd procedure} {
+ list [catch {selection clear -selectionfoo foo} cmd] $cmd
+} {1 {bad option "-selectionfoo": must be -displayof or -selection}}
+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 {bad option "-badopt": must be -displayof, -selection, or -type}}
+test select-6.18 {Tk_SelectionCmd procedure} {
+ list [catch {selection get -selectionfoo foo} cmd] $cmd
+} {1 {bad option "-selectionfoo": must be -displayof, -selection, or -type}}
+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 {bad option "-badopt": must be -format, -selection, or -type}}
+test select-6.25 {Tk_SelectionCmd procedure} {
+ list [catch {selection handle -selectionfoo foo} cmd] $cmd
+} {1 {bad option "-selectionfoo": must be -format, -selection, or -type}}
+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 {bad option "-badopt": must be -command, -displayof, or -selection}}
+test select-6.35 {Tk_SelectionCmd procedure} {
+ list [catch {selection own -selectionfoo foo} cmd] $cmd
+} {1 {bad option "-selectionfoo": must be -command, -displayof, or -selection}}
+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
+ proc Ready {fd} {
+ variable x
+ lappend x [gets $fd]
+ }
+ set fd [open "|[list [interpreter] -geometry +0+0 -name tktest]" r+]
+ puts $fd "puts foo; flush stdout"
+ flush $fd
+ gets $fd
+ fileevent $fd readable [list Ready $fd]
+ 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 x {}
+ vwait [namespace which -variable x]
+ puts $fd {exit}
+ flush $fd
+ close $fd
+ lappend x $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
+# This one hangs in Exceed
+test select-10.4 {ConvertSelection procedure} {unixOnly noExceed} {
+ 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 {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/send.test b/tcl/tests/send.test
new file mode 100644
index 00000000000..92bdb890ef7
--- /dev/null
+++ b/tcl/tests/send.test
@@ -0,0 +1,630 @@
+# This file is a Tcl script to test out the "send" command and the
+# other procedures in the file tkSend.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2001 by ActiveState Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint xhost [llength [auto_execok xhost]]
+testConstraint testsend [llength [info commands testsend]]
+
+# 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]
+set commId ""
+catch {
+ 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 .}
+
+test send-1.1 {RegOpen procedure, bogus property} {secureserver testsend} {
+ testsend bogus
+ set result [winfo interps]
+ tk appname tktest
+ list $result [winfo interps]
+} {{} tktest}
+test send-1.2 {RegOpen procedure, bogus property} {secureserver testsend} {
+ testsend prop root InterpRegistry {}
+ set result [winfo interps]
+ tk appname tktest
+ list $result [winfo interps]
+} {{} tktest}
+test send-1.3 {RegOpen procedure, bogus property} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ testsend prop root InterpRegistry {}
+ list [catch {send foo bar} msg] $msg
+} {1 {no application named "foo"}}
+test send-2.2 {RegFindName procedure} {secureserver testsend} {
+ testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n"
+ tk appname foo
+} {foo #2}
+test send-2.3 {RegFindName procedure} {secureserver testsend} {
+ testsend prop root InterpRegistry "gyz foo\n"
+ tk appname foo
+} {foo}
+test send-2.4 {RegFindName procedure} {secureserver testsend} {
+ testsend prop root InterpRegistry "${id}z foo\n"
+ tk appname foo
+} {foo}
+
+test send-3.1 {RegDeleteName procedure} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ testsend prop root InterpRegistry ""
+ tk appname bar
+ testsend prop root InterpRegistry
+} "$commId bar\n"
+test send-4.2 {RegAddName procedure} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ testsend prop root InterpRegistry "123 abc\n"
+ winfo interps
+} {}
+test send-5.2 {ValidateName procedure} {secureserver testsend} {
+ testsend prop root InterpRegistry "$id Hi there"
+ winfo interps
+} {{Hi there}}
+test send-5.3 {ValidateName procedure} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ tk appname test
+ testsend prop root InterpRegistry "$commId Bogus\n$commId test\n"
+ winfo interps
+} {test}
+
+if {[testConstraint xhost]} {
+ 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 secureserver} {
+ set a 44
+ list [dobg [list send [tk appname] set a 55]] $a
+} {55 55}
+test send-6.2 {ServerSecure procedure} {nonPortable secureserver} {
+ 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 secureserver} {
+ set a abc
+ exec xhost - [exec hostname]
+ list [dobg [list send [tk appname] set a new]] $a
+} {new new}
+cleanupbg
+
+test send-7.1 {Tk_SetAppName procedure} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver} {
+ 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}
+test send-8.2 {Tk_SendCmd procedure, options} {secureserver altDisplay} {
+ 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} {secureserver} {
+ list [catch {send -- -async foo bar baz} msg] $msg
+} {1 {no application named "-async"}}
+test send-8.4 {Tk_SendCmd procedure, options} {secureserver} {
+ 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} {secureserver} {
+ 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} {secureserver} {
+ 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} {secureserver} {
+ set a initial
+ send [tk appname] {set a new}
+ set a
+} {new}
+test send-8.8 {Tk_SendCmd procedure, local execution} {secureserver} {
+ set a initial
+ send [tk appname] set a new
+ set a
+} {new}
+test send-8.9 {Tk_SendCmd procedure, local execution} {secureserver} {
+ 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} {secureserver} {
+ list [catch {send bogus_name bogus_command} msg] $msg
+} {1 {no application named "bogus_name"}}
+
+catch {
+ newApp "" t_s_1 Test
+ t_s_1 eval wm withdraw .
+}
+
+test send-8.11 {Tk_SendCmd procedure, local execution, different interp} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ newApp "" t_s_2 Test
+ list [catch {send t_s_2 {destroy .; concat result}} msg] $msg
+} {0 result}
+
+catch {interp delete t_s_2}
+
+test send-8.15 {Tk_SendCmd procedure, local interp, error info} {secureserver testsend} {
+ catch {error foo}
+ list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
+} {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
+ while executing
+"open bogus_file_name"
+ invoked from within
+"if 1 {open bogus_file_name}"
+ invoked from within
+"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
+test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend} {
+ 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"}}
+
+catch {interp delete t_s_1}
+
+test send-8.17 {Tk_SendCmd procedure, deferring events} {secureserver 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} {secureserver} {
+ 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} {secureserver} {
+ 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]
+
+test send-9.1 {Tk_GetInterpNames procedure} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ testsend prop root InterpRegistry {}
+ list [winfo interps] [testsend prop root InterpRegistry]
+} {{} {}}
+
+catch {testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"}
+
+test send-10.1 {SendEventProc procedure, bogus comm property} {secureserver testsend} {
+ testsend prop comm Comm {abc def}
+ testsend prop comm Comm {}
+ update
+} {}
+test send-10.2 {SendEventProc procedure, simultaneous messages} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ setupbg
+ dobg {tk appname t_s_3}
+ set x [list [catch {send t_s_3 exit} msg] $msg]
+ cleanupbg
+ set x
+} {1 {target application died}}
+
+test send-11.1 {AppendPropCarefully and AppendErrorProc procedures} {secureserver testsend} {
+ 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} {secureserver testsend} {
+ 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]
+
+test send-12.1 {TimeoutProc procedure} {secureserver testsend} {
+ 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}}
+
+catch {testsend prop root InterpRegistry ""}
+
+test send-12.2 {TimeoutProc procedure} {secureserver} {
+ winfo interps
+ tk appname tktest
+ update
+ setupbg
+ set app [dobg {
+ after 10 {after 10 {after 5000; exit}}
+ tk appname
+ }]
+ after 200
+ set result [list [catch {send $app foo} msg] $msg]
+ cleanupbg
+ set result
+} {1 {target application died}}
+
+winfo interps
+tk appname tktest
+test send-13.1 {DeleteProc procedure} {secureserver} {
+ 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} {secureserver} {
+ 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}
+
+test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {secureserver altDisplay} {
+ 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}
+
+catch {
+ testsend prop root InterpRegister $registry
+ tk appname tktest
+}
+test send-15.1 {UpdateCommWindow procedure} {secureserver testsend} {
+ 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}
+
+catch {
+ tk appname $name
+ testsend prop root InterpRegistry $registry
+ testdeleteapps
+}
+rename newApp {}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/spinbox.test b/tcl/tests/spinbox.test
new file mode 100644
index 00000000000..aebcb4b0c19
--- /dev/null
+++ b/tcl/tests/spinbox.test
@@ -0,0 +1,1589 @@
+# This file is a Tcl script to test spinbox widgets in Tk. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+proc scroll args {
+ global scrollInfo
+ set scrollInfo $args
+}
+
+# Create additional widget that's used to hold the selection at times.
+
+spinbox .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 *Spinbox.borderWidth 2
+option add *Spinbox.highlightThickness 2
+option add *Spinbox.font {Helvetica -12}
+
+spinbox .e -bd 2 -relief sunken
+pack .e
+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"}}
+ {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
+ {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-buttonbackground #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-buttoncursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-command {a command} {a command} {} {}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-disabledbackground green green non-existent
+ {unknown color name "non-existent"}}
+ {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-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"}}
+ {-format %0.5f %0.5f %d {bad spinbox format specifier "%d"}}
+ {-from -10 -10.0 bogus {expected floating-point number but got "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 {} {}}
+ {-increment 1.0 1.0 bogus {expected floating-point number but got "bogus"}}
+ {-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"}}
+ {-invalidcommand "a command" "a command" {} {}}
+ {-invcmd "a command" "a command" {} {}}
+ {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
+ {-readonlybackground green green non-existent
+ {unknown color name "non-existent"}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-repeatdelay 500 500 3p {expected integer but got "3p"}}
+ {-repeatinterval -500 -500 3p {expected integer but got "3p"}}
+ {-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"}}
+ {-state n normal bogus {bad state "bogus": must be disabled, normal, or readonly}}
+ {-takefocus "any string" "any string" {} {}}
+ {-textvariable i i {} {}}
+ {-to 14.9 14.9 bogus {expected floating-point number but got "bogus"}}
+ {-validate "key" "key" "bogus" {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}}
+ {-validatecommand "a command" "a command" {} {}}
+ {-values {mon tue wed thur} {mon tue wed thur} {bad {}list} {list element in braces followed by "list" instead of space}}
+ {-vcmd "a command" "a command" {} {}}
+ {-width 402 402 3p {expected integer but got "3p"}}
+ {-wrap yes 1 xyzzy {expected boolean value but got "xyzzy"}}
+ {-xscrollcommand {Some command} {Some command} {} {}}
+} {
+ set name [lindex $test 0]
+ test spinbox-1.$i {configuration options} {
+ .e configure $name [lindex $test 1]
+ list [lindex [.e configure $name] 4] [.e cget $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test spinbox-1.$i {configuration options} {
+ list [catch {.e configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .e configure $name [lindex [.e configure $name] 3]
+ incr i
+}
+
+test spinbox-2.1 {Tk_SpinboxCmd procedure} {
+ list [catch {spinbox} msg] $msg
+} {1 {wrong # args: should be "spinbox pathName ?options?"}}
+test spinbox-2.2 {Tk_SpinboxCmd procedure} {
+ list [catch {spinbox gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test spinbox-2.3 {Tk_SpinboxCmd procedure} {
+ catch {destroy .e}
+ spinbox .e
+ list [winfo exists .e] [winfo class .e] [info commands .e]
+} {1 Spinbox .e}
+test spinbox-2.4 {Tk_SpinboxCmd procedure} {
+ catch {destroy .e}
+ list [catch {spinbox .e -gorp foo} msg] $msg [winfo exists .e] \
+ [info commands .e]
+} {1 {unknown option "-gorp"} 0 {}}
+test spinbox-2.5 {Tk_SpinboxCmd procedure} {
+ catch {destroy .e}
+ spinbox .e
+} {.e}
+
+catch {destroy .e}
+spinbox .e -font $fixed
+pack .e
+update
+
+set cx [font measure $fixed a]
+set cy [font metrics $fixed -linespace]
+set ux [font measure $fixed \u4e4e]
+
+test spinbox-3.1 {SpinboxWidgetCmd procedure} {
+ list [catch {.e} msg] $msg
+} {1 {wrong # args: should be ".e option ?arg arg ...?"}}
+test spinbox-3.2 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ list [catch {.e bbox} msg] $msg
+} {1 {wrong # args: should be ".e bbox index"}}
+test spinbox-3.3 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ list [catch {.e bbox a b} msg] $msg
+} {1 {wrong # args: should be ".e bbox index"}}
+test spinbox-3.4 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ list [catch {.e bbox bogus} msg] $msg
+} {1 {bad spinbox index "bogus"}}
+test spinbox-3.5 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ .e delete 0 end
+ .e bbox 0
+} [list 5 5 0 $cy]
+test spinbox-3.6 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): no utf chars
+
+ .e delete 0 end
+ .e insert 0 "abc"
+ list [.e bbox 3] [.e bbox end]
+} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"]
+test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): utf at end
+ .e delete 0 end
+ .e insert 0 "ab\u4e4e"
+ .e bbox end
+} "[expr 5+2*$cx] 5 $ux $cy"
+test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): utf before index
+ .e delete 0 end
+ .e insert 0 "ab\u4e4ec"
+ .e bbox 3
+} "[expr 5+2*$cx+$ux] 5 $cx $cy"
+test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ # Tcl_UtfAtIndex(): no chars
+ .e delete 0 end
+ .e bbox end
+} "5 5 0 $cy"
+test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} {
+ .e delete 0 end
+ .e insert 0 "abcdefghij\u4e4eklmnop"
+ list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
+} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"]
+test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} {
+ list [catch {.e cget} msg] $msg
+} {1 {wrong # args: should be ".e cget option"}}
+test spinbox-3.12 {SpinboxWidgetCmd procedure, "cget" widget command} {
+ list [catch {.e cget a b} msg] $msg
+} {1 {wrong # args: should be ".e cget option"}}
+test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} {
+ list [catch {.e cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} {
+ .e configure -bd 4
+ .e cget -bd
+} {4}
+test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} {
+ llength [.e configure]
+} {49}
+test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} {
+ list [catch {.e configure -foo} msg] $msg
+} {1 {unknown option "-foo"}}
+test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} {
+ .e configure -bd 4
+ .e configure -bg #ffffff
+ lindex [.e configure -bd] 4
+} {4}
+test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete} msg] $msg
+} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
+test spinbox-3.19 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete a b c} msg] $msg
+} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
+test spinbox-3.20 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete foo} msg] $msg
+} {1 {bad spinbox index "foo"}}
+test spinbox-3.21 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ list [catch {.e delete 0 bar} msg] $msg
+} {1 {bad spinbox index "bar"}}
+test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e delete 2 4
+ .e get
+} {014567890}
+test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e delete 6
+ .e get
+} {0123457890}
+test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ # UTF
+ set x {}
+ .e delete 0 end
+ .e insert end "01234\u4e4e67890"
+ .e delete 6
+ lappend x [.e get]
+ .e delete 0 end
+ .e insert end "012345\u4e4e7890"
+ .e delete 6
+ lappend x [.e get]
+ .e delete 0 end
+ .e insert end "0123456\u4e4e890"
+ .e delete 6
+ lappend x [.e get]
+} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
+test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e delete 6 5
+ .e get
+} {01234567890}
+test spinbox-3.26 {SpinboxWidgetCmd 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 spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} {
+ list [catch {.e get foo} msg] $msg
+} {1 {wrong # args: should be ".e get"}}
+test spinbox-3.28 {SpinboxWidgetCmd procedure, "icursor" widget command} {
+ list [catch {.e icursor} msg] $msg
+} {1 {wrong # args: should be ".e icursor pos"}}
+test spinbox-3.29 {SpinboxWidgetCmd procedure, "icursor" widget command} {
+ list [catch {.e icursor foo} msg] $msg
+} {1 {bad spinbox index "foo"}}
+test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e icursor 4
+ .e index insert
+} {4}
+test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} {
+ list [catch {.e in} msg] $msg
+} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}}
+test spinbox-3.32 {SpinboxWidgetCmd procedure, "index" widget command} {
+ list [catch {.e index} msg] $msg
+} {1 {wrong # args: should be ".e index string"}}
+test spinbox-3.33 {SpinboxWidgetCmd procedure, "index" widget command} {
+ list [catch {.e index foo} msg] $msg
+} {1 {bad spinbox index "foo"}}
+test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} {
+ list [catch {.e index 0} msg] $msg
+} {0 0}
+test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} {
+ # UTF
+ .e delete 0 end
+ .e insert 0 abc\u4e4e\u0153def
+ list [.e index 3] [.e index 4] [.e index end]
+} {3 4 8}
+test spinbox-3.36 {SpinboxWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert a} msg] $msg
+} {1 {wrong # args: should be ".e insert index text"}}
+test spinbox-3.37 {SpinboxWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert a b c} msg] $msg
+} {1 {wrong # args: should be ".e insert index text"}}
+test spinbox-3.38 {SpinboxWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert foo Text} msg] $msg
+} {1 {bad spinbox index "foo"}}
+test spinbox-3.39 {SpinboxWidgetCmd procedure, "insert" widget command} {
+ .e delete 0 end
+ .e insert end "01234567890"
+ .e insert 3 xxx
+ .e get
+} {012xxx34567890}
+test spinbox-3.40 {SpinboxWidgetCmd 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 spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} {
+ list [catch {.e insert a b c} msg] $msg
+} {1 {wrong # args: should be ".e insert index text"}}
+test spinbox-3.42 {SpinboxWidgetCmd procedure, "scan" widget command} {
+ list [catch {.e scan a} msg] $msg
+} {1 {wrong # args: should be ".e scan mark|dragto x"}}
+test spinbox-3.43 {SpinboxWidgetCmd procedure, "scan" widget command} {
+ list [catch {.e scan a b c} msg] $msg
+} {1 {wrong # args: should be ".e scan mark|dragto x"}}
+test spinbox-3.44 {SpinboxWidgetCmd procedure, "scan" widget command} {
+ list [catch {.e scan foobar 20} msg] $msg
+} {1 {bad scan option "foobar": must be mark or dragto}}
+test spinbox-3.45 {SpinboxWidgetCmd 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 spinbox-3.46 {SpinboxWidgetCmd 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 spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} {
+ list [catch {.e select} msg] $msg
+} {1 {wrong # args: should be ".e selection option ?index?"}}
+test spinbox-3.48 {SpinboxWidgetCmd procedure, "select" widget command} {
+ list [catch {.e select foo} msg] $msg
+} {1 {bad selection option "foo": must be adjust, clear, element, from, present, range, or to}}
+test spinbox-3.49 {SpinboxWidgetCmd procedure, "select clear" widget command} {
+ list [catch {.e select clear gorp} msg] $msg
+} {1 {wrong # args: should be ".e selection clear"}}
+test spinbox-3.50 {SpinboxWidgetCmd 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 spinbox-3.51 {SpinboxWidgetCmd procedure, "selection present" widget command} {
+ list [catch {.e selection present foo} msg] $msg
+} {1 {wrong # args: should be ".e selection present"}}
+test spinbox-3.52 {SpinboxWidgetCmd 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 spinbox-3.53 {SpinboxWidgetCmd 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 spinbox-3.54 {SpinboxWidgetCmd 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 spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} {
+ list [catch {.e select adjust x} msg] $msg
+} {1 {bad spinbox index "x"}}
+test spinbox-3.56 {SpinboxWidgetCmd procedure, "selection adjust" widget command} {
+ list [catch {.e select adjust 2 3} msg] $msg
+} {1 {wrong # args: should be ".e selection adjust index"}}
+test spinbox-3.57 {SpinboxWidgetCmd 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 spinbox-3.58 {SpinboxWidgetCmd 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 spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} {
+ list [catch {.e select from 2 3} msg] $msg
+} {1 {wrong # args: should be ".e selection from index"}}
+test spinbox-3.60 {SpinboxWidgetCmd procedure, "selection range" widget command} {
+ list [catch {.e select range 2} msg] $msg
+} {1 {wrong # args: should be ".e selection range start end"}}
+test spinbox-3.61 {SpinboxWidgetCmd 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 spinbox-3.62 {SpinboxWidgetCmd 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 widget .e}}
+test spinbox-3.63 {SpinboxWidgetCmd 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 spinbox-3.64 {SpinboxWidgetCmd procedure, "selection to" widget command} {
+ list [catch {.e select to 2 3} msg] $msg
+} {1 {wrong # args: should be ".e selection to index"}}
+test spinbox-3.65 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview 5
+ .e xview
+} {0.0537634 0.268817}
+test spinbox-3.66 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview gorp} msg] $msg
+} {1 {bad spinbox index "gorp"}}
+test spinbox-3.67 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview 0
+ .e icursor 10
+ .e xview insert
+ .e xview
+} {0.107527 0.322581}
+test spinbox-3.68 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview moveto foo bar} msg] $msg
+} {1 {wrong # args: should be ".e xview moveto fraction"}}
+test spinbox-3.69 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview moveto foo} msg] $msg
+} {1 {expected floating-point number but got "foo"}}
+test spinbox-3.70 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview moveto 0.5
+ .e xview
+} {0.505376 0.72043}
+test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview scroll 24} msg] $msg
+} {1 {wrong # args: should be ".e xview scroll number units|pages"}}
+test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview scroll gorp units} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview moveto 0
+ .e xview scroll 1 pages
+ .e xview
+} {0.193548 0.408602}
+test spinbox-3.74 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview moveto .9
+ update
+ .e xview scroll -2 p
+ .e xview
+} {0.397849 0.612903}
+test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview 30
+ update
+ .e xview scroll 2 units
+ .e index @0
+} {32}
+test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview 30
+ update
+ .e xview scroll -1 units
+ .e index @0
+} {29}
+test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview scroll 23 foobars} msg] $msg
+} {1 {bad argument "foobars": must be units or pages}}
+test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ list [catch {.e xview eat 23 hamburgers} msg] $msg
+} {1 {unknown option "eat": must be moveto or scroll}}
+test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview 0
+ update
+ .e xview -4
+ .e index @0
+} {0}
+test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ .e xview 300
+ .e index @0
+} {73}
+.e insert 10 \u4e4e
+test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} {
+ # UTF
+ # If Tcl_NumUtfChars wasn't used, wrong answer would be:
+ # 0.106383 0.117021 0.117021
+
+ set x {}
+ .e xview moveto .1
+ lappend x [lindex [.e xview] 0]
+ .e xview moveto .11
+ lappend x [lindex [.e xview] 0]
+ .e xview moveto .12
+ lappend x [lindex [.e xview] 0]
+} {0.0957447 0.106383 0.117021}
+test spinbox-3.82 {SpinboxWidgetCmd procedure} {
+ list [catch {.e gorp} msg] $msg
+} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}}
+
+frame .f -width 200 -height 50 -relief raised -bd 2
+pack .f -side right
+test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} {
+ catch {destroy .e}
+ set x 12345
+ spinbox .e -textvariable x
+ .e get
+} {12345}
+test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} {
+ catch {destroy .e}
+ set x 12345
+ spinbox .e -textvariable x
+ set y abcde
+ .e configure -textvariable y
+ set x 54321
+ .e get
+} {abcde}
+test spinbox-5.3 {ConfigureSpinbox procedure, -textvariable} {
+ catch {destroy .e}
+ catch {unset x}
+ spinbox .e
+ .e insert 0 "Some text"
+ .e configure -textvariable x
+ set x
+} {Some text}
+test spinbox-5.4 {ConfigureSpinbox procedure, -textvariable} {
+ proc override args {
+ global x
+ set x 12345
+ }
+ catch {destroy .e}
+ catch {unset x}
+ trace variable x w override
+ spinbox .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 spinbox-5.5 {ConfigureSpinbox procedure} {
+ catch {destroy .e}
+ spinbox .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 spinbox-5.6 {ConfigureSpinbox procedure} {
+ catch {destroy .e}
+ spinbox .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 spinbox-5.7 {ConfigureSpinbox procedure} {
+ catch {destroy .e}
+ spinbox .e -font $fixed -width 4 -xscrollcommand scroll
+ pack .e
+ .e insert end "01234567890"
+ update
+ .e configure -width 5
+ set scrollInfo
+} {0 0.363636}
+test spinbox-5.8 {ConfigureSpinbox procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .e -width 0
+ pack .e
+ .e insert end "0123"
+ update
+ .e configure -font $big
+ update
+ winfo geom .e
+} {79x37+0+0}
+test spinbox-5.9 {ConfigureSpinbox procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .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 spinbox-5.10 {ConfigureSpinbox procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .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 spinbox-5.11 {ConfigureSpinbox procedure} {
+ # If "0" in selected font had 0 width, caused divide-by-zero error.
+
+ catch {destroy .e}
+ pack [spinbox .e -font {{open look glyph}}]
+ .e scan dragto 30
+ update
+} {}
+
+# No tests for DisplaySpinbox.
+
+test spinbox-6.1 {SpinboxComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .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 spinbox-6.2 {SpinboxComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .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 spinbox-6.3 {SpinboxComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .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 spinbox-6.4 {SpinboxComputeGeometry procedure} {
+ catch {destroy .e}
+ spinbox .e -font $fixed -bd 2 -relief raised -width 5
+ pack .e
+ .e insert end "01234567890"
+ update
+ .e xview 6
+ .e index @0
+} {6}
+test spinbox-6.5 {SpinboxComputeGeometry procedure} {
+ catch {destroy .e}
+ spinbox .e -font $fixed -bd 2 -relief raised -width 5
+ pack .e
+ .e insert end "01234567890"
+ update
+ .e xview 7
+ .e index @0
+} {6}
+test spinbox-6.6 {SpinboxComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .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 spinbox-6.7 {SpinboxComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .e -font $big -bd 3 -relief raised -width 5
+ pack .e
+ .e insert end "01234567"
+ update
+ list [winfo reqwidth .e] [winfo reqheight .e]
+} {94 39}
+test spinbox-6.8 {SpinboxComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .e -font $big -bd 3 -relief raised -width 0
+ pack .e
+ .e insert end "01234567"
+ update
+ list [winfo reqwidth .e] [winfo reqheight .e]
+} {133 39}
+test spinbox-6.9 {SpinboxComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ spinbox .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2
+ pack .e
+ update
+ list [winfo reqwidth .e] [winfo reqheight .e]
+} {42 39}
+
+catch {destroy .e}
+spinbox .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
+pack .e
+focus .e
+test spinbox-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 spinbox-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 spinbox-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 spinbox-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 spinbox-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 spinbox-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 spinbox-7.7 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e icursor 4
+ .e insert 4 XXX
+ .e index insert
+} {7}
+test spinbox-7.8 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e icursor 4
+ .e insert 5 XXX
+ .e index insert
+} {4}
+test spinbox-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 spinbox-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 spinbox-7.11 {InsertChars procedure} {fonts} {
+ .e delete 0 end
+ .e insert 0 "xyzzy"
+ update
+ .e insert 2 00
+ winfo reqwidth .e
+} {70}
+
+.e configure -width 10
+test spinbox-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 spinbox-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 spinbox-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 spinbox-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 spinbox-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 spinbox-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 spinbox-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 widget .e}}
+test spinbox-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 spinbox-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 widget .e}}
+test spinbox-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 spinbox-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 spinbox-8.12 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e icursor 4
+ .e delete 1 4
+ .e index insert
+} {1}
+test spinbox-8.13 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e icursor 4
+ .e delete 1 5
+ .e index insert
+} {1}
+test spinbox-8.14 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e icursor 4
+ .e delete 4 6
+ .e index insert
+} {4}
+test spinbox-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 spinbox-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 spinbox-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 spinbox-8.18 {DeleteChars procedure} {fonts} {
+ .e delete 0 end
+ .e insert 0 "xyzzy"
+ update
+ .e delete 2 4
+ winfo reqwidth .e
+} {42}
+
+test spinbox-9.1 {SpinboxValueChanged procedure} {
+ catch {destroy .e}
+ proc override args {
+ global x
+ set x 12345
+ }
+ catch {unset x}
+ trace variable x w override
+ spinbox .e -textvariable x
+ .e insert 0 foo
+ set result [list $x [.e get]]
+ unset x; rename override {}
+ set result
+} {12345 12345}
+
+catch {destroy .e}
+spinbox .e
+pack .e
+.e configure -width 0
+test spinbox-10.1 {SpinboxSetValue 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 35}
+test spinbox-10.2 {SpinboxSetValue procedure, updating selection} {
+ catch {destroy .e}
+ spinbox .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 widget .e}}
+test spinbox-10.3 {SpinboxSetValue procedure, updating selection} {
+ catch {destroy .e}
+ spinbox .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 spinbox-10.4 {SpinboxSetValue procedure, updating selection} {
+ catch {destroy .e}
+ spinbox .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 spinbox-10.5 {SpinboxSetValue procedure, updating display position} {
+ catch {destroy .e}
+ spinbox .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 spinbox-10.6 {SpinboxSetValue procedure, updating display position} {
+ catch {destroy .e}
+ spinbox .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 spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} {
+ catch {destroy .e}
+ spinbox .e -width 10 -font $fixed -textvariable x
+ pack .e
+ .e insert 0 "abcdefghjklmnopqrstuvwxyz"
+ .e icursor 5
+ set x "123"
+ .e index insert
+} {3}
+test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} {
+ catch {destroy .e}
+ spinbox .e -width 10 -font $fixed -textvariable x
+ pack .e
+ .e insert 0 "abcdefghjklmnopqrstuvwxyz"
+ .e icursor 5
+ set x "123456"
+ .e index insert
+} {5}
+
+test spinbox-11.1 {SpinboxEventProc procedure} {
+ catch {destroy .e}
+ spinbox .e
+ .e insert 0 abcdefg
+ destroy .e
+ update
+} {}
+test spinbox-11.2 {SpinboxEventProc procedure} {
+ deleteWindows
+ spinbox .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 spinbox-12.1 {SpinboxCmdDeletedProc procedure} {
+ deleteWindows
+ button .e1 -text "xyz_123"
+ rename .e1 {}
+ list [info command .e*] [winfo children .]
+} {{} {}}
+
+catch {destroy .e}
+spinbox .e -font $fixed -width 5 -bd 2 -relief sunken
+pack .e
+.e insert 0 012345678901234567890
+.e xview 4
+update
+test spinbox-13.1 {GetSpinboxIndex procedure} {
+ .e index end
+} {21}
+test spinbox-13.2 {GetSpinboxIndex procedure} {
+ list [catch {.e index abogus} msg] $msg
+} {1 {bad spinbox index "abogus"}}
+test spinbox-13.3 {GetSpinboxIndex procedure} {
+ .e select from 1
+ .e select to 6
+ .e index anchor
+} {1}
+test spinbox-13.4 {GetSpinboxIndex procedure} {
+ .e select from 4
+ .e select to 1
+ .e index anchor
+} {4}
+test spinbox-13.5 {GetSpinboxIndex procedure} {
+ .e select from 3
+ .e select to 15
+ .e select adjust 4
+ .e index anchor
+} {15}
+test spinbox-13.6 {GetSpinboxIndex procedure} {
+ list [catch {.e index ebogus} msg] $msg
+} {1 {bad spinbox index "ebogus"}}
+test spinbox-13.7 {GetSpinboxIndex procedure} {
+ .e icursor 2
+ .e index insert
+} {2}
+test spinbox-13.8 {GetSpinboxIndex procedure} {
+ list [catch {.e index ibogus} msg] $msg
+} {1 {bad spinbox index "ibogus"}}
+test spinbox-13.9 {GetSpinboxIndex procedure} {
+ .e select from 1
+ .e select to 6
+ list [.e index sel.first] [.e index sel.last]
+} {1 6}
+selection clear .e
+test spinbox-13.10 {GetSpinboxIndex procedure} {unixOnly} {
+ # On unix, when selection is cleared, spinbox widget's internal
+ # selection range is reset.
+
+ list [catch {.e index sel.first} msg] $msg
+} {1 {selection isn't in widget .e}}
+test spinbox-13.11 {GetSpinboxIndex procedure} {macOrPc} {
+ # On mac and pc, when selection is cleared, spinbox widget remembers
+ # last selected range. When selection ownership is restored to
+ # spinbox, the old range will be rehighlighted.
+
+ list [catch {selection get}] [.e index sel.first]
+} {1 1}
+test spinbox-13.12 {GetSpinboxIndex procedure} {unixOnly} {
+ list [catch {.e index sbogus} msg] $msg
+} {1 {selection isn't in widget .e}}
+test spinbox-13.13 {GetSpinboxIndex procedure} {macOrPc} {
+ list [catch {.e index sbogus} msg] $msg
+} {1 {bad spinbox index "sbogus"}}
+test spinbox-13.14 {GetSpinboxIndex procedure} {macOrPc} {
+ list [catch {selection get}] [catch {.e index sbogus}]
+} {1 1}
+test spinbox-13.15 {GetSpinboxIndex procedure} {
+ list [catch {.e index @xyz} msg] $msg
+} {1 {bad spinbox index "@xyz"}}
+test spinbox-13.16 {GetSpinboxIndex procedure} {fonts} {
+ .e index @4
+} {4}
+test spinbox-13.17 {GetSpinboxIndex procedure} {fonts} {
+ .e index @11
+} {4}
+test spinbox-13.18 {GetSpinboxIndex procedure} {fonts} {
+ .e index @12
+} {5}
+test spinbox-13.19 {GetSpinboxIndex procedure} {fonts} {
+ # 11 is the minimum button width
+ .e index @[expr [winfo width .e] - 6 - 11]
+} {8}
+test spinbox-13.20 {GetSpinboxIndex procedure} {fonts} {
+ .e index @[expr [winfo width .e] - 5]
+} {9}
+test spinbox-13.21 {GetSpinboxIndex procedure} {
+ .e index @1000
+} {9}
+test spinbox-13.22 {GetSpinboxIndex procedure} {
+ list [catch {.e index 1xyz} msg] $msg
+} {1 {bad spinbox index "1xyz"}}
+test spinbox-13.23 {GetSpinboxIndex procedure} {
+ .e index -10
+} {0}
+test spinbox-13.24 {GetSpinboxIndex procedure} {
+ .e index 12
+} {12}
+test spinbox-13.25 {GetSpinboxIndex procedure} {
+ .e index 49
+} {21}
+
+# XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo.
+
+set x {}
+for {set i 1} {$i <= 500} {incr i} {
+ append x "This is line $i, out of 500\n"
+}
+test spinbox-14.1 {SpinboxFetchSelection procedure} {
+ catch {destroy .e}
+ spinbox .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 spinbox-14.3 {SpinboxFetchSelection procedure} {
+ catch {destroy .e}
+ spinbox .e
+ .e insert end $x
+ .e select from 0
+ .e select to end
+ string compare [selection get] $x
+} 0
+
+test spinbox-15.1 {SpinboxLostSelection} {
+ catch {destroy .e}
+ spinbox .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}
+spinbox .e -width 10 -xscrollcommand scroll
+pack .e
+update
+
+test spinbox-16.1 {SpinboxVisibleRange procedure} {fonts} {
+ .e delete 0 end
+ .e insert 0 .............................
+ .e xview
+} {0 0.827586}
+test spinbox-15.4 {SpinboxVisibleRange procedure} {
+ .e delete 0 end
+ .e xview
+} {0 1}
+
+catch {destroy .e}
+spinbox .e -width 10 -xscrollcommand scroll -font $fixed
+pack .e
+update
+test spinbox-17.1 {SpinboxUpdateScrollbar procedure} {
+ .e delete 0 end
+ .e insert 0 123
+ update
+ set scrollInfo
+} {0 1}
+test spinbox-17.2 {SpinboxUpdateScrollbar procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcdef
+ .e xview 3
+ update
+ set scrollInfo
+} {0.1875 0.8125}
+test spinbox-17.3 {SpinboxUpdateScrollbar procedure} {
+ .e delete 0 end
+ .e insert 0 abcdefghijklmnopqrs
+ .e xview 6
+ update
+ set scrollInfo
+} {0.315789 0.842105}
+test spinbox-17.4 {SpinboxUpdateScrollbar procedure} {
+ destroy .e
+ proc bgerror msg {
+ global x
+ set x $msg
+ }
+ spinbox .e -width 5 -xscrollcommand thisisnotacommand
+ pack .e
+ update
+ rename bgerror {}
+ list $x $errorInfo
+} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand"
+ while executing
+"thisisnotacommand 0 1"
+ (horizontal scrolling command executed by .e)}}
+
+set l [interp hidden]
+deleteWindows
+
+test spinbox-18.1 {Spinbox widget vs hiding} {
+ destroy .e
+ spinbox .e
+ interp hide {} .e
+ destroy .e
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+##
+## Spinbox widget VALIDATION tests
+##
+
+destroy .e
+catch {unset ::e}
+catch {unset ::vVals}
+spinbox .e -validate all \
+ -validatecommand [list doval %W %d %i %P %s %S %v %V] \
+ -invalidcommand bell \
+ -textvariable ::e \
+ -background red -foreground white
+pack .e
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ return 1
+}
+
+# The validation tests build each one upon the previous, so cascading
+# failures aren't good
+#
+test spinbox-19.1 {spinbox widget validation} {
+ .e insert 0 a
+ set ::vVals
+} {.e 1 0 a {} a all key}
+test spinbox-19.2 {spinbox widget validation} {
+ .e insert 1 b
+ set ::vVals
+} {.e 1 1 ab a b all key}
+test spinbox-19.3 {spinbox widget validation} {
+ .e insert end c
+ set ::vVals
+} {.e 1 2 abc ab c all key}
+test spinbox-19.4 {spinbox widget validation} {
+ .e insert 1 123
+ list $::vVals $::e
+} {{.e 1 1 a123bc abc 123 all key} a123bc}
+test spinbox-19.5 {spinbox widget validation} {
+ .e delete 2
+ set ::vVals
+} {.e 0 2 a13bc a123bc 2 all key}
+test spinbox-19.6 {spinbox widget validation} {
+ .e configure -validate key
+ .e delete 1 3
+ set ::vVals
+} {.e 0 1 abc a13bc 13 key key}
+test spinbox-19.7 {spinbox widget validation} {
+ set ::vVals {}
+ .e configure -validate focus
+ .e insert end d
+ set ::vVals
+} {}
+test spinbox-19.8 {spinbox widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focus focusin}
+test spinbox-19.9 {spinbox widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focus focusout}
+.e configure -validate all
+test spinbox-19.10 {spinbox widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} all focusin}
+test spinbox-19.11 {spinbox widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} all focusout}
+.e configure -validate focusin
+test spinbox-19.12 {spinbox widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focusin focusin}
+test spinbox-19.13 {spinbox widget validation} {
+ set ::vVals {}
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {}
+.e configure -validate focuso
+test spinbox-19.14 {spinbox widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {}
+test spinbox-19.15 {spinbox widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focusout focusout}
+test spinbox-19.16 {spinbox widget validation} {
+ list [.e validate] $::vVals
+} {1 {.e -1 -1 abcd abcd {} all forced}}
+test spinbox-19.17 {spinbox widget validation} {
+ set ::e newdata
+ list [.e cget -validate] $::vVals
+} {focusout {.e -1 -1 newdata abcd {} focusout forced}}
+
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ return 0
+}
+.e configure -validate all
+
+test spinbox-19.18 {spinbox widget validation} {
+ set ::e nextdata
+ list [.e cget -validate] $::vVals
+} {none {.e -1 -1 nextdata newdata {} all forced}}
+
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ set ::e mydata
+ return 1
+}
+.e configure -validate all
+
+## This sets validate to none because it shows that we prevent a possible
+## loop condition in the validation, when the spinbox textvar is also set
+test spinbox-19.19 {spinbox widget validation} {
+ .e validate
+ list [.e cget -validate] [.e get] $::vVals
+} {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
+
+.e configure -validate all
+
+## This leaves validate alone because we trigger validation through the
+## textvar (a write trace), and the write during validation triggers
+## nothing (by definition of avoiding loops on var traces). This is
+## one of those "dangerous" conditions where the user will have a
+## different value in the spinbox widget shown as is in the textvar.
+test spinbox-19.20 {spinbox widget validation} {
+ set ::e testdata
+ list [.e cget -validate] [.e get] $::e $::vVals
+} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
+
+# A format specifier is allowed to be of the form %[-+ 0]{0,1}\d.?\d?f
+#
+destroy .e
+spinbox .e
+test spinbox-20.1 {spinbox config, -format specifier} {
+ list [catch {.e config -format %2f} msg] $msg
+} {0 {}}
+test spinbox-20.2 {spinbox config, -format specifier} {
+ list [catch {.e config -format %2.2f} msg] $msg
+} {0 {}}
+test spinbox-20.3 {spinbox config, -format specifier} {
+ list [catch {.e config -format %.2f} msg] $msg
+} {0 {}}
+test spinbox-20.4 {spinbox config, -format specifier} {
+ list [catch {.e config -format %2.f} msg] $msg
+} {0 {}}
+test spinbox-20.5 {spinbox config, -format specifier} {
+ list [catch {.e config -format %2e-1f} msg] $msg
+} {1 {bad spinbox format specifier "%2e-1f"}}
+test spinbox-20.6 {spinbox config, -format specifier} {
+ list [catch {.e config -format 2.2} msg] $msg
+} {1 {bad spinbox format specifier "2.2"}}
+test spinbox-20.7 {spinbox config, -format specifier} {
+ list [catch {.e config -format %2.-2f} msg] $msg
+} {1 {bad spinbox format specifier "%2.-2f"}}
+test spinbox-20.8 {spinbox config, -format specifier} {
+ list [catch {.e config -format %-2.02f} msg] $msg
+} {0 {}}
+test spinbox-20.9 {spinbox config, -format specifier} {
+ list [catch {.e config -format "% 2.02f"} msg] $msg
+} {0 {}}
+test spinbox-20.10 {spinbox config, -format specifier} {
+ list [catch {.e config -format "% -2.200f"} msg] $msg
+} {0 {}}
+test spinbox-20.11 {spinbox config, -format specifier} {
+ list [catch {.e config -format "%09.200f"} msg] $msg
+} {0 {}}
+test spinbox-20.12 {spinbox config, -format specifier does something} {
+ set out {}
+ .e config -format "%02.f"
+ .e config -values {} -from 0 -to 10 -increment 1
+ lappend out [.e set 0]; # set currently doesn't force format
+ .e invoke buttonup
+ lappend out [.e set]; # but after invoke it should be formatted
+ lappend out [.e set 3]; # set currently doesn't force format
+ .e config -format "%03.f"
+ lappend out [.e set]; # changing -format should cause formatting
+} {0 01 3 003}
+
+test spinbox-21.1 {spinbox button, out of range checking} {
+ destroy .e
+ spinbox .e -from -10 -to 20 -increment 2
+ set out {}
+ lappend out [.e get]; # -10
+ .e delete 0 end
+ .e insert 0 25; # set outside of range
+ .e invoke buttondown; # should constrain
+ lappend out [.e get]; # 20
+ .e delete 0 end
+ .e insert 0 25; # set outside of range
+ .e invoke buttonup; # should constrain
+ lappend out [.e get]; # 20
+ .e delete 0 end
+ .e insert 0 -100; # set outside of range
+ .e invoke buttonup; # should constrain
+ lappend out [.e get]; # -10
+ .e delete 0 end
+ .e insert 0 -100; # set outside of range
+ .e invoke buttondown; # should constrain
+ lappend out [.e get]; # -10
+ .e delete 0 end
+ .e insert 0 bogus; # set to a bogus value
+ .e invoke buttondown; # should use fromValue
+ lappend out [.e get]; # -10
+ .e delete 0 end
+ .e insert 0 19; # set just inside of range
+ .e invoke buttonup; # no wrap
+ lappend out [.e get]; # 20
+ .e invoke buttonup; # no wrap
+ lappend out [.e get]; # 20
+ .e invoke buttondown
+ lappend out [.e get]; # 18
+ .e delete 0 end
+ .e insert 0 -9; # set just inside of range
+ .e invoke buttondown; # no wrap
+ lappend out [.e get]; # -10
+ .e invoke buttondown; # no wrap
+ lappend out [.e get]; # -10
+ .e invoke buttonup; # no wrap
+ lappend out [.e get]; # -8
+
+ .e configure -wrap 1
+ .e delete 0 end
+ .e insert 0 19; # set just inside of range
+ .e invoke buttonup; # wrap
+ lappend out [.e get]; # -10
+ .e invoke buttonup
+ lappend out [.e get]; # -8
+ .e invoke buttondown
+ lappend out [.e get]; # -10
+ .e delete 0 end
+ .e insert 0 -9; # set just inside of range
+ .e invoke buttondown; # wrap
+ lappend out [.e get]; # 20
+ .e invoke buttondown
+ lappend out [.e get]; # 18
+ .e invoke buttonup; # no wrap
+ lappend out [.e get]; # 20
+
+} {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20}
+
+test spinbox-22.1 {spinbox config, -from changes SF bug 559078} {
+ set val 5
+ destroy .s
+ spinbox .s -from 1 -to 10 -textvariable val
+ set val
+} {5}
+test spinbox-22.2 {spinbox config, -from changes SF bug 559078} {
+ .s configure -from 3 -to 10
+ set val
+} {5}
+test spinbox-22.3 {spinbox config, -from changes SF bug 559078} {
+ .s configure -from 6 -to 10
+ set val
+} {6}
+
+destroy .e
+catch {unset ::e ::vVals}
+
+##
+## End validation tests
+##
+
+# XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc,
+# and SpinboxTextVarProc.
+
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/text.test b/tcl/tests/text.test
new file mode 100644
index 00000000000..730a3182927
--- /dev/null
+++ b/tcl/tests/text.test
@@ -0,0 +1,1594 @@
+# This file is a Tcl script to test the code in the file tkText.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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 {
+ {-autoseparators yes 1 nah}
+ {-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}
+ {-maxundo 5 5 noway}
+ {-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 d disabled foo}
+ {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
+ {-undo 1 1 eh}
+ {-width 73 73 2.4}
+ {-wrap w 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
+} {1 blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 5 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 1 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, dump, edit, 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, dump, edit, 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, dump, edit, 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 {bad text index "a"}}
+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 configure -state disabled
+ .t delete 2.3
+ .t g 2.0 2.end
+} abcdefghijklm
+.t configure -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-8.8 {TextWidgetCmd procedure, "delete" option} {
+ # All indices are checked before we actually delete anything
+ list [catch {.t delete 2.1 2.3 foo} msg] $msg \
+ [.t get 2.0 2.end]
+} {1 {bad text index "foo"} aefghijklm}
+set prevtext [.t get 1.0 end-1c]
+test text-8.9 {TextWidgetCmd procedure, "delete" option} {
+ # auto-forward one byte if the last "pair" is just one
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.1 2.3 2.3
+ .t get 1.0 end-1c
+} foo\naefghijklm
+test text-8.10 {TextWidgetCmd procedure, "delete" option} {
+ # all indices will be ordered before deletion
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.3 2.7 2.9 2.4
+ .t get 1.0 end-1c
+} foo\ndfgjklm
+test text-8.11 {TextWidgetCmd procedure, "delete" option} {
+ # and check again with even pairs
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 2.7 2.9 2.4 2.5
+ .t get 1.0 end-1c
+} foo\ncdfgjklm
+test text-8.12 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the longest range on equal start indices
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 2.0 2.5 2.0 2.3 2.8 2.7
+ .t get 1.0 end-1c
+} foo\nfghijklm
+test text-8.13 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the longest range on equal start indices
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 1.2 2.6 2.0 2.5
+ .t get 1.0 end-1c
+} foghijklm
+test text-8.14 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the longest range on equal start indices
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 2.0 2.5 1.1 2.3 2.8 2.7
+ .t get 1.0 end-1c
+} ffghijklm
+test text-8.15 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the watch for overlapping ranges - they should
+ # essentially be merged into one span.
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.6 2.2 2.8
+ .t get 1.0 end-1c
+} foo\nijklm
+test text-8.16 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the watch for overlapping ranges - they should
+ # essentially be merged into one span.
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.6 2.2 2.4
+ .t get 1.0 end-1c
+} foo\nghijklm
+
+.t delete 1.0 end; .t insert 1.0 $prevtext
+
+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 {bad text index "a"}}
+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-9.11 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.4
+} {{y } G}
+test text-9.12 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.4 5.5
+} {{y } G}
+test text-9.13 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.5 "5.5+5c"
+} {{y } {Irl .}}
+test text-9.14 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.4 5.5 end-3c
+} {{y } G { }}
+test text-9.15 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.4 5.5 end-3c end
+} {{y } G { 7
+}}
+test text-9.17 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg
+} {1 {bad text index "foo"}}
+
+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, dump, edit, 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}}
+
+# Edit, 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 --, -backward, -count, -elide, -exact, -forward, -nocase, or -regexp}}
+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: parentheses () not balanced}}
+test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
+ .t search -backwards BaR end 1.0
+} {2.23}
+test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
+ .t search -backwards \n end 1.0
+} {3.9}
+test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
+ .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}
+test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} {
+ # Test for fix of bug #1643
+ .t insert end "\n"
+ tk::TextSetCursor .t 4.0
+ .t search -forward -regexp {^$} insert end
+} {4.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
+} {}
+test text-20.63 {TextSearchCmd, unicode} {
+ .t delete 1.0 end
+ .t insert end "foo\u30c9\u30cabar"
+ .t search \u30c9\u30ca 1.0
+} 1.3
+test text-20.64 {TextSearchCmd, unicode} {
+ .t delete 1.0 end
+ .t insert end "foo\u30c9\u30cabar"
+ list [.t search -count n \u30c9\u30ca 1.0] $n
+} {1.3 2}
+test text-20.65 {TextSearchCmd, unicode with non-text segments} {
+ .t delete 1.0 end
+ button .b1 -text baz
+ .t insert end "foo\u30c9"
+ .t window create end -window .b1
+ .t insert end "\u30cabar"
+ set result [list [.t search -count n \u30c9\u30ca 1.0] $n]
+ destroy .b1
+ set result
+} {1.3 3}
+
+test text-20.66 {TextSearchCmd, hidden text does not affect match index} {
+ deleteWindows
+ pack [text .t2]
+ .t2 insert end "12345H7890"
+ .t2 search 7 1.0
+} 1.6
+test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
+ deleteWindows
+ pack [text .t2]
+ .t2 insert end "12345H7890"
+ .t2 tag configure hidden -elide true
+ .t2 tag add hidden 1.5
+ .t2 search 7 1.0
+} 1.6
+test text-20.68 {TextSearchCmd, hidden text does not affect match index} {
+ deleteWindows
+ pack [text .t2]
+ .t2 insert end "foobar\nbarbaz\nbazboo"
+ .t2 search boo 1.0
+} 3.3
+test text-20.69 {TextSearchCmd, hidden text does not affect match index} {
+ deleteWindows
+ pack [text .t2]
+ .t2 insert end "foobar\nbarbaz\nbazboo"
+ .t2 tag configure hidden -elide true
+ .t2 tag add hidden 2.0 3.0
+ .t2 search boo 1.0
+} 3.3
+
+test text-20.70 {TextSearchCmd, -regexp -nocase searches} {
+ catch {destroy .t}
+ pack [text .t]
+ .t insert end "word1 word2"
+ set res [.t search -nocase -regexp {\mword.} 1.0 end]
+ destroy .t
+ set res
+} 1.0
+test text-20.71 {TextSearchCmd, -regexp -nocase searches} {
+ catch {destroy .t}
+ pack [text .t]
+ .t insert end "word1 word2"
+ set res [.t search -nocase -regexp {word.\M} 1.0 end]
+ destroy .t
+ set res
+} 1.0
+test text-20.72 {TextSearchCmd, -regexp -nocase searches} {
+ catch {destroy .t}
+ pack [text .t]
+ .t insert end "word1 word2"
+ set res [.t search -nocase -regexp {word.\W} 1.0 end]
+ destroy .t
+ set res
+} 1.0
+
+deleteWindows
+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"}}
+
+deleteWindows
+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}
+test text-22.25 {TextDumpCmd procedure, unicode characters} {
+ catch {destroy .t}
+ text .t
+ .t delete 1.0 end
+ .t insert 1.0 \xb1\xb1\xb1
+ .t dump -all 1.0 2.0
+} "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3"
+test text-22.26 {TextDumpCmd procedure, unicode characters} {
+ catch {destroy .t}
+ text .t
+ .t delete 1.0 end
+ .t insert 1.0 abc\xb1\xb1\xb1
+ .t dump -all 1.0 2.0
+} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
+
+set l [interp hidden]
+deleteWindows
+
+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]
+
+test text-24.1 {bug fix - 1642} {
+ catch {destroy .t}
+ text .t
+ pack .t
+ .t insert end "line 1\n"
+ .t insert end "line 2\n"
+ .t insert end "line 3\n"
+ .t insert end "line 4\n"
+ .t insert end "line 5\n"
+ tk::TextSetCursor .t 3.0
+ .t search -backward -regexp "\$" insert 1.0
+} {2.6}
+
+test text-25.1 {TextEditCmd procedure, argument parsing} {
+ list [catch {.t edit} msg] $msg
+} {1 {wrong # args: should be ".t edit option ?arg arg ...?"}}
+
+test text-25.2 {TextEditCmd procedure, argument parsing} {
+ list [catch {.t edit gorp} msg] $msg
+} {1 {bad edit option "gorp": must be modified, redo, reset, separator or undo}}
+
+test text-25.3 {TextEditUndo procedure, undoing changes} {
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "should be gone after undo\n"
+ .t edit undo
+ .t get 1.0 end
+} "line\n\n"
+
+test text-25.4 {TextEditRedo procedure, redoing changes} {
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "should be back after redo\n"
+ .t edit undo
+ .t edit redo
+ .t get 1.0 end
+} "line\nshould be back after redo\n\n"
+
+test text-25.5 {TextEditUndo procedure, resetting stack} {
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "should be back after redo\n"
+ .t edit reset
+ catch {.t edit undo} msg
+ set msg
+} "nothing to undo"
+
+test text-25.6 {TextEditCmd procedure, insert separator} {
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ .t insert end "line 1\n"
+ .t edit separator
+ .t insert end "line 2\n"
+ .t edit undo
+ .t get 1.0 end
+} "line 1\n\n"
+
+test text-25.7 {-autoseparators configuration option} {
+ catch {destroy .t}
+ text .t -undo 1 -autoseparators 0
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "line 2\n"
+ .t edit undo
+ .t get 1.0 end
+} "\n"
+
+test text-25.8 {TextEditCmd procedure, modified flag} {
+ catch {destroy .t}
+ text .t
+ pack .t
+ .t insert end "line 1\n"
+ .t edit modified
+} {1}
+
+test text-25.9 {TextEditCmd procedure, reset modified flag} {
+ catch {destroy .t}
+ text .t
+ pack .t
+ .t insert end "line 1\n"
+ .t edit modified 0
+ .t edit modified
+} {0}
+
+test text-25.10 {TextEditCmd procedure, set modified flag} {
+ catch {destroy .t}
+ text .t
+ pack .t
+ .t edit modified 1
+ .t edit modified
+} {1}
+
+test text-25.11 {<<Modified>> virtual event} {
+ set ::retval unmodified
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ bind .t <<Modified>> "set ::retval modified"
+ update idletasks
+ .t insert end "nothing special\n"
+ set ::retval
+} {modified}
+
+test text-25.12 {<<Selection>> virtual event} {
+ set ::retval no_selection
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ bind .t <<Selection>> "set ::retval selection_changed"
+ update idletasks
+ .t insert end "nothing special\n"
+ .t tag add sel 1.0 1.1
+ set ::retval
+} {selection_changed}
+
+test text-25.13 {-maxundo configuration option} {
+ catch {destroy .t}
+ text .t -undo 1 -autoseparators 1 -maxundo 2
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "line 2\n"
+ catch {.t edit undo}
+ catch {.t edit undo}
+ catch {.t edit undo}
+ .t get 1.0 end
+} "line 1\n\n"
+
+deleteWindows
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/textBTree.test b/tcl/tests/textBTree.test
new file mode 100644
index 00000000000..548361e1d04
--- /dev/null
+++ b/tcl/tests/textBTree.test
@@ -0,0 +1,916 @@
+# This file is a Tcl script to test out the B-tree facilities of
+# Tk's text widget (the contents of the file "tkTextBTree.c". There are
+# several file with additional tests for other features of text widgets.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/textDisp.test b/tcl/tests/textDisp.test
new file mode 100644
index 00000000000..dd91c2c95a5
--- /dev/null
+++ b/tcl/tests/textDisp.test
@@ -0,0 +1,2866 @@
+# This file is a Tcl script to test the code in the file tkTextDisp.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+# 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.
+
+frame .f -width 100 -height 20
+pack append . .f left
+
+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\n13"
+ 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 x y" or ".t scan dragto x y ?gain?"}}
+test textDisp-17.2 {TkTextScanCmd procedure} {
+ list [catch {.t scan a b c d} msg] $msg
+} {1 {expected integer but got "b"}}
+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 {}}
+
+deleteWindows
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/textImage.test b/tcl/tests/textImage.test
new file mode 100644
index 00000000000..835c4f80b93
--- /dev/null
+++ b/tcl/tests/textImage.test
@@ -0,0 +1,368 @@
+# textImage.test -- test images embedded in text widgets
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# One time setup. Create a font to insure the tests are font metric invariant.
+
+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
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/textIndex.test b/tcl/tests/textIndex.test
new file mode 100644
index 00000000000..93fea9301e8
--- /dev/null
+++ b/tcl/tests/textIndex.test
@@ -0,0 +1,687 @@
+# This file is a Tcl script to test the code in the file tkTextIndex.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# Some tests require the testtext command
+testConstraint testtext [llength [info commands testtext]]
+
+catch {destroy .t}
+text .t -font {Courier -12} -width 20 -height 10
+pack append . .t {top expand fill}
+update
+.t debug on
+wm geometry . {}
+
+# The statements below reset the main window; it's needed if the window
+# manager is mwm to make mwm forget about a previous minimum size setting.
+
+wm withdraw .
+wm minsize . 1 1
+wm positionfrom . user
+wm deiconify .
+
+.t insert 1.0 "Line 1
+abcdefghijklm
+12345
+Line 4
+b\u4e4fy GIrl .#@? x_yz
+!@#$%
+Line 7"
+
+image create photo textimage -width 10 -height 10
+textimage put red -to 0 0 9 9
+
+test textIndex-1.1 {TkTextMakeByteIndex} {testtext} {
+ # (lineIndex < 0)
+ testtext .t byteindex -1 3
+} {1.0 0}
+test textIndex-1.2 {TkTextMakeByteIndex} {testtext} {
+ # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1
+ testtext .t byteindex 0 3
+} {1.0 0}
+test textIndex-1.3 {TkTextMakeByteIndex} {testtext} {
+ # not (lineIndex < 0)
+ testtext .t byteindex 1 3
+} {1.3 3}
+test textIndex-1.4 {TkTextMakeByteIndex} {testtext} {
+ # (byteIndex < 0)
+ testtext .t byteindex 3 -1
+} {3.0 0}
+test textIndex-1.5 {TkTextMakeByteIndex} {testtext} {
+ # not (byteIndex < 0)
+ testtext .t byteindex 3 3
+} {3.3 3}
+test textIndex-1.6 {TkTextMakeByteIndex} {testtext} {
+ # (indexPtr->linePtr == NULL)
+ testtext .t byteindex 9 2
+} {8.0 0}
+test textIndex-1.7 {TkTextMakeByteIndex} {testtext} {
+ # not (indexPtr->linePtr == NULL)
+ testtext .t byteindex 7 2
+} {7.2 2}
+test textIndex-1.8 {TkTextMakeByteIndex: shortcut for 0} {testtext} {
+ # (byteIndex == 0)
+ testtext .t byteindex 1 0
+} {1.0 0}
+test textIndex-1.9 {TkTextMakeByteIndex: shortcut for 0} {testtext} {
+ # not (byteIndex == 0)
+ testtext .t byteindex 3 80
+} {3.5 5}
+test textIndex-1.10 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+ # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+ # one segment
+
+ testtext .t byteindex 3 5
+} {3.5 5}
+test textIndex-1.11 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+ # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+ # index += segPtr->size
+ # Multiple segments, make sure add segment size to index.
+
+ .t mark set foo 3.2
+ set x [testtext .t byteindex 3 7]
+ .t mark unset foo
+ set x
+} {3.5 5}
+test textIndex-1.12 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+ # (segPtr == NULL)
+ testtext .t byteindex 3 7
+} {3.5 5}
+test textIndex-1.13 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+ # not (segPtr == NULL)
+ testtext .t byteindex 3 4
+} {3.4 4}
+test textIndex-1.14 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+ # (index + segPtr->size > byteIndex)
+ # in this segment.
+
+ testtext .t byteindex 3 4
+} {3.4 4}
+test textIndex-1.15 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+ # (index + segPtr->size > byteIndex), index != 0
+ # in this segment.
+
+ .t mark set foo 3.2
+ set x [testtext .t byteindex 3 4]
+ .t mark unset foo
+ set x
+} {3.4 4}
+test textIndex-1.16 {TkTextMakeByteIndex: UTF-8 characters} {testtext} {
+ testtext .t byteindex 5 100
+} {5.18 20}
+test textIndex-1.17 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
+ {testtext} {
+ # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType))
+ # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
+
+ set x [testtext .t byteindex 5 2]
+ list $x [.t get insert]
+} {{5.2 4} y}
+test textIndex-1.18 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
+ {testtext} {
+ # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType))
+ testtext .t byteindex 5 1
+ .t get insert
+} "\u4e4f"
+
+test textIndex-2.1 {TkTextMakeCharIndex} {
+ # (lineIndex < 0)
+ .t index -1.3
+} 1.0
+test textIndex-2.2 {TkTextMakeCharIndex} {
+ # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1
+ .t index 0.3
+} 1.0
+test textIndex-2.3 {TkTextMakeCharIndex} {
+ # not (lineIndex < 0)
+ .t index 1.3
+} 1.3
+test textIndex-2.4 {TkTextMakeCharIndex} {
+ # (charIndex < 0)
+ .t index 3.-1
+} 3.0
+test textIndex-2.5 {TkTextMakeCharIndex} {
+ # (charIndex < 0)
+ .t index 3.3
+} 3.3
+test textIndex-2.6 {TkTextMakeCharIndex} {
+ # (indexPtr->linePtr == NULL)
+ .t index 9.2
+} 8.0
+test textIndex-2.7 {TkTextMakeCharIndex} {
+ # not (indexPtr->linePtr == NULL)
+ .t index 7.2
+} 7.2
+test textIndex-2.8 {TkTextMakeCharIndex: verify index is in range} {
+ # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+ # one segment
+
+ .t index 3.5
+} 3.5
+test textIndex-2.9 {TkTextMakeCharIndex: verify index is in range} {
+ # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+ # Multiple segments, make sure add segment size to index.
+
+ .t mark set foo 3.2
+ set x [.t index 3.7]
+ .t mark unset foo
+ set x
+} 3.5
+test textIndex-2.10 {TkTextMakeCharIndex: verify index is in range} {
+ # (segPtr == NULL)
+ .t index 3.7
+} 3.5
+test textIndex-2.11 {TkTextMakeCharIndex: verify index is in range} {
+ # not (segPtr == NULL)
+ .t index 3.4
+} 3.4
+test textIndex-2.12 {TkTextMakeCharIndex: verify index is in range} {
+ # (segPtr->typePtr == &tkTextCharType)
+ # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
+
+ .t mark set insert 5.2
+ .t get insert
+} y
+test textIndex-2.13 {TkTextMakeCharIndex: verify index is in range} {
+ # not (segPtr->typePtr == &tkTextCharType)
+
+ .t image create 5.2 -image textimage
+ .t mark set insert 5.5
+ set x [.t get insert]
+ .t delete 5.2
+ set x
+} "G"
+test textIndex-2.14 {TkTextMakeCharIndex: verify index is in range} {
+ # (charIndex < segPtr->size)
+
+ .t image create 5.0 -image textimage
+ set x [.t index 5.0]
+ .t delete 5.0
+ set x
+} 5.0
+
+.t mark set foo 3.2
+.t tag add x 2.8 2.11
+.t tag add x 6.0 6.2
+set weirdTag "funny . +- 22.1\n\t{"
+.t tag add $weirdTag 2.1 2.6
+set weirdMark "asdf \n{-+ 66.2\t"
+.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, "@"} {nonPortable 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 {1.3 + 3 lines}} msg] $msg
+} {0 4.3}
+test textIndex-10.6 {ForwBack} {
+ list [catch {.t index {2.3 -1l}} msg] $msg
+} {0 1.3}
+test textIndex-10.7 {ForwBack} {
+ list [catch {.t index {2.3 -1 gorp}} msg] $msg
+} {1 {bad text index "2.3 -1 gorp"}}
+test textIndex-10.8 {ForwBack} {
+ list [catch {.t index {2.3 - 4 lines}} msg] $msg
+} {0 1.3}
+test textIndex-10.9 {ForwBack} {
+ .t mark set insert 2.0
+ list [catch {.t index {insert -0 chars}} msg] $msg
+} {0 2.0}
+test textIndex-10.10 {ForwBack} {
+ .t mark set insert 2.end
+ list [catch {.t index {insert +0 chars}} msg] $msg
+} {0 2.13}
+
+test textIndex-11.1 {TkTextIndexForwBytes} {testtext} {
+ testtext .t forwbytes 2.3 -7
+} {1.3 3}
+test textIndex-11.2 {TkTextIndexForwBytes} {testtext} {
+ testtext .t forwbytes 2.3 5
+} {2.8 8}
+test textIndex-11.3 {TkTextIndexForwBytes} {testtext} {
+ testtext .t forwbytes 2.3 10
+} {2.13 13}
+test textIndex-11.4 {TkTextIndexForwBytes} {testtext} {
+ testtext .t forwbytes 2.3 11
+} {3.0 0}
+test textIndex-11.5 {TkTextIndexForwBytes} {testtext} {
+ testtext .t forwbytes 2.3 57
+} {7.6 6}
+test textIndex-11.6 {TkTextIndexForwBytes} {testtext} {
+ testtext .t forwbytes 2.3 58
+} {8.0 0}
+test textIndex-11.7 {TkTextIndexForwBytes} {testtext} {
+ testtext .t forwbytes 2.3 59
+} {8.0 0}
+
+test textIndex-12.1 {TkTextIndexForwChars} {
+ # (charCount < 0)
+ .t index {2.3 + -7 chars}
+} 1.3
+test textIndex-12.2 {TkTextIndexForwChars} {
+ # not (charCount < 0)
+ .t index {2.3 + 5 chars}
+} 2.8
+test textIndex-12.3 {TkTextIndexForwChars: find index} {
+ # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+ # one loop
+ .t index {2.3 + 9 chars}
+} 2.12
+test textIndex-12.4 {TkTextIndexForwChars: find index} {
+ # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+ # multiple loops
+ .t mark set foo 2.5
+ set x [.t index {2.3 + 9 chars}]
+ .t mark unset foo
+ set x
+} 2.12
+test textIndex-12.5 {TkTextIndexForwChars: find index} {
+ # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+ # border condition: last char
+
+ .t index {2.3 + 10 chars}
+} 2.13
+test textIndex-12.6 {TkTextIndexForwChars: find index} {
+ # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+ # border condition: segPtr == NULL -> beginning of next line
+
+ .t index {2.3 + 11 chars}
+} 3.0
+test textIndex-12.7 {TkTextIndexForwChars: find index} {
+ # (segPtr->typePtr == &tkTextCharType)
+ .t index {2.3 + 2 chars}
+} 2.5
+test textIndex-12.8 {TkTextIndexForwChars: find index} {
+ # (charCount == 0)
+ # No more chars, so we found byte offset.
+
+ .t index {2.3 + 2 chars}
+} 2.5
+test textIndex-12.9 {TkTextIndexForwChars: find index} {
+ # not (segPtr->typePtr == &tkTextCharType)
+
+ .t image create 2.4 -image textimage
+ set x [.t get {2.3 + 3 chars}]
+ .t delete 2.4
+ set x
+} "f"
+test textIndex-12.10 {TkTextIndexForwChars: find index} {
+ # dstPtr->byteIndex += segPtr->size - byteOffset
+ # When moving to next segment, account for bytes in last segment.
+ # Wrong answer would be 2.4
+
+ .t mark set foo 2.4
+ set x [.t index {2.3 + 5 chars}]
+ .t mark unset foo
+ set x
+} 2.8
+test textIndex-12.11 {TkTextIndexForwChars: go to next line} {
+ # (linePtr == NULL)
+ .t index {7.6 + 3 chars}
+} 8.0
+test textIndex-12.12 {TkTextIndexForwChars: go to next line} {
+ # Reset byteIndex to 0 now that we are on a new line.
+ # Wrong answer would be 2.9
+ .t index {1.3 + 6 chars}
+} 2.2
+test textIndex-12.13 {TkTextIndexForwChars} {
+ # right to end
+ .t index {2.3 + 56 chars}
+} 8.0
+test textIndex-12.14 {TkTextIndexForwChars} {
+ # try to go past end
+ .t index {2.3 + 57 chars}
+} 8.0
+
+test textIndex-13.1 {TkTextIndexBackBytes} {testtext} {
+ testtext .t backbytes 3.2 -10
+} {4.6 6}
+test textIndex-13.2 {TkTextIndexBackBytes} {testtext} {
+ testtext .t backbytes 3.2 2
+} {3.0 0}
+test textIndex-13.3 {TkTextIndexBackBytes} {testtext} {
+ testtext .t backbytes 3.2 3
+} {2.13 13}
+test textIndex-13.4 {TkTextIndexBackBytes} {testtext} {
+ testtext .t backbytes 3.2 22
+} {1.1 1}
+test textIndex-13.5 {TkTextIndexBackBytes} {testtext} {
+ testtext .t backbytes 3.2 23
+} {1.0 0}
+test textIndex-13.6 {TkTextIndexBackBytes} {testtext} {
+ testtext .t backbytes 3.2 24
+} {1.0 0}
+
+test textIndex-14.1 {TkTextIndexBackChars} {
+ # (charCount < 0)
+ .t index {3.2 - -10 chars}
+} 4.6
+test textIndex-14.2 {TkTextIndexBackChars} {
+ # not (charCount < 0)
+ .t index {3.2 - 2 chars}
+} 3.0
+test textIndex-14.3 {TkTextIndexBackChars: find starting segment} {
+ # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+ # single loop
+
+ .t index {3.2 - 3 chars}
+} 2.13
+test textIndex-14.4 {TkTextIndexBackChars: find starting segment} {
+ # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+ # multiple loop
+
+ .t mark set foo1 2.5
+ .t mark set foo2 2.7
+ .t mark set foo3 2.10
+ set x [.t index {2.9 - 1 chars}]
+ .t mark unset foo1 foo2 foo3
+ set x
+} 2.8
+test textIndex-14.5 {TkTextIndexBackChars: find starting seg and offset} {
+ # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+ # Make sure segSize was decremented. Wrong answer would be 2.10
+
+ .t mark set foo 2.2
+ set x [.t index {2.9 - 1 char}]
+ .t mark unset foo
+ set x
+} 2.8
+test textIndex-14.6 {TkTextIndexBackChars: back over characters} {
+ # (segPtr->typePtr == &tkTextCharType)
+
+ .t index {3.2 - 22 chars}
+} 1.1
+test textIndex-14.7 {TkTextIndexBackChars: loop backwards over chars} {
+ # (charCount == 0)
+ # No more chars, so we found byte offset.
+
+ .t index {3.4 - 2 chars}
+} 3.2
+test textIndex-14.8 {TkTextIndexBackChars: loop backwards over chars} {
+ # (p == start)
+ # Still more chars, but we reached beginning of segment
+
+ .t image create 5.6 -image textimage
+ set x [.t index {5.8 - 3 chars}]
+ .t delete 5.6
+ set x
+} 5.5
+test textIndex-14.9 {TkTextIndexBackChars: back over image} {
+ # not (segPtr->typePtr == &tkTextCharType)
+
+ .t image create 5.6 -image textimage
+ set x [.t get {5.8 - 4 chars}]
+ .t delete 5.6
+ set x
+} "G"
+test textIndex-14.10 {TkTextIndexBackChars: move to previous segment} {
+ # (segPtr != oldPtr)
+ # More segments to go
+
+ .t mark set foo 3.4
+ set x [.t index {3.5 - 2 chars}]
+ .t mark unset foo
+ set x
+} 3.3
+test textIndex-14.11 {TkTextIndexBackChars: move to previous segment} {
+ # not (segPtr != oldPtr)
+ # At beginning of line.
+
+ .t mark set foo 3.4
+ set x [.t index {3.5 - 10 chars}]
+ .t mark unset foo
+ set x
+} 2.9
+test textIndex-14.12 {TkTextIndexBackChars: move to previous line} {
+ # (lineIndex == 0)
+ .t index {1.5 - 10 chars}
+} 1.0
+test textIndex-14.13 {TkTextIndexBackChars: move to previous line} {
+ # not (lineIndex == 0)
+ .t index {2.5 - 10 chars}
+} 1.2
+test textIndex-14.14 {TkTextIndexBackChars: move to previous line} {
+ # for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr)
+ # Set byteIndex to end of previous line so we can subtract more
+ # bytes from it. Otherwise we get an TkTextIndex with a negative
+ # byteIndex.
+
+ .t index {2.5 - 6 chars}
+} 1.6
+test textIndex-14.15 {TkTextIndexBackChars: UTF} {
+ .t get {5.3 - 1 chars}
+} y
+test textIndex-14.16 {TkTextIndexBackChars: UTF} {
+ .t get {5.3 - 2 chars}
+} \u4e4f
+test textIndex-14.17 {TkTextIndexBackChars: UTF} {
+ .t get {5.3 - 3 chars}
+} b
+
+proc getword index {
+ .t get [.t index "$index wordstart"] [.t index "$index wordend"]
+}
+test textIndex-15.1 {StartEnd} {
+ list [catch {.t index {2.3 lineend}} msg] $msg
+} {0 2.13}
+test textIndex-15.2 {StartEnd} {
+ list [catch {.t index {2.3 linee}} msg] $msg
+} {0 2.13}
+test textIndex-15.3 {StartEnd} {
+ list [catch {.t index {2.3 line}} msg] $msg
+} {1 {bad text index "2.3 line"}}
+test textIndex-15.4 {StartEnd} {
+ list [catch {.t index {2.3 linestart}} msg] $msg
+} {0 2.0}
+test textIndex-15.5 {StartEnd} {
+ list [catch {.t index {2.3 lines}} msg] $msg
+} {0 2.0}
+test textIndex-15.6 {StartEnd} {
+ getword 5.3
+} { }
+test textIndex-15.7 {StartEnd} {
+ getword 5.4
+} GIrl
+test textIndex-15.8 {StartEnd} {
+ getword 5.7
+} GIrl
+test textIndex-15.9 {StartEnd} {
+ getword 5.8
+} { }
+test textIndex-15.10 {StartEnd} {
+ getword 5.14
+} x_yz
+test textIndex-15.11 {StartEnd} {
+ getword 6.2
+} #
+test textIndex-15.12 {StartEnd} {
+ getword 3.4
+} 12345
+.t tag add x 2.8 2.11
+test textIndex-15.13 {StartEnd} {
+ list [catch {.t index {2.2 worde}} msg] $msg
+} {0 2.13}
+test textIndex-15.14 {StartEnd} {
+ list [catch {.t index {2.12 words}} msg] $msg
+} {0 2.0}
+test textIndex-15.15 {StartEnd} {
+ list [catch {.t index {2.12 word}} msg] $msg
+} {1 {bad text index "2.12 word"}}
+
+test testIndex-16.1 {TkTextPrintIndex} {
+ set t [text .t2]
+ $t insert end \n
+ $t window create end -window [button $t.b]
+ set result [$t index end-2c]
+ pack $t
+ catch {destroy $t}
+} 0
+
+
+test testIndex-16.2 {TkTextPrintIndex} {
+ set t [text .t2]
+ $t insert end \n
+ $t window create end -window [button $t.b]
+ set result [$t tag add {} end-2c]
+ pack $t
+ catch {destroy $t}
+} 0
+
+# cleanup
+rename textimage {}
+catch {destroy .t}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/textMark.test b/tcl/tests/textMark.test
new file mode 100644
index 00000000000..faac3697f48
--- /dev/null
+++ b/tcl/tests/textMark.test
@@ -0,0 +1,239 @@
+# This file is a Tcl script to test the code in the file tkTextMark.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+catch {destroy .t}
+testConstraint courier12 [expr {[catch {
+ text .t -font {Courier 12} -width 20 -height 10
+ }] == 0}]
+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} courier12 {
+ list [catch {.t mark} msg] $msg
+} {1 {wrong # args: should be ".t mark option ?arg arg ...?"}}
+test textMark-1.2 {TkTextMarkCmd - bogus option} courier12 {
+ 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} courier12 {
+ list [catch {.t mark gravity foo} msg] $msg
+} {1 {there is no mark named "foo"}}
+test textMark-1.4 {TkTextMarkCmd - "gravity" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ 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} courier12 {
+ list [catch {.t mark gravity} msg] $msg
+} {1 {wrong # args: should be ".t mark gravity markName ?gravity?"}}
+
+test textMark-2.1 {TkTextMarkCmd - "names" option} courier12 {
+ 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} courier12 {
+ lsort [.t mark n]
+} {current insert}
+test textMark-2.3 {TkTextMarkCmd - "names" option} courier12 {
+ .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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ list [catch {.t mark set a @x} msg] $msg
+} {1 {bad text index "@x"}}
+test textMark-3.4 {TkTextMarkCmd - "set" option} courier12 {
+ .t mark set a 1.2
+ .t index a
+} 1.2
+test textMark-3.5 {TkTextMarkCmd - "set" option} courier12 {
+ .t mark set a end
+ .t index a
+} {8.0}
+
+test textMark-4.1 {TkTextMarkCmd - "unset" option} courier12 {
+ list [catch {.t mark unset} msg] $msg
+} {0 {}}
+test textMark-4.2 {TkTextMarkCmd - "unset" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ list [catch {.t mark} msg] $msg
+} {1 {wrong # args: should be ".t mark option ?arg arg ...?"}}
+test textMark-5.2 {TkTextMarkCmd - miscellaneous} courier12 {
+ 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} courier12 {
+ .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} courier12 {
+ catch {.t mark next bogus} x
+ set x
+} {bad text index "bogus"}
+test textMark-7.2 {MarkFindNext - marks at same location} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .t mark set current end
+ .t mark next end
+} {current}
+test textMark-7.8 {MarkFindNext - no next mark} courier12 {
+ .t mark set current 1.0
+ .t mark set insert 3.0
+ .t mark next insert
+} {}
+test textMark-8.1 {MarkFindPrev - invalid mark name} courier12 {
+ catch {.t mark prev bogus} x
+ set x
+} {bad text index "bogus"}
+test textMark-8.2 {MarkFindPrev - marks at same location} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .t mark set insert 3.0
+ .t mark set current end
+ .t mark prev end
+} {insert}
+test textMark-8.8 {MarkFindPrev - no previous mark} courier12 {
+ .t mark set current 1.0
+ .t mark set insert 3.0
+ .t mark prev current
+} {}
+
+catch {destroy .t}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/textTag.test b/tcl/tests/textTag.test
new file mode 100644
index 00000000000..ca7a5d0ad86
--- /dev/null
+++ b/tcl/tests/textTag.test
@@ -0,0 +1,784 @@
+# This file is a Tcl script to test the code in the file tkTextTag.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+catch {destroy .t}
+testConstraint courier12 [expr {[catch {
+ text .t -font {Courier 12} -width 20 -height 10
+ }] == 0}]
+
+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} courier12 {
+ .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} courier12 {
+ 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} courier12 {
+ list [catch {.t tag} msg] $msg
+} {1 {wrong # args: should be ".t tag option ?arg arg ...?"}}
+test textTag-2.2 {TkTextTagCmd - "add" option} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ list [catch {.t tag add x gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test textTag-2.5 {TkTextTagCmd - "add" option} courier12 {
+ list [catch {.t tag add x 1.2 gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test textTag-2.6 {TkTextTagCmd - "add" option} courier12 {
+ .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} courier12 {
+ .t tag add x 1.0 1.end
+ .t tag ranges x
+} {1.0 1.6}
+test textTag-2.8 {TkTextTagCmd - "add" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ .t tag bind x <Enter> script1
+ .t tag bind x <Enter>
+} script1
+test textTag-3.4 {TkTextTagCmd - "bind" option} courier12 {
+ list [catch {.t tag bind x <Gorp> script2} msg] $msg
+} {1 {bad event type or keysym "Gorp"}}
+test textTag-3.5 {TkTextTagCmd - "bind" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .t tag delete x
+ .t tag bind x <Enter> script1
+ .t tag bind x <Enter> +script2
+ .t tag bind x <Enter>
+} {script1
+script2}
+test textTag-3.7 {TkTextTagCmd - "bind" option} courier12 {
+ .t tag delete x
+ list [catch {.t tag bind x <Enter>} msg] $msg
+} {0 {}}
+test textTag-3.8 {TkTextTagCmd - "bind" option} courier12 {
+ .t tag delete x
+ list [catch {.t tag bind x <} msg] $msg
+} {1 {no event type or button # or keysym}}
+
+test textTag-4.1 {TkTextTagCmd - "cget" option} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ .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} courier12 {
+ list [catch {.t tag cget sel bogus} msg] $msg
+} {1 {unknown option "bogus"}}
+test textTag-4.5 {TkTextTagCmd - "cget" option} courier12 {
+ .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} courier12 {
+ 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} courier12 {
+ list [catch {.t tag configure x -foo} msg] $msg
+} {1 {unknown option "-foo"}}
+test textTag-5.3 {TkTextTagCmd - "configure" option} courier12 {
+ list [catch {.t tag configure x -background red -underline} msg] $msg
+} {1 {value for "-underline" missing}}
+test textTag-5.4 {TkTextTagCmd - "configure" option} courier12 {
+ .t tag delete x
+ .t tag configure x -underline yes
+ .t tag configure x -underline
+} {-underline {} {} {} yes}
+test textTag-5.5 {TkTextTagCmd - "configure" option} courier12 {
+ .t tag delete x
+ .t tag configure x -overstrike on
+ .t tag cget x -overstrike
+} {on}
+test textTag-5.6 {TkTextTagCmd - "configure" option} courier12 {
+ list [catch {.t tag configure x -overstrike foo} msg] $msg
+} {1 {expected boolean value but got "foo"}}
+test textTag-5.7 {TkTextTagCmd - "configure" option} courier12 {
+ .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} courier12 {
+ .t tag delete x
+ .t tag configure x -justify left
+ .t tag configure x -justify
+} {-justify {} {} {} left}
+test textTag-5.9 {TkTextTagCmd - "configure" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .t tag delete x
+ .t tag configure x -offset 2
+ .t tag configure x -offset
+} {-offset {} {} {} 2}
+test textTag-5.12 {TkTextTagCmd - "configure" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .t configure -selectborderwidth 20
+ .t tag configure sel -borderwidth {}
+ .t cget -selectborderwidth
+} {}
+
+test textTag-6.1 {TkTextTagCmd - "delete" option} courier12 {
+ list [catch {.t tag delete} msg] $msg
+} {1 {wrong # args: should be ".t tag delete tagName tagName ..."}}
+test textTag-6.2 {TkTextTagCmd - "delete" option} courier12 {
+ list [catch {.t tag delete zork} msg] $msg
+} {0 {}}
+test textTag-6.3 {TkTextTagCmd - "delete" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ list [catch {.t tag lower} msg] $msg
+} {1 {wrong # args: should be ".t tag lower tagName ?belowThis?"}}
+test textTag-7.2 {TkTextTagCmd - "lower" option} courier12 {
+ list [catch {.t tag lower foo} msg] $msg
+} {1 {tag "foo" isn't defined in text widget}}
+test textTag-7.3 {TkTextTagCmd - "lower" option} courier12 {
+ 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} courier12 {
+ tagsetup
+ .t tag lower c
+ .t tag names
+} {c sel a b d}
+test textTag-7.5 {TkTextTagCmd - "lower" option} courier12 {
+ tagsetup
+ .t tag lower d b
+ .t tag names
+} {sel a d b c}
+test textTag-7.6 {TkTextTagCmd - "lower" option} courier12 {
+ tagsetup
+ .t tag lower a c
+ .t tag names
+} {sel b a c d}
+
+test textTag-8.1 {TkTextTagCmd - "names" option} courier12 {
+ 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} courier12 {
+ tagsetup
+ .t tag names
+} {sel a b c d}
+test textTag-8.3 {TkTextTagCmd - "names" option} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ list [catch {.t tag nextrange foo 1.0} msg] $msg
+} {0 {}}
+test textTag-9.4 {TkTextTagCmd - "nextrange" option} courier12 {
+ list [catch {.t tag nextrange x foo} msg] $msg
+} {1 {bad text index "foo"}}
+test textTag-9.5 {TkTextTagCmd - "nextrange" option} courier12 {
+ list [catch {.t tag nextrange x 1.0 bar} msg] $msg
+} {1 {bad text index "bar"}}
+test textTag-9.6 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 1.0
+} {2.3 2.5}
+test textTag-9.7 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 2.2
+} {2.3 2.5}
+test textTag-9.8 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 2.3
+} {2.3 2.5}
+test textTag-9.9 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 2.4
+} {2.9 3.1}
+test textTag-9.10 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 2.4 2.9
+} {}
+test textTag-9.11 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 2.4 2.10
+} {2.9 3.1}
+test textTag-9.12 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 2.4 2.11
+} {2.9 3.1}
+test textTag-9.13 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 7.0
+} {7.2 7.3}
+test textTag-9.14 {TkTextTagCmd - "nextrange" option} courier12 {
+ .t tag nextrange x 7.3
+} {}
+
+test textTag-10.1 {TkTextTagCmd - "prevrange" option} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ list [catch {.t tag prevrange foo end} msg] $msg
+} {0 {}}
+test textTag-10.4 {TkTextTagCmd - "prevrange" option} courier12 {
+ list [catch {.t tag prevrange x foo} msg] $msg
+} {1 {bad text index "foo"}}
+test textTag-10.5 {TkTextTagCmd - "prevrange" option} courier12 {
+ list [catch {.t tag prevrange x end bar} msg] $msg
+} {1 {bad text index "bar"}}
+test textTag-10.6 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x end
+} {7.2 7.3}
+test textTag-10.7 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 2.4
+} {2.3 2.5}
+test textTag-10.8 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 2.5
+} {2.3 2.5}
+test textTag-10.9 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 2.9
+} {2.3 2.5}
+test textTag-10.10 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 2.9 2.6
+} {}
+test textTag-10.11 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 2.9 2.5
+} {}
+test textTag-10.12 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 2.9 2.3
+} {2.3 2.5}
+test textTag-10.13 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 7.0
+} {2.9 3.1}
+test textTag-10.14 {TkTextTagCmd - "prevrange" option} courier12 {
+ .t tag prevrange x 2.3
+} {}
+
+test textTag-11.1 {TkTextTagCmd - "raise" option} courier12 {
+ list [catch {.t tag raise} msg] $msg
+} {1 {wrong # args: should be ".t tag raise tagName ?aboveThis?"}}
+test textTag-11.2 {TkTextTagCmd - "raise" option} courier12 {
+ list [catch {.t tag raise foo} msg] $msg
+} {1 {tag "foo" isn't defined in text widget}}
+test textTag-11.3 {TkTextTagCmd - "raise" option} courier12 {
+ 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} courier12 {
+ tagsetup
+ .t tag raise c
+ .t tag names
+} {sel a b d c}
+test textTag-11.5 {TkTextTagCmd - "raise" option} courier12 {
+ tagsetup
+ .t tag raise d b
+ .t tag names
+} {sel a b d c}
+test textTag-11.6 {TkTextTagCmd - "raise" option} courier12 {
+ tagsetup
+ .t tag raise a c
+ .t tag names
+} {sel b c a d}
+
+test textTag-12.1 {TkTextTagCmd - "ranges" option} courier12 {
+ list [catch {.t tag ranges} msg] $msg
+} {1 {wrong # args: should be ".t tag ranges tagName"}}
+test textTag-12.2 {TkTextTagCmd - "ranges" option} courier12 {
+ .t tag delete x
+ .t tag ranges x
+} {}
+test textTag-12.3 {TkTextTagCmd - "ranges" option} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ 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} courier12 {
+ .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} courier12 {
+ .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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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 <Button> -x $x1 -y $y1
+ event gen .t <Motion> -x $x1 -y $y1
+ event gen .t <ButtonRelease> -x $x1 -y $y1
+ event gen .t <Button> -x $x1 -y $y1
+ event gen .t <Motion> -x $x2 -y $y2
+ event gen .t <ButtonRelease> -x $x2 -y $y2
+ event gen .t <Button> -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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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} courier12 {
+ 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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/textWind.test b/tcl/tests/textWind.test
new file mode 100644
index 00000000000..22780ecccc3
--- /dev/null
+++ b/tcl/tests/textWind.test
@@ -0,0 +1,841 @@
+# This file is a Tcl script to test the code in the file tkTextWind.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/tk.test b/tcl/tests/tk.test
new file mode 100644
index 00000000000..a4fe6832ec6
--- /dev/null
+++ b/tcl/tests/tk.test
@@ -0,0 +1,137 @@
+# This file is a Tcl script to test the tk command.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2002 ActiveState Corporation.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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, caret, scaling, useinputmethods, or windowingsystem}}
+
+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
+
+set useim [tk useinputmethods]
+test tk-4.1 {tk command: useinputmethods} {
+ list [catch {tk useinputmethods -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test tk-4.2 {tk command: useinputmethods: get current} {
+ tk useinputmethods no
+} 0
+test tk-4.3 {tk command: useinputmethods: get current} {
+ tk useinputmethods -displayof .
+} 0
+test tk-4.4 {tk command: useinputmethods: set new} {
+ list [catch {tk useinputmethods xyz} msg] $msg
+} {1 {expected boolean value but got "xyz"}}
+test tk-4.5 {tk command: useinputmethods: set new} {
+ list [catch {tk useinputmethods -displayof . xyz} msg] $msg
+} {1 {expected boolean value but got "xyz"}}
+test tk-4.6 {tk command: useinputmethods: set new} {unixOnly} {
+ # This isn't really a test, but more of a check...
+ # The answer is what was given, because we may be on a Unix
+ # system that doesn't have the XIM stuff
+ if {[tk useinputmethods 1] == 0} {
+ puts "this wish doesn't have XIM (X Input Methods) support"
+ }
+ set useim
+} $useim
+test tk-4.7 {tk command: useinputmethods: set new} {macOrPc} {
+ # Mac and Windows don't have X Input Methods, so this should
+ # always return 0
+ tk useinputmethods 1
+} 0
+tk useinputmethods $useim
+
+test tk-5.1 {tk caret} {
+ list [catch {tk caret} msg] $msg
+} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
+test tk-5.2 {tk caret} {
+ list [catch {tk caret bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+test tk-5.3 {tk caret} {
+ list [catch {tk caret . -foo} msg] $msg
+} {1 {bad caret option "-foo": must be -x, -y, or -height}}
+test tk-5.4 {tk caret} {
+ list [catch {tk caret . -x 0 -y} msg] $msg
+} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
+test tk-5.5 {tk caret} {
+ list [catch {tk caret . -x 10 -y 11 -h 12; tk caret .} msg] $msg
+} {0 {-height 12 -x 10 -y 11}}
+test tk-5.6 {tk caret} {
+ list [catch {tk caret . -x 20 -y 25 -h 30; tk caret . -hei} msg] $msg
+} {0 30}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/unixButton.test b/tcl/tests/unixButton.test
new file mode 100644
index 00000000000..d3354afb79f
--- /dev/null
+++ b/tcl/tests/unixButton.test
@@ -0,0 +1,183 @@
+# This file is a Tcl script to test the Unix specific behavior of
+# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
+# widgets defined in tkUnixButton.c). It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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]
+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} {unix testImageType} {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} {unix nonPortable fonts} {
+ deleteWindows
+ 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} {unix nonPortable fonts} {
+ deleteWindows
+ 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} {unix nonPortable fonts} {
+ deleteWindows
+ 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} {unix nonPortable fonts} {
+ deleteWindows
+ 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} {unix nonPortable fonts} {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ button .b2 -bitmap question -default active
+ list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {37 47}
+test unixbutton-1.10 {TkpComputeButtonGeometry procedure} unix {
+ deleteWindows
+ button .b2 -bitmap question -default normal
+ list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {37 47}
+test unixbutton-1.11 {TkpComputeButtonGeometry procedure} unix {
+ deleteWindows
+ button .b2 -bitmap question -default disabled
+ list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {27 37}
+
+deleteWindows
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/unixEmbed.test b/tcl/tests/unixEmbed.test
new file mode 100644
index 00000000000..c9475e84e47
--- /dev/null
+++ b/tcl/tests/unixEmbed.test
@@ -0,0 +1,577 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkUnixEmbed.c. It is organized in the standard fashion for Tcl
+# tests.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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} unix {
+ 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} unix {
+ 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} {unix nonPortable} {
+ catch {destroy .t}
+ catch {destroy .x}
+ toplevel .t -colormap new
+ wm geometry .t +0+0
+ eatColors .t.t
+ frame .t.f -container 1
+ toplevel .x -use [winfo id .t.f]
+ set result [colorsFree .x]
+ destroy .t
+ set result
+} {0}
+test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {unix nonPortable} {
+ catch {destroy .t}
+ catch {destroy .t2}
+ catch {destroy .x}
+ toplevel .t -container 1 -colormap new
+ wm geometry .t +0+0
+ eatColors .t2
+ toplevel .x -use [winfo id .t]
+ set result [colorsFree .x]
+ destroy .t
+ set result
+} {1}
+
+test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {unix testembed} {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} \
+ {unix testembed nonPortable} {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ catch {interp delete child}
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} {unix testembed} {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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} unix {
+ deleteWindows
+ 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}
+
+# cleanup
+deleteWindows
+cleanupbg
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/unixFont.test b/tcl/tests/unixFont.test
new file mode 100644
index 00000000000..43a3d137eb6
--- /dev/null
+++ b/tcl/tests/unixFont.test
@@ -0,0 +1,332 @@
+# This file is a Tcl script to test out the procedures in tkUnixFont.c.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Many of these tests are visually oriented and cannot be checked
+# programmatically (such as "does an underlined font appear to be
+# underlined?"); these tests attempt to exercise the code in question,
+# but there are no results that can be checked. Some tests depend on the
+# fonts having or not having certain properties, which may not be valid
+# at all sites.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint hasArial 1
+testConstraint hasCourierNew 1
+testConstraint hasTimesNew 1
+set xlsf [auto_execok xlsfonts]
+if {[llength $xlsf]} {
+ foreach {constraint font} {
+ hasArial arial
+ hasCourierNew "courier new"
+ hasTimesNew "times new roman"
+ } {
+ if {![catch {eval exec $xlsf [list *-$font-*]} res]
+ && ![string match *unmatched* $res]} {
+ # Newer Unix systems have more default fonts installed,
+ # so we can't rely on fallbacks for fonts to need to
+ # fall back on anything.
+ testConstraint $constraint 0
+ }
+ }
+}
+
+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} {unix noExceed} {
+ list [catch {font measure {} xyz} msg] $msg
+} {1 {font "" doesn't exist}}
+test unixfont-1.2 {TkpGetNativeFont procedure: native} unix {
+ font measure fixed 0
+} {6}
+
+test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} unix {
+ font actual {-size 10}
+ set x {}
+} {}
+test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} \
+ {unix noExceed hasTimesNew} {
+ 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} \
+ {unix noExceed hasCourierNew} {
+ 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} \
+ {unix noExceed hasArial} {
+ 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} unix {
+ font actual {-xyz-xyz-*-*-*-*-*-*-*-*-*-*-*-*}
+ set x {}
+} {}
+test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} unix {
+ lindex [font actual {-family fixed -size 10}] 1
+} {fixed}
+test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} unix {
+ # no test available
+} {}
+test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} unix {
+ lindex [font actual {-family fixed -size 31}] 1
+} {fixed}
+test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {unix noExceed} {
+ lindex [font actual {-family courier}] 1
+} {courier}
+test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} unix {
+ lindex [font actual {-family courier -size 37}] 3
+} {37}
+test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} unix {
+ # 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} unix {
+ font actual {-family xyz}
+ set x {}
+} {}
+
+test unixfont-4.1 {TkpGetFontFamilies procedure} unix {
+ font families
+ set x {}
+} {}
+
+test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} unix {
+ .b.l config -text "000000" -wrap [expr $ax*3]
+ .b.l config -wrap 0
+} {}
+test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} unix {
+ .b.l config -text "000000"
+} {}
+test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} unix {
+ .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} unix {
+ .b.l config -text "0000000000000"
+ getsize
+} "[expr $ax*10] [expr $ay*2]"
+test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} unix {
+ .b.l config -text "000000"
+ getsize
+} "[expr $ax*6] $ay"
+test unixfont-5.6 {Tk_MeasureChars procedure: find last word} unix {
+ .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} unix {
+ .b.l config -text "000000 00000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} unix {
+ .b.l config -text "00 000 00000"
+ getsize
+} "[expr $ax*7] [expr $ay*2]"
+test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} unix {
+ .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} unix {
+ .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!} unix {
+ 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} unix {
+ .b.l config -text "000 \n000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+
+test unixfont-6.1 {Tk_DrawChars procedure: loop test} unix {
+ .b.l config -text "a"
+ update
+} {}
+test unixfont-6.2 {Tk_DrawChars procedure: loop test} unix {
+ .b.l config -text "abcd"
+ update
+} {}
+test unixfont-6.3 {Tk_DrawChars procedure: special char} unix {
+ .b.l config -text "\001"
+ update
+} {}
+test unixfont-6.4 {Tk_DrawChars procedure: normal then special} unix {
+ .b.l config -text "ab\001"
+ update
+} {}
+test unixfont-6.5 {Tk_DrawChars procedure: ends with special} unix {
+ .b.l config -text "ab\001"
+ update
+} {}
+test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} unix {
+ .b.l config -text "ab\001def"
+ update
+} {}
+
+test unixfont-7.1 {DrawChars procedure: no effects} unix {
+ .b.l config -text "abc"
+ update
+} {}
+test unixfont-7.2 {DrawChars procedure: underlining} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ expr {[lindex [font actual {-family times -size 0}] 3] == 0}
+} {0}
+test unixfont-8.3 {AllocFont procedure: can't parse info from name} unix {
+ catch {unset fontArray}
+ # check that font actual returns the correct attributes.
+ # the values of those attributes are system dependent.
+ array set fontArray [font actual a12biluc]
+ set result [lsort [array names fontArray]]
+ catch {unset fontArray}
+ set result
+} {-family -overstrike -size -slant -underline -weight}
+test unixfont-8.4 {AllocFont procedure: classify characters} unix {
+ set x 0
+ incr x [font measure $courier "\u4000"] ;# 6
+ incr x [font measure $courier "\002"] ;# 4
+ incr x [font measure $courier "\012"] ;# 2
+ incr x [font measure $courier "\101"] ;# 1
+ set x
+} [expr $cx*13]
+test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} unix {
+ font metrics $courier -fixed
+} {1}
+test unixfont-8.6 {AllocFont procedure: setup widths of special chars} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ .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} unix {
+ .b.c dchars $t 0 end
+ .b.c insert $t 0 "0\0010"
+ set x {}
+ lappend x [.b.c index $t @[expr $ax*0],0]
+ lappend x [.b.c index $t @[expr $ax*1],0]
+ lappend x [.b.c index $t @[expr $ax*2],0]
+ lappend x [.b.c index $t @[expr $ax*3],0]
+ lappend x [.b.c index $t @[expr $ax*4],0]
+ lappend x [.b.c index $t @[expr $ax*5],0]
+} {0 1 1 1 1 2}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/unixMenu.test b/tcl/tests/unixMenu.test
new file mode 100644
index 00000000000..863d576e23b
--- /dev/null
+++ b/tcl/tests/unixMenu.test
@@ -0,0 +1,953 @@
+# This file is a Tcl script to test menus in Tk. It is
+# organized in the standard fashion for Tcl tests. This
+# file tests the Macintosh-specific features of the menu
+# system.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test unixMenu-1.1 {TkpNewMenu - normal menu} unix {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test unixMenu-1.2 {TkpNewMenu - help menu} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -indicatoron 0
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} {unix testImageType} {
+ 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 {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
+} {0 {} {}}
+test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -bitmap questhead -label foo
+ .m1 invoke foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} {unix testImageType} {
+ 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 {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
+} {0 {} {}}
+test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -bitmap questhead -label foo
+ .m1 invoke foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ .m1 invoke foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo -hidemargin 1
+ .m1 invoke foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+S"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-9.3 {GetMenuAccelGeometry - null label} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} unix {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ $tearoff activate 0
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-10.3 {DrawMenuEntryBackground - non-active} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} unix {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+U"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -indicatoron 0
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo -indicatoron 0
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-13.1 {DrawMenuSeparator - menubar case} unix {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-14.1 {DrawMenuEntryLabel} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-15.1 {DrawMenuUnderline - menubar} unix {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -underline 0
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-16.1 {TkpPostMenu} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test unixMenu-17.1 {GetMenuSeparatorGeometry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test unixMenu-18.1 {GetTearoffEntryGeometry} unix {
+ catch {destroy .m1}
+ menubutton .mb -text "test" -menu .mb.m
+ menu .mb.m
+ .mb.m add command -label test
+ pack .mb
+ raise .
+ list [catch {tk::MbPost .mb} msg] $msg [tk::MenuUnpost .mb.m] [destroy .mb]
+} {0 {} {} {}}
+
+# Don't know how to reproduce the case where the tkwin has been deleted.
+test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activeforeground red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} unix {
+ catch {destroy .m1}
+ menu .m1
+ set tk_strictMotif 1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .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} unix {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground blue
+ .m1 add command -label foo -state disabled -background red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} unix {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground blue
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} unix {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground ""
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -foreground red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -selectcolor orange
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activebackground green
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.12 {TkpDrawMenuEntry - border} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} unix {
+ catch {destroy .m1}
+ set tk_strictMotif 1
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activeforeground yellow
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.15 {TkpDrawMenuEntry - active border} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -font "Helvectica 72"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.17 {TkpDrawMenuEntry - font} unix {
+ catch {destroy .m1}
+ menu .m1 -font "Courier 72"
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.18 {TkpDrawMenuEntry - separator} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.19 {TkpDrawMenuEntry - standard} unix {
+ catch {destroy .mb}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} unix {
+ 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 [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.21 {TkpDrawMenuEntry - indicator} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label Foo
+ .m1 invoke Foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label Foo -hidemargin 1
+ .m1 invoke Foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test unixMenu-24.1 {GetMenuLabelGeometry - image} {testImageType unix} {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -bitmap questhead
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-24.3 {GetMenuLabelGeometry - no text} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-24.4 {GetMenuLabelGeometry - text} unix {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.3 {TkpComputeStandardMenuGeometry - more than one entry} unix {
+ 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} unix {
+ 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 {tk::MbPost .mb}
+ list [update] [tk::MenuUnpost .mb.m] [destroy .mb]
+} {{} {} {}}
+test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} unix {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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 } {unix testImageType} {
+ 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 testImageType} {
+ 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} unix {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.17 {TkpComputeStandardMenuGeometry - first column bigger} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} {} {}
+
+# cleanup
+deleteWindows
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/unixSelect.test b/tcl/tests/unixSelect.test
new file mode 100644
index 00000000000..4599caf2d51
--- /dev/null
+++ b/tcl/tests/unixSelect.test
@@ -0,0 +1,239 @@
+# This file contains tests for the tkUnixSelect.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) 1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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
+}
+
+test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} {unixOnly} {
+ setupbg
+ entry .e
+ pack .e
+ update
+ .e insert 0 [encoding convertfrom identity \u00fcber]
+ .e selection range 0 end
+ set result [dobg {string bytelength [selection get]}]
+ cleanupbg
+ destroy .e
+ set result
+} {5}
+test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 \u00fc\u0444
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal \u00fc? $x] \
+ [string length $x] [string bytelength $x]
+} {1 2 3}
+test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} {
+ setupbg
+ setup
+ selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
+ {handler COMPOUND_TEXT}
+ selection own .
+ set selValue \u00fc\u0444
+ set selInfo {}
+ set result [dobg {
+ set x [selection get -type COMPOUND_TEXT]
+ list [string equal \u00fc\u0444 $x] \
+ [string length $x] [string bytelength $x]
+ }]
+ cleanupbg
+ lappend result $selInfo
+} {1 2 4 {COMPOUND_TEXT 0 4000}}
+test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} {unixOnly} {
+
+ # This test is subtle. The selection ends up getting fetched twice by
+ # Tk: once to compute the length, and again to actually send the data.
+ # The first time through, we don't convert the data to ISO2022, so the
+ # buffer boundaries end up being different in the two passes.
+
+ setupbg
+ setup
+ selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
+ {handler COMPOUND_TEXT}
+ selection own .
+ set selValue [string repeat x 3999]\u00fc\u0444[string repeat x 3999]
+ set selInfo {}
+ set result [dobg {
+ set x [selection get -type COMPOUND_TEXT]
+ list [string equal \
+ [string repeat x 3999]\u00fc\u0444[string repeat x 3999] $x] \
+ [string length $x] [string bytelength $x]
+ }]
+ cleanupbg
+ lappend result $selInfo
+} {1 8000 8002 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}}
+test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} {
+ setupbg
+ setup
+ selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
+ {handler COMPOUND_TEXT}
+ selection own .
+ set selValue \u00fc\u0444
+ set selInfo {}
+ set result [dobg {
+ set x [selection get -type COMPOUND_TEXT]
+ list [string equal \u00fc\u0444 $x] \
+ [string length $x] [string bytelength $x]
+ }]
+ cleanupbg
+ lappend result $selInfo
+} {1 2 4 {COMPOUND_TEXT 0 4000}}
+test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg "entry .e; pack .e; update
+ .e insert 0 \[encoding convertfrom identity \\u00fcber\]$longValue
+ .e selection range 0 end"
+ set result [string bytelength [selection get]]
+ cleanupbg
+ set result
+} [expr {5 + [string bytelength $longValue]}]
+test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 [string repeat x 3999]\u00fc
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal [string repeat x 3999]\u00fc $x] \
+ [string length $x] [string bytelength $x]
+} {1 4000 4001}
+test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 \u00fc[string repeat x 3999]
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal \u00fc[string repeat x 3999] $x] \
+ [string length $x] [string bytelength $x]
+} {1 4000 4001}
+test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000]
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \
+ [string length $x] [string bytelength $x]
+} {1 8000 8001}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/unixWm.test b/tcl/tests/unixWm.test
new file mode 100644
index 00000000000..08e5660f63e
--- /dev/null
+++ b/tcl/tests/unixWm.test
@@ -0,0 +1,2408 @@
+# This file is a Tcl script to test out Tk's interactions with
+# the window manager, including the "wm" command. It is organized
+# in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.2
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+proc sleep ms {
+ global x
+ after $ms {set x 1}
+ vwait x
+}
+
+# Procedure to set up a collection of top-level windows
+
+proc makeToplevels {} {
+ deleteWindows
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} {unix 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} {unix 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} {unix 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} {unix 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} {unix 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} {unix 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} {unix 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} unix {
+ .t config -width 180 -height 150
+ update
+ wm geom .t
+} 180x150+10+10
+test unixWm-6.2 {size changes} unix {
+ wm geom .t 250x60
+ .t config -width 170 -height 140
+ update
+ wm geom .t
+} 250x60+10+10
+test unixWm-6.3 {size changes} unix {
+ 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} {unix nonPortable userInteraction} {
+ wm minsize .t 1 1
+ update
+ puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
+ puts -nonewline stdout "then hit return: "
+ flush stdout
+ gets stdin
+ update
+ 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} {unix 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} unix {
+ 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} unix {
+ 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} unix {
+ list [winfo ismapped .m]
+} 0
+destroy .m
+catch {destroy .t}
+
+test unixWm-8.1 {icon windows} unix {
+ 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} unix {
+ 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} unix {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ list [catch {wm iconwindow .t b c} msg] $msg
+} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}}
+test unixWm-8.4 {icon windows} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} unix {
+ 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} {unix 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}
+
+test unixWm-8.10.1 {test for memory leaks} unix {
+ wm title .t "This is a long long long long long long title"
+ wm title .t "This is a long long long long long long title"
+ wm title .t "This is a long long long long long long title"
+ wm title .t "This is a long long long long long long title"
+ wm title .t "This is a long long long long long long title"
+ wm title .t "This is a long long long long long long title"
+ wm title .t "This is a long long long long long long title"
+ wm title .t "This is a long long long long long long title"
+ set x 1
+} 1
+test unixWm-8.10.2 {test for memory leaks} unix {
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ wm group .t .
+ set x 1
+} 1
+
+test unixWm-9.1 {TkWmMapWindow procedure, client property} {unix testwrapper} {
+ 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} {unix testwrapper} {
+ 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}
+
+testConstraint testmenubar [llength [info commands testmenubar]]
+
+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} {unix testmenubar} {
+ 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 aspect} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} {
+ list [catch {wm iconify 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 # args: should 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 # args: should 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 # args: should be "wm client window ?name?"}}
+test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unix testwrapper} {
+ 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 # args: should 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 # args: should 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 # args: should be "wm command window ?value?"}}
+test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unix testwrapper} {
+ 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 # args: should 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 # args: should 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 # args: should 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 # args: should 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 # args: should 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 # args: should 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 # args: should 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} {unix testwrapper} {
+ 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} {unix testwrapper} {
+ 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} {unix testwrapper} {
+ 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} unix {
+ list [catch {wm iconbitmap .t 12 13} msg] $msg
+} {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}}
+test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} {
+ 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 # args: should 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
+ update
+ 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
+ update
+ 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 # args: should be "wm iconmask window ?bitmap?"}}
+test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unix testwrapper} {
+ 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 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, 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 # args: should be "wm iconname window ?newName?"}}
+test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} {
+ 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 # args: should 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 # args: should be "wm iconposition window ?x y?"}}
+test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unix testwrapper} {
+ 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 # args: should be "wm iconwindow window ?pathName?"}}
+test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unix testwrapper} {
+ 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} {nonPortable} {
+ wm maxsize .t
+} {1137 870}
+
+test unixWm-28.2 {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} {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 # args: should 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 # args: should be "wm positionfrom window ?user/program?"}}
+test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unix testwrapper} {
+ 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 # args: should 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} {unix testwrapper} {
+ 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 # args: should 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 # args: should 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 # args: should be "wm sizefrom window ?user|program?"}}
+test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} {
+ 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} unix {
+ list [catch {wm state .t 1} msg] $msg
+} {1 {bad argument "1": must be normal, iconic, or withdrawn}}
+test unixWm-35.2 {Tk_WmCmd procedure, "state" option} {
+ list [catch {wm state .t iconic 1} msg] $msg
+} {1 {wrong # args: should be "wm state window ?state?"}}
+test unixWm-35.3 {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-35.4 {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 state .t2 withdrawn
+ lappend result [wm state .t2]
+ wm state .t2 iconic
+ lappend result [wm state .t2]
+ wm state .t2 normal
+ 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 # args: should be "wm title window ?newTitle?"}}
+test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unix testwrapper} {
+ 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.3 {Tk_WmCmd procedure, "transient" option} {unix testwrapper} {
+ 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 {TkWmDeadWindow, destroy on master should clear transient} {unix testwrapper} {
+ catch {destroy .t2}
+ toplevel .t2
+ catch {destroy .t3}
+ toplevel .t3
+ wm transient .t2 .t3
+ update
+ destroy .t3
+ update
+ list [wm transient .t2] [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
+} {{} 0x0}
+test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unix testwrapper} {
+ 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 # args: should 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 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, 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} {nonPortable testmenubar} {
+ 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}
+
+catch {destroy .t}
+toplevel .t -width 80 -height 60
+test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
+ wm geometry .t +5-10
+ wm overrideredirect .t 1
+ tkwait visibility .t
+ list [winfo x .t] [winfo y .t]
+} [list 5 [expr [winfo screenheight .t] - 70]]
+
+catch {destroy .t}
+toplevel .t -width 80 -height 60
+test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
+ wm geometry .t -30+2
+ wm overrideredirect .t 1
+ tkwait visibility .t
+ list [winfo x .t] [winfo y .t]
+} [list [expr [winfo screenwidth .t] - 110] 2]
+catch {destroy .t}
+
+test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} {
+ 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} testmenubar {
+ 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} {unix testwrapper} {
+ 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} {unix testwrapper} {
+ 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} {testmenubar testwrapper} {
+ 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} {testmenubar testwrapper} {
+ 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} {nonPortable} {
+ 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 <ButtonRelease> -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} {unix testmenubar} {
+ 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}
+
+deleteWindows
+wm iconify .
+test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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
+} -constraints tempNotWin -setup {
+ deleteWindows
+ 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
+} -body {
+ 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]]
+} -cleanup {
+ cleanupbg
+} -result {{} .x .t .t.f}
+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} {unix testmenubar} {
+ deleteWindows
+ 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.} {
+ deleteWindows
+ 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}
+deleteWindows
+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}
+deleteWindows
+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} unix {
+ 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} unix {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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} {unix testmenubar} {
+ 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 unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unix testwrapper} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 50
+ wm geom .t +0+0
+ wm command .t "argumentNumber0 argumentNumber1 argumentNumber2 argumentNumber0 argumentNumber3 argumentNumber4 argumentNumber5 argumentNumber6 argumentNumber0 argumentNumber7 argumentNumber8 argumentNumber9 argumentNumber10 argumentNumber0 argumentNumber11 argumentNumber12 argumentNumber13 argumentNumber14 argumentNumber15 argumentNumber16 argumentNumber17 argumentNumber18"
+ update
+ testprop [testwrapper .t] WM_COMMAND
+} {argumentNumber0
+argumentNumber1
+argumentNumber2
+argumentNumber0
+argumentNumber3
+argumentNumber4
+argumentNumber5
+argumentNumber6
+argumentNumber0
+argumentNumber7
+argumentNumber8
+argumentNumber9
+argumentNumber10
+argumentNumber0
+argumentNumber11
+argumentNumber12
+argumentNumber13
+argumentNumber14
+argumentNumber15
+argumentNumber16
+argumentNumber17
+argumentNumber18
+}
+
+# Test exit processing and cleanup:
+
+test unixWm-59.1 {exit processing} {
+ set script [makeFile {
+ update
+ exit
+ } script]
+ if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+ set error 1
+ } else {
+ set error 0
+ }
+ removeFile script
+ list $error $msg
+} {0 {}}
+test unixWm-59.2 {exit processing} {
+ set script [makeFile {
+ interp create x
+ x eval {set argc 2}
+ x eval {set argv "-geometry 10x10+0+0"}
+ x eval {load {} Tk}
+ update
+ exit
+ } script]
+ if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+ set error 1
+ } else {
+ set error 0
+ }
+ removeFile script
+ list $error $msg
+} {0 {}}
+test unixWm-59.3 {exit processing} {
+ set script [makeFile {
+ 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
+ } script]
+ if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+ set error 1
+ } else {
+ set error 0
+ }
+ removeFile script
+ list $error $msg
+} {0 {}}
+
+test unixWm-60.1 {wm attributes} unix {
+ destroy .t
+ toplevel .t
+ wm attributes .t
+} {}
+test unixWm-60.2 {wm attributes} unix {
+ destroy .t
+ toplevel .t
+ list [catch {wm attributes .t -foo} msg] $msg
+} {1 {wrong # args: should be "wm attributes window"}}
+
+# cleanup
+catch {destroy .t}
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/util.test b/tcl/tests/util.test
index 23c1c145209..25e7213d7fb 100644
--- a/tcl/tests/util.test
+++ b/tcl/tests/util.test
@@ -1,313 +1,84 @@
-# This file is a Tcl script to test the code in the file tclUtil.c.
-# This file is organized in the standard fashion for Tcl tests.
+# 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) 1995-1998 Sun Microsystems, Inc.
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-if {[info commands testobj] == {}} {
- puts "This application hasn't been compiled with the \"testobj\""
- puts "command, so I can't test the Tcl type and object support."
- ::tcltest::cleanupTests
- return
-}
-
-test util-1.1 {TclFindElement procedure - binary element in middle of list} {
- lindex {0 foo\x00help 1} 1
-} "foo\x00help"
-test util-1.2 {TclFindElement procedure - binary element at end of list} {
- lindex {0 foo\x00help} 1
-} "foo\x00help"
-
-test util-2.1 {TclCopyAndCollapse procedure - normal string} {
- lindex {0 foo} 1
-} {foo}
-test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} {
- lindex {0 foo\n\x00help 1} 1
-} "foo\n\x00help"
-
-test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} {
- # This test checks for a very tricky feature. Any list element
- # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must
- # have the property that it can be enclosing in curly braces to make
- # an embedded sub-list. If this property doesn't hold, then
- # Tcl_DStringStartSublist doesn't work.
-
- set x {}
- lappend x " \\\{ \\"
- concat $x [llength "{$x}"]
-} {\ \\\{\ \\ 1}
-
-test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {
- concat a {b\ } c
-} {a b\ c}
-test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} {
- concat a {b\ } c
-} {a b\ c}
-test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} {
- concat a {b\\ } c
-} {a b\\ c}
-test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
- concat a {b } c
-} {a b c}
-test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
- concat a { } c
-} {a c}
-test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
- # Check for Bug #227512. If this violates C isspace, then it returns \xc3.
- concat \xe0
-} \xe0
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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}}
-proc Wrapper_Tcl_StringMatch {pattern string} {
- # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
- switch -glob -- $string $pattern {return 1} default {return 0}
-}
-test util-5.1 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch ab*c abc
-} 1
-test util-5.2 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch ab**c abc
-} 1
-test util-5.3 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch ab* abcdef
-} 1
-test util-5.4 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch *c abc
-} 1
-test util-5.5 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch *3*6*9 0123456789
-} 1
-test util-5.6 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch *3*6*9 01234567890
-} 0
-test util-5.7 {Tcl_StringMatch: UTF-8} {
- Wrapper_Tcl_StringMatch *u \u4e4fu
-} 1
-test util-5.8 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch a?c abc
-} 1
-test util-5.9 {Tcl_StringMatch: UTF-8} {
- # skip one character in string
+# cleanup
+::tcltest::cleanupTests
+return
- Wrapper_Tcl_StringMatch a?c a\u4e4fc
-} 1
-test util-5.10 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch a??c abc
-} 0
-test util-5.11 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch ?1??4???8? 0123456789
-} 1
-test util-5.12 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {[abc]bc} abc
-} 1
-test util-5.13 {Tcl_StringMatch: UTF-8} {
- # string += Tcl_UtfToUniChar(string, &ch);
- Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc"
-} 1
-test util-5.14 {Tcl_StringMatch} {
- # if ((*pattern == ']') || (*pattern == '\0'))
- # badly formed pattern
- Wrapper_Tcl_StringMatch {[]} {[]}
-} 0
-test util-5.15 {Tcl_StringMatch} {
- # if ((*pattern == ']') || (*pattern == '\0'))
- # badly formed pattern
- Wrapper_Tcl_StringMatch {[} {[}
-} 0
-test util-5.16 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {a[abc]c} abc
-} 1
-test util-5.17 {Tcl_StringMatch: UTF-8} {
- # pattern += Tcl_UtfToUniChar(pattern, &endChar);
- # get 1 UTF-8 character
- Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"
-} 1
-test util-5.18 {Tcl_StringMatch: UTF-8} {
- # pattern += Tcl_UtfToUniChar(pattern, &endChar);
- # proper advance: wrong answer would match on UTF trail byte of \u4e4f
- Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc]
-} 0
-test util-5.19 {Tcl_StringMatch: UTF-8} {
- # pattern += Tcl_UtfToUniChar(pattern, &endChar);
- # proper advance.
- Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"
-} 1
-test util-5.20 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {a[xyz]c} abc
-} 0
-test util-5.21 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {12[2-7]45} 12345
-} 1
-test util-5.22 {Tcl_StringMatch: UTF-8 range} {
- Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0"
-} 0
-test util-5.23 {Tcl_StringMatch: UTF-8 range} {
- Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33"
-} 1
-test util-5.24 {Tcl_StringMatch: UTF-8 range} {
- Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08"
-} 0
-test util-5.25 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345
-} 1
-test util-5.26 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12b45
-} 1
-test util-5.27 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12d45
-} 1
-test util-5.28 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12145
-} 0
-test util-5.29 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12545
-} 0
-test util-5.30 {Tcl_StringMatch: forwards range} {
- Wrapper_Tcl_StringMatch {[k-w]} "z"
-} 0
-test util-5.31 {Tcl_StringMatch: forwards range} {
- Wrapper_Tcl_StringMatch {[k-w]} "w"
-} 1
-test util-5.32 {Tcl_StringMatch: forwards range} {
- Wrapper_Tcl_StringMatch {[k-w]} "r"
-} 1
-test util-5.33 {Tcl_StringMatch: forwards range} {
- Wrapper_Tcl_StringMatch {[k-w]} "k"
-} 1
-test util-5.34 {Tcl_StringMatch: forwards range} {
- Wrapper_Tcl_StringMatch {[k-w]} "a"
-} 0
-test util-5.35 {Tcl_StringMatch: reverse range} {
- Wrapper_Tcl_StringMatch {[w-k]} "z"
-} 0
-test util-5.36 {Tcl_StringMatch: reverse range} {
- Wrapper_Tcl_StringMatch {[w-k]} "w"
-} 1
-test util-5.37 {Tcl_StringMatch: reverse range} {
- Wrapper_Tcl_StringMatch {[w-k]} "r"
-} 1
-test util-5.38 {Tcl_StringMatch: reverse range} {
- Wrapper_Tcl_StringMatch {[w-k]} "k"
-} 1
-test util-5.39 {Tcl_StringMatch: reverse range} {
- Wrapper_Tcl_StringMatch {[w-k]} "a"
-} 0
-test util-5.40 {Tcl_StringMatch: skip correct number of ']'} {
- Wrapper_Tcl_StringMatch {[A-]x} Ax
-} 0
-test util-5.41 {Tcl_StringMatch: skip correct number of ']'} {
- Wrapper_Tcl_StringMatch {[A-]]x} Ax
-} 1
-test util-5.42 {Tcl_StringMatch: skip correct number of ']'} {
- Wrapper_Tcl_StringMatch {[A-]]x} \ue1x
-} 0
-test util-5.43 {Tcl_StringMatch: skip correct number of ']'} {
- Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x
-} 1
-test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {
- Wrapper_Tcl_StringMatch {[A-]h]x} hx
-} 1
-test util-5.45 {Tcl_StringMatch} {
- # if (*pattern == '\0')
- # badly formed pattern, still treats as a set
- Wrapper_Tcl_StringMatch {[a} a
-} 1
-test util-5.46 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {a\*b} a*b
-} 1
-test util-5.47 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {a\*b} ab
-} 0
-test util-5.48 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch {a\*\?\[\]\\\x} "a*?\[\]\\x"
-} 1
-test util-5.49 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch ** ""
-} 1
-test util-5.50 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch *. ""
-} 0
-test util-5.51 {Tcl_StringMatch} {
- Wrapper_Tcl_StringMatch "" ""
-} 1
-test util-6.1 {Tcl_PrintDouble - using tcl_precision} {
- concat x[expr 1.4]
-} {x1.4}
-test util-6.2 {Tcl_PrintDouble - using tcl_precision} {
- concat x[expr 1.39999999999]
-} {x1.39999999999}
-test util-6.3 {Tcl_PrintDouble - using tcl_precision} {
- concat x[expr 1.399999999999]
-} {x1.4}
-test util-6.4 {Tcl_PrintDouble - using tcl_precision} {
- set tcl_precision 5
- concat x[expr 1.123412341234]
-} {x1.1234}
-set tcl_precision 12
-test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
- concat x[expr 2.0]
-} {x2.0}
-test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} {
- concat x[expr 3.0e98]
-} {x3e+98}
-test util-7.1 {TclPrecTraceProc - unset callbacks} {
- set tcl_precision 7
- set x $tcl_precision
- unset tcl_precision
- list $x $tcl_precision
-} {7 7}
-test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} {
- set tcl_precision 12
- interp create child
- set x [child eval set tcl_precision]
- child eval {set tcl_precision 6}
- interp delete child
- list $x $tcl_precision
-} {12 6}
-test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} {
- set tcl_precision 12
- interp create -safe child
- set x [child eval {
- list [catch {set tcl_precision 8} msg] $msg
- }]
- interp delete child
- list $x $tcl_precision
-} {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12}
-test util-7.4 {TclPrecTraceProc - write traces, bogus values} {
- set tcl_precision 12
- list [catch {set tcl_precision abc} msg] $msg $tcl_precision
-} {1 {can't set "tcl_precision": improper value for precision} 12}
-set tcl_precision 12
-# This test always succeeded in the C locale anyway...
-test util-8.1 {TclNeedSpace - correct UTF8 handling} {
- interp create \u5420
- interp create [list \u5420 foo]
- interp alias {} fooset [list \u5420 foo] set
- set result [interp target {} fooset]
- interp delete \u5420
- set result
-} "\u5420 foo"
-# cleanup
-::tcltest::cleanupTests
-return
diff --git a/tcl/tests/visual.test b/tcl/tests/visual.test
new file mode 100644
index 00000000000..1ba896e708d
--- /dev/null
+++ b/tcl/tests/visual.test
@@ -0,0 +1,320 @@
+# This file is a Tcl script to test the visual- and colormap-handling
+# procedures in the file tkVisual.c. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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
+ } {}
+}
+
+deleteWindows
+rename eatColors {}
+rename colorsFree {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/visual_bb.test b/tcl/tests/visual_bb.test
new file mode 100644
index 00000000000..16680222901
--- /dev/null
+++ b/tcl/tests/visual_bb.test
@@ -0,0 +1,119 @@
+#!/usr/local/bin/wish -f
+#
+# This script displays provides visual tests for many of Tk's features.
+# Each test displays a window with various information in it, along
+# with instructions about how the window should appear. You can look
+# at the window to make sure it appears as expected. Individual tests
+# are kept in separate ".tcl" files in this directory.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::cleanupTests
+
+set auto_path ". $auto_path"
+wm title . "Visual Tests for Tk"
+
+set testNum 1
+
+# Each menu entry invokes a visual test file
+
+proc runTest {file} {
+ global testNum
+
+ test "2.$testNum" "testing $file" {userInteraction} {
+ uplevel \#0 source [file join [testsDirectory] $file]
+ concat ""
+ } {}
+ incr testNum
+}
+
+# The following procedure is invoked to print the contents of a canvas:
+
+proc lpr {c args} {
+ exec lpr <<[eval [list $c postscript] $args]
+}
+
+proc end {} {
+ cleanupTests
+ set ::EndOfVisualTests 1
+}
+
+test 1.1 "running visual tests" {userInteraction} {
+ #-------------------------------------------------------
+ # The code below create the main window, consisting of a
+ # menu bar and a message explaining the basic operation
+ # of the program.
+ #-------------------------------------------------------
+
+ frame .menu -relief raised -borderwidth 1
+ message .msg -font {Times 18} -relief raised -width 4i \
+ -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit. Each menu entry invokes a test, which displays information on the screen. You can then verify visually that the information is being displayed in the correct way. The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
+
+ pack .menu -side top -fill x
+ pack .msg -side bottom -expand yes -fill both
+
+ #-------------------------------------------------------
+ # The code below creates all the menus, which invoke procedures
+ # to create particular demonstrations of various widgets.
+ #-------------------------------------------------------
+
+ menubutton .menu.file -text "File" -menu .menu.file.m
+ menu .menu.file.m
+ .menu.file.m add command -label "Quit" -command end
+
+ menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
+ menu .menu.group1.m
+ .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
+ .menu.group1.m add command -label "Beveled borders in text widgets" \
+ -command {runTest bevel.tcl}
+ .menu.group1.m add command -label "Colormap management" \
+ -command {runTest cmap.tcl}
+ .menu.group1.m add command -label "Label/button geometry" \
+ -command {runTest butGeom.tcl}
+ .menu.group1.m add command -label "Label/button colors" \
+ -command {runTest butGeom2.tcl}
+
+ menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
+ menu .menu.ps.m
+ .menu.ps.m add command -label "Rectangles and other graphics" \
+ -command {runTest canvPsGrph.tcl}
+ .menu.ps.m add command -label "Text" \
+ -command {runTest canvPsText.tcl}
+ .menu.ps.m add command -label "Bitmaps" \
+ -command {runTest canvPsBmap.tcl}
+ .menu.ps.m add command -label "Images" \
+ -command {runTest canvPsImg.tcl}
+ .menu.ps.m add command -label "Arcs" \
+ -command {runTest canvPsArc.tcl}
+
+ pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
+
+ # Set up for keyboard-based menu traversal
+
+ bind . <Any-FocusIn> {
+ if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
+ focus .menu
+ }
+ }
+ tk_menuBar .menu .menu.file .menu.group1 .menu.ps
+
+ # Set up a class binding to allow objects to be deleted from a canvas
+ # by clicking with mouse button 1:
+
+ bind Canvas <1> {%W delete [%W find closest %x %y]}
+
+ concat ""
+} {}
+
+if {![testConstraint userInteraction]} {
+ cleanupTests
+} else {
+ vwait EndOfVisualTests
+}
diff --git a/tcl/tests/winButton.test b/tcl/tests/winButton.test
new file mode 100644
index 00000000000..f8b7c13af3a
--- /dev/null
+++ b/tcl/tests/winButton.test
@@ -0,0 +1,150 @@
+# This file is a Tcl script to test the Windows specific behavior of
+# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
+# widgets defined in tkWinButton.c). It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+proc bogusTrace args {
+ error "trace aborted"
+}
+catch {unset value}
+catch {unset value2}
+
+eval image delete [image names]
+if {[testConstraint testImageType]} {
+ 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} {testImageType pcOnly} {
+ deleteWindows
+ 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
+ # with patch 463234 with native L&F enabled, this returns:
+ # {68 48 70 50 88 50 88 50}
+ 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 70 50 90 52 90 52}
+test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} {
+ deleteWindows
+ 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
+ # with patch 463234 with native L&F enabled, this returns:
+ # {23 33 25 35 43 35 43 35}
+ 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 25 35 45 37 45 37}
+test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} {
+ deleteWindows
+ 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
+ # with patch 463234 with native L&F enabled, this returns:
+ # {31 41 23 33 25 35 25 35}
+ 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 23 33 27 37 27 37}
+test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
+ deleteWindows
+ label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
+ button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
+ checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8}
+ radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8}
+ pack .b1 .b2 .b3 .b4
+ update
+ list [winfo reqwidth .b1] [winfo reqheight .b1] \
+ [winfo reqwidth .b2] [winfo reqheight .b2] \
+ [winfo reqwidth .b3] [winfo reqheight .b3] \
+ [winfo reqwidth .b4] [winfo reqheight .b4]
+} {58 24 67 33 88 30 90 28}
+test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
+ deleteWindows
+ label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0
+ pack .l1
+ update
+ list [winfo reqwidth .l1] [winfo reqheight .l1]
+} {178 84}
+test winbutton-1.6 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
+ deleteWindows
+ label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
+ pack .l1
+ update
+ list [winfo reqwidth .l1] [winfo reqheight .l1]
+} {222 52}
+test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
+ deleteWindows
+ label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
+ button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
+ checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
+ radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4
+ pack .b1 .b2 .b3 .b4
+ update
+ list [winfo reqwidth .b1] [winfo reqheight .b1] \
+ [winfo reqwidth .b2] [winfo reqheight .b2] \
+ [winfo reqwidth .b3] [winfo reqheight .b3] \
+ [winfo reqwidth .b4] [winfo reqheight .b4]
+} {74 24 67 97 174 46 64 28}
+test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
+ deleteWindows
+ label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
+ -highlightthickness 4
+ button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
+ -highlightthickness 0
+ checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \
+ -highlightthickness 1 -indicatoron no
+ radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0
+ pack .b1 .b2 .b3 .b4
+ update
+ list [winfo reqwidth .b1] [winfo reqheight .b1] \
+ [winfo reqwidth .b2] [winfo reqheight .b2] \
+ [winfo reqwidth .b3] [winfo reqheight .b3] \
+ [winfo reqwidth .b4] [winfo reqheight .b4]
+} {66 32 65 31 69 31 71 29}
+test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} {
+ deleteWindows
+ button .b2 -bitmap question -default normal
+ list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {23 33}
+
+# cleanup
+deleteWindows
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/winClipboard.test b/tcl/tests/winClipboard.test
new file mode 100644
index 00000000000..9db36915d7f
--- /dev/null
+++ b/tcl/tests/winClipboard.test
@@ -0,0 +1,85 @@
+# This file is a Tcl script to test out Tk's Windows specific
+# clipboard code. It is organized in the standard fashion for Tcl
+# tests.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::bytestring
+
+# Note that these tests may fail if another application is grabbing the
+# clipboard (e.g. an X server)
+
+testConstraint testclipboard [llength [info commands testclipboard]]
+
+test winClipboard-1.1 {TkSelGetSelection} {pcOnly} {
+ clipboard clear
+ catch {selection get -selection CLIPBOARD} msg
+ set msg
+} {CLIPBOARD selection doesn't exist or form "STRING" not defined}
+test winClipboard-1.2 {TkSelGetSelection} {pcOnly testclipboard} {
+ clipboard clear
+ clipboard append {}
+ catch {selection get -selection CLIPBOARD} r1
+ catch {testclipboard} r2
+ list $r1 $r2
+} {{} {}}
+test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} {
+ clipboard clear
+ clipboard append abcd
+ update
+ catch {selection get -selection CLIPBOARD} r1
+ catch {testclipboard} r2
+ list $r1 $r2
+} {abcd abcd}
+test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} {
+ clipboard clear
+ clipboard append "line 1\nline 2"
+ catch {selection get -selection CLIPBOARD} r1
+ catch {testclipboard} r2
+ list $r1 $r2
+} [list "line 1\nline 2" "line 1\r\nline 2"]
+test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} {
+ clipboard clear
+ clipboard append "line 1\u00c7\nline 2"
+ catch {selection get -selection CLIPBOARD} r1
+ catch {testclipboard} r2
+ list $r1 $r2
+} [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]]
+
+test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly testclipboard} {
+ clipboard clear
+ clipboard append -type OUR_ACTION "action data"
+ clipboard append "string data"
+ update
+ catch {selection get -selection CLIPBOARD -type OUR_ACTION} r1
+ catch {testclipboard} r2
+ list $r1 $r2
+} [list "action data" "string data"]
+test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {pcOnly testclipboard} {
+ clipboard clear
+ clipboard append -type OUR_ACTION "new data"
+ clipboard append "more data in string"
+ update
+ catch {testclipboard} r1
+ catch {selection get -selection CLIPBOARD -type OUR_ACTION} r2
+ list $r1 $r2
+} [list "more data in string" "new data"]
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/winDialog.test b/tcl/tests/winDialog.test
new file mode 100644
index 00000000000..038c301963c
--- /dev/null
+++ b/tcl/tests/winDialog.test
@@ -0,0 +1,327 @@
+# This file is a Tcl script to test the Windows specific behavior of
+# the common dialog boxes. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 ActiveState Corporation.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+testConstraint testwinevent [llength [info commands testwinevent]]
+
+catch {testwinevent debug 1}
+
+proc start {arg} {
+ set ::tk_dialog 0
+ set ::iter_after 0
+
+ after 1 $arg
+}
+
+proc then {cmd} {
+ set ::command $cmd
+ set ::dialogresult {}
+
+ afterbody
+ vwait ::dialogresult
+ return $::dialogresult
+}
+
+proc afterbody {} {
+ if {$::tk_dialog == 0} {
+ if {[incr ::iter_after] > 30} {
+ set ::dialogresult ">30 iterations waiting on tk_dialog"
+ return
+ }
+ after 150 {afterbody}
+ return
+ }
+ uplevel #0 {set dialogresult [eval $command]}
+}
+
+proc Click {button} {
+ testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
+ testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
+}
+
+proc GetText {button} {
+ return [testwinevent $::tk_dialog $button WM_GETTEXT]
+}
+
+proc SetText {button text} {
+ return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
+}
+
+test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} {
+} {}
+
+test winDialog-2.1 {ColorDlgHookProc} {nt} {
+} {}
+
+test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent} {
+ start {tk_getOpenFile}
+ then {
+ set x [GetText 2]
+ Click 2
+ }
+ set x
+} {Cancel}
+
+test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent} {
+ start {tk_getSaveFile}
+ then {
+ set x [GetText 2]
+ Click 2
+ }
+ set x
+} {Cancel}
+
+test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} {
+ start {tk_getOpenFile -title Open}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.2 {GetFileName: one argument} {nt} {
+ list [catch {tk_getOpenFile -foo} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
+test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} {
+ start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
+ list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
+test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
+ start {tk_getOpenFile -title bar}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} {
+ list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
+} {1 {value for "-title" missing}}
+test winDialog-5.8 {GetFileName: extension begins with .} {nt testwinevent} {
+# if (string[0] == '.') {
+# string++;
+# }
+
+ start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
+ then {
+ SetText 0x480 bar
+ Click 1
+ }
+ string totitle $x
+} [string totitle [file join [pwd] bar.foo]]
+test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent} {
+ start {set x [tk_getSaveFile -defaultextension foo -title Save]}
+ then {
+ SetText 0x480 bar
+ Click 1
+ }
+ string totitle $x
+} [string totitle [file join [pwd] bar.foo]]
+test winDialog-5.10 {GetFileName: file types} {nt testwinevent} {
+# case FILE_TYPES:
+
+ start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
+ then {
+ set x [GetText 0x470]
+ Click cancel
+ }
+ set x
+} {foo files (*.foo)}
+test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} {
+# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK)
+
+ list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
+} {1 {bad Macintosh file type "FOO"}}
+test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} {
+# case FILE_INITDIR:
+
+ start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
+ then {
+ Click 1
+ }
+ set x
+} {C:/12x 455}
+test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \
+ {nt} {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+
+ list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+test winDialog-5.14 {GetFileName: initial file} {nt testwinevent} {
+# case FILE_INITFILE:
+
+ start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
+ then {
+ Click 1
+ }
+ string totitle $x
+} [string totitle [file join [pwd] "12x 456"]]
+test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+ list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+append a $a
+append a $a
+append a $a
+append a $a
+test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} {
+ start {set x [tk_getSaveFile -initialfile $a -title Long]}
+ then {
+ Click 1
+ }
+ string totitle $x
+} [string totitle [string range [file join [pwd] $a] 0 257]]
+test winDialog-5.17 {GetFileName: parent} {nt} {
+# case FILE_PARENT:
+
+ toplevel .t
+ set x 0
+ start {tk_getOpenFile -parent .t -title Parent; set x 1}
+ then {
+ destroy .t
+ }
+ set x
+} {1}
+test winDialog-5.18 {GetFileName: title} {nt testwinevent} {
+# case FILE_TITLE:
+
+ start {tk_getOpenFile -title Narf}
+ then {
+ Click 2
+ }
+} {0}
+test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} {
+# if (ofn.lpstrFilter == NULL)
+
+ start {tk_getOpenFile -title Filter}
+ then {
+ set x [GetText 0x470]
+ Click 2
+ }
+ set x
+} {All Files (*.*)}
+test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} {
+# if (Tk_WindowId(parent) == None)
+
+ toplevel .t
+ start {tk_getOpenFile -parent .t -title Open}
+ then {
+ destroy .t
+ }
+} {}
+test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} {
+ toplevel .t
+ update
+ start {tk_getOpenFile -parent .t -title Open}
+ then {
+ destroy .t
+ }
+} {}
+test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent} {
+# winCode = GetOpenFileName(&ofn);
+
+ start {tk_getOpenFile -title Open}
+ then {
+ set x [GetText 1]
+ Click 2
+ }
+ set x
+} {&Open}
+test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent} {
+# winCode = GetSaveFileName(&ofn);
+
+ start {tk_getSaveFile -title Save}
+ then {
+ set x [GetText 1]
+ Click 2
+ }
+ set x
+} {&Save}
+test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} {
+ start {set x [tk_getSaveFile -title Back]}
+ then {
+ SetText 0x480 "c:\\12x 457"
+ Click 1
+ }
+ set x
+} {c:/12x 457}
+
+test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {}
+
+test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}
+
+test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {}
+
+## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows
+## because somehow the GetOpenFileName ends up a noop in the static
+## build.
+##
+test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} {
+ start {tk_chooseDirectory}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} {
+ list [catch {tk_chooseDirectory -foo} msg] $msg
+} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
+test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} {
+ start {
+ tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test
+ }
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-9.4 {Tk_ChooseDirectoryObjCmd:\
+ Tcl_GetIndexFromObj() != TCL_OK} {nt} {
+ list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg
+} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
+test winDialog-9.5 {Tk_ChooseDirectoryObjCmd:\
+ Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
+ start {tk_chooseDirectory -title bar}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-9.6 {Tk_ChooseDirectoryObjCmd:\
+ valid option, but missing value} {nt} {
+ list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg
+} {1 {value for "-title" missing}}
+test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} {
+# case DIR_INITIAL:
+
+ start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
+ then {
+ Click 1
+ }
+ string tolower [set x]
+} {c:/}
+test winDialog-9.8 {Tk_ChooseDirectoryObjCmd:\
+ initial directory: Tcl_TranslateFilename()} {nt} {
+# if (Tcl_TranslateFileName(interp, string,
+# &utfDirString) == NULL)
+
+ list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+
+catch {testwinevent debug 0}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/winFont.test b/tcl/tests/winFont.test
new file mode 100644
index 00000000000..d1776d8a90e
--- /dev/null
+++ b/tcl/tests/winFont.test
@@ -0,0 +1,188 @@
+# This file is a Tcl script to test out the procedures in tkWinFont.c.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Many of these tests are visually oriented and cannot be checked
+# programmatically (such as "does an underlined font appear to be
+# underlined?"); these tests attempt to exercise the code in question,
+# but there are no results that can be checked.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+catch {destroy .b}
+catch {font delete xyz}
+
+toplevel .b
+wm geometry .b +0+0
+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} {pcOnly} {
+ list [catch {font measure {} xyz} msg] $msg
+} {1 {font "" doesn't exist}}
+test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} {
+ font measure ansifixed 0
+ font measure ansi 0
+ font measure device 0
+ font measure oemfixed 0
+ font measure systemfixed 0
+ font measure system 0
+ set x {}
+} {}
+
+test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
+ expr [font actual {-size -10} -size]>0
+} {1}
+test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
+ expr [font actual {-family Arial} -size]>0
+} {1}
+test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {pcOnly} {
+ font actual {-weight normal} -weight
+} {normal}
+test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {pcOnly} {
+ font actual {-weight bold} -weight
+} {bold}
+test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {pcOnly} {
+ catch {expr {[font actual {-size 10} -size]}}
+} 0
+test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {pcOnly} {
+ font actual {-family Arial} -family
+} {Arial}
+test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {pcOnly} {
+ set x {}
+ lappend x [font actual {-family "Times"} -family]
+ lappend x [font actual {-family "New York"} -family]
+ lappend x [font actual {-family "Times New Roman"} -family]
+} {{Times New Roman} {Times New Roman} {Times New Roman}}
+test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {pcOnly} {
+ set x {}
+ lappend x [font actual {-family "Courier"} -family]
+ lappend x [font actual {-family "Monaco"} -family]
+ lappend x [font actual {-family "Courier New"} -family]
+} {{Courier New} {Courier New} {Courier New}}
+test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {pcOnly} {
+ set x {}
+ lappend x [font actual {-family "Helvetica"} -family]
+ lappend x [font actual {-family "Geneva"} -family]
+ lappend x [font actual {-family "Arial"} -family]
+} {Arial Arial Arial}
+test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {pcOnly} {
+ # No way to get it to fail! Any font name is acceptable.
+} {}
+
+test winfont-3.1 {TkpDeleteFont procedure} {pcOnly} {
+ font actual {-family xyz}
+ set x {}
+} {}
+
+test winfont-4.1 {TkpGetFontFamilies procedure} {pcOnly} {
+ font families
+ set x {}
+} {}
+
+test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {pcOnly} {
+ .b.l config -wrap 0 -text "000000"
+ getsize
+} "[expr $ax*6] $ay"
+test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {pcOnly} {
+ .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+ getsize
+} "[expr $ax*256] $ay"
+test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {pcOnly} {
+ .b.l config -wrap [expr $ax*10] -text "00000000"
+ getsize
+} "[expr $ax*8] $ay"
+test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {pcOnly} {
+ .b.l config -wrap [expr $ax*6] -text "00000000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {pcOnly} {
+ .b.c dchars $t 0 end
+ .b.c insert $t 0 "0000"
+ .b.c index $t @[expr int($cx*2.5)],1
+} {2}
+test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} {pcOnly} {
+ .b.l config -text "000000" -wrap 1
+ getsize
+} "$ax [expr $ay*6]"
+test winfont-5.7 {Tk_MeasureChars procedure: whole words} {pcOnly} {
+ .b.l config -wrap [expr $ax*8] -text "000000 0000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {pcOnly} {
+ .b.l config -wrap [expr $ax*12] -text "000000 0000000"
+ getsize
+} "[expr $ax*7] [expr $ay*2]"
+test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {pcOnly} {
+ .b.l config -wrap [expr $ax*12] -text "000 00 00000"
+ getsize
+} "[expr $ax*7] [expr $ay*2]"
+test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {pcOnly} {
+ .b.l config -wrap [expr $ax*12] -text "0000000000000000"
+ getsize
+} "[expr $ax*12] [expr $ay*2]"
+test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} \
+ {pcOnly nonPortable} {
+ set font [.b.l cget -font]
+ .b.l config -font {{MS Sans Serif} 8} -text "W"
+ set width [winfo reqwidth .b.l]
+ .b.l config -text "XaYoYaKaWx"
+ set x [lindex [getsize] 0]
+ .b.l config -font $font
+ expr $x < ($width*10)
+} 1
+test winfont-6.1 {Tk_DrawChars procedure: loop test} {pcOnly} {
+ .b.l config -text "a"
+ update
+} {}
+
+test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} {
+ font create xyz
+ catch {destroy .c}
+ button .c -font xyz
+ font configure xyz -family times
+ update
+ destroy .c
+ font delete xyz
+} {}
+test winfont-7.2 {AllocFont procedure: extract info from logfont} {pcOnly} {
+ font actual {arial 10 bold italic underline overstrike}
+} {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
+test winfont-7.3 {AllocFont procedure: extract info from textmetric} {pcOnly} {
+ font metric {arial 10 bold italic underline overstrike} -fixed
+} {0}
+test winfont-7.4 {AllocFont procedure: extract info from textmetric} {pcOnly} {
+ font metric systemfixed -fixed
+} {1}
+
+# cleanup
+destroy .b
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/winMenu.test b/tcl/tests/winMenu.test
new file mode 100644
index 00000000000..50c75304009
--- /dev/null
+++ b/tcl/tests/winMenu.test
@@ -0,0 +1,1051 @@
+# This file is a Tcl script to test menus in Tk. It is
+# organized in the standard fashion for Tcl tests. This
+# file tests the Macintosh-specific features of the menu
+# system.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+test winMenu-1.1 {GetNewID} {pcOnly} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+# Basically impossible to test menu IDs wrapping.
+
+test winMenu-2.1 {FreeID} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+
+test winMenu-3.1 {TkpNewMenu} {pcOnly} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2
+} {0 .m1 0 {}}
+test winMenu-3.2 {TkpNewMenu} {pcOnly} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add command -label "foo"
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
+} {0 {} {} 0 {}}
+
+test winMenu-4.1 {TkpDestroyMenu} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test winMenu-4.2 {TkpDestroyMenu - help menu} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.system
+ . configure -menu .m1
+ list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test winMenu-5.1 {TkpDestroyMenuEntry} {pcOnly} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add command -label "test"
+ update idletasks
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test winMenu-6.1 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test winMenu-6.2 {GetEntryText} {testImageType pcOnly} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ menu .m1
+ image create test image1
+ list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
+} {0 {} {} {}}
+test winMenu-6.3 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.4 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.5 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.6 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.7 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.8 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.9 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.10 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.11 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.12 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.13 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.14 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.15 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-6.16 {GetEntryText} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.system
+ menu .m1.system
+ .m1.system add command -label foo
+ update idletasks
+ .m1.system add command -label bar
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label Hello
+ update idletasks
+ .m1 add command -label foo
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello
+ .m1 delete Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.4 {ReconfigureWindowsMenu - one item} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.5 {ReconfigureWindowsMenu - two items} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label One
+ .m1 add command -label Two
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.6 {ReconfigureWindowsMenu - separator item} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add separator
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello -state disabled
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add checkbutton -label Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add radiobutton -label Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add checkbutton -label Hello
+ .m1 invoke Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add radiobutton -label Hello
+ .m1 invoke Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {pcOnly} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1 -tearoff 0
+ menu .m2
+ .m1 add cascade -menu .m2 -label Hello
+ list [catch {update idletasks} msg] $msg [destroy .m1] [destroy .m2]
+} {0 {} {} {}}
+test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.file
+ menu .m1.file -tearoff 0
+ . configure -menu .m1
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.system
+ menu .m1.system -tearoff 0
+ . configure -menu .m1
+ update idletasks
+ .m1.system add command -label Hello
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.system
+ menu .m1.system -tearoff 0
+ . configure -menu .m1
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.system
+ menu .m1.system -tearoff 0
+ .m1.system add command -label Hello
+ update idletasks
+ . configure -menu .m1
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test winMenu-7.19 {ReconfigureWindowsMenu - column break} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label one
+ .m1 add command -label two -columnbreak 1
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+#Don't know how to generate nested post menus
+test winMenu-8.1 {TkpPostMenu} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -postcommand "blork"
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {1 {invalid command name "blork"} {}}
+test winMenu-8.2 {TkpPostMenu} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -postcommand "destroy .m1"
+ list [.m1 post 40 40] [winfo exists .m1]
+} {{} 0}
+test winMenu-8.3 {TkpPostMenu - popup menu} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-8.3: Hit ESCAPE."
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} {
+ catch {destroy .mb}
+ menubutton .mb -text test -menu .mb.menu
+ menu .mb.menu
+ .mb.menu add command -label "winMenu-8.4 - Hit ESCAPE."
+ pack .mb
+ list [tk::MbPost .mb] [destroy .m1]
+} {{} {}}
+test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-8.5 - Hit ESCAPE."
+ update idletasks
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test winMenu-9.1 {TkpMenuNewEntry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test winMenu-10.1 {TkwinMenuProc} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-10.1: Hit ESCAPE."
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+
+# Can't generate a WM_INITMENU without a Tk menu yet.
+test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1 -postcommand "set foo test"
+ .m1 add command -label "winMenu-11.1: Hit ESCAPE."
+ list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1]
+} {test test {} {}}
+test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item."
+ list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1]
+} {{} {} 1 {} {}}
+test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ catch {unset foo}
+ proc bgerror {args} {
+ global foo errorInfo
+ set foo [list $args $errorInfo]
+ }
+ menu .m1
+ .m1 add command -command {error 1} -label "winMenu-11.2: Please select this menu item."
+ list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1]
+} {{} {} {1 {1
+ while executing
+"error 1"
+ (menu invoke)}} {} {}}
+
+# Can't test WM_MENUCHAR
+test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-11.3: Hit ESCAPE."
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-11.5: Hit ESCAPE."
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} \
+ {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \
+ {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label "winMenu-11.7: Hit ESCAPE"
+ update idletasks
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test winMenu-12.1 {TkpSetWindowMenuBar} {pcOnly} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add command -label foo
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
+} {0 {} {} 0 {}}
+test winMenu-12.2 {TkpSetWindowMenuBar} {pcOnly} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add command -label foo
+ . configure -menu .m1
+ list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2
+} {0 {} 0 {}}
+test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {pcOnly} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1 -tearoff 0
+ .m1 add command -label foo
+ update idletasks
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest pcOnly} {} {}
+
+test winMenu-14.1 {GetMenuIndicatorGeometry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test winMenu-14.2 {GetMenuIndicatorGeometry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -hidemargin 1
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test winMenu-15.1 {GetMenuAccelGeometry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo -accel Ctrl+U
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test winMenu-15.2 {GetMenuAccelGeometry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test winMenu-15.3 {GetMenuAccelGeometry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+U"
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test winMenu-16.1 {GetTearoffEntryGeometry} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-19.1: Hit ESCAPE."
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+
+test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+# Currently, the only callers to DrawWindowsSystemBitmap want things
+# centered vertically, and either centered or right aligned horizontally.
+test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ .m1 invoke foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ .m1 entryconfigure foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -indicatoron 0
+ .m1 invoke foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground red
+ .m1 add command -label foo -accel "Ctrl+U" -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+U"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground ""
+ .m1 add command -label foo -accel "Ctrl+U" -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \
+ {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label "winMenu-23.5: Hit ESCAPE."
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+
+test winMenu-21.1 {DrawMenuSeparator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test winMenu-22.1 {DrawMenuUnderline} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -underline 0
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \
+ {pcOnly emptyTest} {} {}
+test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} \
+ {pcOnly emptyTest} {} {}
+
+test winMenu-25.1 {DrawMenuEntryLabel - normal} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground red
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground ""
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test winMenu-26.1 {TkpComputeMenubarGeometry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label File
+ list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
+} {{} {} {}}
+
+test winMenu-27.1 {DrawTearoffEntry} {pcOnly userInteraction} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "winMenu-24.4: Hit ESCAPE."
+ list [.m1 post 40 40] [destroy .m1]
+} {{} {}}
+
+test winMenu-28.1 {TkpConfigureMenuEntry - update pending} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello
+ list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
+} {0 {} {}}
+test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label One
+ update idletasks
+ list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activeforeground red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ set tk_strictMotif 1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1] [set tk_strictMotif 0]
+} {{} {} 0}
+test winMenu-29.4 \
+ {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground blue
+ .m1 add command -label foo -state disabled -background red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground blue
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground ""
+ .m1 add command -label foo -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -foreground red
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -selectcolor orange
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke 1
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activebackground green
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} {
+ catch {destroy .m1}
+ set tk_strictMotif 1
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1] [set tk_strictMotif 0]
+} {{} {} 0}
+test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -activeforeground yellow
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ .m1 entryconfigure 1 -state active
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -font "Helvectica 72"
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.17 {TkpDrawMenuEntry - font} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -font "Courier 72"
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.18 {TkpDrawMenuEntry - separator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.19 {TkpDrawMenuEntry - standard} {pcOnly} {
+ catch {destroy .mb}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label File -menu .m1.file
+ menu .m1.file
+ .m1.file add command -label foo
+ .m1 entryconfigure File -state disabled
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label winMenu-31.20
+ .m1 invoke winMenu-31.20
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label winMenu-31.21 -hidemargin 1
+ .m1 invoke winMenu-31.21
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test winMenu-30.1 {GetMenuLabelGeometry - image} {testImageType pcOnly} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ menu .m1
+ image create test image1
+ .m1 add command -image image1
+ list [update idletasks] [destroy .m1] [image delete image1]
+} {{} {} {}}
+test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -bitmap questhead
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-30.3 {GetMenuLabelGeometry - no text} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-30.4 {GetMenuLabelGeometry - text} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a test."
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+
+test winMenu-31.1 {DrawMenuEntryBackground} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tk::TearOffMenu .m1 40 40]
+ $tearoff activate 0
+ list [update] [destroy .m1]
+} {{} {}}
+
+test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ .m1 add command -label "two"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
+ catch {destroy .m1}
+ menubutton .mb -text "test" -menu .mb.m
+ menu .mb.m
+ .mb.m add command -label test
+ pack .mb
+ catch {tk::MbPost .mb}
+ list [update] [destroy .mb]
+} {{} {}}
+test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -font "Helvetica 12"
+ .m1 add command -label "test" -font "Courier 12"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "test test"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test test"
+ .m1 add command -label "test"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test" -accel "Ctrl+S"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test" -accel "1"
+ .m1 add command -label "test" -accel "1 1"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test" -accel "1 1"
+ .m1 add command -label "test" -accel "1"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label test
+ .m1 invoke 1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.14 \
+ {TkpComputeStandardMenuGeometry - second indicator less or equal} \
+ {testImageType pcOnly} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ image create test image1
+ menu .m1
+ .m1 add checkbutton -image image1
+ .m1 invoke 1
+ .m1 add checkbutton -label test
+ .m1 invoke 2
+ list [update idletasks] [destroy .m1] [image delete image1]
+} {{} {} {}}
+test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \
+ {testImageType unixOnly} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ image create test image1
+ menu .m1
+ .m1 add checkbutton -image image1
+ .m1 invoke 1
+ .m1 add checkbutton -label test
+ .m1 invoke 2
+ list [update idletasks] [destroy .m1] [image delete image1]
+} {{} {} {}}
+test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label one
+ .m1 add command -label two
+ .m1 add command -label three -columnbreak 1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \
+ {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label one
+ .m1 add command -label two -columnbreak 1
+ .m1 add command -label three
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {pcOnly} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label one
+ .m1 add command -label two -columnbreak 1
+ .m1 add command -label three
+ .m1 add command -label four
+ .m1 add command -label five -columnbreak 1
+ .m1 add command -label six
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+
+test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {pcOnly} {
+ catch {destroy .t2}
+ catch {destroy .m1}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ list [update idletasks] [destroy .t2]
+} {{} {}}
+test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {pcOnly} {
+ catch {destroy .t2}
+ catch {destroy .m1}
+ menu .m1
+ menu .m1.system
+ .m1 add cascade -menu .m1.system
+ .m1.system add separator
+ .m1.system add command -label foo
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ list [update idletasks] [destroy .m1] [destroy .t2]
+} {{} {} {}}
+
+test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest pcOnly} {} {}
+
+# cleanup
+deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/winSend.test b/tcl/tests/winSend.test
new file mode 100644
index 00000000000..17ff7828d48
--- /dev/null
+++ b/tcl/tests/winSend.test
@@ -0,0 +1,412 @@
+# This file is a Tcl script to test out the "send" command and the
+# other procedures in the file tkSend.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::interpreter
+
+# Compute a script that will load Tk into a child interpreter.
+
+foreach pkg [info loaded] {
+ if {[lindex $pkg 1] == "Tk"} {
+ set loadTk "load $pkg"
+ break
+ }
+}
+
+# Procedure to create a new application with a given name and class.
+
+proc newApp {name {safe {}}} {
+ global loadTk
+ if {[string compare $safe "-safe"] == 0} {
+ interp create -safe $name
+ } else {
+ interp create $name
+ }
+ $name eval [list set argv [list -name $name]]
+ catch {eval $loadTk $name}
+}
+
+set currentInterps [winfo interps]
+if {[testConstraint win] && [llength [info commands send]]} {
+
+ if {[catch {exec [interpreter] &}] == 0} {
+
+ # Wait until the child application has launched.
+ while {[llength [winfo interps]] == [llength $currentInterps]} {}
+
+ # Now find an interp to send to
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch -exact $currentInterps $interp] < 0} {
+ break
+ }
+ }
+
+ # Now we have found our interpreter we are going to send to.
+ # Make sure that it works first.
+ testConstraint winSend [expr {[catch {
+ send $interp {console hide; update}
+ }] == 0}]
+ }
+}
+
+# setting up dde server is done when the first interp is created and
+# cannot be tested very easily.
+test winSend-1.1 {Tk_SetAppName - changing name of interp} winSend {
+ newApp testApp
+ list [testApp eval tk appname testApp2] [interp delete testApp]
+} {testApp2 {}}
+test winSend-1.2 {Tk_SetAppName - changing name - not front of linked list} {
+ winSend
+} {
+ newApp testApp
+ newApp testApp2
+ list [testApp eval tk appname testApp3] [interp delete testApp] [interp delete testApp2]
+} {testApp3 {} {}}
+test winSend-1.3 {Tk_SetAppName - unique name - no conflicts} winSend {
+ newApp testApp
+ list [testApp eval tk appname testApp] [interp delete testApp]
+} {testApp {}}
+test winSend-1.4 {Tk_SetAppName - unique name - one conflict} winSend {
+ newApp testApp
+ newApp foobar
+ list [foobar eval tk appname testApp] [interp delete foobar] [interp delete testApp]
+} {{testApp #2} {} {}}
+test winSend-1.5 {Tk_SetAppName - unique name - one conflict} winSend {
+ newApp testApp
+ newApp foobar
+ newApp blaz
+ foobar eval tk appname testApp
+ list [blaz eval tk appname testApp] [interp delete foobar] [interp delete testApp] [interp delete blaz]
+} {{testApp #3} {} {} {}}
+test winSend-1.6 {Tk_SetAppName - safe interps} winSend {
+ newApp testApp -safe
+ list [catch {testApp eval send testApp {set foo a}} msg] $msg [interp delete testApp]
+} {1 {invalid command name "send"} {}}
+
+test winSend-2.1 {Tk_SendObjCmd - # of args} winSend {
+ list [catch {send tktest} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} winSend {
+ list [catch {send -bogus tktest} msg] $msg
+} {1 {bad option "-bogus": must be -async, -displayof, or --}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} winSend {
+ list [catch {send -async bogus foo} msg] $msg
+} {1 {no registered server named "bogus"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} winSend {
+ list [catch {send -displayof . bogus foo} msg] $msg
+} {1 {no registered server named "bogus"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} winSend {
+ list [catch {send -- -bogus foo} msg] $msg
+} {1 {no registered server named "-bogus"}}
+test winSend-2.2 {Tk_SendObjCmd - sending to ourselves} winSend {
+ list [send [tk appname] {set foo a}]
+} {a}
+test winSend-2.3 {Tk_SendObjCmd - sending to ourselves in a different interpreter} winSend {
+ newApp testApp
+ list [catch {send testApp {set foo b}} msg] $msg [interp delete testApp]
+} {0 b {}}
+test winSend-2.4 {Tk_SendObjCmd - sending to ourselves in a different interp with errors} winSend {
+ newApp testApp
+ list [catch {send testApp {expr 2 / 0}} msg] $msg $errorCode $errorInfo [interp delete testApp]
+} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send testApp {expr 2 / 0}\"} {}"
+test winSend-2.5 {Tk_SendObjCmd - sending to another app async} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send -async $interp {set foo a}} msg] $msg
+} {0 {}}
+test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send $interp {set foo a}} msg] $msg
+} {0 a}
+test winSend-2.7 {Tk_SendObjCmd - sending to another app - error} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send $interp {expr 2 / 0}} msg] $msg $errorCode $errorInfo
+} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send \$interp {expr 2 / 0}\"}"
+
+test winSend-3.1 {TkGetInterpNames} winSend {
+ set origLength [llength $currentInterps]
+ set newLength [llength [winfo interps]]
+ expr {($newLength - 2) == $origLength}
+} {1}
+
+test winSend-4.1 {DeleteProc - changing name of app} winSend {
+ newApp a
+ list [a eval tk appname foo] [interp delete a]
+} {foo {}}
+test winSend-4.2 {DeleteProc - normal} winSend {
+ newApp a
+ list [interp delete a]
+} {{}}
+
+test winSend-5.1 {ExecuteRemoteObject - no error} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [send $interp {send [tk appname] {expr 2 / 1}}]
+} {2}
+test winSend-5.2 {ExecuteRemoteObject - error} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send $interp {send [tk appname] {expr 2 / 0}}} msg] $msg
+} {1 {divide by zero}}
+
+test winSend-6.1 {SendDDEServer - XTYP_CONNECT} winSend {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.2 {SendDDEServer - XTYP_CONNECT_CONFIRM} winSend {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.3 {SendDDEServer - XTYP_DISCONNECT} winSend {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} winSend {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.5 {SendDDEServer - XTYP_REQUEST array} winSend {
+ catch {unset foo}
+ set foo(test) "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo(test)"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg [catch {unset foo}]
+} {0 {Hello, World} 0}
+test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} winSend {
+ set foo 3
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "send [tk appname] {expr $foo + 1}"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 4}
+test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "send [tk appname] {expr 4 / 2}"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 2}
+test winSend-6.8 {SendDDEServer - XTYP_WILDCONNECT} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde services Tk {}"
+ list [catch "send \{$interp\} \{$command\}"]
+} {0}
+
+test winSend-7.1 {DDEExitProc} winSend {
+ newApp testApp
+ list [interp delete testApp]
+} {{}}
+
+test winSend-8.1 {SendDdeConnect} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [send $interp {set tk foo}]
+} {foo}
+
+test winSend-9.1 {SetDDEError} winSend {
+ list [catch {dde execute Tk foo {set foo hello}} msg] $msg
+} {1 {dde command failed}}
+
+test winSend-10.1 {Tk_DDEObjCmd - wrong num args} winSend {
+ list [catch {dde} msg] $msg
+} {1 {wrong # args: should be "dde ?-async? serviceName topicName value"}}
+test winSend-10.2 {Tk_DDEObjCmd - unknown subcommand} winSend {
+ list [catch {dde foo} msg] $msg
+} {1 {bad command "foo": must be execute, request, or services}}
+test winSend-10.3 {Tk_DDEObjCmd - execute - wrong num args} winSend {
+ list [catch {dde execute} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.4 {Tk_DDEObjCmd - execute - wrong num args} winSend {
+ list [catch {dde execute 3 4 5 6 7} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.5 {Tk_DDEObjCmd - execute async - wrong num args} winSend {
+ list [catch {dde execute -async} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.6 {Tk_DDEObjCmd - request - wrong num args} winSend {
+ list [catch {dde request} msg] $msg
+} {1 {wrong # args: should be "dde request serviceName topicName value"}}
+test winSend-10.7 {Tk_DDEObjCmd - services wrong num args} winSend {
+ list [catch {dde services} msg] $msg
+} {1 {wrong # args: should be "dde services serviceName topicName"}}
+test winSend-10.8 {Tk_DDEObjCmd - null service name} winSend {
+ list [catch {dde services {} {tktest #2}}]
+} {0}
+test winSend-10.9 {Tk_DDEObjCmd - null topic name} winSend {
+ list [catch {dde services {Tk} {}}]
+} {0}
+test winSend-10.10 {Tk_DDEObjCmd - execute - nothing to execute} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde execute Tk $interp {}} msg] $msg
+} {1 {cannot execute null data}}
+test winSend-10.11 {Tk_DDEObjCmd - execute - no such conversation} winSend {
+ list [catch {dde execute Tk foo {set foo hello}} msg] $msg
+} {1 {dde command failed}}
+test winSend-10.12 {Tk_DDEObjCmd - execute - async} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde execute -async Tk $interp {set foo hello}} msg] $msg
+} {0 {}}
+test winSend-10.13 {Tk_DDEObjCmd - execute} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde execute Tk $interp {set foo goodbye}} msg] $msg
+} {0 {}}
+test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde request Tk $interp {}} msg] $msg
+} {1 {cannot request value of null data}}
+test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde request Tk foo foo} msg] $msg
+} {1 {dde command failed}}
+test winSend-10.16 {Tk_DDEObjCmd - invalid variable} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ send $interp {unset foo}
+ list [catch {dde request Tk $interp foo} msg] $msg
+} {1 {remote server cannot handle this command}}
+test winSend-10.17 {Tk_DDEObjCmd - valid variable} winSend {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ send $interp {set foo winSend-10.17}
+ list [catch {dde request Tk $interp foo} msg] $msg
+} {0 winSend-10.17}
+test winSend-10.18 {Tk_DDEObjCmd - services} winSend {
+ set currentService [list Tk [tk appname]]
+ list [catch {dde services Tk {}} msg] [expr [lsearch $msg $currentService] >= 0]
+} {0 1}
+
+# Get rid of the other app and all of its interps
+
+set newInterps [winfo interps]
+while {[llength $newInterps] != [llength $currentInterps]} {
+ foreach interp $newInterps {
+ if {[lsearch -exact $currentInterps $interp] < 0} {
+ catch {send $interp exit}
+ set newInterps [winfo interps]
+ break
+ }
+ }
+}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/winWm.test b/tcl/tests/winWm.test
new file mode 100644
index 00000000000..e5d9a8e20fe
--- /dev/null
+++ b/tcl/tests/winWm.test
@@ -0,0 +1,276 @@
+# This file tests is a Tcl script to test the procedures in the file
+# tkWinWm.c. It is organized in the standard fashion for Tcl tests.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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} {pcOnly} {
+ toplevel .t
+ wm override .t 1
+ wm geometry .t +0+0
+ update
+ set result [list [winfo rootx .t] [winfo rooty .t]]
+ destroy .t
+ set result
+} {0 0}
+test winWm-1.2 {TkWmMapWindow} {pcOnly} {
+ toplevel .t
+ wm transient .t .
+ update
+ wm iconify .
+ update
+ wm deiconify .
+ update
+ catch {wm iconify .t} msg
+ destroy .t
+ set msg
+} {can't iconify ".t": it is a transient}
+test winWm-1.3 {TkWmMapWindow} {pcOnly} {
+ toplevel .t
+ update
+ toplevel .t2
+ update
+ set result [expr [winfo x .t] != [winfo x .t2]]
+ destroy .t .t2
+ set result
+} 1
+test winWm-1.4 {TkWmMapWindow} {pcOnly} {
+ toplevel .t
+ wm geometry .t +10+10
+ update
+ toplevel .t2
+ wm geometry .t2 +40+10
+ update
+ set result [list [winfo x .t] [winfo x .t2]]
+ destroy .t .t2
+ set result
+} {10 40}
+test winWm-1.5 {TkWmMapWindow} {pcOnly} {
+ toplevel .t
+ wm iconify .t
+ update
+ set result [wm state .t]
+ destroy .t
+ set result
+} iconic
+
+test winWm-2.1 {TkpWmSetState} {pcOnly} {
+ toplevel .t
+ wm geometry .t 150x50+10+10
+ update
+ set result [wm state .t]
+ wm iconify .t
+ update
+ lappend result [wm state .t]
+ wm deiconify .t
+ update
+ lappend result [wm state .t]
+ destroy .t
+ set result
+} {normal iconic normal}
+test winWm-2.2 {TkpWmSetState} {pcOnly} {
+ toplevel .t
+ wm geometry .t 150x50+10+10
+ update
+ set result [wm state .t]
+ wm withdraw .t
+ update
+ lappend result [wm state .t]
+ wm iconify .t
+ update
+ lappend result [wm state .t]
+ wm deiconify .t
+ update
+ lappend result [wm state .t]
+ destroy .t
+ set result
+} {normal withdrawn iconic normal}
+test winWm-2.2 {TkpWmSetState} {pcOnly} {
+ toplevel .t
+ wm geometry .t 150x50+10+10
+ update
+ set result [wm state .t]
+ wm state .t withdrawn
+ update
+ lappend result [wm state .t]
+ wm state .t iconic
+ update
+ lappend result [wm state .t]
+ wm state .t normal
+ update
+ lappend result [wm state .t]
+ destroy .t
+ set result
+} {normal withdrawn iconic normal}
+test winWm-2.4 {TkpWmSetState} {pcOnly} {
+ set result {}
+ toplevel .t
+ wm geometry .t 150x50+10+10
+ update
+ lappend result [list [wm state .t] [wm geometry .t]]
+ wm iconify .t
+ update
+ lappend result [list [wm state .t] [wm geometry .t]]
+ wm geometry .t 200x50+10+10
+ update
+ lappend result [list [wm state .t] [wm geometry .t]]
+ wm deiconify .t
+ update
+ lappend result [list [wm state .t] [wm geometry .t]]
+ destroy .t
+ set result
+} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}
+
+test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} {
+ toplevel .t
+ wm geometry .t +0+0
+ button .t.b
+ pack .t.b
+ update
+ set x [winfo x .t.b]
+ destroy .t
+ toplevel .t
+ wm geometry .t +0+0
+ button .t.b
+ update
+ pack .t.b
+ update
+ set x [expr $x == [winfo x .t.b]]
+ destroy .t
+ set x
+} 1
+
+test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} {
+ set result {}
+ toplevel .t
+ frame .t.f -width 150 -height 50 -bg red
+ pack .t.f
+ wm geometry .t -0-0
+ update
+ set y [winfo y .t]
+ menu .t.m
+ .t.m add command -label foo
+ .t conf -menu .t.m
+ update
+ set result [expr $y - [winfo y .t]]
+ destroy .t
+ set result
+} [expr $menuheight + 1]
+
+test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} {
+ set result {}
+ toplevel .t
+ frame .t.f -width 150 -height 50 -bg red
+ pack .t.f
+ update
+ set result [winfo height .t]
+ menu .t.m
+ .t.m add command -label foo
+ .t conf -menu .t.m
+ update
+ lappend result [winfo height .t]
+ .t.m add command -label "thisisreallylong"
+ .t.m add command -label "thisisreallylong"
+ update
+ lappend result [winfo height .t]
+ destroy .t
+ set result
+} {50 50 50}
+test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} {
+ set result {}
+ toplevel .t
+ frame .t.f -width 150 -height 50 -bg red
+ pack .t.f
+ wm geom .t -0-0
+ update
+ set y [winfo rooty .t]
+ lappend result [winfo height .t]
+ menu .t.m
+ .t conf -menu .t.m
+ .t.m add command -label foo
+ .t.m add command -label "thisisreallylong"
+ .t.m add command -label "thisisreallylong"
+ update
+ lappend result [winfo height .t]
+ lappend result [expr $y - [winfo rooty .t]]
+ destroy .t
+ set result
+} {50 50 0}
+
+test winWm-6.1 {wm attributes} {pcOnly} {
+ destroy .t
+ toplevel .t
+ wm attributes .t
+} {-disabled 0 -toolwindow 0 -topmost 0}
+test winWm-6.2 {wm attributes} {pcOnly} {
+ destroy .t
+ toplevel .t
+ wm attributes .t -disabled
+} {0}
+test winWm-6.3 {wm attributes} {pcOnly} {
+ # This isn't quite the correct error message yet, but it works.
+ destroy .t
+ toplevel .t
+ list [catch {wm attributes .t -foo} msg] $msg
+} {1 {wrong # args: should be "wm attributes window ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}}
+
+destroy .t
+
+test winWm-6.1 {deiconify on an unmapped toplevel
+ will raise the window and set the focus} {pcOnly} {
+ destroy .t
+ toplevel .t
+ lower .t
+ focus -force .
+ wm deiconify .t
+ update
+ list [wm stackorder .t isabove .] [focus]
+} {1 .t}
+
+test winWm-6.2 {deiconify on an already mapped toplevel
+ will raise the window and set the focus} {pcOnly} {
+ destroy .t
+ toplevel .t
+ lower .t
+ update
+ focus -force .
+ wm deiconify .t
+ update
+ list [wm stackorder .t isabove .] [focus]
+} {1 .t}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/window.test b/tcl/tests/window.test
new file mode 100644
index 00000000000..3f57861d748
--- /dev/null
+++ b/tcl/tests/window.test
@@ -0,0 +1,150 @@
+# This file is a Tcl script to test the procedures in the file
+# tkWindow.c. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+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
+} {}
+
+# Some tests require the testmenubar command
+testConstraint testmenubar [llength [info commands testmenubar]]
+
+test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \
+ {unixOnly testmenubar} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200
+ wm geometry .t +0+0
+ pack [entry .t.e]
+ frame .t.f -bd 2 -relief raised
+ testmenubar window .t .t.f
+ update
+ # If stacking order isn't handle properly, generates an X error.
+} {}
+test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \
+ {unixOnly testmenubar} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200
+ wm geometry .t +0+0
+ pack [entry .t.e]
+ pack [entry .t.e2]
+ update
+ frame .t.f -bd 2 -relief raised
+ raise .t.f .t.e
+ testmenubar window .t .t.f
+ update
+ # If stacking order isn't handled properly, generates an X error.
+} {}
+
+test window-4.1 {Tk_NameToWindow procedure} {testmenubar} {
+ catch {destroy .t}
+ list [catch {winfo geometry .t} msg] $msg
+} {1 {bad window path name ".t"}}
+test window-4.2 {Tk_NameToWindow procedure} {testmenubar} {
+ catch {destroy .t}
+ frame .t -width 100 -height 50
+ place .t -x 10 -y 10
+ update
+ list [catch {winfo geometry .t} msg] $msg
+} {0 100x50+10+10}
+
+test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \
+ {unixOnly testmenubar} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200
+ wm geometry .t +0+0
+ pack [entry .t.e]
+ pack [entry .t.e2]
+ frame .t.f -bd 2 -relief raised
+ testmenubar window .t .t.f
+ update
+ lower .t.e2 .t.f
+ update
+ # If stacking order isn't handled properly, generates an X error.
+} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/winfo.test b/tcl/tests/winfo.test
new file mode 100644
index 00000000000..c0e8a827704
--- /dev/null
+++ b/tcl/tests/winfo.test
@@ -0,0 +1,376 @@
+# This file is a Tcl script to test out the "winfo" command. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+# 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
+
+# Some tests require the "pseudocolor" visual class.
+testConstraint pseudocolor [expr { ([winfo depth .] == 8)
+ && ([winfo visual .] == "pseudocolor")}]
+
+test winfo-3.1 {"winfo colormapfull" command} {pseudocolor} {
+ list [catch {winfo colormapfull} msg] $msg
+} {1 {wrong # args: should be "winfo colormapfull window"}}
+test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} {
+ list [catch {winfo colormapfull a b} msg] $msg
+} {1 {wrong # args: should be "winfo colormapfull window"}}
+test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} {
+ list [catch {winfo colormapfull foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} {
+ eatColors .t {-colormap new}
+ set result [list [winfo colormapfull .] [winfo colormapfull .t]]
+ .t.c delete 34
+ lappend result [winfo colormapfull .t]
+ .t.c create rectangle 30 30 80 80 -fill #441739
+ lappend result [winfo colormapfull .t]
+ .t.c create rectangle 40 40 90 90 -fill #ffeedd
+ lappend result [winfo colormapfull .t]
+ destroy .t.c
+ lappend result [winfo colormapfull .t]
+} {0 1 0 0 1 0}
+catch {destroy .t}
+
+toplevel .t -width 550 -height 400
+frame .t.f -width 80 -height 60 -bd 2 -relief raised
+place .t.f -x 50 -y 50
+wm geom .t +0+0
+update
+test winfo-4.1 {"winfo containing" command} {
+ list [catch {winfo containing 22} msg] $msg
+} {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 .]
+} {.}
+test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} {
+ winfo pathname [testwrapper .]
+} {}
+
+test winfo-8.1 {"winfo pointerx" command} {
+ catch [winfo pointerx .b]
+} 1
+test winfo-8.2 {"winfo pointery" command} {
+ 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} {
+ deleteWindows
+ 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} {
+ deleteWindows
+ 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 .
+deleteWindows
+
+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} {
+ MakeEmbed
+ set z [expr [winfo rootx .emb] == [winfo rootx .con] && \
+ [winfo rooty .emb] == [winfo rooty .con]]
+ destroy .emb
+ destroy .con
+ set z
+} {1}
+test winfo-13.2 {destroying embedded toplevel} {
+ destroy .emb
+ update
+ expr [winfo exists .emb.b] || [winfo exists .con]
+} 0
+
+deleteWindows
+
+test winfo-13.3 {destroying container window} {
+ MakeEmbed
+ destroy .con
+ update
+ set z [expr [winfo exists .emb.b] || [winfo exists .emb]]
+ catch {destroy .emb}
+ catch {destroy .con}
+ set z
+} 0
+
+deleteWindows
+
+test winfo-13.4 {[winfo containing] with embedded windows} {
+ MakeEmbed
+ button .b
+ pack .b -expand yes -fill both
+ update
+
+ set z [string compare \
+ [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b]
+ catch {destroy .con}
+ catch {destroy .emb}
+ set z
+} 0
+
+test winfo-14.1 {usage} {
+ list [catch {winfo ismapped} msg] $msg
+} {1 {wrong # args: should be "winfo ismapped window"}}
+
+test winfo-14.2 {usage} {
+ list [catch {winfo ismapped . .} msg] $msg
+} {1 {wrong # args: should be "winfo ismapped window"}}
+
+test winfo-14.3 {initially unmapped} {
+ catch {destroy .t}
+ toplevel .t
+ winfo ismapped .t
+} 0
+
+test winfo-14.4 {mapped at idle time} {
+ catch {destroy .t}
+ toplevel .t
+ update idletasks
+ winfo ismapped .t
+} 1
+
+deleteWindows
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/wm.test b/tcl/tests/wm.test
new file mode 100644
index 00000000000..d0c1232ea44
--- /dev/null
+++ b/tcl/tests/wm.test
@@ -0,0 +1,1636 @@
+# This file is a Tcl script to test out Tk's interactions with
+# the window manager, including the "wm" command. It is organized
+# in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+# This file tests window manager interactions that work across
+# platforms. Window manager tests that only work on a specific
+# platform should be placed in unixWm.test or winWm.test.
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+wm deiconify .
+if {![winfo ismapped .]} {
+ tkwait visibility .
+}
+
+proc stdWindow {} {
+ destroy .t
+ toplevel .t -width 100 -height 50
+ wm geom .t +0+0
+ update
+}
+
+# [raise] and [lower] may return before the window manager
+# has completed the operation. The raiseDelay procedure
+# idles for a while to give the operation a chance to complete.
+#
+
+proc raiseDelay {} {
+ after 100; update
+}
+
+
+deleteWindows
+stdWindow
+
+test wm-1.1 {Tk_WmObjCmd procedure, miscellaneous errors} {
+ list [catch {wm} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} {
+ list [catch {wm foo} msg] $msg
+} {1 {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}
+
+test wm-1.3 {Tk_WmObjCmd procedure, miscellaneous errors} {
+ list [catch {wm command} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-1.4 {Tk_WmObjCmd procedure, miscellaneous errors} {
+ list [catch {wm aspect bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+
+test wm-1.5 {Tk_WmObjCmd 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}}
+
+
+test wm-aspect-1.1 {usage} {
+ list [catch {wm aspect} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-aspect-1.2 {usage} {
+ list [catch {wm aspect . _} err] $err
+} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
+
+test wm-aspect-1.3 {usage} {
+ list [catch {wm aspect . _ _ _} err] $err
+} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
+
+test wm-aspect-1.4 {usage} {
+ list [catch {wm aspect . _ _ _ _ _} err] $err
+} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
+
+test wm-aspect-1.5 {usage} {
+ list [catch {wm aspect . bad 14 15 16} msg] $msg
+} {1 {expected integer but got "bad"}}
+
+test wm-aspect-1.6 {usage} {
+ list [catch {wm aspect . 13 foo 15 16} msg] $msg
+} {1 {expected integer but got "foo"}}
+
+test wm-aspect-1.7 {usage} {
+ list [catch {wm aspect . 13 14 bar 16} msg] $msg
+} {1 {expected integer but got "bar"}}
+
+test wm-aspect-1.8 {usage} {
+ list [catch {wm aspect . 13 14 15 baz} msg] $msg
+} {1 {expected integer but got "baz"}}
+
+test wm-aspect-1.9 {usage} {
+ list [catch {wm aspect . 0 14 15 16} msg] $msg
+} {1 {aspect number can't be <= 0}}
+
+test wm-aspect-1.10 {usage} {
+ list [catch {wm aspect . 13 0 15 16} msg] $msg
+} {1 {aspect number can't be <= 0}}
+
+test wm-aspect-1.11 {usage} {
+ list [catch {wm aspect . 13 14 0 16} msg] $msg
+} {1 {aspect number can't be <= 0}}
+
+test wm-aspect-1.12 {usage} {
+ list [catch {wm aspect . 13 14 15 0} msg] $msg
+} {1 {aspect number can't be <= 0}}
+
+test wm-aspect-2.1 {setting and reading values} {
+ 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]
+} [list {} {3 4 10 2} {}]
+
+
+test wm-attributes-1.1 {usage} {
+ list [catch {wm attributes} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-attributes-1.2.1 {usage} {pcOnly} {
+ list [catch {wm attributes . _} err] $err
+} {1 {wrong # args: should be "wm attributes window ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}}
+
+test wm-attributes-1.2.2 {usage} {macOrUnix} {
+ list [catch {wm attributes . _} err] $err
+} {1 {wrong # args: should be "wm attributes window"}}
+
+
+test wm-client-1.1 {usage} {
+ list [catch {wm client} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-client-1.2 {usage} {
+ list [catch {wm client . _ _} err] $err
+} {1 {wrong # args: should be "wm client window ?name?"}}
+
+test wm-client-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm client .t]
+ wm client .t Miffo
+ lappend result [wm client .t]
+ wm client .t {}
+ lappend result [wm client .t]
+} [list {} Miffo {}]
+
+
+test wm-colormapwindows-1.1 {usage} {
+ list [catch {wm colormapwindows} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-colormapwindows-1.2 {usage} {
+ list [catch {wm colormapwindows . _ _} err] $err
+} {1 {wrong # args: should be "wm colormapwindows window ?windowList?"}}
+
+test wm-colormapwindows-1.3 {usage} {
+ list [catch {wm colormapwindows . "a \{"} msg] $msg
+} {1 {unmatched open brace in list}}
+
+test wm-colormapwindows-1.4 {usage} {
+ list [catch {wm colormapwindows . foo} msg] $msg
+} {1 {bad window path name "foo"}}
+
+test wm-colormapwindows-2.1 {reading values} {
+ 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 wm-colormapwindows-2.2 {setting and reading values} {
+ 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 wm-command-1.1 {usage} {
+ list [catch {wm command} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-command-1.2 {usage} {
+ list [catch {wm command . _ _} err] $err
+} {1 {wrong # args: should be "wm command window ?value?"}}
+
+test wm-command-1.3 {usage} {
+ list [catch {wm command . "a \{"} msg] $msg
+} {1 {unmatched open brace in list}}
+
+test wm-command-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm command .t]
+ wm command .t [list Miffo Foo]
+ lappend result [wm command .t]
+ wm command .t {}
+ lappend result [wm command .t]
+} [list {} [list Miffo Foo] {}]
+
+
+test wm-deiconify-1.1 {usage} {
+ list [catch {wm deiconify} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-deiconify-1.2 {usage} {
+ list [catch {wm deiconify . _} err] $err
+} {1 {wrong # args: should be "wm deiconify window"}}
+
+test wm-deiconify-1.3 {usage} {
+ list [catch {wm deiconify _} err] $err
+} {1 {bad window path name "_"}}
+
+test wm-deiconify-1.4 {usage} {
+ 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 wm-deiconify-1.5 {usage} {
+ catch {destroy .embed}
+ frame .t.f -container 1
+ toplevel .embed -use [winfo id .t.f]
+ set result [list [catch {wm deiconify .embed} msg] $msg]
+ destroy .t.f .embed
+ set result
+} {1 {can't deiconify .embed: it is an embedded window}}
+
+test wm-deiconify-2.1 {a window that has never been mapped
+ should not be mapped by a call to deiconify} {
+ deleteWindows
+ toplevel .t
+ wm deiconify .t
+ winfo ismapped .t
+} 0
+
+test wm-deiconify-2.2 {a window that has already been
+ mapped should be mapped by deiconify} {
+ deleteWindows
+ toplevel .t
+ update idletasks
+ wm withdraw .t
+ wm deiconify .t
+ winfo ismapped .t
+} 1
+
+test wm-deiconify-2.3 {geometry for an unmapped window
+ should not be calculated by a call to deiconify,
+ it should be done at idle time} {
+ deleteWindows
+ set results {}
+ toplevel .t -width 200 -height 200
+ lappend results [wm geometry .t]
+ wm deiconify .t
+ lappend results [wm geometry .t]
+ update idletasks
+ lappend results [lindex [split \
+ [wm geometry .t] +] 0]
+} {1x1+0+0 1x1+0+0 200x200}
+
+test wm-deiconify-2.4 {invoking destroy after a deiconify
+ should not result in a crash because of a callback
+ set on the toplevel} {
+ deleteWindows
+ toplevel .t
+ wm withdraw .t
+ wm deiconify .t
+ destroy .t
+ update
+} {}
+
+
+test wm-focusmodel-1.1 {usage} {
+ list [catch {wm focusmodel} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-focusmodel-1.2 {usage} {
+ list [catch {wm focusmodel . _ _} err] $err
+} {1 {wrong # args: should be "wm focusmodel window ?active|passive?"}}
+
+test wm-focusmodel-1.3 {usage} {
+ list [catch {wm focusmodel . bogus} msg] $msg
+} {1 {bad argument "bogus": must be active or passive}}
+
+stdWindow
+
+test wm-focusmodel-2.1 {setting and reading values} {
+ 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 wm-frame-1.1 {usage} {
+ list [catch {wm frame} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-frame-1.2 {usage} {
+ list [catch {wm frame . _} err] $err
+} {1 {wrong # args: should be "wm frame window"}}
+
+
+test wm-geometry-1.1 {usage} {
+ list [catch {wm geometry} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-geometry-1.2 {usage} {
+ list [catch {wm geometry . _ _} err] $err
+} {1 {wrong # args: should be "wm geometry window ?newGeometry?"}}
+
+test wm-geometry-1.3 {usage} {
+ list [catch {wm geometry . bogus} msg] $msg
+} {1 {bad geometry specifier "bogus"}}
+
+test wm-geometry-2.1 {setting values} {
+ set result {}
+ wm geometry .t 150x150+50+50
+ update
+ lappend result [wm geometry .t]
+ wm geometry .t {}
+ update
+ lappend result [string equal [wm geometry .t] "150x150+50+50"]
+} [list 150x150+50+50 0]
+
+
+test wm-grid-1.1 {usage} {
+ list [catch {wm grid} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-grid-1.2 {usage} {
+ list [catch {wm grid . _} err] $err
+} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
+
+test wm-grid-1.3 {usage} {
+ list [catch {wm grid . _ _ _} err] $err
+} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
+
+test wm-grid-1.4 {usage} {
+ list [catch {wm grid . _ _ _ _ _} err] $err
+} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
+
+test wm-grid-1.5 {usage} {
+ list [catch {wm grid . bad 14 15 16} msg] $msg
+} {1 {expected integer but got "bad"}}
+
+test wm-grid-1.6 {usage} {
+ list [catch {wm grid . 13 foo 15 16} msg] $msg
+} {1 {expected integer but got "foo"}}
+
+test wm-grid-1.7 {usage} {
+ list [catch {wm grid . 13 14 bar 16} msg] $msg
+} {1 {expected integer but got "bar"}}
+
+test wm-grid-1.8 {usage} {
+ list [catch {wm grid . 13 14 15 baz} msg] $msg
+} {1 {expected integer but got "baz"}}
+
+test wm-grid-1.9 {usage} {
+ list [catch {wm grid . -1 14 15 16} msg] $msg
+} {1 {baseWidth can't be < 0}}
+
+test wm-grid-1.10 {usage} {
+ list [catch {wm grid . 13 -1 15 16} msg] $msg
+} {1 {baseHeight can't be < 0}}
+
+test wm-grid-1.11 {usage} {
+ list [catch {wm grid . 13 14 -1 16} msg] $msg
+} {1 {widthInc can't be < 0}}
+
+test wm-grid-1.12 {usage} {
+ list [catch {wm grid . 13 14 15 -1} msg] $msg
+} {1 {heightInc can't be < 0}}
+
+test wm-grid-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm grid .t]
+ wm grid .t 3 4 10 2
+ lappend result [wm grid .t]
+ wm grid .t {} {} {} {}
+ lappend result [wm grid .t]
+} [list {} {3 4 10 2} {}]
+
+
+test wm-group-1.1 {usage} {
+ list [catch {wm group} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-group-1.2 {usage} {
+ list [catch {wm group .t 12 13} msg] $msg
+} {1 {wrong # args: should be "wm group window ?pathName?"}}
+
+test wm-group-1.3 {usage} {
+ list [catch {wm group .t bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+
+test wm-group-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm group .t]
+ wm group .t .
+ lappend result [wm group .t]
+ wm group .t {}
+ lappend result [wm group .t]
+} [list {} . {}]
+
+
+test wm-iconbitmap-1.1 {usage} {
+ list [catch {wm iconbitmap} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-iconbitmap-1.2.1 {usage} {macOrUnix} {
+ list [catch {wm iconbitmap .t 12 13} msg] $msg
+} {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}}
+
+test wm-iconbitmap-1.2.2 {usage} {pcOnly} {
+ list [catch {wm iconbitmap .t 12 13 14} msg] $msg
+} {1 {wrong # args: should be "wm iconbitmap window ?-default? ?image?"}}
+
+test wm-iconbitmap-1.3 {usage} {pcOnly} {
+ list [catch {wm iconbitmap .t 12 13} msg] $msg
+} {1 {illegal option "12" must be "-default"}}
+
+test wm-iconbitmap-1.4 {usage} {
+ list [catch {wm iconbitmap .t bad-bitmap} msg] $msg
+} {1 {bitmap "bad-bitmap" not defined}}
+
+test wm-iconbitmap-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm iconbitmap .t]
+ wm iconbitmap .t hourglass
+ lappend result [wm iconbitmap .t]
+ wm iconbitmap .t {}
+ lappend result [wm iconbitmap .t]
+} [list {} hourglass {}]
+
+
+test wm-iconify-1.1 {usage} {
+ list [catch {wm iconify} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-iconify-1.2 {usage} {
+ list [catch {wm iconify .t _} msg] $msg
+} {1 {wrong # args: should be "wm iconify window"}}
+
+test wm-iconify-2.1 {Misc errors} {
+ 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 wm-iconify-2.2 {Misc errors} {
+ 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 wm-iconify-2.3 {Misc errors} {
+ 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 wm-iconify-2.4 {Misc errors} {
+ catch {destroy .t2}
+ frame .t.f -container 1
+ toplevel .t2 -use [winfo id .t.f]
+ set result [list [catch {wm iconify .t2} msg] $msg]
+ destroy .t2 .r.f
+ set result
+} {1 {can't iconify .t2: it is an embedded window}}
+
+test wm-iconify-3.1 {} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 -0+0
+ update
+ set result [winfo ismapped .t2]
+ wm iconify .t2
+ update
+ lappend result [winfo ismapped .t2]
+ destroy .t2
+ set result
+} {1 0}
+
+
+test wm-iconmask-1.1 {usage} {
+ list [catch {wm iconmask} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-iconmask-1.2 {usage} {
+ list [catch {wm iconmask .t 12 13} msg] $msg
+} {1 {wrong # args: should be "wm iconmask window ?bitmap?"}}
+
+test wm-iconmask-1.3 {usage} {
+ list [catch {wm iconmask .t bad-bitmap} msg] $msg
+} {1 {bitmap "bad-bitmap" not defined}}
+
+test wm-iconmask-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm iconmask .t]
+ wm iconmask .t hourglass
+ lappend result [wm iconmask .t]
+ wm iconmask .t {}
+ lappend result [wm iconmask .t]
+} [list {} hourglass {}]
+
+
+test wm-iconname-1.1 {usage} {
+ list [catch {wm iconname} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-iconname-1.2 {usage} {
+ list [catch {wm iconname .t 12 13} msg] $msg
+} {1 {wrong # args: should be "wm iconname window ?newName?"}}
+
+test wm-iconname-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm iconname .t]
+ wm iconname .t ThisIconHasAName
+ lappend result [wm iconname .t]
+ wm iconname .t {}
+ lappend result [wm iconname .t]
+} [list {} ThisIconHasAName {}]
+
+
+test wm-iconposition-1.1 {usage} {
+ list [catch {wm iconposition} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-iconposition-1.2 {usage} {
+ list [catch {wm iconposition .t 12} msg] $msg
+} {1 {wrong # args: should be "wm iconposition window ?x y?"}}
+
+test wm-iconposition-1.3 {usage} {
+ list [catch {wm iconposition .t 12 13 14} msg] $msg
+} {1 {wrong # args: should be "wm iconposition window ?x y?"}}
+
+test wm-iconposition-1.4 {usage} {
+ list [catch {wm iconposition .t bad 13} msg] $msg
+} {1 {expected integer but got "bad"}}
+
+test wm-iconposition-1.5 {usage} {
+ list [catch {wm iconposition .t 13 lousy} msg] $msg
+} {1 {expected integer but got "lousy"}}
+
+test wm-iconposition-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm iconposition .t]
+ wm iconposition .t 10 20
+ lappend result [wm iconposition .t]
+ wm iconposition .t {} {}
+ lappend result [wm iconposition .t]
+} [list {} {10 20} {}]
+
+
+test wm-iconwindow-1.1 {usage} {
+ list [catch {wm iconwindow} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-iconwindow-1.2 {usage} {
+ list [catch {wm iconwindow .t 12 13} msg] $msg
+} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}}
+
+test wm-iconwindow-1.3 {usage} {
+ list [catch {wm iconwindow .t bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+
+test wm-iconwindow-1.4 {usage} {
+ 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 wm-iconwindow-1.5 {usage} {
+ 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 wm-iconwindow-2.1 {setting and reading values} {
+ set result {}
+ lappend result [wm iconwindow .t]
+ catch {destroy .icon}
+ toplevel .icon -width 50 -height 50 -bg green
+ wm iconwindow .t .icon
+ lappend result [wm iconwindow .t]
+ wm iconwindow .t {}
+ destroy .icon
+ lappend result [wm iconwindow .t]
+} [list {} .icon {}]
+
+
+test wm-maxsize-1.1 {usage} {
+ list [catch {wm maxsize} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-maxsize-1.2 {usage} {
+ list [catch {wm maxsize . a} msg] $msg
+} {1 {wrong # args: should be "wm maxsize window ?width height?"}}
+
+test wm-maxsize-1.3 {usage} {
+ list [catch {wm maxsize . a b c} msg] $msg
+} {1 {wrong # args: should be "wm maxsize window ?width height?"}}
+
+test wm-maxsize-1.4 {usage} {
+ list [catch {wm maxsize . x 100} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test wm-maxsize-1.5 {usage} {
+ list [catch {wm maxsize . 100 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+
+test wm-maxsize-1.6 {usage} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm maxsize .t2 200 150
+ set result [wm maxsize .t2]
+ destroy .t2
+ set result
+} {200 150}
+
+
+test wm-minsize-1.1 {usage} {
+ list [catch {wm minsize} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-minsize-1.2 {usage} {
+ list [catch {wm minsize . a} msg] $msg
+} {1 {wrong # args: should be "wm minsize window ?width height?"}}
+
+test wm-minsize-1.3 {usage} {
+ list [catch {wm minsize . a b c} msg] $msg
+} {1 {wrong # args: should be "wm minsize window ?width height?"}}
+
+test wm-minsize-1.4 {usage} {
+ list [catch {wm minsize . x 100} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test wm-minsize-1.5 {usage} {
+ list [catch {wm minsize . 100 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+
+test wm-minsize-1.6 {usage} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm minsize .t2 200 150
+ set result [wm minsize .t2]
+ destroy .t2
+ set result
+} {200 150}
+
+
+test wm-overrideredirect-1.1 {usage} {
+ list [catch {wm overrideredirect} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-overrideredirect-1.2 {usage} {
+ list [catch {wm overrideredirect .t 1 2} msg] $msg
+} {1 {wrong # args: should be "wm overrideredirect window ?boolean?"}}
+
+test wm-overrideredirect-1.3 {usage} {
+ list [catch {wm overrideredirect .t boo} msg] $msg
+} {1 {expected boolean value but got "boo"}}
+
+test wm-overrideredirect-2.1 {setting and reading values} {
+ 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 wm-positionfrom-1.1 {usage} {
+ list [catch {wm positionfrom} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-positionfrom-1.2 {usage} {
+ list [catch {wm positionfrom .t 1 2} msg] $msg
+} {1 {wrong # args: should be "wm positionfrom window ?user/program?"}}
+
+test wm-positionfrom-1.3 {usage} {
+ list [catch {wm positionfrom .t none} msg] $msg
+} {1 {bad argument "none": must be program or user}}
+
+test wm-positionfrom-2.1 {setting and reading values} {
+ catch {destroy .t2}
+ toplevel .t2
+ set result {}
+ wm positionfrom .t user
+ lappend result [wm positionfrom .t]
+ wm positionfrom .t program
+ lappend result [wm positionfrom .t]
+ wm positionfrom .t {}
+ lappend result [wm positionfrom .t]
+ destroy .t2
+ set result
+} {user program {}}
+
+
+test wm-protocol-1.1 {usage} {
+ list [catch {wm protocol} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-protocol-1.2 {usage} {
+ list [catch {wm protocol .t 1 2 3} msg] $msg
+} {1 {wrong # args: should be "wm protocol window ?name? ?command?"}}
+
+test wm-protocol-2.1 {setting and reading values} {
+ 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 wm-protocol-2.2 {setting and reading values} {
+ 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 wm-protocol-2.3 {setting and reading values} {
+ 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 wm-resizable-1.1 {usage} {
+ list [catch {wm resizable} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-resizable-1.2 {usage} {
+ list [catch {wm resizable .t 1} msg] $msg
+} {1 {wrong # args: should be "wm resizable window ?width height?"}}
+
+test wm-resizable-1.3 {usage} {
+ list [catch {wm resizable .t 1 2 3} msg] $msg
+} {1 {wrong # args: should be "wm resizable window ?width height?"}}
+
+test wm-resizable-1.4 {usage} {
+ list [catch {wm resizable .t bad 0} msg] $msg
+} {1 {expected boolean value but got "bad"}}
+
+test wm-resizable-1.5 {usage} {
+ list [catch {wm resizable .t 1 bad} msg] $msg
+} {1 {expected boolean value but got "bad"}}
+
+test wm-resizable-2.1 {setting and reading values} {
+ wm resizable .t 0 1
+ set result [wm resizable .t]
+ wm resizable .t 1 0
+ lappend result [wm resizable .t]
+ wm resizable .t 1 1
+ lappend result [wm resizable .t]
+} {0 1 {1 0} {1 1}}
+
+
+test wm-sizefrom-1.1 {usage} {
+ list [catch {wm sizefrom} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-sizefrom-1.2 {usage} {
+ list [catch {wm sizefrom .t 1 2} msg] $msg
+} {1 {wrong # args: should be "wm sizefrom window ?user|program?"}}
+
+test wm-sizefrom-1.4 {usage} {
+ list [catch {wm sizefrom .t bad} msg] $msg
+} {1 {bad argument "bad": must be program or user}}
+
+test wm-sizefrom-2.1 {setting and reading values} {
+ set result [list [wm sizefrom .t]]
+ wm sizefrom .t user
+ lappend result [wm sizefrom .t]
+ wm sizefrom .t program
+ lappend result [wm sizefrom .t]
+ wm sizefrom .t {}
+ lappend result [wm sizefrom .t]
+} {{} user program {}}
+
+
+
+test wm-stackorder-1.1 {usage} {
+ list [catch {wm stackorder} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-stackorder-1.2 {usage} {
+ list [catch {wm stackorder . _} err] $err
+} {1 {wrong # args: should be "wm stackorder window ?isabove|isbelow window?"}}
+
+test wm-stackorder-1.3 {usage} {
+ list [catch {wm stackorder . _ _ _} err] $err
+} {1 {wrong # args: should be "wm stackorder window ?isabove|isbelow window?"}}
+
+test wm-stackorder-1.4 {usage} {
+ list [catch {wm stackorder . is .} err] $err
+} {1 {ambiguous argument "is": must be isabove or isbelow}}
+
+test wm-stackorder-1.5 {usage} {
+ list [catch {wm stackorder _} err] $err
+} {1 {bad window path name "_"}}
+
+test wm-stackorder-1.6 {usage} {
+ list [catch {wm stackorder . isabove _} err] $err
+} {1 {bad window path name "_"}}
+
+test wm-stackorder-1.7 {usage} {
+ catch {destroy .t}
+ toplevel .t
+ button .t.b
+ list [catch {wm stackorder .t.b} err] $err
+} {1 {window ".t.b" isn't a top-level window}}
+
+test wm-stackorder-1.8 {usage} {
+ catch {destroy .t}
+ toplevel .t
+ button .t.b
+ pack .t.b
+ update
+ list [catch {wm stackorder . isabove .t.b} err] $err
+} {1 {window ".t.b" isn't a top-level window}}
+
+test wm-stackorder-1.9 {usage} {
+ catch {destroy .t}
+ toplevel .t
+ button .t.b
+ pack .t.b
+ update
+ list [catch {wm stackorder . isbelow .t.b} err] $err
+} {1 {window ".t.b" isn't a top-level window}}
+
+test wm-stackorder-1.10 {usage, isabove|isbelow toplevels must be mapped} {
+ catch {destroy .t}
+ toplevel .t ; update
+ wm withdraw .t
+ list [catch {wm stackorder .t isabove .} err] $err
+} {1 {window ".t" isn't mapped}}
+
+test wm-stackorder-1.11 {usage, isabove|isbelow toplevels must be mapped} {
+ catch {destroy .t}
+ toplevel .t ; update
+ wm withdraw .t
+ list [catch {wm stackorder . isbelow .t} err] $err
+} {1 {window ".t" isn't mapped}}
+
+
+deleteWindows
+
+
+test wm-stackorder-2.1 {} {
+ catch {destroy .t}
+ toplevel .t ; update
+ wm stackorder .
+} {. .t}
+
+test wm-stackorder-2.2 {} {
+ catch {destroy .t}
+ toplevel .t ; update
+ raise .
+ raiseDelay
+ wm stackorder .
+} {.t .}
+
+test wm-stackorder-2.3 {} {
+ catch {destroy .t}
+ toplevel .t ; update
+ catch {destroy .t2}
+ toplevel .t2 ; update
+ raise .
+ raise .t2
+ raiseDelay
+ wm stackorder .
+} {.t . .t2}
+
+test wm-stackorder-2.4 {} {
+ catch {destroy .t}
+ toplevel .t ; update
+ catch {destroy .t2}
+ toplevel .t2 ; update
+ raise .
+ lower .t2
+ raiseDelay
+ wm stackorder .
+} {.t2 .t .}
+
+test wm-stackorder-2.5 {} {
+ catch {destroy .parent}
+ toplevel .parent ; update
+ catch {destroy .parent.child1}
+ toplevel .parent.child1 ; update
+ catch {destroy .parent.child2}
+ toplevel .parent.child2 ; update
+ catch {destroy .extra}
+ toplevel .extra ; update
+ raise .parent
+ lower .parent.child2
+ raiseDelay
+ wm stackorder .parent
+} {.parent.child2 .parent.child1 .parent}
+
+deleteWindows
+
+test wm-stackorder-2.6 {non-toplevel widgets ignored} {
+ catch {destroy .t1}
+ toplevel .t1
+ button .t1.b
+ pack .t1.b
+ update
+ wm stackorder .
+} {. .t1}
+
+deleteWindows
+
+test wm-stackorder-2.7 {no children returns self} {
+ wm stackorder .
+} {.}
+
+deleteWindows
+
+
+test wm-stackorder-3.1 {unmapped toplevel} {
+ catch {destroy .t1}
+ toplevel .t1 ; update
+ catch {destroy .t2}
+ toplevel .t2 ; update
+ wm iconify .t1
+ wm stackorder .
+} {. .t2}
+
+test wm-stackorder-3.2 {unmapped toplevel} {
+ catch {destroy .t1}
+ toplevel .t1 ; update
+ catch {destroy .t2}
+ toplevel .t2 ; update
+ wm withdraw .t2
+ wm stackorder .
+} {. .t1}
+
+test wm-stackorder-3.3 {unmapped toplevel} {
+ catch {destroy .t1}
+ toplevel .t1 ; update
+ catch {destroy .t2}
+ toplevel .t2 ; update
+ wm withdraw .t2
+ wm stackorder .t2
+} {}
+
+test wm-stackorder-3.4 {unmapped toplevel} {
+ catch {destroy .t1}
+ toplevel .t1 ; update
+ toplevel .t1.t2 ; update
+ wm withdraw .t1.t2
+ wm stackorder .t1
+} {.t1}
+
+test wm-stackorder-3.5 {unmapped toplevel} {
+ catch {destroy .t1}
+ toplevel .t1 ; update
+ toplevel .t1.t2 ; update
+ wm withdraw .t1
+ wm stackorder .t1
+} {.t1.t2}
+
+test wm-stackorder-3.6 {unmapped toplevel} {
+ catch {destroy .t1}
+ toplevel .t1 ; update
+ toplevel .t1.t2 ; update
+ toplevel .t1.t2.t3 ; update
+ wm withdraw .t1.t2
+ wm stackorder .t1
+} {.t1 .t1.t2.t3}
+
+test wm-stackorder-3.7 {unmapped toplevel, mapped children returned} {
+ catch {destroy .t1}
+ toplevel .t1 ; update
+ toplevel .t1.t2 ; update
+ wm withdraw .t1
+ wm stackorder .t1
+} {.t1.t2}
+
+test wm-stackorder-3.8 {toplevel mapped in idle callback } {
+ catch {destroy .t1}
+ toplevel .t1
+ wm stackorder .
+} {.}
+
+
+deleteWindows
+
+
+test wm-stackorder-4.1 {wm stackorder isabove|isbelow} {
+ catch {destroy .t}
+ toplevel .t ; update
+ raise .t
+ wm stackorder . isabove .t
+} {0}
+
+test wm-stackorder-4.2 {wm stackorder isabove|isbelow} {
+ catch {destroy .t}
+ toplevel .t ; update
+ raise .t
+ wm stackorder . isbelow .t
+} {1}
+
+test wm-stackorder-4.3 {wm stackorder isabove|isbelow} {
+ catch {destroy .t}
+ toplevel .t ; update
+ raise .
+ raiseDelay
+ wm stackorder .t isa .
+} {0}
+
+test wm-stackorder-4.4 {wm stackorder isabove|isbelow} {
+ catch {destroy .t}
+ toplevel .t ; update
+ raise .
+ raiseDelay
+ wm stackorder .t isb .
+} {1}
+
+deleteWindows
+
+test wm-stackorder-5.1 {a menu is not a toplevel} {
+ catch {destroy .t}
+ toplevel .t
+ menu .t.m -type menubar
+ .t.m add cascade -label "File"
+ .t configure -menu .t.m
+ update
+ raise .
+ raiseDelay
+ wm stackorder .
+} {.t .}
+
+test wm-stackorder-5.2 {A normal toplevel can't be
+ raised above an overrideredirect toplevel } {
+ catch {destroy .t}
+ toplevel .t
+ wm overrideredirect .t 1
+ raise .
+ update
+ raiseDelay
+ wm stackorder . isabove .t
+} 0
+
+test wm-stackorder-5.3 {An overrideredirect window
+ can be explicitly lowered } {
+ catch {destroy .t}
+ toplevel .t
+ wm overrideredirect .t 1
+ lower .t
+ update
+ raiseDelay
+ wm stackorder .t isbelow .
+} 1
+
+test wm-stackorder-6.1 {An embedded toplevel does not
+ appear in the stacking order} {
+ deleteWindows
+ toplevel .real -container 1
+ toplevel .embd -bg blue -use [winfo id .real]
+ update
+ wm stackorder .
+} {. .real}
+
+stdWindow
+
+test wm-title-1.1 {usage} {
+ list [catch {wm title} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-title-1.2 {usage} {
+ list [catch {wm title . 1 2} msg] $msg
+} {1 {wrong # args: should be "wm title window ?newTitle?"}}
+
+test wm-title-2.1 {setting and reading values} {
+ destroy .t
+ toplevel .t
+ set result [wm title .t]
+ wm title .t Apa
+ lappend result [wm title .t]
+ wm title .t {}
+ lappend result [wm title .t]
+} {t Apa {}}
+
+
+test wm-transient-1.1 {usage} {
+ catch {destroy .t} ; toplevel .t
+ list [catch {wm transient .t 1 2} msg] $msg
+} {1 {wrong # args: should be "wm transient window ?master?"}}
+
+test wm-transient-1.2 {usage} {
+ catch {destroy .t} ; toplevel .t
+ list [catch {wm transient .t foo} msg] $msg
+} {1 {bad window path name "foo"}}
+
+test wm-transient-1.3 {usage} {
+ catch {destroy .t} ; toplevel .t
+ list [catch {wm transient foo .t} msg] $msg
+} {1 {bad window path name "foo"}}
+
+test wm-transient-1.4 {usage} {
+ deleteWindows
+ toplevel .master
+ toplevel .subject
+ wm transient .subject .master
+ list [catch {wm iconify .subject} msg] $msg
+} {1 {can't iconify ".subject": it is a transient}}
+
+test wm-transient-1.5 {usage} {
+ deleteWindows
+ toplevel .icon -bg blue
+ toplevel .top
+ wm iconwindow .top .icon
+ toplevel .dummy
+ list [catch {wm transient .icon .dummy} msg] $msg
+} {1 {can't make ".icon" a transient: it is an icon for .top}}
+
+test wm-transient-1.6 {usage} {
+ deleteWindows
+ toplevel .icon -bg blue
+ toplevel .top
+ wm iconwindow .top .icon
+ toplevel .dummy
+ list [catch {wm transient .dummy .icon} msg] $msg
+} {1 {can't make ".icon" a master: it is an icon for .top}}
+
+test wm-transient-1.7 {usage} {
+ deleteWindows
+ toplevel .master
+ list [catch {wm transient .master .master} err] $err
+} {1 {can't make ".master" its own master}}
+
+test wm-transient-1.8 {usage} {
+ deleteWindows
+ toplevel .master
+ frame .master.f
+ list [catch {wm transient .master .master.f} err] $err
+} {1 {can't make ".master" its own master}}
+
+test wm-transient-2.1 { basic get/set of master } {
+ deleteWindows
+ set results [list]
+ toplevel .master
+ toplevel .subject
+ lappend results [wm transient .subject]
+ wm transient .subject .master
+ lappend results [wm transient .subject]
+ wm transient .subject {}
+ lappend results [wm transient .subject]
+ set results
+} {{} .master {}}
+
+test wm-transient-2.2 { first toplevel parent of
+ non-toplevel master is used } {
+ deleteWindows
+ toplevel .master
+ frame .master.f
+ toplevel .subject
+ wm transient .subject .master.f
+ wm transient .subject
+} {.master}
+
+test wm-transient-3.1 { transient toplevel is withdrawn
+ when mapped if master is withdrawn } {
+ deleteWindows
+ toplevel .master
+ wm withdraw .master
+ update
+ toplevel .subject
+ wm transient .subject .master
+ update
+ list [wm state .subject] [winfo ismapped .subject]
+} {withdrawn 0}
+
+test wm-transient-3.2 { already mapped transient toplevel
+ takes on withdrawn state of master } {
+ deleteWindows
+ toplevel .master
+ wm withdraw .master
+ update
+ toplevel .subject
+ update
+ wm transient .subject .master
+ update
+ list [wm state .subject] [winfo ismapped .subject]
+} {withdrawn 0}
+
+test wm-transient-3.3 { withdraw/deiconify on the master
+ also does a withdraw/deiconify on the transient } {
+ deleteWindows
+ set results [list]
+ toplevel .master
+ toplevel .subject
+ update
+ wm transient .subject .master
+ wm withdraw .master
+ update
+ lappend results [wm state .subject] \
+ [winfo ismapped .subject]
+ wm deiconify .master
+ update
+ lappend results [wm state .subject] \
+ [winfo ismapped .subject]
+ set results
+} {withdrawn 0 normal 1}
+
+test wm-transient-4.1 { transient toplevel is withdrawn
+ when mapped if master is iconic } {
+ deleteWindows
+ toplevel .master
+ wm iconify .master
+ update
+ toplevel .subject
+ wm transient .subject .master
+ update
+ list [wm state .subject] [winfo ismapped .subject]
+} {withdrawn 0}
+
+test wm-transient-4.2 { already mapped transient toplevel
+ is withdrawn if master is iconic } {
+ deleteWindows
+ toplevel .master
+ wm iconify .master
+ update
+ toplevel .subject
+ update
+ wm transient .subject .master
+ update
+ list [wm state .subject] [winfo ismapped .subject]
+} {withdrawn 0}
+
+test wm-transient-4.3 { iconify/deiconify on the master
+ does a withdraw/deiconify on the transient } {
+ deleteWindows
+ set results [list]
+ toplevel .master
+ toplevel .subject
+ update
+ wm transient .subject .master
+ wm iconify .master
+ update
+ lappend results [wm state .subject] \
+ [winfo ismapped .subject]
+ wm deiconify .master
+ update
+ lappend results [wm state .subject] \
+ [winfo ismapped .subject]
+ set results
+} {withdrawn 0 normal 1}
+
+test wm-transient-5.1 { an error during transient command should not
+ cause the map/unmap binding to be deleted } {
+ deleteWindows
+ set results [list]
+ toplevel .master
+ toplevel .subject
+ update
+ wm transient .subject .master
+ # Expect a bad window path error here
+ lappend results [catch {wm transient .subject .bad}]
+ wm withdraw .master
+ update
+ lappend results [wm state .subject]
+ wm deiconify .master
+ update
+ lappend results [wm state .subject]
+ set results
+} {1 withdrawn normal}
+
+test wm-transient-5.2 { remove transient property when master
+ is destroyed } {
+ deleteWindows
+ toplevel .master
+ toplevel .subject
+ wm transient .subject .master
+ update
+ destroy .master
+ update
+ wm transient .subject
+} {}
+
+test wm-transient-5.3 { remove transient property from window
+ that had never been mapped when master is destroyed } {
+ deleteWindows
+ toplevel .master
+ toplevel .subject
+ wm transient .subject .master
+ destroy .master
+ wm transient .subject
+} {}
+
+test wm-transient-6.1 { a withdrawn transient does not track
+ state changes in the master } {
+ deleteWindows
+ toplevel .master
+ toplevel .subject
+ update
+ wm transient .subject .master
+ wm withdraw .subject
+ wm withdraw .master
+ wm deiconify .master
+ # idle handler should not map the transient
+ update
+ wm state .subject
+} {withdrawn}
+
+test wm-transient-6.2 { a withdrawn transient does not track
+ state changes in the master } {
+ set results [list]
+ deleteWindows
+ toplevel .master
+ toplevel .subject
+ update
+ wm transient .subject .master
+ wm withdraw .subject
+ wm withdraw .master
+ wm deiconify .master
+ # idle handler should not map the transient
+ update
+ lappend results [wm state .subject]
+ wm deiconify .subject
+ lappend results [wm state .subject]
+ wm withdraw .master
+ lappend results [wm state .subject]
+ wm deiconify .master
+ # idle handler should map transient
+ update
+ lappend results [wm state .subject]
+} {withdrawn normal withdrawn normal}
+
+
+# wm-transient-7.*: See SF Tk Bug #592201 "wm transient fails with two masters"
+# wm-transient-7.3 through 7.5 all caused panics on Unix in Tk 8.4b1.
+# 7.1 and 7.2 added to catch (potential) future errors.
+#
+test wm-transient-7.1 {Destroying transient} {
+ deleteWindows
+ toplevel .t
+ toplevel .transient
+ wm transient .transient .t
+ destroy .transient
+ destroy .t
+ # OK: the above did not cause a panic.
+} {}
+
+test wm-transient-7.2 {Destroying master} {
+ deleteWindows
+ toplevel .t
+ toplevel .transient
+ wm transient .transient .t
+ destroy .t
+ set result [wm transient .transient]
+ destroy .transient
+ set result
+} {}
+
+test wm-transient-7.3 {Reassign transient, destroy old master} {
+ deleteWindows
+ toplevel .t1
+ toplevel .t2
+ toplevel .transient
+ wm transient .transient .t1
+ wm transient .transient .t2
+ destroy .t1 ;# Caused panic in 8.4b1
+ destroy .t2
+ destroy .transient
+} {}
+
+test wm-transient-7.4 {Reassign transient, destroy new master} {
+ deleteWindows
+ toplevel .t1
+ toplevel .t2
+ toplevel .transient
+ wm transient .transient .t1
+ wm transient .transient .t2
+ destroy .t2 ;# caused panic in 8.4b1
+ destroy .t1
+ destroy .transient
+} {}
+
+test wm-transient-7.5 {Reassign transient, destroy transient} {
+ deleteWindows
+ toplevel .t1
+ toplevel .t2
+ toplevel .transient
+ wm transient .transient .t1
+ wm transient .transient .t2
+ destroy .transient
+ destroy .t2 ;# caused panic in 8.4b1
+ destroy .t1 ;# so did this
+} {}
+
+test wm-state-1.1 {usage} {
+ list [catch {wm state} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-state-1.2 {usage} {
+ list [catch {wm state . _ _} err] $err
+} {1 {wrong # args: should be "wm state window ?state?"}}
+
+test wm-state-2.1 {initial state} {
+ deleteWindows
+ toplevel .t
+ wm state .t
+} {normal}
+
+test wm-state-2.2 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm state .t withdrawn
+ wm state .t
+} {withdrawn}
+
+test wm-state-2.3 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm withdraw .t
+ wm state .t
+} {withdrawn}
+
+test wm-state-2.4 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm state .t withdrawn
+ wm state .t
+} {withdrawn}
+
+test wm-state-2.5 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm withdraw .t
+ wm state .t
+} {withdrawn}
+
+test wm-state-2.6 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm state .t iconic
+ wm state .t
+} {iconic}
+
+test wm-state-2.7 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm iconify .t
+ wm state .t
+} {iconic}
+
+test wm-state-2.8 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm state .t iconic
+ wm state .t
+} {iconic}
+
+test wm-state-2.9 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm iconify .t
+ wm state .t
+} {iconic}
+
+test wm-state-2.10 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm withdraw .t
+ wm state .t normal
+ wm state .t
+} {normal}
+
+test wm-state-2.11 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm withdraw .t
+ wm deiconify .t
+ wm state .t
+} {normal}
+
+test wm-state-2.12 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm withdraw .t
+ wm state .t normal
+ wm state .t
+} {normal}
+
+test wm-state-2.13 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm withdraw .t
+ wm deiconify .t
+ wm state .t
+} {normal}
+
+test wm-state-2.14 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm iconify .t
+ wm state .t normal
+ wm state .t
+} {normal}
+
+test wm-state-2.15 {state change before map} {
+ deleteWindows
+ toplevel .t
+ wm iconify .t
+ wm deiconify .t
+ wm state .t
+} {normal}
+
+test wm-state-2.16 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm iconify .t
+ wm state .t normal
+ wm state .t
+} {normal}
+
+test wm-state-2.17 {state change after map} {
+ deleteWindows
+ toplevel .t
+ update
+ wm iconify .t
+ wm deiconify .t
+ wm state .t
+} {normal}
+
+
+test wm-withdraw-1.1 {usage} {
+ list [catch {wm withdraw} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-withdraw-1.2 {usage} {
+ list [catch {wm withdraw . _} msg] $msg
+} {1 {wrong # args: should be "wm withdraw window"}}
+
+test wm-withdraw-2.1 {Misc errors} {
+ deleteWindows
+ toplevel .t
+ toplevel .t2
+ 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 wm-withdraw-3.1 {} {
+ update
+ 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}
+
+
+# FIXME:
+
+# Test delivery of virtual events to the WM. We could check to see
+# if the window was raised after a button click for example.
+# This sort of testing may not be possible.
+
+
+deleteWindows
+tcltest::cleanupTests
+return
+
+
+
diff --git a/tcl/tests/xmfbox.test b/tcl/tests/xmfbox.test
new file mode 100644
index 00000000000..6273af5ff91
--- /dev/null
+++ b/tcl/tests/xmfbox.test
@@ -0,0 +1,158 @@
+# xmfbox.test --
+#
+# This file is a Tcl script to test the file dialog that's used
+# when the tk_strictMotif flag is set. Because the file dialog
+# runs in a modal loop, the only way to test it sufficiently is
+# to call the internal Tcl procedures in xmfbox.tcl directly.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+set testPWD [pwd]
+catch {unset foo}
+
+catch {unset data foo}
+
+proc cleanup {} {
+ global testPWD
+
+ set err0 [catch {
+ cd $testPWD
+ } msg0]
+
+ set err1 [catch {
+ if [file exists ./~nosuchuser1] {
+ file delete ./~nosuchuser1
+ }
+ } msg1]
+
+ set err2 [catch {
+ if [file exists ./~nosuchuser2] {
+ file delete ./~nosuchuser2
+ }
+ } msg2]
+
+ set err3 [catch {
+ if [file exists ./~nosuchuser3] {
+ file delete ./~nosuchuser3
+ }
+ } msg3]
+
+ set err4 [catch {
+ if [file exists ./~nosuchuser4] {
+ file delete ./~nosuchuser4
+ }
+ } msg4]
+
+ if {$err0 || $err1 || $err2 || $err3 || $err4} {
+ error [list $msg0 $msg1 $msg2 $msg3 $msg4]
+ }
+ catch {unset foo}
+ catch {destroy .foo}
+}
+
+test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} {unixOnly} {
+ catch {unset foo}
+ set x [tk::MotifFDialog_Create foo open {-parent .}]
+ catch {destroy $x}
+ set x
+} .foo
+
+test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} {unixOnly} {
+ catch {unset foo}
+ toplevel .bar
+ wm geometry .bar +0+0
+ set x [tk::MotifFDialog_Create foo open {-parent .bar}]
+ catch {destroy $x}
+ catch {destroy .bar}
+ set x
+} .bar.foo
+
+test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} {unixOnly} {
+ cleanup
+ file mkdir ./~nosuchuser1
+ set x [tk::MotifFDialog_Create foo open {}]
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ set kk [tk::MotifFDialog_InterpFilter $x]
+} [list $testPWD/~nosuchuser1 *]
+
+test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tk::MotifFDialog_Create foo open {}]
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ set kk [tk::MotifFDialog_InterpFilter $x]
+} [list $testPWD ./~nosuchuser1]
+
+test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tk::MotifFDialog_Create foo open {}]
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ tk::MotifFDialog_InterpFilter $x
+ tk::MotifFDialog_Update $x
+ $::tk::dialog::file::foo(fList) get end
+} ~nosuchuser1
+
+test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tk::MotifFDialog_Create foo open {}]
+ set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
+ expr {$i >= 0}
+} 1
+
+test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tk::MotifFDialog_Create foo open {}]
+ set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
+ $::tk::dialog::file::foo(fList) selection clear 0 end
+ $::tk::dialog::file::foo(fList) selection set $i
+ tk::MotifFDialog_BrowseFList $x
+ $::tk::dialog::file::foo(sEnt) get
+} $testPWD/~nosuchuser1
+
+test xmfbox-2.6 {tk::MotifFDialog_ActivateFList, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tk::MotifFDialog_Create foo open {}]
+ set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
+ $::tk::dialog::file::foo(fList) selection clear 0 end
+ $::tk::dialog::file::foo(fList) selection set $i
+ tk::MotifFDialog_BrowseFList $x
+ tk::MotifFDialog_ActivateFList $x
+ list $::tk::dialog::file::foo(selectPath) \
+ $::tk::dialog::file::foo(selectFile) $tk::Priv(selectFilePath)
+} [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1]
+
+# cleanup
+cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/unix/Makefile.in b/tcl/unix/Makefile.in
index e4dcb1b6f1c..ac5ad95234e 100644
--- a/tcl/unix/Makefile.in
+++ b/tcl/unix/Makefile.in
@@ -1,5 +1,5 @@
#
-# This file is a Makefile for Tcl. If it has the name "Makefile.in"
+# 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
@@ -7,10 +7,14 @@
#
# RCS: @(#) $Id$
-VERSION = @TCL_VERSION@
-MAJOR_VERSION = @TCL_MAJOR_VERSION@
-MINOR_VERSION = @TCL_MINOR_VERSION@
-PATCH_LEVEL = @TCL_PATCH_LEVEL@
+# Current Tk version; used in various names.
+
+TCLVERSION = @TCL_VERSION@
+VERSION = @TK_VERSION@
+MAJOR_VERSION = @TK_MAJOR_VERSION@
+MINOR_VERSION = @TK_MINOR_VERSION@
+PATCH_LEVEL = @TK_PATCH_LEVEL@
+LOCALES = @LOCALES@
#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
@@ -23,8 +27,7 @@ PATCH_LEVEL = @TCL_PATCH_LEVEL@
# 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. The *dir vars are standard configure
-# substitutions that are based off prefix and exec_prefix.
+# to the "configure" script.
prefix = @prefix@
exec_prefix = @exec_prefix@
@@ -40,43 +43,63 @@ mandir = @mandir@
# when installing files.
INSTALL_ROOT =
-# Path for the platform independent Tcl scripting libraries:
-TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION)
+# 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 = $(prefix)/lib/tk$(VERSION)
# Path to use at runtime to refer to LIB_INSTALL_DIR:
LIB_RUNTIME_DIR = $(libdir)
-# Directory in which to install the program tclsh:
+# Directory in which to install the program wish:
BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
-# Directory in which to install libtcl.so or libtcl.a:
+# Directory in which to install the .a or .so binary for the Tk library:
LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
-# Path name to use when installing library scripts.
-SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)
-# Directory in which to install the include file tcl.h:
+# Directory in which to install the include file tk.h:
INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
-# Top-level directory in which to install manual entries:
+# Top-level directory for manual entries:
MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir)
-# Directory in which to install manual entry for tclsh:
+# Directory in which to install manual entry for wish:
MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
-# Directory in which to install manual entries for Tcl's C library
+# 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:
+# Tcl commands implemented by Tk:
MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
-# Package search path.
-TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@
+# 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@
+
+# The linker flags needed to link in the Tcl library (ex: -ltcl8.2)
+TCL_LIB_FLAG = @TCL_LIB_FLAG@
# Libraries built with optimization switches have this additional extension
-TCL_DBGX = @TCL_DBGX@
+TK_DBGX = @TK_DBGX@
+
+# Flag, 1: we're building a shared lib, 0 we're not
+TK_SHARED_BUILD = @TK_SHARED_BUILD@
+
+# Directory in which to install the pkgIndex.tcl file for loadable Tk
+PKG_INSTALL_DIR = $(LIB_INSTALL_DIR)/tk$(VERSION)$(TK_DBGX)
+
+# Package index file for loadable Tk
+PKG_INDEX = $(PKG_INSTALL_DIR)/pkgIndex.tcl
# warning flags
CFLAGS_WARNING = @CFLAGS_WARNING@
@@ -97,81 +120,58 @@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
+# A "-I" switch that can be used when compiling to make all of the
+# X11 include files accessible (the configure script will try to
+# set this value, and will cause it to be an empty string if the
+# include files are accessible via /usr/include).
+X11_INCLUDES = @XINCLUDES@
+
+# Linker switch(es) to use to link with the X11 library archive (the
+# configure script will try to set this value automatically, but you
+# can override it).
+X11_LIB_SWITCHES = @XLIBSW@
+
+
+# To turn off the security checks that disallow incoming sends when
+# the X server appears to be insecure, reverse the comments on the
+# following lines:
+SECURITY_FLAGS =
+#SECURITY_FLAGS = -DTK_NO_SECURITY
+
# To disable ANSI-C procedure prototypes reverse the comment characters
# on the following lines:
PROTO_FLAGS =
#PROTO_FLAGS = -DNO_PROTOTYPE
-# Mathematical functions like sin and atan2 are enabled for expressions
-# by default. To disable them, reverse the comment characters on the
-# following pairs of lines:
-MATH_FLAGS =
-#MATH_FLAGS = -DTCL_NO_MATH
-MATH_LIBS = @MATH_LIBS@
-#MATH_LIBS =
-
-# If you use the setenv, putenv, or unsetenv procedures to modify
-# environment variables in your application and you'd like those
-# modifications to appear in the "env" Tcl variable, switch the
-# comments on the two lines below so that Tcl provides these
-# procedures instead of your standard C library.
-
-ENV_FLAGS =
-#ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv
-
-# To compile for non-UNIX systems (so that only the non-UNIX-specific
-# commands are available), reverse the comment characters on the
-# following pairs of lines. In addition, you'll have to provide your
-# own replacement for the "panic" procedure (see panic.c for what
-# the current one does).
-GENERIC_FLAGS =
-#GENERIC_FLAGS = -DTCL_GENERIC_ONLY
-UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
- tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
- tclUnixTime.o tclUnixInit.o tclUnixThrd.o
-#UNIX_OBJS =
-NOTIFY_OBJS = tclUnixNotfy.o
-#NOTIFY_OBJS =
-
# 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@
+MEM_DEBUG_FLAGS =
#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
-TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
-#TCL_STUB_LIB_FILE = libtclstub.a
-
-# Generic stub lib name used in rules that apply to tcl and tk
-STUB_LIB_FILE = ${TCL_STUB_LIB_FILE}
-
-TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@
-#TCL_STUB_LIB_FLAG = -ltclstub
-
-# To enable compilation debugging reverse the comment characters on
-# one of the following lines.
-COMPILE_DEBUG_FLAGS =
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_STATS
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+# 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
-# To compile without backward compatibility and deprecated code
-# uncomment the following
-NO_DEPRECATED_FLAGS =
-#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
+# Tk does not used deprecated Tcl constructs so it should
+# compile fine with -DTCL_NO_DEPRECATED. To remove its own
+# set of deprecated code uncomment the second line.
+NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
+#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED
# Some versions of make, like SGI's, use the following variable to
# determine which shell to use for executing commands:
SHELL = /bin/sh
-# Tcl used to let the configure script choose which program to use
+# 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_STRIP_PROGRAM = -s
-INSTALL_STRIP_LIBRARY = -S -S
-
INSTALL = @srcdir@/install-sh -c
INSTALL_PROGRAM = ${INSTALL}
INSTALL_LIBRARY = ${INSTALL}
@@ -185,48 +185,60 @@ INSTALL_DATA = ${INSTALL} -m 644
TCL_EXE = tclsh
# The symbols below provide support for dynamic loading and shared
-# libraries. See configure.in for a description of what the
-# symbols mean. The values of the symbols are normally set by the
+# 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.
-STLIB_LD = @STLIB_LD@
-SHLIB_LD = @SHLIB_LD@
SHLIB_CFLAGS = @SHLIB_CFLAGS@
-SHLIB_LD_FLAGS = @SHLIB_LD_FLAGS@
-SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
-TCL_SHLIB_LD_EXTRAS = @TCL_SHLIB_LD_EXTRAS@
-SHLIB_SUFFIX = @SHLIB_SUFFIX@
-#SHLIB_SUFFIX =
+# To enable support for stubs in Tcl.
+STUB_LIB_FILE = @TK_STUB_LIB_FILE@
-DLTEST_TARGETS = dltest.marker
+TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@
+#TK_STUB_LIB_FILE = libtkstub.a
-# 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.
-CC_SEARCH_FLAGS = @CC_SEARCH_FLAGS@
-LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@
+# Generic stub lib name used in rules that apply to tcl and tk
+STUB_LIB_FILE = ${TK_STUB_LIB_FILE}
-# The following symbol is defined to "$(DLTEST_TARGETS)" if dynamic
-# loading is available; this causes everything in the "dltest"
-# subdirectory to be built when making "tcltest. If dynamic loading
-# isn't available, configure defines this symbol to an empty string,
-# in which case the shared libraries aren't built.
-BUILD_DLTEST = @BUILD_DLTEST@
-#BUILD_DLTEST =
+TK_STUB_LIB_FLAG = @TK_STUB_LIB_FLAG@
+#TK_STUB_LIB_FLAG = -ltkstub
-TCL_LIB_FILE = @TCL_LIB_FILE@
-#TCL_LIB_FILE = libtcl.a
+TK_LIB_FILE = @TK_LIB_FILE@
+#TK_LIB_FILE = libtk.a
# Generic lib name used in rules that apply to tcl and tk
-LIB_FILE = ${TCL_LIB_FILE}
+LIB_FILE = ${TK_LIB_FILE}
-TCL_LIB_FLAG = @TCL_LIB_FLAG@
-#TCL_LIB_FLAG = -ltcl
+TK_LIB_FLAG = @TK_LIB_FLAG@
+#TK_LIB_FLAG = -ltk
+
+TCL_LIB_SPEC = @TCL_LIB_SPEC@
+TCL_STUB_LIB_SPEC = @TCL_STUB_LIB_SPEC@
+TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@
+TK_EXP_FILE = @TK_EXP_FILE@
+TK_BUILD_EXP_FILE = @TK_BUILD_EXP_FILE@
-TCL_EXP_FILE = @TCL_EXP_FILE@
-TCL_BUILD_EXP_FILE = @TCL_BUILD_EXP_FILE@
+TCL_STUB_FLAGS = @TCL_STUB_FLAGS@
+
+# Libraries to use when linking. This definition is determined by the
+# configure script.
+LIBS = @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@
+WISH_LIBS = $(TCL_LIB_SPEC) @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@
+
+# 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.
+
+STLIB_LD = @STLIB_LD@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
+TK_SHLIB_LD_EXTRAS = @TK_SHLIB_LD_EXTRAS@
+
+# 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.
+CC_SEARCH_FLAGS = @CC_SEARCH_FLAGS@
+LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@
# support for embedded libraries on Darwin / Mac OS X
DYLIB_INSTALL_DIR = ${LIB_RUNTIME_DIR}
@@ -237,38 +249,15 @@ DYLIB_INSTALL_DIR = ${LIB_RUNTIME_DIR}
# modify any of this stuff by hand.
#----------------------------------------------------------------
-COMPAT_OBJS = @LIBOBJS@
-
AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
AR = @AR@
RANLIB = @RANLIB@
-SRC_DIR = @srcdir@
+SRC_DIR = @srcdir@/..
TOP_DIR = @srcdir@/..
GENERIC_DIR = $(TOP_DIR)/generic
-COMPAT_DIR = $(TOP_DIR)/compat
-TOOL_DIR = $(TOP_DIR)/tools
-UNIX_DIR = $(TOP_DIR)/unix
-MAC_OSX_DIR = $(TOP_DIR)/macosx
-# Must be absolute because of the cd dltest $(DLTEST_DIR)/configure below.
-DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest
-# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
-TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library
-
-CC = @CC@
-#CC = purify -best-effort @CC@ -DPURIFY
-
-# Flags to be passed to mkLinks to control whether the manpages
-# should be compressed and linked with softlinks
-MKLINKS_FLAGS = @MKLINKS_FLAGS@
-
-#----------------------------------------------------------------
-# The information below is usually usable as is. The configure
-# script won't modify it and it only exists to make working
-# around selected rare system configurations easier.
-#----------------------------------------------------------------
-
-GDB = gdb
-DDD = ddd
+UNIX_DIR = @srcdir@
+BMAP_DIR = $(TOP_DIR)/bitmaps
+TOOL_DIR = @TCL_SRC_DIR@/tools
#----------------------------------------------------------------
# The information below should be usable as is. The configure
@@ -276,184 +265,139 @@ DDD = ddd
# either.
#----------------------------------------------------------------
+# Flags to be passed to mkLinks to control whether the manpages
+# should be compressed and linked with softlinks
+MKLINKS_FLAGS = @MKLINKS_FLAGS@
+
+CC = @CC@
-CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
--I${GENERIC_DIR} -I${SRC_DIR} \
-${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
-${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} ${ENV_FLAGS} \
--DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
-
-STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
--I${GENERIC_DIR} -I${SRC_DIR} \
-${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
-${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
-
-LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS)
-
-DEPEND_SWITCHES = ${CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
-${AC_FLAGS} ${MATH_FLAGS} \
-${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
--DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
-
-TCLSH_OBJS = tclAppInit.o
-
-TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
- tclThreadTest.o tclUnixTest.o
-
-XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
- tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o
-
-GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
- tclAsync.o tclBasic.o tclBinary.o \
- tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
- tclCompCmds.o tclCompExpr.o tclCompile.o tclDate.o tclEncoding.o \
- tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
- tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
- tclIOGT.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
- tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
- tclObj.o tclPanic.o tclParse.o tclParseExpr.o tclPipe.o \
- tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o tclRegexp.o \
- tclResolve.o tclResult.o tclScan.o tclStringObj.o tclThread.o \
- tclThreadAlloc.o tclThreadJoin.o tclStubInit.o tclStubLib.o \
- tclTimer.o tclUtf.o tclUtil.o tclVar.o
-
-STUB_LIB_OBJS = tclStubLib.o ${COMPAT_OBJS}
-
-OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
- @DL_OBJS@ @PLAT_OBJS@
-
-TCL_DECLS = \
- $(GENERIC_DIR)/tcl.decls \
- $(GENERIC_DIR)/tclInt.decls
-
-GENERIC_HDRS = \
- $(GENERIC_DIR)/tcl.h \
- $(GENERIC_DIR)/tclDecls.h \
- $(GENERIC_DIR)/tclInt.h \
- $(GENERIC_DIR)/tclIntDecls.h \
- $(GENERIC_DIR)/tclIntPlatDecls.h \
- $(GENERIC_DIR)/tclPatch.h \
- $(GENERIC_DIR)/tclPlatDecls.h \
- $(GENERIC_DIR)/tclPort.h \
- $(GENERIC_DIR)/tclRegexp.h
-
-GENERIC_SRCS = \
- $(GENERIC_DIR)/regcomp.c \
- $(GENERIC_DIR)/regexec.c \
- $(GENERIC_DIR)/regfree.c \
- $(GENERIC_DIR)/regerror.c \
- $(GENERIC_DIR)/tclAlloc.c \
- $(GENERIC_DIR)/tclAsync.c \
- $(GENERIC_DIR)/tclBasic.c \
- $(GENERIC_DIR)/tclBinary.c \
- $(GENERIC_DIR)/tclCkalloc.c \
- $(GENERIC_DIR)/tclClock.c \
- $(GENERIC_DIR)/tclCmdAH.c \
- $(GENERIC_DIR)/tclCmdIL.c \
- $(GENERIC_DIR)/tclCmdMZ.c \
- $(GENERIC_DIR)/tclCompCmds.c \
- $(GENERIC_DIR)/tclCompExpr.c \
- $(GENERIC_DIR)/tclCompile.c \
- $(GENERIC_DIR)/tclDate.c \
- $(GENERIC_DIR)/tclEncoding.c \
- $(GENERIC_DIR)/tclEnv.c \
- $(GENERIC_DIR)/tclEvent.c \
- $(GENERIC_DIR)/tclExecute.c \
- $(GENERIC_DIR)/tclFCmd.c \
- $(GENERIC_DIR)/tclFileName.c \
- $(GENERIC_DIR)/tclGet.c \
- $(GENERIC_DIR)/tclHash.c \
- $(GENERIC_DIR)/tclHistory.c \
- $(GENERIC_DIR)/tclIndexObj.c \
- $(GENERIC_DIR)/tclInterp.c \
- $(GENERIC_DIR)/tclIO.c \
- $(GENERIC_DIR)/tclIOCmd.c \
- $(GENERIC_DIR)/tclIOGT.c \
- $(GENERIC_DIR)/tclIOSock.c \
- $(GENERIC_DIR)/tclIOUtil.c \
- $(GENERIC_DIR)/tclLink.c \
- $(GENERIC_DIR)/tclListObj.c \
- $(GENERIC_DIR)/tclLiteral.c \
- $(GENERIC_DIR)/tclLoad.c \
- $(GENERIC_DIR)/tclMain.c \
- $(GENERIC_DIR)/tclNamesp.c \
- $(GENERIC_DIR)/tclNotify.c \
- $(GENERIC_DIR)/tclObj.c \
- $(GENERIC_DIR)/tclParse.c \
- $(GENERIC_DIR)/tclParseExpr.c \
- $(GENERIC_DIR)/tclPipe.c \
- $(GENERIC_DIR)/tclPkg.c \
- $(GENERIC_DIR)/tclPosixStr.c \
- $(GENERIC_DIR)/tclPreserve.c \
- $(GENERIC_DIR)/tclProc.c \
- $(GENERIC_DIR)/tclRegexp.c \
- $(GENERIC_DIR)/tclResolve.c \
- $(GENERIC_DIR)/tclResult.c \
- $(GENERIC_DIR)/tclScan.c \
- $(GENERIC_DIR)/tclStubInit.c \
- $(GENERIC_DIR)/tclStubLib.c \
- $(GENERIC_DIR)/tclStringObj.c \
- $(GENERIC_DIR)/tclTest.c \
- $(GENERIC_DIR)/tclTestObj.c \
- $(GENERIC_DIR)/tclTestProcBodyObj.c \
- $(GENERIC_DIR)/tclThread.c \
- $(GENERIC_DIR)/tclThreadAlloc.c \
- $(GENERIC_DIR)/tclThreadJoin.c \
- $(GENERIC_DIR)/tclTimer.c \
- $(GENERIC_DIR)/tclUtil.c \
- $(GENERIC_DIR)/tclVar.c
-
-STUB_SRCS = \
- $(GENERIC_DIR)/tclStubLib.c
-
-UNIX_HDRS = \
- $(UNIX_DIR)/tclUnixPort.h
-
-UNIX_SRCS = \
- $(UNIX_DIR)/tclAppInit.c \
- $(UNIX_DIR)/tclUnixChan.c \
- $(UNIX_DIR)/tclUnixEvent.c \
- $(UNIX_DIR)/tclUnixFCmd.c \
- $(UNIX_DIR)/tclUnixFile.c \
- $(UNIX_DIR)/tclUnixNotfy.c \
- $(UNIX_DIR)/tclUnixPipe.c \
- $(UNIX_DIR)/tclUnixSock.c \
- $(UNIX_DIR)/tclUnixTest.c \
- $(UNIX_DIR)/tclUnixThrd.c \
- $(UNIX_DIR)/tclUnixTime.c \
- $(UNIX_DIR)/tclUnixInit.c
-
-DL_SRCS = \
- $(UNIX_DIR)/tclLoadAix.c \
- $(UNIX_DIR)/tclLoadAout.c \
- $(UNIX_DIR)/tclLoadDl.c \
- $(UNIX_DIR)/tclLoadDl2.c \
- $(UNIX_DIR)/tclLoadDld.c \
- $(UNIX_DIR)/tclLoadDyld.c \
- $(GENERIC_DIR)/tclLoadNone.c \
- $(UNIX_DIR)/tclLoadOSF.c \
- $(UNIX_DIR)/tclLoadShl.c
-
-MAC_OSX_SRCS = \
- $(MAC_OSX_DIR)/tclMacOSXBundle.c
-
-# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those
-# files won't compile on the current machine, and they will cause
-# problems for things like "make depend".
-
-SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(STUB_SRCS)
+CC_SWITCHES_NO_STUBS = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
+-I${UNIX_DIR} -I${GENERIC_DIR} \
+-I${BMAP_DIR} -I${TCL_GENERIC_DIR} ${X11_INCLUDES} \
+${AC_FLAGS} ${PROTO_FLAGS} \
+${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} ${NO_DEPRECATED_FLAGS}
+
+CC_SWITCHES = ${CC_SWITCHES_NO_STUBS} ${TCL_STUB_FLAGS}
+
+DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
+-I${BMAP_DIR} \
+-I${TCL_GENERIC_DIR} ${X11_INCLUDES} \
+${AC_FLAGS} ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} \
+${KEYSYM_FLAGS}
+
+WISH_OBJS = tkAppInit.o
+
+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 \
+ tkPanedWindow.o tkScale.o tkScrollbar.o
+
+CANVOBJS = tkCanvas.o tkCanvArc.o tkCanvBmap.o tkCanvImg.o \
+ tkCanvLine.o tkCanvPoly.o tkCanvPs.o tkCanvText.o \
+ tkCanvUtil.o tkCanvWind.o tkRectOval.o tkTrig.o
+
+IMAGEOBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPPM.o tkImgPhoto.o
+
+TEXTOBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \
+ tkTextMark.o tkTextTag.o tkTextWind.o
+
+UNIXOBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixConfig.o \
+ tkUnixCursor.o tkUnixDraw.o tkUnixEmbed.o tkUnixEvent.o \
+ tkUnixFocus.o tkUnixFont.o tkUnixInit.o tkUnixKey.o tkUnixMenu.o \
+ tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o tkUnixSelect.o \
+ tkUnixSend.o tkUnixWm.o tkUnixXId.o tkStubInit.o tkStubLib.o
+
+STUB_LIB_OBJS = tkStubLib.o tkStubImg.o
+
+OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o tkCmds.o \
+ tkColor.o tkConfig.o tkConsole.o tkCursor.o tkError.o tkEvent.o \
+ tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o tkGrid.o \
+ tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \
+ tkSelect.o tkStyle.o tkUndo.o tkUtil.o tkVisual.o tkWindow.o \
+ $(UNIXOBJS) $(WIDGOBJS) $(CANVOBJS) $(IMAGEOBJS) $(TEXTOBJS)
+
+TK_DECLS = \
+ $(GENERIC_DIR)/tk.decls \
+ $(GENERIC_DIR)/tkInt.decls
+
+SRCS = \
+ $(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \
+ $(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c \
+ $(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkClipboard.c \
+ $(GENERIC_DIR)/tkCmds.c $(GENERIC_DIR)/tkColor.c \
+ $(GENERIC_DIR)/tkConfig.c $(GENERIC_DIR)/tkCursor.c \
+ $(GENERIC_DIR)/tkError.c $(GENERIC_DIR)/tkEvent.c \
+ $(GENERIC_DIR)/tkFocus.c $(GENERIC_DIR)/tkFont.c \
+ $(GENERIC_DIR)/tkGet.c $(GENERIC_DIR)/tkGC.c \
+ $(GENERIC_DIR)/tkGeometry.c $(GENERIC_DIR)/tkGrab.c \
+ $(GENERIC_DIR)/tkGrid.c $(GENERIC_DIR)/tkConsole.c \
+ $(GENERIC_DIR)/tkMain.c $(GENERIC_DIR)/tkOption.c \
+ $(GENERIC_DIR)/tkPack.c $(GENERIC_DIR)/tkPlace.c \
+ $(GENERIC_DIR)/tkSelect.c $(GENERIC_DIR)/tkStyle.c \
+ $(GENERIC_DIR)/tkUndo.c $(GENERIC_DIR)/tkUtil.c \
+ $(GENERIC_DIR)/tkVisual.c $(GENERIC_DIR)/tkWindow.c \
+ $(GENERIC_DIR)/tkButton.c $(GENERIC_DIR)/tkObj.c \
+ $(GENERIC_DIR)/tkEntry.c $(GENERIC_DIR)/tkFrame.c \
+ $(GENERIC_DIR)/tkListbox.c $(GENERIC_DIR)/tkMenu.c \
+ $(GENERIC_DIR)/tkMenubutton.c $(GENERIC_DIR)/tkMenuDraw.c \
+ $(GENERIC_DIR)/tkMessage.c $(GENERIC_DIR)/tkPanedWindow.c \
+ $(GENERIC_DIR)/tkScale.c $(GENERIC_DIR)/tkScrollbar.c \
+ $(GENERIC_DIR)/tkCanvas.c $(GENERIC_DIR)/tkCanvArc.c \
+ $(GENERIC_DIR)/tkCanvBmap.c $(GENERIC_DIR)/tkCanvImg.c \
+ $(GENERIC_DIR)/tkCanvLine.c $(GENERIC_DIR)/tkCanvPoly.c \
+ $(GENERIC_DIR)/tkCanvPs.c $(GENERIC_DIR)/tkCanvText.c \
+ $(GENERIC_DIR)/tkCanvUtil.c \
+ $(GENERIC_DIR)/tkCanvWind.c $(GENERIC_DIR)/tkRectOval.c \
+ $(GENERIC_DIR)/tkTrig.c $(GENERIC_DIR)/tkImage.c \
+ $(GENERIC_DIR)/tkImgBmap.c $(GENERIC_DIR)/tkImgGIF.c \
+ $(GENERIC_DIR)/tkImgPPM.c \
+ $(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkText.c \
+ $(GENERIC_DIR)/tkTextBTree.c $(GENERIC_DIR)/tkTextDisp.c \
+ $(GENERIC_DIR)/tkTextImage.c \
+ $(GENERIC_DIR)/tkTextIndex.c $(GENERIC_DIR)/tkTextMark.c \
+ $(GENERIC_DIR)/tkTextTag.c $(GENERIC_DIR)/tkTextWind.c \
+ $(GENERIC_DIR)/tkOldConfig.c \
+ $(GENERIC_DIR)/tkSquare.c $(GENERIC_DIR)/tkTest.c \
+ $(GENERIC_DIR)/tkStubInit.c $(GENERIC_DIR)/tkStubLib.c \
+ $(UNIX_DIR)/tkAppInit.c $(UNIX_DIR)/tkUnix.c \
+ $(UNIX_DIR)/tkUnix3d.c \
+ $(UNIX_DIR)/tkUnixButton.c $(UNIX_DIR)/tkUnixColor.c \
+ $(UNIX_DIR)/tkUnixConfig.c \
+ $(UNIX_DIR)/tkUnixCursor.c \
+ $(UNIX_DIR)/tkUnixDraw.c \
+ $(UNIX_DIR)/tkUnixEmbed.c $(UNIX_DIR)/tkUnixEvent.c \
+ $(UNIX_DIR)/tkUnixFocus.c \
+ $(UNIX_DIR)/tkUnixFont.c $(UNIX_DIR)/tkUnixInit.c \
+ $(UNIX_DIR)/tkUnixKey.c \
+ $(UNIX_DIR)/tkUnixMenu.c $(UNIX_DIR)/tkUnixMenubu.c \
+ $(UNIX_DIR)/tkUnixScale.c $(UNIX_DIR)/tkUnixScrlbr.c \
+ $(UNIX_DIR)/tkUnixSelect.c \
+ $(UNIX_DIR)/tkUnixSend.c $(UNIX_DIR)/tkUnixWm.c \
+ $(UNIX_DIR)/tkUnixXId.c
+
+
+HDRS = bltList.h \
+ default.h ks_names.h tkPatch.h tk.h tkButton.h tkCanvas.h tkInt.h \
+ tkPort.h tkScrollbar.h tkText.h
+
+DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget
all: binaries libraries doc
-binaries: ${LIB_FILE} $(STUB_LIB_FILE) $(TCL_BUILD_EXP_FILE) tclsh
+binaries: ${LIB_FILE} ${STUB_LIB_FILE} wish
libraries:
-doc:
+$(SRC_DIR)/doc/man.macros:
+ chmod +x $(UNIX_DIR)/install-sh
+ $(INSTALL_DATA) @TCL_SRC_DIR@/doc/man.macros $(SRC_DIR)/doc/man.macros
+
+doc: $(SRC_DIR)/doc/man.macros
# The following target is configured by autoconf to generate either
-# a shared library or non-shared library for Tcl.
-${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE}
+# a shared library or non-shared library for Tk.
+${LIB_FILE}: ${OBJS}
rm -f $@
@MAKE_LIB@
@@ -461,33 +405,44 @@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
rm -f $@
@MAKE_STUB_LIB@
-# Make target which outputs the list of the .o contained in the Tcl lib
-# usefull to build a single big shared library containing Tcl and other
+# 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
-# The dependency on OBJS is not there because we just want the list
-# of objects here, not actually building them
-tclLibObjs:
+tkLibObjs:
@echo ${OBJS}
+
# This targets actually build the objects needed for the lib in the above
# case
objs: ${OBJS}
-tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
- ${CC} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
- ${CC_SEARCH_FLAGS} -o tclsh
+wish: $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE)
+ $(CC) $(LDFLAGS) $(WISH_OBJS) \
+ @TK_BUILD_LIB_SPEC@ \
+ $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o wish
# Resetting the LIB_RUNTIME_DIR below is required so that
-# the generated tcltest executable gets the build directory
-# burned into its ld search path. This keeps tcltest from
-# picking up an already installed version of the Tcl library.
-
-tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}
- $(MAKE) tcltest-real LIB_RUNTIME_DIR=`pwd`
-
-tcltest-real:
- ${CC} ${LDFLAGS} ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
- ${CC_SEARCH_FLAGS} -o tcltest
+# the generated tktest executable gets the build directory
+# burned into its ld search path. This keeps tktest from
+# picking up an already installed version of the Tcl or
+# Tk shared libraries.
+
+tktest: $(TKTEST_OBJS) $(TK_LIB_FILE)
+ $(MAKE) tktest-real LIB_RUNTIME_DIR=`pwd`:$(TCL_BIN_DIR)
+
+tktest-real:
+ ${CC} $(LDFLAGS) $(TKTEST_OBJS) \
+ @TK_BUILD_LIB_SPEC@ \
+ $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o tktest
+
+# FIXME: This xttest rule seems to be broken in a number of ways.
+# It should use CC_SEARCH_FLAGS, it does not include the shared
+# lib location logic from tktest, and it is not clear where this
+# test.o object file comes from.
+xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
+ ${CC} $(LDFLAGS) test.o tkTest.o tkSquare.o \
+ @TK_BUILD_LIB_SPEC@ \
+ $(WISH_LIBS) $(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
@@ -496,93 +451,54 @@ tcltest-real:
# args to tcltest, ie:
# % make test TESTFLAGS="-verbose bps -file fileName.test"
-test: tcltest
- @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
- ./tcltest $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) $(TCLTESTARGS)
-
-# Useful target to launch a built tcltest with the proper path,...
-runtest: tcltest
- @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
- ./tcltest
-
-# Useful target for running the test suite with an unwritable current
-# directory...
-ro-test: tcltest
- @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
- echo 'exec chmod -w .;package require tcltest;tcltest::temporaryDirectory /tmp;source ../tests/all.tcl;exec chmod +w .' | ./tcltest
-
-# This target can be used to run tclsh from the build directory
-# via `make shell SCRIPT=/tmp/foo.tcl`
-shell: tclsh
- @@LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
- ./tclsh $(SCRIPT)
-
-# This target can be used to run tclsh inside either gdb or insight
-gdb: tclsh
- @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}" > gdb.run
- @echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
- $(GDB) ./tclsh --command=gdb.run
- rm gdb.run
+test: tktest
+ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
+ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
+ ./tktest $(TOP_DIR)/tests/all.tcl -geometry +0+0 \
+ $(TESTFLAGS) $(TCLTESTARGS)
+
+# Tests with different languages
+testlang: tktest
+ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
+ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
+ for lang in $(LOCALES) ; \
+ do \
+ LANG=$(lang); export LANG; \
+ ./tktest $(TOP_DIR)/tests/all.tcl -geometry +0+0 \
+ $(TESTFLAGS) $(TCLTESTARGS); \
+ done
-# This target can be used to run tclsh inside ddd
-ddd: tclsh
- @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}" > gdb.run
- @echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
- $(DDD) -command=gdb.run ./tclsh
+# Useful target to launch a built tktest with the proper path,...
+runtest: tktest
+ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
+ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
+ ./tktest
+
+# This target can be used to run wish from the build directory
+# via `make shell` or `make shell SCRIPT=/tmp/foo.tcl`
+shell: wish
+ @LD_LIBRARY_PATH_VAR@=`pwd`:${TCL_BIN_DIR}:${@LD_LIBRARY_PATH_VAR@}; \
+ export @LD_LIBRARY_PATH_VAR@; \
+ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
+ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
+ ./wish $(SCRIPT)
+
+# This target can be used to run wish inside either gdb or insight
+gdb: wish
+ @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:${TCL_BIN_DIR}:${@LD_LIBRARY_PATH_VAR@}" > gdb.run
+ @echo "set env TCL_LIBRARY=@TCL_SRC_DIR@/library" >> gdb.run
+ @echo "set env TK_LIBRARY=@TK_SRC_DIR@/library" >> gdb.run
+ gdb ./wish --command=gdb.run
rm gdb.run
-# The following target outputs the name of the top-level source directory
-# for Tcl (it is used by Tk's configure script, for example). The
-# .NO_PARALLEL line is needed to avoid problems under Sun's "pmake".
-# Note: this target is now obsolete (use the autoconf variable
-# TCL_SRC_DIR from tclConfig.sh instead).
-
-.NO_PARALLEL: topDirName
-topDirName:
- @cd $(TOP_DIR); pwd
-
-# The following target generates the file generic/tclDate.c
-# from the yacc grammar found in generic/tclGetDate.y. This is
-# only run by hand as yacc is not available in all environments.
-# The name of the .c file is different than the name of the .y file
-# so that make doesn't try to automatically regenerate the .c file.
-
-gendate:
- yacc -l $(GENERIC_DIR)/tclGetDate.y
- sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
- -e 's?SCCSID?RCS: @(#) ?' \
- -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
- -e '/TclDatenewstate:/d' -e '/#pragma/d' \
- -e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \
- <y.tab.c >$(GENERIC_DIR)/tclDate.c
- rm y.tab.c
-
-# The following target generates the shared libraries in dltest/ that
-# are used for testing; they are included as part of the "tcltest"
-# target (via the BUILD_DLTEST variable) if dynamic loading is supported
-# on this platform. The Makefile in the dltest subdirectory creates
-# the dltest.marker file in this directory after a successful build.
-
-dltest.marker:
- cd dltest ; $(MAKE)
-
-install: install-binaries install-libraries install-doc
-
-install-strip:
- $(MAKE) install \
- INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \
- INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}"
+install: all install-binaries install-libraries install-demos install-doc
# 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: binaries
- @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
+install-binaries: $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) $(TK_BUILD_EXP_FILE) wish
+ @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) $(PKG_INSTALL_DIR); \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
@@ -591,28 +507,40 @@ install-binaries: binaries
else true; \
fi; \
done;
- @if test ! -x $(SRC_DIR)/install-sh; then \
- chmod +x $(SRC_DIR)/install-sh; \
+ @if test ! -x $(UNIX_DIR)/install-sh; then \
+ chmod +x $(UNIX_DIR)/install-sh; \
+ fi
+ @if test "x$(TK_SHARED_BUILD)" = "x1"; then \
+ echo "Creating package index $(PKG_INDEX)"; \
+ rm -f $(PKG_INDEX); \
+ (\
+ echo "if {[package vcompare [package provide Tcl]\
+ $(TCLVERSION)] != 0} { return }";\
+ echo "package ifneeded Tk $(VERSION)\
+ [list load [file join \$$dir .. $(TK_LIB_FILE)] Tk]";\
+ ) > $(PKG_INDEX); \
fi
@echo "Installing $(LIB_FILE) to $(LIB_INSTALL_DIR)/"
@@INSTALL_LIB@
@chmod 555 $(LIB_INSTALL_DIR)/$(LIB_FILE)
- @if test "$(TCL_BUILD_EXP_FILE)" != ""; then \
- echo "Installing $(TCL_EXP_FILE) to $(LIB_INSTALL_DIR)/"; \
- $(INSTALL_DATA) $(TCL_BUILD_EXP_FILE) \
- $(LIB_INSTALL_DIR)/$(TCL_EXP_FILE); \
- fi
- @echo "Installing tclsh as $(BIN_INSTALL_DIR)/tclsh$(VERSION)"
- @$(INSTALL_PROGRAM) tclsh $(BIN_INSTALL_DIR)/tclsh$(VERSION)
- @echo "Installing tclConfig.sh to $(LIB_INSTALL_DIR)/"
- @$(INSTALL_DATA) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
+ @echo "Installing wish as $(BIN_INSTALL_DIR)/wish$(VERSION)"
+ @$(INSTALL_PROGRAM) wish $(BIN_INSTALL_DIR)/wish$(VERSION)
+ @echo "Installing tkConfig.sh to $(LIB_INSTALL_DIR)/"
+ @$(INSTALL_DATA) tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh
+ @if test "$(TK_BUILD_EXP_FILE)" != ""; then \
+ echo "Installing $(TK_EXP_FILE) to $(LIB_INSTALL_DIR)/"; \
+ $(INSTALL_DATA) $(TK_BUILD_EXP_FILE) \
+ $(LIB_INSTALL_DIR)/$(TK_EXP_FILE); \
+ fi
@if test "$(STUB_LIB_FILE)" != "" ; then \
echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
@INSTALL_STUB_LIB@ ; \
fi
-install-libraries: libraries
- @for i in $(INCLUDE_INSTALL_DIR) $(SCRIPT_INSTALL_DIR); \
+install-libraries:
+ @for i in $(INCLUDE_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images \
+ $(SCRIPT_INSTALL_DIR)/msgs; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
@@ -621,60 +549,69 @@ install-libraries: libraries
else true; \
fi; \
done;
- @for i in http2.4 http1.0 opt0.4 encoding msgcat1.3 tcltest2.2; \
- do \
- if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
- echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- mkdir -p $(SCRIPT_INSTALL_DIR)/$$i; \
- chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
- else true; \
- fi; \
- done;
- @if test ! -x $(SRC_DIR)/install-sh; then \
- chmod +x $(SRC_DIR)/install-sh; \
+ @if test ! -x $(UNIX_DIR)/install-sh; then \
+ chmod +x $(UNIX_DIR)/install-sh; \
fi
@echo "Installing header files";
- @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
- $(GENERIC_DIR)/tclPlatDecls.h ; \
+ @for i in $(GENERIC_DIR)/tk.h $(GENERIC_DIR)/tkDecls.h \
+ $(GENERIC_DIR)/tkPlatDecls.h ; \
do \
$(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
done;
@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
- @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
+ @for i in $(SRC_DIR)/library/*.tcl $(GENERIC_DIR)/prolog.ps \
+ $(SRC_DIR)/library/tclIndex $(UNIX_DIR)/tkAppInit.c; \
do \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
- @echo "Installing library http1.0 directory";
- @for j in $(TOP_DIR)/library/http1.0/*.tcl ; \
+ @echo "Installing library images directory";
+ @for i in $(SRC_DIR)/library/images/*; \
do \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http1.0; \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/images; \
+ fi; \
done;
- @echo "Installing library http2.4 directory";
- @for j in $(TOP_DIR)/library/http/*.tcl ; \
+ @echo "Installing translation directory";
+ @for i in $(SRC_DIR)/library/msgs/*.msg; \
do \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http2.4; \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/msgs; \
+ fi; \
+ done;
+
+install-demos:
+ @for i in $(SCRIPT_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR)/demos \
+ $(SCRIPT_INSTALL_DIR)/demos/images ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir -p $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
done;
- @echo "Installing library opt0.4 directory";
- @for j in $(TOP_DIR)/library/opt/*.tcl ; \
+ @echo "Installing demos to $(SCRIPT_INSTALL_DIR)/demos/";
+ @for i in $(SRC_DIR)/library/demos/*; \
do \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/opt0.4; \
+ if [ -f $$i ] ; then \
+ sed -e '3 s|exec wish|exec wish$(VERSION)|' \
+ $$i > $(SCRIPT_INSTALL_DIR)/demos/`basename $$i`; \
+ fi; \
done;
- @echo "Installing library msgcat1.3 directory";
- @for j in $(TOP_DIR)/library/msgcat/*.tcl ; \
+ @for i in $(DEMOPROGS); \
do \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/msgcat1.3; \
+ chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
done;
- @echo "Installing library tcltest2.2 directory";
- @for j in $(TOP_DIR)/library/tcltest/*.tcl ; \
+ @echo "Installing demo images";
+ @for i in $(SRC_DIR)/library/demos/images/*; \
do \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/tcltest2.2; \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \
+ fi; \
done;
- @echo "Installing library encoding directory";
- @for i in $(TOP_DIR)/library/encoding/*.enc ; do \
- $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/encoding; \
- done;
-install-doc: doc
+install-doc:
@if test ! -x $(UNIX_DIR)/mkLinks; then \
chmod +x $(UNIX_DIR)/mkLinks; \
fi
@@ -688,7 +625,7 @@ install-doc: doc
fi; \
done;
@echo "Installing top-level (.1) docs";
- @cd $(TOP_DIR)/doc; for i in *.1; \
+ @cd $(SRC_DIR)/doc; for i in *.1; \
do \
rm -f $(MAN1_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
@@ -698,17 +635,17 @@ install-doc: doc
@echo "Cross-linking top-level (.1) docs";
@$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MAN1_INSTALL_DIR)
@echo "Installing C API (.3) docs";
- @cd $(TOP_DIR)/doc; for i in *.3; \
+ @cd $(SRC_DIR)/doc; for i in *.3; \
do \
rm -f $(MAN3_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN3_INSTALL_DIR)/$$i; \
chmod 444 $(MAN3_INSTALL_DIR)/$$i; \
done;
- @echo "Cross-linking C API (.3) docs";
+ @echo "Cross-linking top-level (.3) docs";
@$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MAN3_INSTALL_DIR)
@echo "Installing command (.n) docs";
- @cd $(TOP_DIR)/doc; for i in *.n; \
+ @cd $(SRC_DIR)/doc; for i in *.n; \
do \
rm -f $(MANN_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
@@ -718,413 +655,357 @@ install-doc: doc
@echo "Cross-linking command (.n) docs";
@$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MANN_INSTALL_DIR)
-Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
+Makefile: $(UNIX_DIR)/Makefile.in
$(SHELL) config.status
clean:
- rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
- errors tclsh tcltest lib.exp
- cd dltest ; $(MAKE) clean
+ rm -f *.a *.o libtk* core errs *~ \#* TAGS *.E a.out errors \
+ tktest wish config.info lib.exp
distclean: clean
- rm -rf Makefile config.status config.cache config.log tclConfig.sh \
+ rm -f Makefile config.status config.cache config.log tkConfig.sh \
$(PACKAGE).* prototype
- cd dltest ; $(MAKE) distclean
depend:
makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)
-# Test binaries. The rules for tclTestInit.o and xtTestInit.o are
-# complicated because they are compiled from tclAppInit.c. Can't use
-# the "-o" option because this doesn't work on some strange compilers
-# (e.g. UnixWare).
-
-tclTestInit.o: $(UNIX_DIR)/tclAppInit.c
- @if test -f tclAppInit.o ; then \
- rm -f tclAppInit.sav; \
- mv tclAppInit.o tclAppInit.sav; \
- fi;
- $(CC) -c $(CC_SWITCHES) \
- -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
- -DTCL_TEST $(UNIX_DIR)/tclAppInit.c
- rm -f tclTestInit.o
- mv tclAppInit.o tclTestInit.o
- @if test -f tclAppInit.sav ; then \
- mv tclAppInit.sav tclAppInit.o; \
- fi;
+# 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).
-xtTestInit.o: $(UNIX_DIR)/tclAppInit.c
- @if test -f tclAppInit.o ; then \
- rm -f tclAppInit.sav; \
- mv tclAppInit.o tclAppInit.sav; \
+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) \
- -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
- -DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
- rm -f xtTestInit.o
- mv tclAppInit.o xtTestInit.o
- @if test -f tclAppInit.sav ; then \
- mv tclAppInit.sav tclAppInit.o; \
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) -DTK_TEST $(UNIX_DIR)/tkAppInit.c
+ rm -f tkTestInit.o
+ mv tkAppInit.o tkTestInit.o
+ @if test -f tkAppInit.sav ; then \
+ mv tkAppInit.sav tkAppInit.o; \
fi;
-# Object files used on all Unix systems:
-
-REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
- $(GENERIC_DIR)/regcustom.h
-regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
- $(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
- $(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c
-
-regexec.o: $(REGHDRS) $(GENERIC_DIR)/regexec.c $(GENERIC_DIR)/rege_dfa.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regexec.c
-
-regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c
+tkAppInit.o: $(UNIX_DIR)/tkAppInit.c
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) $(UNIX_DIR)/tkAppInit.c
-regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c
+tk3d.o: $(GENERIC_DIR)/tk3d.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tk3d.c
-tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
+tkArgv.o: $(GENERIC_DIR)/tkArgv.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkArgv.c
-# On unix we want to use the normal malloc/free implementation, so we
-# specifically set the USE_TCLALLOC flag.
+tkAtom.o: $(GENERIC_DIR)/tkAtom.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkAtom.c
-tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
- $(CC) -c $(CC_SWITCHES) -DUSE_TCLALLOC=0 $(GENERIC_DIR)/tclAlloc.c
+tkBind.o: $(GENERIC_DIR)/tkBind.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBind.c
-tclAsync.o: $(GENERIC_DIR)/tclAsync.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c
+tkBitmap.o: $(GENERIC_DIR)/tkBitmap.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBitmap.c
-tclBasic.o: $(GENERIC_DIR)/tclBasic.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBasic.c
+tkClipboard.o: $(GENERIC_DIR)/tkClipboard.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkClipboard.c
-tclBinary.o: $(GENERIC_DIR)/tclBinary.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBinary.c
+tkCmds.o: $(GENERIC_DIR)/tkCmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCmds.c
-tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c
+tkColor.o: $(GENERIC_DIR)/tkColor.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkColor.c
-tclClock.o: $(GENERIC_DIR)/tclClock.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c
+tkConfig.o: $(GENERIC_DIR)/tkConfig.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkConfig.c
-tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c
+tkConsole.o: $(GENERIC_DIR)/tkConsole.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkConsole.c
-tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c
+tkCursor.o: $(GENERIC_DIR)/tkCursor.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCursor.c
-tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c
+tkError.o: $(GENERIC_DIR)/tkError.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkError.c
-tclDate.o: $(GENERIC_DIR)/tclDate.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c
+tkEvent.o: $(GENERIC_DIR)/tkEvent.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkEvent.c
-tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmds.c
+tkFocus.o: $(GENERIC_DIR)/tkFocus.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFocus.c
-tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompExpr.c
+tkFont.o: $(GENERIC_DIR)/tkFont.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFont.c
-tclCompile.o: $(GENERIC_DIR)/tclCompile.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompile.c
+tkGet.o: $(GENERIC_DIR)/tkGet.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGet.c
-tclEncoding.o: $(GENERIC_DIR)/tclEncoding.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEncoding.c
+tkGC.o: $(GENERIC_DIR)/tkGC.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGC.c
-tclEnv.o: $(GENERIC_DIR)/tclEnv.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c
+tkGeometry.o: $(GENERIC_DIR)/tkGeometry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGeometry.c
-tclEvent.o: $(GENERIC_DIR)/tclEvent.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c
+tkGrab.o: $(GENERIC_DIR)/tkGrab.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGrab.c
-tclExecute.o: $(GENERIC_DIR)/tclExecute.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c
+tkGrid.o: $(GENERIC_DIR)/tkGrid.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGrid.c
-tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFCmd.c
+tkMain.o: $(GENERIC_DIR)/tkMain.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMain.c
-tclFileName.o: $(GENERIC_DIR)/tclFileName.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFileName.c
+tkObj.o: $(GENERIC_DIR)/tkObj.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkObj.c
-tclGet.o: $(GENERIC_DIR)/tclGet.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclGet.c
+tkOldConfig.o: $(GENERIC_DIR)/tkOldConfig.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOldConfig.c
-tclHash.o: $(GENERIC_DIR)/tclHash.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHash.c
+tkOption.o: $(GENERIC_DIR)/tkOption.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOption.c
-tclHistory.o: $(GENERIC_DIR)/tclHistory.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHistory.c
+tkPack.o: $(GENERIC_DIR)/tkPack.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPack.c
-tclIndexObj.o: $(GENERIC_DIR)/tclIndexObj.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIndexObj.c
+tkPlace.o: $(GENERIC_DIR)/tkPlace.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPlace.c
-tclInterp.o: $(GENERIC_DIR)/tclInterp.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclInterp.c
+tkSelect.o: $(GENERIC_DIR)/tkSelect.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkSelect.c
-tclIO.o: $(GENERIC_DIR)/tclIO.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIO.c
+tkStyle.o: $(GENERIC_DIR)/tkStyle.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStyle.c
-tclIOCmd.o: $(GENERIC_DIR)/tclIOCmd.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOCmd.c
+tkUtil.o: $(GENERIC_DIR)/tkUtil.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkUtil.c
-tclIOGT.o: $(GENERIC_DIR)/tclIOGT.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOGT.c
+tkVisual.o: $(GENERIC_DIR)/tkVisual.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkVisual.c
-tclIOSock.o: $(GENERIC_DIR)/tclIOSock.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOSock.c
+tkWindow.o: $(GENERIC_DIR)/tkWindow.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkWindow.c
-tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOUtil.c
+tkButton.o: $(GENERIC_DIR)/tkButton.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkButton.c
-tclLink.o: $(GENERIC_DIR)/tclLink.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLink.c
+tkEntry.o: $(GENERIC_DIR)/tkEntry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkEntry.c
-tclListObj.o: $(GENERIC_DIR)/tclListObj.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclListObj.c
+tkFrame.o: $(GENERIC_DIR)/tkFrame.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFrame.c
-tclLiteral.o: $(GENERIC_DIR)/tclLiteral.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLiteral.c
+tkListbox.o: $(GENERIC_DIR)/tkListbox.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkListbox.c
-tclObj.o: $(GENERIC_DIR)/tclObj.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c
+tkMenu.o: $(GENERIC_DIR)/tkMenu.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenu.c
-tclLoad.o: $(GENERIC_DIR)/tclLoad.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c
+tkMenubutton.o: $(GENERIC_DIR)/tkMenubutton.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenubutton.c
-tclLoadAix.o: $(UNIX_DIR)/tclLoadAix.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAix.c
+tkMenuDraw.o: $(GENERIC_DIR)/tkMenuDraw.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenuDraw.c
-tclLoadAout.o: $(UNIX_DIR)/tclLoadAout.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAout.c
+tkMessage.o: $(GENERIC_DIR)/tkMessage.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMessage.c
-tclLoadDl.o: $(UNIX_DIR)/tclLoadDl.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl.c
+tkPanedWindow.o: $(GENERIC_DIR)/tkPanedWindow.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPanedWindow.c
-tclLoadDl2.o: $(UNIX_DIR)/tclLoadDl2.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl2.c
+tkScale.o: $(GENERIC_DIR)/tkScale.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScale.c
-tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c
+tkScrollbar.o: $(GENERIC_DIR)/tkScrollbar.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScrollbar.c
-tclLoadDyld.o: $(UNIX_DIR)/tclLoadDyld.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDyld.c
+tkSquare.o: $(GENERIC_DIR)/tkSquare.c
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkSquare.c
-tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoadNone.c
+tkCanvas.o: $(GENERIC_DIR)/tkCanvas.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvas.c
-tclLoadOSF.o: $(UNIX_DIR)/tclLoadOSF.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadOSF.c
+tkCanvArc.o: $(GENERIC_DIR)/tkCanvArc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvArc.c
-tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadShl.c
+tkCanvBmap.o: $(GENERIC_DIR)/tkCanvBmap.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvBmap.c
-tclMain.o: $(GENERIC_DIR)/tclMain.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMain.c
+tkCanvImg.o: $(GENERIC_DIR)/tkCanvImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvImg.c
-tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c
+tkCanvLine.o: $(GENERIC_DIR)/tkCanvLine.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvLine.c
-tclNotify.o: $(GENERIC_DIR)/tclNotify.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
+tkCanvPoly.o: $(GENERIC_DIR)/tkCanvPoly.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvPoly.c
-tclParse.o: $(GENERIC_DIR)/tclParse.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
+tkCanvPs.o: $(GENERIC_DIR)/tkCanvPs.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvPs.c
-tclParseExpr.o: $(GENERIC_DIR)/tclParseExpr.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParseExpr.c
+tkCanvText.o: $(GENERIC_DIR)/tkCanvText.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvText.c
-tclPanic.o: $(GENERIC_DIR)/tclPanic.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPanic.c
+tkCanvUtil.o: $(GENERIC_DIR)/tkCanvUtil.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvUtil.c
-tclPipe.o: $(GENERIC_DIR)/tclPipe.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPipe.c
+tkCanvWind.o: $(GENERIC_DIR)/tkCanvWind.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvWind.c
-tclPkg.o: $(GENERIC_DIR)/tclPkg.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPkg.c
+tkRectOval.o: $(GENERIC_DIR)/tkRectOval.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkRectOval.c
-tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c
+tkTrig.o: $(GENERIC_DIR)/tkTrig.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTrig.c
-tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c
+tkImage.o: $(GENERIC_DIR)/tkImage.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImage.c
-tclProc.o: $(GENERIC_DIR)/tclProc.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c
+tkImgBmap.o: $(GENERIC_DIR)/tkImgBmap.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgBmap.c
-tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclRegexp.c
+tkImgGIF.o: $(GENERIC_DIR)/tkImgGIF.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgGIF.c
-tclResolve.o: $(GENERIC_DIR)/tclResolve.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResolve.c
+tkImgPPM.o: $(GENERIC_DIR)/tkImgPPM.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPPM.c
-tclResult.o: $(GENERIC_DIR)/tclResult.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResult.c
+tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhoto.c
-tclScan.o: $(GENERIC_DIR)/tclScan.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclScan.c
+tkTest.o: $(GENERIC_DIR)/tkTest.c
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkTest.c
-tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c
+tkText.o: $(GENERIC_DIR)/tkText.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkText.c
-tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStubInit.c
+tkTextBTree.o: $(GENERIC_DIR)/tkTextBTree.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextBTree.c
-tclUtil.o: $(GENERIC_DIR)/tclUtil.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
+tkTextDisp.o: $(GENERIC_DIR)/tkTextDisp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextDisp.c
-tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c
+tkTextImage.o: $(GENERIC_DIR)/tkTextImage.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextImage.c
-tclVar.o: $(GENERIC_DIR)/tclVar.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c
+tkTextIndex.o: $(GENERIC_DIR)/tkTextIndex.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextIndex.c
-tclTest.o: $(GENERIC_DIR)/tclTest.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
+tkTextMark.o: $(GENERIC_DIR)/tkTextMark.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextMark.c
-tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c
+tkTextTag.o: $(GENERIC_DIR)/tkTextTag.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextTag.c
-tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c
+tkTextWind.o: $(GENERIC_DIR)/tkTextWind.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextWind.c
-tclTimer.o: $(GENERIC_DIR)/tclTimer.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTimer.c
+tkStubInit.o: $(GENERIC_DIR)/tkStubInit.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubInit.c
-tclThread.o: $(GENERIC_DIR)/tclThread.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c
-
-tclThreadAlloc.o: $(GENERIC_DIR)/tclThreadAlloc.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadAlloc.c
-
-tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c
-
-tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c
-
-tclUnixChan.o: $(UNIX_DIR)/tclUnixChan.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixChan.c
-
-tclUnixEvent.o: $(UNIX_DIR)/tclUnixEvent.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixEvent.c
-
-tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c
+# Stub library binaries, these must be compiled for use in a shared library
+# even though they will be placed in a static archive
-tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c
+tkStubLib.o: $(GENERIC_DIR)/tkStubLib.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubLib.c
-tclUnixNotfy.o: $(UNIX_DIR)/tclUnixNotfy.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixNotfy.c
+tkStubImg.o: $(GENERIC_DIR)/tkStubImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubImg.c
-tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixPipe.c
+tkUndo.o: $(GENERIC_DIR)/tkUndo.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkUndo.c
-tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixSock.c
+tkUnix.o: $(UNIX_DIR)/tkUnix.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix.c
-tclUnixTest.o: $(UNIX_DIR)/tclUnixTest.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c
+tkUnix3d.o: $(UNIX_DIR)/tkUnix3d.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix3d.c
-tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c
+tkUnixButton.o: $(UNIX_DIR)/tkUnixButton.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixButton.c
-tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
+tkUnixColor.o: $(UNIX_DIR)/tkUnixColor.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixColor.c
-tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c $(GENERIC_DIR)/tclInitScript.h tclConfig.sh
- $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \
- -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \
- $(UNIX_DIR)/tclUnixInit.c
+tkUnixConfig.o: $(UNIX_DIR)/tkUnixConfig.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixConfig.c
-# This is the CFBundle interface. It is only used on Mac OS X.
-tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c
- $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c
+tkUnixCursor.o: $(UNIX_DIR)/tkUnixCursor.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixCursor.c
-# The following targets are not completely general. They are provide
-# purely for documentation purposes so people who are interested in
-# the Xt based notifier can modify them to suit their own installation.
+tkUnixDraw.o: $(UNIX_DIR)/tkUnixDraw.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDraw.c
-xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
- @DL_OBJS@ ${BUILD_DLTEST}
- ${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
- @DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
- ${CC_SEARCH_FLAGS} -L/usr/openwin/lib -lXt -o xttest
+tkUnixEmbed.o: $(UNIX_DIR)/tkUnixEmbed.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEmbed.c
-tclXtNotify.o: $(UNIX_DIR)/tclXtNotify.c
- $(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \
- $(UNIX_DIR)/tclXtNotify.c
+tkUnixEvent.o: $(UNIX_DIR)/tkUnixEvent.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEvent.c
-tclXtTest.o: $(UNIX_DIR)/tclXtTest.c
- $(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \
- $(UNIX_DIR)/tclXtTest.c
+tkUnixFocus.o: $(UNIX_DIR)/tkUnixFocus.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFocus.c
-# compat binaries, these must be compiled for use in a shared library
-# even though they may be placed in a static executable or library. Since
-# they are included in both the tcl library and the stub library, they
-# need to be relocatable.
+tkUnixFont.o: $(UNIX_DIR)/tkUnixFont.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFont.c
-fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.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
-opendir.o: $(COMPAT_DIR)/opendir.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c
+tkUnixKey.o: $(UNIX_DIR)/tkUnixKey.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixKey.c
-memcmp.o: $(COMPAT_DIR)/memcmp.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/memcmp.c
+tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenu.c
-strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c
+tkUnixMenubu.o: $(UNIX_DIR)/tkUnixMenubu.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenubu.c
-strstr.o: $(COMPAT_DIR)/strstr.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c
+tkUnixScale.o: $(UNIX_DIR)/tkUnixScale.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScale.c
-strtod.o: $(COMPAT_DIR)/strtod.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtod.c
+tkUnixScrlbr.o: $(UNIX_DIR)/tkUnixScrlbr.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScrlbr.c
-strtol.o: $(COMPAT_DIR)/strtol.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c
+tkUnixSelect.o: $(UNIX_DIR)/tkUnixSelect.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixSelect.c
-strtoll.o: $(COMPAT_DIR)/strtoll.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoll.c
+tkUnixSend.o: $(UNIX_DIR)/tkUnixSend.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixSend.c
-strtoul.o: $(COMPAT_DIR)/strtoul.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c
+tkUnixWm.o: $(UNIX_DIR)/tkUnixWm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixWm.c
-strtoull.o: $(COMPAT_DIR)/strtoull.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoull.c
+tkUnixXId.o: $(UNIX_DIR)/tkUnixXId.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixXId.c
-tmpnam.o: $(COMPAT_DIR)/tmpnam.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/tmpnam.c
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
-waitpid.o: $(COMPAT_DIR)/waitpid.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c
+#
+# Target to check for proper usage of UCHAR macro.
+#
-# Stub library binaries, these must be compiled for use in a shared library
-# even though they will be placed in a static archive
+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.
+#
-tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
- $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c
+checkexports: $(TK_LIB_FILE)
+ -nm -p $(TK_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]k'
-.c.o:
- $(CC) -c $(CC_SWITCHES) $<
#
-# Target to regenerate header files and stub files from the *.decls tables.
+# Regenerate the stubs files.
#
-$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
- $(GENERIC_DIR)/tclInt.decls
- @echo "Warning: tclStubInit.c may be out of date."
+$(GENERIC_DIR)/tkStubInit.c: $(GENERIC_DIR)/tk.decls \
+ $(GENERIC_DIR)/tkInt.decls
+ @echo "Warning: tkStubInit.c may be out of date."
@echo "Developers may want to run \"make genstubs\" to regenerate."
@echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
$(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
- $(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls
+ $(GENERIC_DIR)/tk.decls $(GENERIC_DIR)/tkInt.decls
#
# Target to check that all exported functions have an entry in the stubs
@@ -1132,10 +1013,10 @@ genstubs:
#
checkstubs:
- -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /T/ { print $$3 }' \
+ -@for i in `nm -p $(TK_LIB_FILE) | awk '$$2 ~ /T/ { print $$3 }' \
| sort -n`; do \
match=0; \
- for j in $(TCL_DECLS); do \
+ for j in $(TK_DECLS); do \
if [ `grep -c $$i $$j` -gt 0 ]; then \
match=1; \
fi; \
@@ -1143,167 +1024,160 @@ checkstubs:
if [ $$match -eq 0 ]; then echo $$i; fi \
done
-#
-# Target to check that all public APIs which are not command
-# implementations have an entry in section three of the distributed
-# manpages.
-#
-
-checkdoc:
- -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \
- | grep -v 'Cmd$$' | sort -n`; do \
- match=0; \
- for j in $(TOP_DIR)/doc/*.3; do \
- if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \
- match=1; \
- fi; \
- done; \
- if [ $$match -eq 0 ]; then echo $$i; fi \
- done
-
-#
-# 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 "Tcl" prefixes are
-# exported.
-#
-
-checkexports: $(TCL_LIB_FILE)
- -nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]cl'
-
-#
-# Target to create a Tcl RPM for Linux. Requires that you be on a Linux
+# Target to create a Tk RPM for Linux. Requires that you be on a Linux
# system.
#
rpm: all /bin/rpm
rm -f THIS.TCL.SPEC
- echo "%define _builddir `pwd`" > THIS.TCL.SPEC
- echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
- cat tcl.spec >> THIS.TCL.SPEC
+ echo "%define _builddir `pwd`" > THIS.TK.SPEC
+ echo "%define _rpmdir `pwd`/RPMS" >> THIS.TK.SPEC
+ cat tk.spec >> THIS.TK.SPEC
mkdir -p RPMS/i386
- rpm -bb THIS.TCL.SPEC
+ rpm -bb THIS.TK.SPEC
mv RPMS/i386/*.rpm .
- rm -rf RPMS THIS.TCL.SPEC
+ rm -rf RPMS THIS.TK.SPEC
mklinks:
- $(TCL_EXE) $(UNIX_DIR)/mkLinks.tcl \
+ $(TCL_EXE) $(TCLDIR)/unix/mkLinks.tcl \
$(UNIX_DIR)/../doc/*.[13n] > $(UNIX_DIR)/mkLinks
chmod +x $(UNIX_DIR)/mkLinks
#
-# Target to create a proper Tcl distribution from information in the
+# 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.
+# to put the distribution. DISTDIR must be an absolute path name.
#
DISTROOT = /tmp/dist
-DISTNAME = tcl${VERSION}${PATCH_LEVEL}
-ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}.zip
-DISTDIR = $(DISTROOT)/$(DISTNAME)
+DISTNAME = tk${VERSION}${PATCH_LEVEL}
+ZIPNAME = tk${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}.zip
+DISTDIR = $(DISTROOT)/$(DISTNAME)
+TCLDIR = @TCL_SRC_DIR@
$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure
-dist: $(UNIX_DIR)/configure mklinks
+dist: $(UNIX_DIR)/configure mklinks
rm -rf $(DISTDIR)
- mkdir -p $(DISTDIR)/unix
+ mkdir -p $(DISTDIR)
+ mkdir $(DISTDIR)/unix
cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix
- cp $(UNIX_DIR)/Makefile.in $(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)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \
- $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
- $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
- $(UNIX_DIR)/mkLinks \
- $(DISTDIR)/unix
+ cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in $(UNIX_DIR)/tk.spec \
+ $(UNIX_DIR)/aclocal.m4 $(UNIX_DIR)/tcl.m4 \
+ $(UNIX_DIR)/tkConfig.sh.in $(TCLDIR)/unix/install-sh \
+ $(UNIX_DIR)/README $(UNIX_DIR)/mkLinks $(DISTDIR)/unix
chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
- chmod 775 $(DISTDIR)/unix/ldAix
chmod +x $(DISTDIR)/unix/install-sh
+ 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)/*.c $(GENERIC_DIR)/*.h $(GENERIC_DIR)/prolog.ps \
+ $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
- cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
- cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \
- $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
- $(DISTDIR)
- mkdir $(DISTDIR)/library
- cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
- $(TOP_DIR)/library/tclIndex $(DISTDIR)/library
- for i in http1.0 http opt msgcat reg dde tcltest; \
- do \
- mkdir $(DISTDIR)/library/$$i ;\
- cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
- done;
- mkdir $(DISTDIR)/library/encoding
- cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
- mkdir $(DISTDIR)/doc
- cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
- $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
- mkdir $(DISTDIR)/compat
- cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/compat/*.c \
- $(TOP_DIR)/compat/*.h $(TOP_DIR)/compat/README \
- $(DISTDIR)/compat
- mkdir $(DISTDIR)/tests
- cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests
- cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
- $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \
- $(DISTDIR)/tests
+ cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \
+ $(TOP_DIR)/license.terms $(DISTDIR)
+ rm -f $(DISTDIR)/generic/blt*.[ch]
mkdir $(DISTDIR)/win
cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
- cp $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \
- $(TOP_DIR)/win/tclConfig.sh.in \
- $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
- $(DISTDIR)/win
- cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h \
- $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
+ cp $(TOP_DIR)/win/configure.in \
+ $(TOP_DIR)/win/configure \
+ $(TOP_DIR)/win/tkConfig.sh.in \
+ $(TOP_DIR)/win/aclocal.m4 $(TOP_DIR)/win/tcl.m4 \
$(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat
cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.*
cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc
- cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win
- $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/coffbase.txt
- cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
- $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.hpj.in
- cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
- $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.ds*
cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/lamp.bmp $(DISTDIR)/win
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
+ mkdir $(DISTDIR)/win/rc
+ cp -p $(TOP_DIR)/win/rc/wish.exe.manifest $(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
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rc/*.rc
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rc/wish.exe.manifest
mkdir $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/tclMacProjects.sea.hqx \
- $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
+ cp -p $(TOP_DIR)/mac/tkMacProjects.sea.hqx $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
$(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/porting.notes $(TOP_DIR)/mac/README $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/*.doc $(TOP_DIR)/mac/*.html $(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/*.tcl $(DISTDIR)/mac
mkdir $(DISTDIR)/macosx
- cp -p $(TOP_DIR)/macosx/Makefile \
- $(TOP_DIR)/macosx/*.c \
- $(DISTDIR)/macosx
- mkdir $(DISTDIR)/macosx/Tcl.pbproj
- cp -p $(TOP_DIR)/macosx/Tcl.pbproj/*.pbx* $(DISTDIR)/macosx/Tcl.pbproj
- mkdir $(DISTDIR)/unix/dltest
- cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
- $(UNIX_DIR)/dltest/README \
- $(DISTDIR)/unix/dltest
- mkdir $(DISTDIR)/tools
- cp -p $(TOP_DIR)/tools/Makefile.in $(TOP_DIR)/tools/README \
- $(TOP_DIR)/tools/configure $(TOP_DIR)/tools/configure.in \
- $(TOP_DIR)/tools/*.tcl $(TOP_DIR)/tools/man2tcl.c \
- $(TOP_DIR)/tools/tcl.wse.in $(TOP_DIR)/tools/*.bmp \
- $(TOP_DIR)/tools/tcl.hpj.in \
- $(DISTDIR)/tools
- $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in \
- $(DISTDIR)/tools/tcl.wse.in
+ cp -p $(TOP_DIR)/macosx/Makefile $(TOP_DIR)/macosx/Wish.icns \
+ $(TOP_DIR)/macosx/*.c $(TOP_DIR)/macosx/*.h \
+ $(TOP_DIR)/macosx/*.r $(DISTDIR)/macosx
+ mkdir $(DISTDIR)/macosx/Wish.pbproj
+ cp -p $(TOP_DIR)/macosx/Wish.pbproj/*.pbx* \
+ $(DISTDIR)/macosx/Wish.pbproj
+ mkdir $(DISTDIR)/compat
+ cp -p $(TOP_DIR)/license.terms $(TCLDIR)/compat/unistd.h \
+ $(TCLDIR)/compat/stdlib.h $(TCLDIR)/compat/limits.h \
+ $(DISTDIR)/compat
+ mkdir $(DISTDIR)/xlib
+ cp -p $(TOP_DIR)/xlib/*.h $(TOP_DIR)/xlib/*.c $(DISTDIR)/xlib
+ cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib
+ mkdir $(DISTDIR)/xlib/X11
+ cp -p $(TOP_DIR)/xlib/X11/*.h $(DISTDIR)/xlib/X11
+ cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib/X11
+ mkdir $(DISTDIR)/library
+ cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
+ $(TOP_DIR)/library/tclIndex \
+ $(DISTDIR)/library
+ mkdir $(DISTDIR)/library/images
+ @(cd $(TOP_DIR); for i in library/images/* ; do \
+ if [ -f $$i ] ; then \
+ cp $$i $(DISTDIR)/$$i; \
+ fi; \
+ done;)
+ mkdir $(DISTDIR)/library/msgs
+ @(cd $(TOP_DIR); for i in library/msgs/*.msg ; 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/*.tcl $(TOP_DIR)/tests/README \
+ $(TOP_DIR)/tests/option.file* $(DISTDIR)/tests
#
# The following target can only be used for non-patch releases. Use
@@ -1330,38 +1204,27 @@ allpatch: dist
rm -f $(DISTROOT)/$(DISTNAME).tar.Z \
$(DISTROOT)/$(DISTNAME).tar.gz \
$(DISTROOT)/$(ZIPNAME)
- mv $(DISTROOT)/tcl${VERSION} $(DISTROOT)/old
- mv $(DISTROOT)/$(DISTNAME) $(DISTROOT)/tcl${VERSION}
- cd $(DISTROOT); tar cf $(DISTNAME).tar tcl${VERSION}; \
+ 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) tcl${VERSION}
- mv $(DISTROOT)/tcl${VERSION} $(DISTROOT)/$(DISTNAME)
- mv $(DISTROOT)/old $(DISTROOT)/tcl${VERSION}
-
-#
-# This target creates the HTML folder for Tcl & Tk and places it
-# in DISTDIR/html. It uses the tcltk-man2html.tcl tool from
-# the Tcl group's tool workspace. It depends on the Tcl & Tk being
-# in directories called tcl8.3 & tk8.3 up two directories from the
-# TOOL_DIR.
-#
-
-html:
- $(TCL_EXE) $(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(DISTDIR)/html \
- --srcdir=$(TOP_DIR)/..
+ 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 group's tool workspace.
+# programs found only in the Tcl greoup's tool workspace.
#
-macdist: dist machtml
-
-machtml:
- rm -f $(DISTDIR)/mac/tclMacProjects.sea.hqx
+macdist: dist
+ rm -f $(DISTDIR)/mac/tkMacProjects.sea.hqx
+ $(TCL_EXE) $(TOOL_DIR)/man2html.tcl $(DISTDIR)/tmp ../.. tk$(VERSION)
+ mv $(DISTDIR)/tmp/tk$(VERSION) $(DISTDIR)/html
rm -rf $(DISTDIR)/doc
+ rm -rf $(DISTDIR)/tmp
$(TCL_EXE) $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)
#
@@ -1385,7 +1248,7 @@ machtml:
# both packages.
#
-PACKAGE=SCRPtcl
+PACKAGE=SCRPtk
package: dist package-config package-common package-binaries package-generate
package-quick: package-config package-binaries package-generate
@@ -1396,11 +1259,12 @@ package-quick: package-config package-binaries package-generate
package-config:
mkdir -p $(DISTDIR)/unix/`arch`
cd $(DISTDIR)/unix/`arch`; \
- ../configure --prefix=/opt/$(PACKAGE)/$(VERSION) \
- --exec_prefix=/opt/$(PACKAGE)/$(VERSION)/`arch` \
+ ../configure --prefix=/opt/SUNWtcl/$(TCLVERSION) \
+ --exec_prefix=/opt/SUNWtcl/$(TCLVERSION)/`arch` \
+ --with-tcl=$(DISTDIR)/../tcl$(TCLVERSION)/unix/`arch` \
--enable-shared
- mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)
- mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`
+ mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)
+ mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`
#
# Build and install the architecture independent files in the dist directory.
@@ -1409,13 +1273,14 @@ package-config:
package-common:
cd $(DISTDIR)/unix/`arch`;\
$(MAKE); \
- $(MAKE) prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION) \
- exec_prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch` \
- install-libraries install-man
- mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin
- sed -e "s/TCLVERSION/$(VERSION)/g" < $(UNIX_DIR)/tclsh.sh \
- > $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin/tclsh$(VERSION)
- chmod 755 $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin/tclsh$(VERSION)
+ $(MAKE) install-libraries install-doc \
+ 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.
@@ -1424,8 +1289,8 @@ package-common:
package-binaries:
cd $(DISTDIR)/unix/`arch`; \
$(MAKE); \
- $(MAKE) install-binaries prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION) \
- exec_prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`
+ $(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
@@ -1433,13 +1298,13 @@ package-binaries:
#
package-generate:
- pkgproto $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin=bin \
- $(DISTDIR)/$(PACKAGE)/$(VERSION)/include=include \
- $(DISTDIR)/$(PACKAGE)/$(VERSION)/lib=lib \
- $(DISTDIR)/$(PACKAGE)/$(VERSION)/man=man \
- $(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`=`arch` \
- | $(TCL_EXE) $(UNIX_DIR)/mkProto.tcl \
- $(VERSION) $(UNIX_DIR) > prototype
+ 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` \
+ | $(TCL_EXE) $(TCLDIR)/unix/mkProto.tcl $(TCLVERSION) \
+ $(UNIX_DIR) > prototype
pkgmk -o -d . -f prototype -a `arch`
pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE)
rm -rf $(PACKAGE)
diff --git a/tcl/unix/README b/tcl/unix/README
index 05fa2c119c0..73ba968277b 100644
--- a/tcl/unix/README
+++ b/tcl/unix/README
@@ -1,18 +1,14 @@
-Tcl UNIX README
----------------
-
-RCS: @(#) $Id$
+Tk UNIX README
+--------------
This is the directory where you configure, compile, test, and install
-UNIX versions of Tcl. This directory also contains source files for Tcl
-that are specific to UNIX. Some of the files in this directory are
-used on the PC or Mac platform too, but they all depend on UNIX
-(POSIX/ANSI C) interfaces and some of them only make sense under UNIX.
+UNIX versions of Tk. This directory also contains source files for Tk
+that are specific to UNIX.
-Updated forms of the information found in this file is available at:
- http://www.tcl.tk/doc/howto/compile.html#unix
+The information in this file is maintained at:
+ http://www.tcl.tk/doc/howto/compile.html
-For information on platforms where Tcl is known to compile, along
+For information on platforms where Tcl/Tk is known to compile, along
with any porting notes for getting it to work on those platforms, see:
http://www.tcl.tk/software/tcltk/platforms.html
@@ -24,43 +20,43 @@ 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.
-How To Compile And Install Tcl:
--------------------------------
+RCS: @(#) $Id$
+
+How To Compile And Install Tk:
+------------------------------
+
+(a) Make sure that the Tcl 8.4 release is present in the directory
+ ../../tcl8.4 (or else use the "--with-tcl" switch described below).
+ This release of Tk will only work with Tcl 8.4. Also, be sure that
+ you have configured Tcl before you configure Tk.
-(a) If you have already compiled Tcl once in this directory and are now
+(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.
-(b) If you need to reconfigure because you changed any of the .in or
- .m4 files, you will need to run autoconf to create a new
- ./configure script. Most users will NOT need to do this since
- a configure script is already provided.
-
- (in the tcl/unix directory)
- autoconf
-
-(c) Type "./configure". This runs a configuration script created by GNU
+(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). Tcl's "configure" supports the following special
- switches in addition to the standard ones:
+ included here). Tk's "configure" script supports the following
+ special switches in addition to the standard ones:
+ --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-threads If this switch is set, Tcl will compile
itself with multithreading support.
- --disable-load If this switch is specified then Tcl will
- configure itself not to allow dynamic loading,
- even if your system appears to support it.
- Normally you can leave this switch out and
- Tcl will build itself for dynamic loading
- if your system supports it.
- --enable-shared If this switch is specified, Tcl will compile
+ --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. This
is the default on platforms where we know
how to build shared libraries.
- --disable-shared If this switch is specified, Tcl will compile
+ --disable-shared If this switch is specified, Tk will compile
itself as a static library.
--enable-symbols build with debugging symbols
--disable-symbols build without debugging symbols
@@ -68,11 +64,6 @@ How To Compile And Install Tcl:
--disable-64bit disable 64bit support (where applicable)
--enable-64bit-vis enable 64bit Sparc VIS support
--disable-64bit-vis disable 64bit Sparc VIS support
- --enable-langinfo Allows use of modern nl_langinfo check for
- better localization support. This is on by
- default on platforms where nl_langinfo is
- found.
- --disable-langinfo Specifically disables use of nl_langinfo.
--enable-man-symlinks Use symlinks for linking the manpages that
should be reachable under several names.
--enable-man-compression=PROG
@@ -80,58 +71,77 @@ How To Compile And Install Tcl:
Note: by default gcc will be used if it can be located on the PATH.
if you want to use cc instead of gcc, set the CC environment variable
- to "cc" before running configure. It is not safe to edit the
- Makefile to use gcc after configure is run.
+ to "cc" before running configure. It is not safe to change the Makefile
+ to use gcc after configure is run.
Note: be sure to use only absolute path names (those starting with "/")
in the --prefix and --exec-prefix options.
-(d) Type "make". This will create a library archive called
- "libtcl<version>.a" or "libtcl<version>.so" and an interpreter
- application called "tclsh" that allows you to type Tcl commands
+(e) Type "make". This will create a library archive called
+ "libtk<version>.a" or "libtk<version>.so" and an interpreter
+ application called "wish" that allows you to type Tcl commands
interactively or execute script files.
-(e) If the make fails then you'll have to personalize the Makefile
+(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 porting Web page above to see if there are hints
for compiling on your system. If you need to modify Makefile,
- are comments at the beginning of it that describe the things you
- might want to change and how to change them.
-
-(f) Type "make install" to install Tcl binaries and script files in
+ 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
- directories to do this. The installation directories are
+ 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.
-(g) At this point you can play with Tcl by running "make shell"
- and typing Tcl commands at the prompt.
-
-If you have trouble compiling Tcl, see the URL noted above about working
+(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.4" or "libtk8.4.so"; to use the installed
+ versions, either specify the version number or create a symbolic
+ link (e.g. from "wish" to "wish8.4").
+
+If you have trouble compiling Tk, see the URL noted above about working
platforms. It contains information that people have provided about changes
-they had to make to compile Tcl in various environments. We're also
-interested in hearing how to change the configuration setup so that Tcl
+they had to make to compile Tk in various environments. We're also
+interested in hearing how to change the configuration setup so that Tk
compiles on additional platforms "out of the box".
Test suite
----------
-There is a relatively complete test suite for all of the Tcl core in
-the subdirectory "tests". To use it 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. See the README file in the "tests" directory for more
-information on the test suite. Note: don't run the tests as superuser:
-this will cause several of them to fail. If a test is failing
-consistently, please send us a bug report with as much detail as you
-can manage. Please use the online database at
- http://tcl.sourceforge.net/
-
-The Tcl test suite is very sensitive to proper implementation of
-ANSI C library procedures such as sprintf and sscanf. If the test
-suite generates errors, most likely they are due to non-conformance
-of your system's ANSI C library; such problems are unlikely to
-affect any real applications so it's probably safe to ignore them.
+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 by manually
+enabling the "userInteraction" constraint when testing, and the results
+have to be verified visually.. This can be done with
+ make test TESTFLAGS="-constraints userInteraction"
+Some tests will present a main window with a bunch of menus, which you can
+use to select various tests.
diff --git a/tcl/unix/configure b/tcl/unix/configure
index f005092f185..b3377628607 100755
--- a/tcl/unix/configure
+++ b/tcl/unix/configure
@@ -19,8 +19,7 @@ ac_help="$ac_help
ac_help="$ac_help
--enable-threads build with threads"
ac_help="$ac_help
- --enable-langinfo use nl_langinfo if possible to determine
- encoding at startup, otherwise use old heuristic"
+ --with-tcl directory containing tcl configuration (tclConfig.sh)"
ac_help="$ac_help
--enable-shared build and link with shared libraries [--enable-shared]"
ac_help="$ac_help
@@ -32,9 +31,7 @@ ac_help="$ac_help
ac_help="$ac_help
--enable-symbols build with debugging symbols [--disable-symbols]"
ac_help="$ac_help
- --enable-memdebug build with memory debugging [--disable-memdebug]"
-ac_help="$ac_help
- --enable-framework package shared libraries in frameworks [--disable-framework]"
+ --with-x use the X Window System"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -475,7 +472,7 @@ 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/tcl.h
+ac_unique_file=../generic/tk.h
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
@@ -547,11 +544,12 @@ fi
-TCL_VERSION=8.4
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=4
-TCL_PATCH_LEVEL=".0"
-VERSION=${TCL_VERSION}
+TK_VERSION=8.4
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=4
+TK_PATCH_LEVEL=".0"
+VERSION=${TK_VERSION}
+LOCALES="cs de el en en_gb es fr it nl ru"
#------------------------------------------------------------------------
# Handle the --prefix=... option
@@ -565,7 +563,9 @@ if test "${exec_prefix}" = "NONE"; then
fi
# libdir must be a fully qualified path and (not ${exec_prefix}/lib)
eval libdir="$libdir"
-TCL_SRC_DIR=`cd $srcdir/..; pwd`
+# Make sure srcdir is fully qualified!
+srcdir=`cd $srcdir ; pwd`
+TK_SRC_DIR=`cd $srcdir/..; pwd`
#------------------------------------------------------------------------
# Compress and/or soft link the manpages?
@@ -832,8 +832,13 @@ else
fi
fi
+
+#------------------------------------------------------------------------
+# I'm not sure why these need to come before all of the other tests
+#------------------------------------------------------------------------
+
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:837: checking how to run the C preprocessor" >&5
+echo "configure:842: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@@ -848,13 +853,13 @@ else
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
-#line 852 "configure"
+#line 857 "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:858: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:863: \"$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
:
@@ -865,13 +870,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
-#line 869 "configure"
+#line 874 "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:875: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:880: \"$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
:
@@ -882,13 +887,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
-#line 886 "configure"
+#line 891 "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:892: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:897: \"$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
:
@@ -916,17 +921,17 @@ 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:920: checking for $ac_hdr" >&5
+echo "configure:925: 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 925 "configure"
+#line 930 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:930: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:935: \"$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*
@@ -959,7 +964,7 @@ done
echo $ac_n "checking for building with threads""... $ac_c" 1>&6
-echo "configure:963: checking for building with threads" >&5
+echo "configure:968: checking for building with threads" >&5
# Check whether --enable-threads or --disable-threads was given.
if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
@@ -991,7 +996,7 @@ EOF
EOF
echo $ac_n "checking for pthread_mutex_init in -lpthread""... $ac_c" 1>&6
-echo "configure:995: checking for pthread_mutex_init in -lpthread" >&5
+echo "configure:1000: checking for pthread_mutex_init in -lpthread" >&5
ac_lib_var=`echo pthread'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -999,7 +1004,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lpthread $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1003 "configure"
+#line 1008 "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
@@ -1010,7 +1015,7 @@ int main() {
pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1014: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1019: \"$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
@@ -1038,7 +1043,7 @@ fi
# pthread.h, but that will work with libpthread really doesn't
# exist, like AIX 4.2. [Bug: 4359]
echo $ac_n "checking for __pthread_mutex_init in -lpthread""... $ac_c" 1>&6
-echo "configure:1042: checking for __pthread_mutex_init in -lpthread" >&5
+echo "configure:1047: checking for __pthread_mutex_init in -lpthread" >&5
ac_lib_var=`echo pthread'_'__pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1046,7 +1051,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lpthread $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1050 "configure"
+#line 1055 "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
@@ -1057,7 +1062,7 @@ int main() {
__pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1061: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1066: \"$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
@@ -1085,7 +1090,7 @@ fi
THREADS_LIBS=" -lpthread"
else
echo $ac_n "checking for pthread_mutex_init in -lpthreads""... $ac_c" 1>&6
-echo "configure:1089: checking for pthread_mutex_init in -lpthreads" >&5
+echo "configure:1094: checking for pthread_mutex_init in -lpthreads" >&5
ac_lib_var=`echo pthreads'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1093,7 +1098,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lpthreads $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1097 "configure"
+#line 1102 "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
@@ -1104,7 +1109,7 @@ int main() {
pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1108: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1113: \"$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
@@ -1130,7 +1135,7 @@ fi
THREADS_LIBS=" -lpthreads"
else
echo $ac_n "checking for pthread_mutex_init in -lc""... $ac_c" 1>&6
-echo "configure:1134: checking for pthread_mutex_init in -lc" >&5
+echo "configure:1139: checking for pthread_mutex_init in -lc" >&5
ac_lib_var=`echo c'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1138,7 +1143,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lc $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1142 "configure"
+#line 1147 "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
@@ -1149,7 +1154,7 @@ int main() {
pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1153: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1158: \"$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
@@ -1172,7 +1177,7 @@ fi
if test "$tcl_ok" = "no"; then
echo $ac_n "checking for pthread_mutex_init in -lc_r""... $ac_c" 1>&6
-echo "configure:1176: checking for pthread_mutex_init in -lc_r" >&5
+echo "configure:1181: checking for pthread_mutex_init in -lc_r" >&5
ac_lib_var=`echo c_r'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1180,7 +1185,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lc_r $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1184 "configure"
+#line 1189 "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
@@ -1191,7 +1196,7 @@ int main() {
pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1195: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1200: \"$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
@@ -1229,12 +1234,12 @@ fi
for ac_func in pthread_attr_setstacksize
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1233: checking for $ac_func" >&5
+echo "configure:1238: 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 1238 "configure"
+#line 1243 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1257,7 +1262,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1261: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1266: \"$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
@@ -1284,12 +1289,12 @@ done
for ac_func in readdir_r
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1288: checking for $ac_func" >&5
+echo "configure:1293: 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 1293 "configure"
+#line 1298 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1312,7 +1317,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1316: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1321: \"$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
@@ -1343,26 +1348,26 @@ done
-#------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# If we're using GCC, see if the compiler understands -pipe. If so, use it.
# It makes compiling go faster. (This is only a performance feature.)
-#------------------------------------------------------------------------
+#------------------------------------------------------------------------------
if test -z "$no_pipe"; then
if test -n "$GCC"; then
echo $ac_n "checking if the compiler understands -pipe""... $ac_c" 1>&6
-echo "configure:1355: checking if the compiler understands -pipe" >&5
+echo "configure:1360: checking if the compiler understands -pipe" >&5
OLDCC="$CC"
CC="$CC -pipe"
cat > conftest.$ac_ext <<EOF
-#line 1359 "configure"
+#line 1364 "configure"
#include "confdefs.h"
int main() {
; return 0; }
EOF
-if { (eval echo configure:1366: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1371: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
echo "$ac_t""yes" 1>&6
else
@@ -1382,21 +1387,21 @@ fi
echo $ac_n "checking for required early compiler flags""... $ac_c" 1>&6
-echo "configure:1386: checking for required early compiler flags" >&5
+echo "configure:1391: checking for required early compiler flags" >&5
tcl_flags=""
if eval "test \"`echo '$''{'tcl_cv_flag__isoc99_source'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1393 "configure"
+#line 1398 "configure"
#include "confdefs.h"
#include <stdlib.h>
int main() {
char *p = (char *)strtoll; char *q = (char *)strtoull;
; return 0; }
EOF
-if { (eval echo configure:1400: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1405: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_flag__isoc99_source=no
else
@@ -1404,7 +1409,7 @@ else
cat conftest.$ac_ext >&5
rm -rf conftest*
cat > conftest.$ac_ext <<EOF
-#line 1408 "configure"
+#line 1413 "configure"
#include "confdefs.h"
#define _ISOC99_SOURCE 1
#include <stdlib.h>
@@ -1412,7 +1417,7 @@ int main() {
char *p = (char *)strtoll; char *q = (char *)strtoull;
; return 0; }
EOF
-if { (eval echo configure:1416: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1421: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_flag__isoc99_source=yes
else
@@ -1438,14 +1443,14 @@ EOF
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1442 "configure"
+#line 1447 "configure"
#include "confdefs.h"
#include <sys/stat.h>
int main() {
struct stat64 buf; int i = stat64("/", &buf);
; return 0; }
EOF
-if { (eval echo configure:1449: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1454: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_flag__largefile64_source=no
else
@@ -1453,7 +1458,7 @@ else
cat conftest.$ac_ext >&5
rm -rf conftest*
cat > conftest.$ac_ext <<EOF
-#line 1457 "configure"
+#line 1462 "configure"
#include "confdefs.h"
#define _LARGEFILE64_SOURCE 1
#include <sys/stat.h>
@@ -1461,7 +1466,7 @@ int main() {
struct stat64 buf; int i = stat64("/", &buf);
; return 0; }
EOF
-if { (eval echo configure:1465: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1470: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_flag__largefile64_source=yes
else
@@ -1490,20 +1495,20 @@ EOF
echo $ac_n "checking for 64-bit integer type""... $ac_c" 1>&6
-echo "configure:1494: checking for 64-bit integer type" >&5
+echo "configure:1499: checking for 64-bit integer type" >&5
if eval "test \"`echo '$''{'tcl_cv_type_64bit'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1500 "configure"
+#line 1505 "configure"
#include "confdefs.h"
int main() {
__int64 value = (__int64) 0;
; return 0; }
EOF
-if { (eval echo configure:1507: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1512: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_type_64bit=__int64
else
@@ -1515,13 +1520,13 @@ else
{ echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
else
cat > conftest.$ac_ext <<EOF
-#line 1519 "configure"
+#line 1524 "configure"
#include "confdefs.h"
#include <unistd.h>
int main() {exit(!(sizeof(long long) > sizeof(long)));}
EOF
-if { (eval echo configure:1525: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:1530: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tcl_cv_type_64bit="long long"
else
@@ -1546,13 +1551,13 @@ EOF
# Now check for auxiliary declarations
echo $ac_n "checking for struct dirent64""... $ac_c" 1>&6
-echo "configure:1550: checking for struct dirent64" >&5
+echo "configure:1555: checking for struct dirent64" >&5
if eval "test \"`echo '$''{'tcl_cv_struct_dirent64'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1556 "configure"
+#line 1561 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/dirent.h>
@@ -1560,7 +1565,7 @@ int main() {
struct dirent64 p;
; return 0; }
EOF
-if { (eval echo configure:1564: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1569: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_struct_dirent64=yes
else
@@ -1581,13 +1586,13 @@ EOF
echo "$ac_t""${tcl_cv_struct_dirent64}" 1>&6
echo $ac_n "checking for struct stat64""... $ac_c" 1>&6
-echo "configure:1585: checking for struct stat64" >&5
+echo "configure:1590: checking for struct stat64" >&5
if eval "test \"`echo '$''{'tcl_cv_struct_stat64'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1591 "configure"
+#line 1596 "configure"
#include "confdefs.h"
#include <sys/stat.h>
int main() {
@@ -1595,7 +1600,7 @@ struct stat64 p;
; return 0; }
EOF
-if { (eval echo configure:1599: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1604: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_struct_stat64=yes
else
@@ -1616,13 +1621,13 @@ EOF
echo "$ac_t""${tcl_cv_struct_stat64}" 1>&6
echo $ac_n "checking for off64_t""... $ac_c" 1>&6
-echo "configure:1620: checking for off64_t" >&5
+echo "configure:1625: checking for off64_t" >&5
if eval "test \"`echo '$''{'tcl_cv_type_off64_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1626 "configure"
+#line 1631 "configure"
#include "confdefs.h"
#include <sys/types.h>
int main() {
@@ -1630,7 +1635,7 @@ off64_t offset;
; return 0; }
EOF
-if { (eval echo configure:1634: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1639: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_cv_type_off64_t=yes
else
@@ -1652,3712 +1657,155 @@ EOF
fi
#--------------------------------------------------------------------
-# Check endianness because we can optimize comparisons of
-# Tcl_UniChar strings to memcmp on big-endian systems.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6
-echo "configure:1661: checking whether byte ordering is bigendian" >&5
-if eval "test \"`echo '$''{'ac_cv_c_bigendian'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- ac_cv_c_bigendian=unknown
-# See if sys/param.h defines the BYTE_ORDER macro.
-cat > conftest.$ac_ext <<EOF
-#line 1668 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <sys/param.h>
-int main() {
-
-#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
- bogus endian macros
-#endif
-; return 0; }
-EOF
-if { (eval echo configure:1679: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- # It does; now see whether it defined to BIG_ENDIAN or not.
-cat > conftest.$ac_ext <<EOF
-#line 1683 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <sys/param.h>
-int main() {
-
-#if BYTE_ORDER != BIG_ENDIAN
- not big endian
-#endif
-; return 0; }
-EOF
-if { (eval echo configure:1694: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_c_bigendian=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_c_bigendian=no
-fi
-rm -f conftest*
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
-fi
-rm -f conftest*
-if test $ac_cv_c_bigendian = unknown; then
-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 1714 "configure"
-#include "confdefs.h"
-main () {
- /* Are we little or big endian? From Harbison&Steele. */
- union
- {
- long l;
- char c[sizeof (long)];
- } u;
- u.l = 1;
- exit (u.c[sizeof (long) - 1] == 1);
-}
-EOF
-if { (eval echo configure:1727: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- ac_cv_c_bigendian=no
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- ac_cv_c_bigendian=yes
-fi
-rm -fr conftest*
-fi
-
-fi
-fi
-
-echo "$ac_t""$ac_cv_c_bigendian" 1>&6
-if test $ac_cv_c_bigendian = yes; then
- cat >> confdefs.h <<\EOF
-#define WORDS_BIGENDIAN 1
-EOF
-
-fi
-
-
-#--------------------------------------------------------------------
-# Supply substitutes for missing POSIX library procedures, or
-# set flags so Tcl uses alternate procedures.
-#--------------------------------------------------------------------
-
-# Check if Posix compliant getcwd exists, if not we'll use getwd.
-for ac_func in getcwd
-do
-echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1760: 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 1765 "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:1788: \"$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
-cat >> confdefs.h <<\EOF
-#define USEGETWD 1
-EOF
-
-fi
-done
-
-# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
-# define USEGETWD even if the posix getcwd exists. Add a test ?
-
-for ac_func in opendir strstr
-do
-echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1822: 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 1827 "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:1850: \"$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
-LIBOBJS="$LIBOBJS ${ac_func}.${ac_objext}"
-fi
-done
-
-
-
-for ac_func in strtol strtoll strtoull tmpnam waitpid
-do
-echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1880: 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 1885 "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:1908: \"$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
-LIBOBJS="$LIBOBJS ${ac_func}.${ac_objext}"
-fi
-done
-
-
-echo $ac_n "checking for strerror""... $ac_c" 1>&6
-echo "configure:1935: checking for strerror" >&5
-if eval "test \"`echo '$''{'ac_cv_func_strerror'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1940 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strerror(); 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 strerror();
-
-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_strerror) || defined (__stub___strerror)
-choke me
-#else
-strerror();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:1963: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_strerror=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_strerror=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'strerror`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_STRERROR 1
-EOF
-
-fi
-
-echo $ac_n "checking for getwd""... $ac_c" 1>&6
-echo "configure:1987: checking for getwd" >&5
-if eval "test \"`echo '$''{'ac_cv_func_getwd'+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 getwd(); 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 getwd();
-
-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_getwd) || defined (__stub___getwd)
-choke me
-#else
-getwd();
-#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_getwd=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_getwd=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'getwd`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_GETWD 1
-EOF
-
-fi
-
-echo $ac_n "checking for wait3""... $ac_c" 1>&6
-echo "configure:2039: checking for wait3" >&5
-if eval "test \"`echo '$''{'ac_cv_func_wait3'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 2044 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char wait3(); 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 wait3();
-
-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_wait3) || defined (__stub___wait3)
-choke me
-#else
-wait3();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:2067: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_wait3=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_wait3=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'wait3`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_WAIT3 1
-EOF
-
-fi
-
-echo $ac_n "checking for uname""... $ac_c" 1>&6
-echo "configure:2091: checking for uname" >&5
-if eval "test \"`echo '$''{'ac_cv_func_uname'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 2096 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char uname(); 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 uname();
-
-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_uname) || defined (__stub___uname)
-choke me
-#else
-uname();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:2119: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_uname=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_uname=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'uname`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_UNAME 1
-EOF
-
-fi
-
-echo $ac_n "checking for realpath""... $ac_c" 1>&6
-echo "configure:2143: checking for realpath" >&5
-if eval "test \"`echo '$''{'ac_cv_func_realpath'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 2148 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char realpath(); 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 realpath();
-
-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_realpath) || defined (__stub___realpath)
-choke me
-#else
-realpath();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:2171: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_realpath=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_realpath=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'realpath`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_REALPATH 1
-EOF
-
-fi
-
-
-#--------------------------------------------------------------------
-# Supply substitutes for missing POSIX header files. Special
-# notes:
-# - stdlib.h doesn't define strtol, strtoul, or
-# strtod insome versions of SunOS
-# - some versions of string.h don't declare procedures such
-# as strstr
+# Find and load the tclConfig.sh file
#--------------------------------------------------------------------
- echo $ac_n "checking dirent.h""... $ac_c" 1>&6
-echo "configure:2206: checking dirent.h" >&5
- cat > conftest.$ac_ext <<EOF
-#line 2208 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <dirent.h>
-int main() {
-
-#ifndef _POSIX_SOURCE
-# ifdef __Lynx__
- /*
- * Generate compilation error to make the test fail: Lynx headers
- * are only valid if really in the POSIX environment.
- */
-
- missing_procedure();
-# endif
-#endif
-DIR *d;
-struct dirent *entryPtr;
-char *p;
-d = opendir("foobar");
-entryPtr = readdir(d);
-p = entryPtr->d_name;
-closedir(d);
-
-; return 0; }
-EOF
-if { (eval echo configure:2234: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- tcl_ok=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_ok=no
-fi
-rm -f conftest*
-
- if test $tcl_ok = no; then
- cat >> confdefs.h <<\EOF
-#define NO_DIRENT_H 1
-EOF
-
- fi
-
- echo "$ac_t""$tcl_ok" 1>&6
- ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for errno.h""... $ac_c" 1>&6
-echo "configure:2255: checking for errno.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 2260 "configure"
-#include "confdefs.h"
-#include <errno.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2265: \"$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_ERRNO_H 1
-EOF
-
-fi
-
- ac_safe=`echo "float.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for float.h""... $ac_c" 1>&6
-echo "configure:2292: checking for float.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 <float.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_FLOAT_H 1
-EOF
-
-fi
-
- ac_safe=`echo "values.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for values.h""... $ac_c" 1>&6
-echo "configure:2329: checking for values.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 <values.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
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_VALUES_H 1
-EOF
-
-fi
-
- ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for limits.h""... $ac_c" 1>&6
-echo "configure:2366: 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 2371 "configure"
-#include "confdefs.h"
-#include <limits.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2376: \"$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:2403: 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 2408 "configure"
-#include "confdefs.h"
-#include <stdlib.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2413: \"$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 2436 "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 2450 "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 2464 "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:2485: 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 2490 "configure"
-#include "confdefs.h"
-#include <string.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2495: \"$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 2518 "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 2532 "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*
-
-
- # See also memmove check below for a place where NO_STRING_H can be
- # set and why.
-
- if test $tcl_ok = 0; then
- cat >> confdefs.h <<\EOF
-#define NO_STRING_H 1
-EOF
-
- fi
-
- ac_safe=`echo "sys/wait.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for sys/wait.h""... $ac_c" 1>&6
-echo "configure:2558: checking for sys/wait.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 2563 "configure"
-#include "confdefs.h"
-#include <sys/wait.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2568: \"$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_SYS_WAIT_H 1
-EOF
-
-fi
-
- ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
-echo "configure:2595: checking for dlfcn.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 2600 "configure"
-#include "confdefs.h"
-#include <dlfcn.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2605: \"$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_DLFCN_H 1
-EOF
-
-fi
-
-
- # OS/390 lacks sys/param.h (and doesn't need it, by chance).
+ #
+ # Ok, lets find the tcl configuration
+ # First, look for one uninstalled.
+ # the alternative search directory is invoked by --with-tcl
+ #
- for ac_hdr in unistd.h sys/param.h
-do
-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:2637: 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 2642 "configure"
-#include "confdefs.h"
-#include <$ac_hdr>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2647: \"$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
+ if test x"${no_tcl}" = x ; then
+ # we reset no_tcl in case something fails here
+ no_tcl=true
+ # Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ with_tclconfig=${withval}
fi
-done
-
-
-
-#---------------------------------------------------------------------------
-# Determine which interface to use to talk to the serial port.
-# Note that #include lines must begin in leftmost column for
-# some compilers to recognize them as preprocessor directives.
-#---------------------------------------------------------------------------
-
-
- for ac_hdr in sys/modem.h
-do
-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:2687: 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 2692 "configure"
-#include "confdefs.h"
-#include <$ac_hdr>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2697: \"$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 termios vs. termio vs. sgtty""... $ac_c" 1>&6
-echo "configure:2724: checking termios vs. termio vs. sgtty" >&5
- if eval "test \"`echo '$''{'tcl_cv_api_serial'+set}'`\" = set"; then
+ echo $ac_n "checking for Tcl configuration""... $ac_c" 1>&6
+echo "configure:1681: checking for Tcl configuration" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test "$cross_compiling" = yes; then
- tcl_cv_api_serial=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 2733 "configure"
-#include "confdefs.h"
-
-#include <termios.h>
-
-int main() {
- struct termios t;
- if (tcgetattr(0, &t) == 0) {
- cfsetospeed(&t, 0);
- t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
- return 0;
- }
- return 1;
-}
-EOF
-if { (eval echo configure:2748: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_api_serial=termios
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_api_serial=no
-fi
-rm -fr conftest*
-fi
-
- if test $tcl_cv_api_serial = no ; then
- if test "$cross_compiling" = yes; then
- tcl_cv_api_serial=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 2765 "configure"
-#include "confdefs.h"
-
-#include <termio.h>
-
-int main() {
- struct termio t;
- if (ioctl(0, TCGETA, &t) == 0) {
- t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
- return 0;
- }
- return 1;
-}
-EOF
-if { (eval echo configure:2779: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_api_serial=termio
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_api_serial=no
-fi
-rm -fr conftest*
-fi
-
- fi
- if test $tcl_cv_api_serial = no ; then
- if test "$cross_compiling" = yes; then
- tcl_cv_api_serial=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 2797 "configure"
-#include "confdefs.h"
-
-#include <sgtty.h>
-
-int main() {
- struct sgttyb t;
- if (ioctl(0, TIOCGETP, &t) == 0) {
- t.sg_ospeed = 0;
- t.sg_flags |= ODDP | EVENP | RAW;
- return 0;
- }
- return 1;
-}
-EOF
-if { (eval echo configure:2812: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_api_serial=sgtty
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_api_serial=no
-fi
-rm -fr conftest*
-fi
-
- fi
- if test $tcl_cv_api_serial = no ; then
- if test "$cross_compiling" = yes; then
- tcl_cv_api_serial=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 2830 "configure"
-#include "confdefs.h"
-
-#include <termios.h>
-#include <errno.h>
-
-int main() {
- struct termios t;
- if (tcgetattr(0, &t) == 0
- || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
- cfsetospeed(&t, 0);
- t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
- return 0;
- }
- return 1;
-}
-EOF
-if { (eval echo configure:2847: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_api_serial=termios
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_api_serial=no
-fi
-rm -fr conftest*
-fi
-
- fi
- if test $tcl_cv_api_serial = no; then
- if test "$cross_compiling" = yes; then
- tcl_cv_api_serial=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 2865 "configure"
-#include "confdefs.h"
-
-#include <termio.h>
-#include <errno.h>
-
-int main() {
- struct termio t;
- if (ioctl(0, TCGETA, &t) == 0
- || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
- t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
- return 0;
- }
- return 1;
- }
-EOF
-if { (eval echo configure:2881: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_api_serial=termio
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_api_serial=no
-fi
-rm -fr conftest*
-fi
-
- fi
- if test $tcl_cv_api_serial = no; then
- if test "$cross_compiling" = yes; then
- tcl_cv_api_serial=none
-else
- cat > conftest.$ac_ext <<EOF
-#line 2899 "configure"
-#include "confdefs.h"
-
-#include <sgtty.h>
-#include <errno.h>
-
-int main() {
- struct sgttyb t;
- if (ioctl(0, TIOCGETP, &t) == 0
- || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
- t.sg_ospeed = 0;
- t.sg_flags |= ODDP | EVENP | RAW;
- return 0;
- }
- return 1;
-}
-EOF
-if { (eval echo configure:2916: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_api_serial=sgtty
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_api_serial=none
-fi
-rm -fr conftest*
-fi
-
- fi
-fi
-
- case $tcl_cv_api_serial in
- termios) cat >> confdefs.h <<\EOF
-#define USE_TERMIOS 1
-EOF
-;;
- termio) cat >> confdefs.h <<\EOF
-#define USE_TERMIO 1
-EOF
-;;
- sgtty) cat >> confdefs.h <<\EOF
-#define USE_SGTTY 1
-EOF
-;;
- esac
- echo "$ac_t""$tcl_cv_api_serial" 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 for fd_set in sys/types""... $ac_c" 1>&6
-echo "configure:2959: checking for fd_set in sys/types" >&5
-if eval "test \"`echo '$''{'tcl_cv_type_fd_set'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 2964 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-int main() {
-fd_set readMask, writeMask;
-; return 0; }
-EOF
-if { (eval echo configure:2971: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_type_fd_set=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_type_fd_set=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$tcl_cv_type_fd_set" 1>&6
-tk_ok=$tcl_cv_type_fd_set
-if test $tcl_cv_type_fd_set = no; then
- echo $ac_n "checking for fd_mask in sys/select""... $ac_c" 1>&6
-echo "configure:2987: checking for fd_mask in sys/select" >&5
- if eval "test \"`echo '$''{'tcl_cv_grep_fd_mask'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 2992 "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*
- tcl_cv_grep_fd_mask=present
-else
- rm -rf conftest*
- tcl_cv_grep_fd_mask=missing
-fi
-rm -f conftest*
-
-fi
-
- echo "$ac_t""$tcl_cv_grep_fd_mask" 1>&6
- if test $tcl_cv_grep_fd_mask = present; then
- cat >> confdefs.h <<\EOF
-#define HAVE_SYS_SELECT_H 1
-EOF
-
- tk_ok=yes
- fi
-fi
-if test $tk_ok = no; then
- cat >> confdefs.h <<\EOF
-#define NO_FD_SET 1
-EOF
-
-fi
-
-#------------------------------------------------------------------------------
-# Find out all about time handling differences.
-#------------------------------------------------------------------------------
-
-echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
-echo "configure:3029: checking whether struct tm is in sys/time.h or time.h" >&5
-if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3034 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <time.h>
-int main() {
-struct tm *tp; tp->tm_sec;
-; return 0; }
-EOF
-if { (eval echo configure:3042: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_struct_tm=time.h
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_struct_tm=sys/time.h
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_struct_tm" 1>&6
-if test $ac_cv_struct_tm = sys/time.h; then
- cat >> confdefs.h <<\EOF
-#define TM_IN_SYS_TIME 1
-EOF
-
-fi
-
-
- 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:3067: 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 3072 "configure"
-#include "confdefs.h"
-#include <$ac_hdr>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:3077: \"$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:3104: 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 3109 "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:3118: \"$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
-
- echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
-echo "configure:3139: checking for tm_zone in struct tm" >&5
-if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3144 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <$ac_cv_struct_tm>
-int main() {
-struct tm tm; tm.tm_zone;
-; return 0; }
-EOF
-if { (eval echo configure:3152: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_struct_tm_zone=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_struct_tm_zone=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6
-if test "$ac_cv_struct_tm_zone" = yes; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_ZONE 1
-EOF
-
-else
- echo $ac_n "checking for tzname""... $ac_c" 1>&6
-echo "configure:3172: checking for tzname" >&5
-if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3177 "configure"
-#include "confdefs.h"
-#include <time.h>
-#ifndef tzname /* For SGI. */
-extern char *tzname[]; /* RS6000 and others reject char **tzname. */
-#endif
-int main() {
-atoi(*tzname);
-; return 0; }
-EOF
-if { (eval echo configure:3187: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- ac_cv_var_tzname=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_var_tzname=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_var_tzname" 1>&6
- if test $ac_cv_var_tzname = yes; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TZNAME 1
-EOF
-
- fi
-fi
-
-
- for ac_func in gmtime_r localtime_r
-do
-echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:3212: 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 3217 "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:3240: \"$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
+ # First check to see if --with-tcl 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
+ { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; }
+ fi
+ 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
+ # then check for a private Tcl installation
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ../tcl \
+ `ls -dr ../tcl[8-9].[0-9]* 2>/dev/null` \
+ ../../tcl \
+ `ls -dr ../../tcl[8-9].[0-9]* 2>/dev/null` \
+ ../../../tcl \
+ `ls -dr ../../../tcl[8-9].[0-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 ${libdir} 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` \
+ `ls -d /usr/contrib/lib 2>/dev/null` \
+ `ls -d /usr/lib 2>/dev/null` \
+ ; do
+ if test -f "$i/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
- echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
-echo "configure:3266: checking tm_tzadj in struct tm" >&5
- if eval "test \"`echo '$''{'tcl_cv_member_tm_tzadj'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3271 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-struct tm tm; tm.tm_tzadj;
-; return 0; }
-EOF
-if { (eval echo configure:3278: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_member_tm_tzadj=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_member_tm_tzadj=no
-fi
-rm -f conftest*
+ # 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[8-9].[0-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
+
fi
- echo "$ac_t""$tcl_cv_member_tm_tzadj" 1>&6
- if test $tcl_cv_member_tm_tzadj = yes ; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_TZADJ 1
-EOF
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCL_BIN_DIR="# no Tcl configs found"
+ echo "configure: warning: Can't find Tcl configuration definitions" 1>&2
+ exit 0
+ else
+ no_tcl=
+ TCL_BIN_DIR=${ac_cv_c_tclconfig}
+ echo "$ac_t""found $TCL_BIN_DIR/tclConfig.sh" 1>&6
+ fi
fi
- echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
-echo "configure:3299: checking tm_gmtoff in struct tm" >&5
- if eval "test \"`echo '$''{'tcl_cv_member_tm_gmtoff'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3304 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-struct tm tm; tm.tm_gmtoff;
-; return 0; }
-EOF
-if { (eval echo configure:3311: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_member_tm_gmtoff=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_member_tm_gmtoff=no
-fi
-rm -f conftest*
-fi
- echo "$ac_t""$tcl_cv_member_tm_gmtoff" 1>&6
- if test $tcl_cv_member_tm_gmtoff = yes ; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_GMTOFF 1
-EOF
+ echo $ac_n "checking for existence of $TCL_BIN_DIR/tclConfig.sh""... $ac_c" 1>&6
+echo "configure:1754: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5
+ if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then
+ echo "$ac_t""loading" 1>&6
+ . $TCL_BIN_DIR/tclConfig.sh
+ else
+ echo "$ac_t""file not found" 1>&6
fi
#
- # Its important to include time.h in this check, as some systems
- # (like convex) have timezone functions, etc.
+ # If the TCL_BIN_DIR is the build directory (not the install directory),
+ # then set the common variable name to the value of the build variables.
+ # For example, the variable TCL_LIB_SPEC will be set to the value
+ # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
+ # instead of TCL_BUILD_LIB_SPEC since it will work with both an
+ # installed and uninstalled version of Tcl.
#
- echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
-echo "configure:3336: checking long timezone variable" >&5
- if eval "test \"`echo '$''{'tcl_cv_var_timezone'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3341 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-extern long timezone;
- timezone += 1;
- exit (0);
-; return 0; }
-EOF
-if { (eval echo configure:3350: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_timezone_long=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_timezone_long=no
-fi
-rm -f conftest*
-fi
-
- echo "$ac_t""$tcl_cv_timezone_long" 1>&6
- if test $tcl_cv_timezone_long = yes ; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_VAR 1
-EOF
-
- else
- #
- # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
- #
- echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
-echo "configure:3373: checking time_t timezone variable" >&5
- if eval "test \"`echo '$''{'tcl_cv_timezone_time'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3378 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-extern time_t timezone;
- timezone += 1;
- exit (0);
-; return 0; }
-EOF
-if { (eval echo configure:3387: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_timezone_time=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_timezone_time=no
-fi
-rm -f conftest*
-fi
-
- echo "$ac_t""$tcl_cv_timezone_time" 1>&6
- if test $tcl_cv_timezone_time = yes ; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_VAR 1
-EOF
-
- fi
- fi
-
-
-#--------------------------------------------------------------------
-# Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
-# in struct stat. But we might be able to use fstatfs instead.
-#--------------------------------------------------------------------
-echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6
-echo "configure:3414: checking for st_blksize in struct stat" >&5
-if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3419 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <sys/stat.h>
-int main() {
-struct stat s; s.st_blksize;
-; return 0; }
-EOF
-if { (eval echo configure:3427: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_struct_st_blksize=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_struct_st_blksize=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_struct_st_blksize" 1>&6
-if test $ac_cv_struct_st_blksize = yes; then
- cat >> confdefs.h <<\EOF
-#define HAVE_ST_BLKSIZE 1
-EOF
-
-fi
-
-echo $ac_n "checking for fstatfs""... $ac_c" 1>&6
-echo "configure:3448: checking for fstatfs" >&5
-if eval "test \"`echo '$''{'ac_cv_func_fstatfs'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3453 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char fstatfs(); 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 fstatfs();
-
-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_fstatfs) || defined (__stub___fstatfs)
-choke me
-#else
-fstatfs();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:3476: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_fstatfs=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_fstatfs=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'fstatfs`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_FSTATFS 1
-EOF
-
-fi
-
-
-#--------------------------------------------------------------------
-# Some system have no memcmp or it does not work with 8 bit
-# data, this checks it and add memcmp.o to LIBOBJS if needed
-#--------------------------------------------------------------------
-echo $ac_n "checking for 8-bit clean memcmp""... $ac_c" 1>&6
-echo "configure:3505: checking for 8-bit clean memcmp" >&5
-if eval "test \"`echo '$''{'ac_cv_func_memcmp_clean'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test "$cross_compiling" = yes; then
- ac_cv_func_memcmp_clean=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 3513 "configure"
-#include "confdefs.h"
-
-main()
-{
- char c0 = 0x40, c1 = 0x80, c2 = 0x81;
- exit(memcmp(&c0, &c2, 1) < 0 && memcmp(&c1, &c2, 1) < 0 ? 0 : 1);
-}
-
-EOF
-if { (eval echo configure:3523: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- ac_cv_func_memcmp_clean=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- ac_cv_func_memcmp_clean=no
-fi
-rm -fr conftest*
-fi
-
-fi
-
-echo "$ac_t""$ac_cv_func_memcmp_clean" 1>&6
-test $ac_cv_func_memcmp_clean = no && LIBOBJS="$LIBOBJS memcmp.${ac_objext}"
-
-
-#--------------------------------------------------------------------
-# Some system like SunOS 4 and other BSD like systems
-# have no memmove (we assume they have bcopy instead).
-# {The replacement define is in compat/string.h}
-#--------------------------------------------------------------------
-echo $ac_n "checking for memmove""... $ac_c" 1>&6
-echo "configure:3547: 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 3552 "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:3575: \"$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 NO_MEMMOVE 1
-EOF
- cat >> confdefs.h <<\EOF
-#define NO_STRING_H 1
-EOF
-
-fi
-
-
-#--------------------------------------------------------------------
-# On some systems strstr is broken: it returns a pointer even
-# even if the original string is empty.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking proper strstr implementation""... $ac_c" 1>&6
-echo "configure:3608: checking proper strstr implementation" >&5
-if test "$cross_compiling" = yes; then
- tcl_ok=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 3613 "configure"
-#include "confdefs.h"
-
-extern int strstr();
-int main()
-{
- exit(strstr("\0test", "test") ? 1 : 0);
-}
-
-EOF
-if { (eval echo configure:3623: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_ok=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_ok=no
-fi
-rm -fr conftest*
-fi
-
-if test $tcl_ok = yes; then
- echo "$ac_t""yes" 1>&6
-else
- echo "$ac_t""broken, using substitute" 1>&6
- LIBOBJS="$LIBOBJS strstr.o"
-fi
-
-#--------------------------------------------------------------------
-# Check for strtoul function. This is tricky because under some
-# versions of AIX strtoul returns an incorrect terminator
-# pointer for the string "0".
-#--------------------------------------------------------------------
-
-echo $ac_n "checking for strtoul""... $ac_c" 1>&6
-echo "configure:3649: checking for strtoul" >&5
-if eval "test \"`echo '$''{'ac_cv_func_strtoul'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3654 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strtoul(); 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 strtoul();
-
-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_strtoul) || defined (__stub___strtoul)
-choke me
-#else
-strtoul();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:3677: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_strtoul=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_strtoul=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'strtoul`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- tcl_ok=1
-else
- echo "$ac_t""no" 1>&6
-tcl_ok=0
-fi
-
-if test "$cross_compiling" = yes; then
- tcl_ok=0
-else
- cat > conftest.$ac_ext <<EOF
-#line 3701 "configure"
-#include "confdefs.h"
-
-extern int strtoul();
-int main()
-{
- char *string = "0";
- char *term;
- int value;
- value = strtoul(string, &term, 0);
- if ((value != 0) || (term != (string+1))) {
- exit(1);
- }
- exit(0);
-}
-EOF
-if { (eval echo configure:3717: \"$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*
- tcl_ok=0
-fi
-rm -fr conftest*
-fi
-
-if test "$tcl_ok" = 0; then
- test -n "$verbose" && echo " Adding strtoul.o."
- LIBOBJS="$LIBOBJS strtoul.o"
-fi
-
-#--------------------------------------------------------------------
-# Check for the strtod function. This is tricky because in some
-# versions of Linux strtod mis-parses strings starting with "+".
-#--------------------------------------------------------------------
-
-echo $ac_n "checking for strtod""... $ac_c" 1>&6
-echo "configure:3740: 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 3745 "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:3768: \"$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
- tcl_ok=1
-else
- echo "$ac_t""no" 1>&6
-tcl_ok=0
-fi
-
-if test "$cross_compiling" = yes; then
- tcl_ok=0
-else
- cat > conftest.$ac_ext <<EOF
-#line 3792 "configure"
-#include "confdefs.h"
-
-extern double strtod();
-int main()
-{
- char *string = " +69";
- char *term;
- double value;
- value = strtod(string, &term);
- if ((value != 69) || (term != (string+4))) {
- exit(1);
- }
- exit(0);
-}
-EOF
-if { (eval echo configure:3808: \"$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*
- tcl_ok=0
-fi
-rm -fr conftest*
-fi
-
-if test "$tcl_ok" = 0; then
- test -n "$verbose" && echo " Adding strtod.o."
- LIBOBJS="$LIBOBJS strtod.o"
-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" that corrects the error.
-#--------------------------------------------------------------------
-
-
- echo $ac_n "checking for strtod""... $ac_c" 1>&6
-echo "configure:3834: 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 3839 "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:3862: \"$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
- tcl_strtod=1
-else
- echo "$ac_t""no" 1>&6
-tcl_strtod=0
-fi
-
- if test "$tcl_strtod" = 1; then
- echo $ac_n "checking for Solaris2.4/Tru64 strtod bugs""... $ac_c" 1>&6
-echo "configure:3884: checking for Solaris2.4/Tru64 strtod bugs" >&5
- if eval "test \"`echo '$''{'tcl_cv_strtod_buggy'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
-
- if test "$cross_compiling" = yes; then
- tcl_cv_strtod_buggy=0
-else
- cat > conftest.$ac_ext <<EOF
-#line 3893 "configure"
-#include "confdefs.h"
-
- extern double strtod();
- int main() {
- char *infString="Inf", *nanString="NaN", *spaceString=" ";
- char *term;
- double value;
- value = strtod(infString, &term);
- if ((term != infString) && (term[-1] == 0)) {
- exit(1);
- }
- value = strtod(nanString, &term);
- if ((term != nanString) && (term[-1] == 0)) {
- exit(1);
- }
- value = strtod(spaceString, &term);
- if (term == (spaceString+1)) {
- exit(1);
- }
- exit(0);
- }
-EOF
-if { (eval echo configure:3916: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_strtod_buggy=1
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_strtod_buggy=0
-fi
-rm -fr conftest*
-fi
-fi
-
- if test "$tcl_cv_strtod_buggy" = 1; then
- echo "$ac_t""ok" 1>&6
- else
- echo "$ac_t""buggy" 1>&6
- LIBOBJS="$LIBOBJS fixstrtod.o"
- cat >> confdefs.h <<\EOF
-#define strtod fixstrtod
-EOF
-
- fi
+ if test -f $TCL_BIN_DIR/Makefile ; then
+ TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC}
+ TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC}
+ TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
fi
+ #
+ # eval is required to do the TCL_DBGX substitution
+ #
-#--------------------------------------------------------------------
-# 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:3949: 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 3954 "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:3962: \"$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 3979 "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 3997 "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 4018 "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:4029: \"$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:4053: 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 4058 "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:4086: 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 4091 "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:4119: 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 4124 "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:4152: 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 4157 "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
-
+ eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
+ eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
+ eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
-echo $ac_n "checking for socklen_t""... $ac_c" 1>&6
-echo "configure:4187: checking for socklen_t" >&5
-if eval "test \"`echo '$''{'ac_cv_type_socklen_t'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4192 "configure"
-#include "confdefs.h"
+ eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
+ eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
+ eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
- #include <sys/types.h>
- #include <sys/socket.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])socklen_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
- rm -rf conftest*
- ac_cv_type_socklen_t=yes
-else
- rm -rf conftest*
- ac_cv_type_socklen_t=no
-fi
-rm -f conftest*
-
-fi
-
-echo "$ac_t""$ac_cv_type_socklen_t" 1>&6
-if test $ac_cv_type_socklen_t = no; then
- cat >> confdefs.h <<\EOF
-#define socklen_t unsigned
-EOF
-
-fi
-
-#--------------------------------------------------------------------
-# If a system doesn't have an opendir function (man, that's old!)
-# then we have to supply a different version of dirent.h which
-# is compatible with the substitute version of opendir that's
-# provided. This version only works with V7-style directories.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking for opendir""... $ac_c" 1>&6
-echo "configure:4231: checking for opendir" >&5
-if eval "test \"`echo '$''{'ac_cv_func_opendir'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4236 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char opendir(); 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 opendir();
-
-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_opendir) || defined (__stub___opendir)
-choke me
-#else
-opendir();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:4259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_opendir=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_opendir=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'opendir`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define USE_DIRENT2_H 1
-EOF
-
-fi
-
-
-#--------------------------------------------------------------------
-# The check below checks whether <sys/wait.h> defines the type
-# "union wait" correctly. It's needed because of weirdness in
-# HP-UX where "union wait" is defined in both the BSD and SYS-V
-# environments. Checking the usability of WIFEXITED seems to do
-# the trick.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking union wait""... $ac_c" 1>&6
-echo "configure:4292: checking union wait" >&5
-if eval "test \"`echo '$''{'tcl_cv_union_wait'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4297 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <sys/wait.h>
-int main() {
-
-union wait x;
-WIFEXITED(x); /* Generates compiler error if WIFEXITED
- * uses an int. */
-; return 0; }
-EOF
-if { (eval echo configure:4309: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- tcl_cv_union_wait=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_union_wait=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$tcl_cv_union_wait" 1>&6
-if test $tcl_cv_union_wait = no; then
- cat >> confdefs.h <<\EOF
-#define NO_UNION_WAIT 1
-EOF
-
-fi
-
-#--------------------------------------------------------------------
-# Check whether there is an strncasecmp 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 strncasecmp""... $ac_c" 1>&6
-echo "configure:4336: checking for strncasecmp" >&5
-if eval "test \"`echo '$''{'ac_cv_func_strncasecmp'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4341 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strncasecmp(); 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 strncasecmp();
-
-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_strncasecmp) || defined (__stub___strncasecmp)
-choke me
-#else
-strncasecmp();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:4364: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_strncasecmp=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_strncasecmp=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'strncasecmp`\" = 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 strncasecmp in -lsocket""... $ac_c" 1>&6
-echo "configure:4386: checking for strncasecmp in -lsocket" >&5
-ac_lib_var=`echo socket'_'strncasecmp | 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 4394 "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 strncasecmp();
-
-int main() {
-strncasecmp()
-; return 0; }
-EOF
-if { (eval echo configure:4405: \"$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 strncasecmp in -linet""... $ac_c" 1>&6
-echo "configure:4429: checking for strncasecmp in -linet" >&5
-ac_lib_var=`echo inet'_'strncasecmp | 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 4437 "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 strncasecmp();
-
-int main() {
-strncasecmp()
-; return 0; }
-EOF
-if { (eval echo configure:4448: \"$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
- LIBOBJS="$LIBOBJS strncasecmp.o"
-fi
-
-#--------------------------------------------------------------------
-# The code below deals with several issues related to gettimeofday:
-# 1. Some systems don't provide a gettimeofday function at all
-# (set NO_GETTOD if this is the case).
-# 2. SGI systems don't use the BSD form of the gettimeofday function,
-# but they have a BSDgettimeofday function that can be used instead.
-# 3. See if gettimeofday is declared in the <sys/time.h> header file.
-# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
-# declare it.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6
-echo "configure:4486: checking for BSDgettimeofday" >&5
-if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4491 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char BSDgettimeofday(); 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 BSDgettimeofday();
-
-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_BSDgettimeofday) || defined (__stub___BSDgettimeofday)
-choke me
-#else
-BSDgettimeofday();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:4514: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_BSDgettimeofday=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_BSDgettimeofday=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'BSDgettimeofday`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- cat >> confdefs.h <<\EOF
-#define HAVE_BSDGETTIMEOFDAY 1
-EOF
-
-else
- echo "$ac_t""no" 1>&6
-
- echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6
-echo "configure:4536: checking for gettimeofday" >&5
-if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4541 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char gettimeofday(); 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 gettimeofday();
-
-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_gettimeofday) || defined (__stub___gettimeofday)
-choke me
-#else
-gettimeofday();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:4564: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_gettimeofday=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_gettimeofday=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'gettimeofday`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-cat >> confdefs.h <<\EOF
-#define NO_GETTOD 1
-EOF
-
-fi
-
-
-fi
-
-echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6
-echo "configure:4591: checking for gettimeofday declaration" >&5
-if eval "test \"`echo '$''{'tcl_cv_grep_gettimeofday'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4596 "configure"
-#include "confdefs.h"
-#include <sys/time.h>
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- egrep "gettimeofday" >/dev/null 2>&1; then
- rm -rf conftest*
- tcl_cv_grep_gettimeofday=present
-else
- rm -rf conftest*
- tcl_cv_grep_gettimeofday=missing
-fi
-rm -f conftest*
-
-fi
-
-echo "$ac_t""$tcl_cv_grep_gettimeofday" 1>&6
-if test $tcl_cv_grep_gettimeofday = missing ; then
- cat >> confdefs.h <<\EOF
-#define GETTOD_NOT_DECLARED 1
-EOF
-
-fi
-
-#--------------------------------------------------------------------
-# The following code checks to see whether it is possible to get
-# signed chars on this platform. This is needed in order to
-# properly generate sign-extended ints from character values.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
-echo "configure:4627: 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 4634 "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 4656 "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:4666: \"$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
-
-echo $ac_n "checking signed char declarations""... $ac_c" 1>&6
-echo "configure:4690: checking signed char declarations" >&5
-if eval "test \"`echo '$''{'tcl_cv_char_signed'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 4695 "configure"
-#include "confdefs.h"
-
-int main() {
-
- signed char *p;
- p = 0;
-
-; return 0; }
-EOF
-if { (eval echo configure:4705: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_char_signed=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_char_signed=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$tcl_cv_char_signed" 1>&6
-if test $tcl_cv_char_signed = yes; then
- cat >> confdefs.h <<\EOF
-#define HAVE_SIGNED_CHAR 1
-EOF
-
-fi
-
-#--------------------------------------------------------------------
-# Does putenv() copy or not? We need to know to avoid memory leaks.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking for a putenv() that copies the buffer""... $ac_c" 1>&6
-echo "configure:4730: checking for a putenv() that copies the buffer" >&5
-if eval "test \"`echo '$''{'tcl_cv_putenv_copy'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test "$cross_compiling" = yes; then
- tcl_cv_putenv_copy=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 4738 "configure"
-#include "confdefs.h"
-
- #include <stdlib.h>
- #define OURVAR "havecopy=yes"
- int main (int argc, char *argv)
- {
- char *foo, *bar;
- foo = (char *)strdup(OURVAR);
- putenv(foo);
- strcpy((char *)(strchr(foo, '=') + 1), "no");
- bar = getenv("havecopy");
- if (!strcmp(bar, "no")) {
- /* doesnt copy */
- return 0;
- } else {
- /* does copy */
- return 1;
- }
- }
-EOF
-if { (eval echo configure:4760: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_putenv_copy=no
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_putenv_copy=yes
-fi
-rm -fr conftest*
-fi
-
-
-fi
-
-echo "$ac_t""$tcl_cv_putenv_copy" 1>&6
-if test $tcl_cv_putenv_copy = yes; then
- cat >> confdefs.h <<\EOF
-#define HAVE_PUTENV_THAT_COPIES 1
-EOF
-
-fi
-
-#--------------------------------------------------------------------
-# Check for support of nl_langinfo function
-#--------------------------------------------------------------------
-
-
- # Check whether --enable-langinfo or --disable-langinfo was given.
-if test "${enable_langinfo+set}" = set; then
- enableval="$enable_langinfo"
- langinfo_ok=$enableval
-else
- langinfo_ok=yes
-fi
-
-
- HAVE_LANGINFO=0
- if test "$langinfo_ok" = "yes"; then
- if test "$langinfo_ok" = "yes"; then
- ac_safe=`echo "langinfo.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for langinfo.h""... $ac_c" 1>&6
-echo "configure:4802: checking for langinfo.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 4807 "configure"
-#include "confdefs.h"
-#include <langinfo.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4812: \"$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
- langinfo_ok=yes
-else
- echo "$ac_t""no" 1>&6
-langinfo_ok=no
-fi
-
- fi
- fi
- echo $ac_n "checking whether to use nl_langinfo""... $ac_c" 1>&6
-echo "configure:4837: checking whether to use nl_langinfo" >&5
- if test "$langinfo_ok" = "yes"; then
- cat > conftest.$ac_ext <<EOF
-#line 4840 "configure"
-#include "confdefs.h"
-#include <langinfo.h>
-int main() {
-nl_langinfo(CODESET);
-; return 0; }
-EOF
-if { (eval echo configure:4847: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- langinfo_ok=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- langinfo_ok=no
-fi
-rm -f conftest*
- if test "$langinfo_ok" = "no"; then
- langinfo_ok="no (could not compile with nl_langinfo)";
- fi
- if test "$langinfo_ok" = "yes"; then
- cat >> confdefs.h <<\EOF
-#define HAVE_LANGINFO 1
-EOF
-
- fi
- fi
- echo "$ac_t""$langinfo_ok" 1>&6
-
-
-#--------------------------------------------------------------------
-# Look for libraries that we will need when compiling the Tcl shell
-#--------------------------------------------------------------------
-
-
- #--------------------------------------------------------------------
- # 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").
- #--------------------------------------------------------------------
-
- echo $ac_n "checking for sin""... $ac_c" 1>&6
-echo "configure:4883: 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 4888 "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:4911: \"$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
- MATH_LIBS=""
-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:4932: 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 4940 "configure"
-#include "confdefs.h"
-
-int main() {
-main()
-; return 0; }
-EOF
-if { (eval echo configure:4947: \"$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
-
-
- #--------------------------------------------------------------------
- # Interactive UNIX requires -linet instead of -lsocket, plus it
- # needs net/errno.h to define the socket-related error codes.
- #--------------------------------------------------------------------
-
- echo $ac_n "checking for main in -linet""... $ac_c" 1>&6
-echo "configure:4974: checking for main in -linet" >&5
-ac_lib_var=`echo inet'_'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="-linet $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 4982 "configure"
-#include "confdefs.h"
-
-int main() {
-main()
-; return 0; }
-EOF
-if { (eval echo configure:4989: \"$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 -linet"
-else
- echo "$ac_t""no" 1>&6
-fi
-
- ac_safe=`echo "net/errno.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for net/errno.h""... $ac_c" 1>&6
-echo "configure:5011: checking for net/errno.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 5016 "configure"
-#include "confdefs.h"
-#include <net/errno.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5021: \"$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
- cat >> confdefs.h <<\EOF
-#define HAVE_NET_ERRNO_H 1
-EOF
-
-else
- echo "$ac_t""no" 1>&6
-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.
- #--------------------------------------------------------------------
-
- tcl_checkBoth=0
- echo $ac_n "checking for connect""... $ac_c" 1>&6
-echo "configure:5066: 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 5071 "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:5094: \"$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 setsockopt""... $ac_c" 1>&6
-echo "configure:5116: checking for setsockopt" >&5
-if eval "test \"`echo '$''{'ac_cv_func_setsockopt'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 5121 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char setsockopt(); 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 setsockopt();
-
-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_setsockopt) || defined (__stub___setsockopt)
-choke me
-#else
-setsockopt();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:5144: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_func_setsockopt=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_func_setsockopt=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'setsockopt`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-echo $ac_n "checking for setsockopt in -lsocket""... $ac_c" 1>&6
-echo "configure:5162: checking for setsockopt in -lsocket" >&5
-ac_lib_var=`echo socket'_'setsockopt | 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 5170 "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 setsockopt();
-
-int main() {
-setsockopt()
-; return 0; }
-EOF
-if { (eval echo configure:5181: \"$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
-tcl_checkBoth=1
-fi
-
-fi
-
- fi
- if test "$tcl_checkBoth" = 1; then
- tk_oldLibs=$LIBS
- LIBS="$LIBS -lsocket -lnsl"
- echo $ac_n "checking for accept""... $ac_c" 1>&6
-echo "configure:5209: 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 5214 "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:5237: \"$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
-LIBS=$tk_oldLibs
-fi
-
- fi
- echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
-echo "configure:5259: 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 5264 "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:5287: \"$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 gethostbyname in -lnsl""... $ac_c" 1>&6
-echo "configure:5305: checking for gethostbyname in -lnsl" >&5
-ac_lib_var=`echo nsl'_'gethostbyname | 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 5313 "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 gethostbyname();
-
-int main() {
-gethostbyname()
-; return 0; }
-EOF
-if { (eval echo configure:5324: \"$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
- # Don't perform the eval of the libraries here because DL_LIBS
- # won't be set until we call SC_CONFIG_CFLAGS
-
- TCL_LIBS='${DL_LIBS} ${LIBS} ${MATH_LIBS}'
+
+
+
-# Add the threads support libraries
-LIBS="$LIBS$THREADS_LIBS"
+#--------------------------------------------------------------------
+# Recompute the necessary flags to run the compiler
+#--------------------------------------------------------------------
echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
-echo "configure:5361: checking how to build libraries" >&5
+echo "configure:1809: checking how to build libraries" >&5
# Check whether --enable-shared or --disable-shared was given.
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
@@ -5387,16 +1835,10 @@ EOF
fi
-#--------------------------------------------------------------------
-# The statements below define a collection of compile flags. This
-# macro depends on the value of SHARED_BUILD, and should be called
-# after SC_ENABLE_SHARED checks the configure switches.
-#--------------------------------------------------------------------
-
# 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:5400: checking for $ac_word" >&5
+echo "configure:1842: 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
@@ -5428,7 +1870,7 @@ fi
# Step 0.a: Enable 64 bit support?
echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6
-echo "configure:5432: checking if 64bit support is requested" >&5
+echo "configure:1874: checking if 64bit support is requested" >&5
# Check whether --enable-64bit or --disable-64bit was given.
if test "${enable_64bit+set}" = set; then
enableval="$enable_64bit"
@@ -5448,7 +1890,7 @@ fi
# Step 0.b: Enable Solaris 64 bit VIS support?
echo $ac_n "checking if 64bit Sparc VIS support is requested""... $ac_c" 1>&6
-echo "configure:5452: checking if 64bit Sparc VIS support is requested" >&5
+echo "configure:1894: checking if 64bit Sparc VIS support is requested" >&5
# Check whether --enable-64bit-vis or --disable-64bit-vis was given.
if test "${enable_64bit_vis+set}" = set; then
enableval="$enable_64bit_vis"
@@ -5472,7 +1914,7 @@ fi
# there are a few systems, like Next, where this doesn't work.
echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6
-echo "configure:5476: checking system version (for dynamic loading)" >&5
+echo "configure:1918: checking system version (for dynamic loading)" >&5
if test -f /usr/lib/NextStep/software_version; then
system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
else
@@ -5498,7 +1940,7 @@ echo "configure:5476: checking system version (for dynamic loading)" >&5
# Linux can use either -ldl or -ldld for dynamic loading.
echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
-echo "configure:5502: checking for dlopen in -ldl" >&5
+echo "configure:1944: checking for dlopen in -ldl" >&5
ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -5506,7 +1948,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5510 "configure"
+#line 1952 "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
@@ -5517,7 +1959,7 @@ int main() {
dlopen()
; return 0; }
EOF
-if { (eval echo configure:5521: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1963: \"$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
@@ -5561,7 +2003,7 @@ fi
# Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:5565: checking for $ac_word" >&5
+echo "configure:2007: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -5674,7 +2116,7 @@ fi
# known GMT value.
echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
-echo "configure:5678: checking for gettimeofday in -lbsd" >&5
+echo "configure:2120: checking for gettimeofday in -lbsd" >&5
ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -5682,7 +2124,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lbsd $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5686 "configure"
+#line 2128 "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
@@ -5693,7 +2135,7 @@ int main() {
gettimeofday()
; return 0; }
EOF
-if { (eval echo configure:5697: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2139: \"$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
@@ -5775,7 +2217,7 @@ EOF
SHLIB_SUFFIX=".sl"
echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
-echo "configure:5779: checking for shl_load in -ldld" >&5
+echo "configure:2221: checking for shl_load in -ldld" >&5
ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -5783,7 +2225,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldld $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5787 "configure"
+#line 2229 "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
@@ -5794,7 +2236,7 @@ int main() {
shl_load()
; return 0; }
EOF
-if { (eval echo configure:5798: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2240: \"$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
@@ -5856,7 +2298,7 @@ fi
HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
SHLIB_SUFFIX=".sl"
echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
-echo "configure:5860: checking for shl_load in -ldld" >&5
+echo "configure:2302: checking for shl_load in -ldld" >&5
ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -5864,7 +2306,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldld $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5868 "configure"
+#line 2310 "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
@@ -5875,7 +2317,7 @@ int main() {
shl_load()
; return 0; }
EOF
-if { (eval echo configure:5879: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2321: \"$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
@@ -6003,17 +2445,17 @@ fi
else
ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dld.h""... $ac_c" 1>&6
-echo "configure:6007: checking for dld.h" >&5
+echo "configure:2449: checking for dld.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 6012 "configure"
+#line 2454 "configure"
#include "confdefs.h"
#include <dld.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6017: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2459: \"$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*
@@ -6072,17 +2514,17 @@ fi
else
ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dld.h""... $ac_c" 1>&6
-echo "configure:6076: checking for dld.h" >&5
+echo "configure:2518: checking for dld.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 6081 "configure"
+#line 2523 "configure"
#include "confdefs.h"
#include <dld.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6086: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2528: \"$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*
@@ -6140,17 +2582,17 @@ fi
# Not available on all versions: check for include file.
ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
-echo "configure:6144: checking for dlfcn.h" >&5
+echo "configure:2586: checking for dlfcn.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 6149 "configure"
+#line 2591 "configure"
#include "confdefs.h"
#include <dlfcn.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6154: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2596: \"$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*
@@ -6178,9 +2620,9 @@ if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
echo $ac_n "checking for ELF""... $ac_c" 1>&6
-echo "configure:6182: checking for ELF" >&5
+echo "configure:2624: checking for ELF" >&5
cat > conftest.$ac_ext <<EOF
-#line 6184 "configure"
+#line 2626 "configure"
#include "confdefs.h"
#ifdef __ELF__
@@ -6538,17 +2980,17 @@ EOF
# that don't grok the -Bexport option. Test that it does.
hold_ldflags=$LDFLAGS
echo $ac_n "checking for ld accepts -Bexport flag""... $ac_c" 1>&6
-echo "configure:6542: checking for ld accepts -Bexport flag" >&5
+echo "configure:2984: checking for ld accepts -Bexport flag" >&5
LDFLAGS="${LDFLAGS} -Wl,-Bexport"
cat > conftest.$ac_ext <<EOF
-#line 6545 "configure"
+#line 2987 "configure"
#include "confdefs.h"
int main() {
int i;
; return 0; }
EOF
-if { (eval echo configure:6552: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2994: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
found=yes
else
@@ -6595,9 +3037,9 @@ rm -f conftest*
if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6
-echo "configure:6599: checking sys/exec.h" >&5
+echo "configure:3041: checking sys/exec.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 6601 "configure"
+#line 3043 "configure"
#include "confdefs.h"
#include <sys/exec.h>
int main() {
@@ -6615,7 +3057,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:6619: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3061: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -6633,9 +3075,9 @@ EOF
else
echo $ac_n "checking a.out.h""... $ac_c" 1>&6
-echo "configure:6637: checking a.out.h" >&5
+echo "configure:3079: checking a.out.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 6639 "configure"
+#line 3081 "configure"
#include "confdefs.h"
#include <a.out.h>
int main() {
@@ -6653,7 +3095,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:6657: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3099: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -6671,9 +3113,9 @@ EOF
else
echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6
-echo "configure:6675: checking sys/exec_aout.h" >&5
+echo "configure:3117: checking sys/exec_aout.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 6677 "configure"
+#line 3119 "configure"
#include "confdefs.h"
#include <sys/exec_aout.h>
int main() {
@@ -6691,7 +3133,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:6695: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3137: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -6845,7 +3287,7 @@ fi
echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
-echo "configure:6849: checking for build with symbols" >&5
+echo "configure:3291: checking for build with symbols" >&5
# Check whether --enable-symbols or --disable-symbols was given.
if test "${enable_symbols+set}" = set; then
enableval="$enable_symbols"
@@ -6870,91 +3312,544 @@ fi
- echo $ac_n "checking for build with memory debugging""... $ac_c" 1>&6
-echo "configure:6875: checking for build with memory debugging" >&5
- # Check whether --enable-memdebug or --disable-memdebug was given.
-if test "${enable_memdebug+set}" = set; then
- enableval="$enable_memdebug"
- tcl_ok=$enableval
+LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}'
+
+TK_DBGX=${DBGX}
+
+#------------------------------------------------------------------------
+# If Tcl and Tk are installed in different places, adjust the library
+# search path to reflect this.
+#------------------------------------------------------------------------
+
+if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then
+ LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib"
+fi
+
+#--------------------------------------------------------------------
+# 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").
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for sin""... $ac_c" 1>&6
+echo "configure:3337: checking for sin" >&5
+if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
else
- tcl_ok=no
+ cat > conftest.$ac_ext <<EOF
+#line 3342 "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:3365: \"$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 test "$tcl_ok" = "yes"; then
- MEM_DEBUG_FLAGS=-DTCL_MEM_DEBUG
- echo "$ac_t""yes" 1>&6
- else
- MEM_DEBUG_FLAGS=""
- echo "$ac_t""no" 1>&6
+if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ MATH_LIBS=""
+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:3386: 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 3394 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:3401: \"$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
+
+
+#--------------------------------------------------------------------
+# On AIX systems, libbsd.a has to be linked in to support
+# non-blocking file IO. This library has to be linked in after
+# the MATH_LIBS or it breaks the pow() function. The way to
+# insure proper sequencing, is to add it to the tail of MATH_LIBS.
+# This library also supplies gettimeofday.
+#--------------------------------------------------------------------
+libbsd=no
+if test "`uname -s`" = "AIX" ; then
+ echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
+echo "configure:3432: checking for gettimeofday in -lbsd" >&5
+ac_lib_var=`echo bsd'_'gettimeofday | 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="-lbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3440 "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 gettimeofday();
+
+int main() {
+gettimeofday()
+; return 0; }
+EOF
+if { (eval echo configure:3451: \"$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
+ libbsd=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
fi
-
+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).
+#--------------------------------------------------------------------
-TCL_DBGX=${DBGX}
+echo $ac_n "checking stdlib.h""... $ac_c" 1>&6
+echo "configure:3482: checking stdlib.h" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3484 "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 3499 "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 3513 "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
#--------------------------------------------------------------------
-# The statements below check for systems where POSIX-style
-# non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented.
-# On these systems (mostly older ones), use the old BSD-style
-# FIONBIO approach instead.
+# 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:3545: checking fd_set and sys/select" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3547 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+int main() {
+fd_set readMask, writeMask;
+; return 0; }
+EOF
+if { (eval echo configure:3554: \"$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 3566 "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*
- for ac_hdr in sys/ioctl.h
-do
-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:6908: checking for $ac_hdr" >&5
-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ 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:3598: 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 6913 "configure"
+#line 3603 "configure"
#include "confdefs.h"
-#include <$ac_hdr>
+#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:6918: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3611: \"$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"
+ ac_cv_header_stdc=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"
+ 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 3628 "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
-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
+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 3646 "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
- echo "$ac_t""no" 1>&6
+ 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 3667 "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:3678: \"$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:3702: 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 3707 "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:3735: 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 3740 "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
-done
- for ac_hdr in sys/filio.h
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:3768: 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 3773 "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:3801: 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 3806 "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:6948: checking for $ac_hdr" >&5
+echo "configure:3843: 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 6953 "configure"
+#line 3848 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6958: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3853: \"$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*
@@ -6980,195 +3875,1170 @@ else
fi
done
- echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6
-echo "configure:6985: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
- if test -f /usr/lib/NextStep/software_version; then
- system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
- else
- system=`uname -s`-`uname -r`
- if test "$?" -ne 0 ; then
- system=unknown
+echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+echo "configure:3880: 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 3885 "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:3894: \"$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
+
+
+#-------------------------------------------
+# In OS/390 struct pwd has no pw_gecos field
+#-------------------------------------------
+
+echo $ac_n "checking pw_gecos in struct pwd""... $ac_c" 1>&6
+echo "configure:3920: checking pw_gecos in struct pwd" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3922 "configure"
+#include "confdefs.h"
+#include <pwd.h>
+int main() {
+struct passwd pwd; pwd.pw_gecos;
+; return 0; }
+EOF
+if { (eval echo configure:3929: \"$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*
+echo "$ac_t""$tk_ok" 1>&6
+if test $tk_ok = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_PW_GECOS 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:3962: 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 4024 "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:4029: \"$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 4098 "configure"
+#include "confdefs.h"
+
+int main() {
+${x_direct_test_function}()
+; return 0; }
+EOF
+if { (eval echo configure:4105: \"$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 4195 "configure"
+#include "confdefs.h"
+#include <X11/XIntrinsic.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4200: \"$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
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- system=MP-RAS-`awk '{print }' /etc/.relid'`
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
fi
- if test "`uname -s`" = "AIX" ; then
- system=AIX-`uname -v`.`uname -r`
+ 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:4220: checking for X11 header files" >&5
+ found_xincludes="no"
+ cat > conftest.$ac_ext <<EOF
+#line 4223 "configure"
+#include "confdefs.h"
+#include <X11/Intrinsic.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4228: \"$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*
+ found_xincludes="yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ found_xincludes="no"
+fi
+rm -f conftest*
+ if test "$found_xincludes" = "no"; 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"
+ found_xincludes="yes"
+ break
+ fi
+ done
+ fi
+ else
+ if test "$x_includes" != ""; then
+ XINCLUDES="-I$x_includes"
+ found_xincludes="yes"
+ fi
+ fi
+ if test found_xincludes = "no"; then
+ echo "$ac_t""couldn't find any!" 1>&6
+ fi
+
+ if test "$no_x" = yes; then
+ echo $ac_n "checking for X11 libraries""... $ac_c" 1>&6
+echo "configure:4264: 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
- case $system in
- # There used to be code here to use FIONBIO under AIX. However, it
- # was reported that FIONBIO doesn't work under AIX 3.2.5. Since
- # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
- # code (JO, 5/31/97).
+ if test "$XLIBSW" = nope ; then
+ echo $ac_n "checking for XCreateWindow in -lXwindow""... $ac_c" 1>&6
+echo "configure:4284: 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 4292 "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();
- OSF*)
- cat >> confdefs.h <<\EOF
-#define USE_FIONBIO 1
+int main() {
+XCreateWindow()
+; return 0; }
EOF
+if { (eval echo configure:4303: \"$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"
- echo "$ac_t""FIONBIO" 1>&6
- ;;
- SunOS-4*)
- cat >> confdefs.h <<\EOF
-#define USE_FIONBIO 1
+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_CC_SEARCH_FLAGS and TCL_LD_SEARCH_FLAGS which
+# causes a substitution of the variable LIB_RUNTIME_DIR.
+
+eval "CC_SEARCH_FLAGS=\"$TCL_CC_SEARCH_FLAGS\""
+eval "LD_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\""
+
+#--------------------------------------------------------------------
+# 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:4377: 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 4385 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
EOF
+if { (eval echo configure:4392: \"$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"
- echo "$ac_t""FIONBIO" 1>&6
- ;;
- ULTRIX-4.*)
- cat >> confdefs.h <<\EOF
-#define USE_FIONBIO 1
+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
+
+
+tk_checkBoth=0
+echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:4415: 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 4420 "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:4443: \"$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
- echo "$ac_t""FIONBIO" 1>&6
- ;;
- *)
- echo "$ac_t""O_NONBLOCK" 1>&6
- ;;
- esac
+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
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:4465: 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 4473 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4480: \"$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
+tk_checkBoth=1
+fi
+
+fi
+if test "$tk_checkBoth" = 1; then
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:4506: 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 4511 "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:4534: \"$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
+ tk_checkNsl=0
+else
+ echo "$ac_t""no" 1>&6
+LIBS=$tk_oldLibs
+fi
+
+fi
+echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:4556: 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 4561 "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:4584: \"$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:4602: 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 4610 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4617: \"$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
+
+
+# Add the threads support libraries
+
+LIBS="$LIBS$THREADS_LIBS"
#--------------------------------------------------------------------
-# The statements below define a collection of symbols related to
-# building libtcl as a shared library instead of a static library.
+# 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.
#--------------------------------------------------------------------
-TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
-TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
-eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"
+if test -d /usr/include/mit ; then
+ echo $ac_n "checking MIT X libraries""... $ac_c" 1>&6
+echo "configure:4657: 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 4663 "configure"
+#include "confdefs.h"
+ #include <X11/Xlib.h>
+
+int main() {
- echo $ac_n "checking how to package libraries""... $ac_c" 1>&6
-echo "configure:7048: checking how to package libraries" >&5
- # Check whether --enable-framework or --disable-framework was given.
-if test "${enable_framework+set}" = set; then
- enableval="$enable_framework"
- tcl_ok=$enableval
+ XOpenDisplay(0);
+
+; return 0; }
+EOF
+if { (eval echo configure:4674: \"$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
- tcl_ok=no
+ 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").
+#--------------------------------------------------------------------
- if test "${enable_framework+set}" = set; then
- enableval="$enable_framework"
- tcl_ok=$enableval
- else
- tcl_ok=no
- fi
+MATH_LIBS=""
+echo $ac_n "checking for sin""... $ac_c" 1>&6
+echo "configure:4701: 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 4706 "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();
- if test "$tcl_ok" = "yes" ; then
- echo "$ac_t""framework" 1>&6
- FRAMEWORK_BUILD=1
- if test "${SHARED_BUILD}" = "0" ; then
- echo "configure: warning: "Frameworks can only be built if --enable-shared is yes"" 1>&2
- FRAMEWORK_BUILD=0
- fi
- else
- echo "$ac_t""standard shared library" 1>&6
- FRAMEWORK_BUILD=0
- fi
+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
-# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
-# so that the backslashes quoting the DBX braces are dropped.
+; return 0; }
+EOF
+if { (eval echo configure:4729: \"$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
-# Trick to replace DBGX with TCL_DBGX
-DBGX='${TCL_DBGX}'
-eval "TCL_LIB_FILE=${TCL_LIB_FILE}"
+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
-# 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.
+echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
+echo "configure:4750: 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 4758 "configure"
+#include "confdefs.h"
-if test "$FRAMEWORK_BUILD" = "1" ; then
- TCL_BUILD_LIB_SPEC="-F`pwd` -framework Tcl"
- TCL_LIB_SPEC="-framework Tcl"
- TCL_LIB_FILE="Tcl"
-elif test "$SHARED_BUILD" = "0" || test "$TCL_NEEDS_EXP_FILE" = "0"; then
- if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TCL_LIB_FLAG="-ltcl${TCL_VERSION}\${TCL_DBGX}"
- else
- TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
- fi
- TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
- TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}"
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4765: \"$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
- TCL_BUILD_EXP_FILE="lib.exp"
- eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}"
+ 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"
- # Replace DBGX with TCL_DBGX
- eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\""
-
- if test "$GCC" = "yes" ; then
- TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`"
- TCL_LIB_SPEC="-Wl,-bI:${libdir}/${TCL_EXP_FILE} -L`pwd`"
- else
- TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}"
- TCL_LIB_SPEC="-bI:${libdir}/${TCL_EXP_FILE}"
- fi
fi
-VERSION='${VERSION}'
-eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
-eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
-eval "CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}"
-VERSION=${TCL_VERSION}
+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
+
#--------------------------------------------------------------------
-# The statements below define the symbol TCL_PACKAGE_PATH, which
-# gives a list of directories that may contain packages. The list
-# consists of one directory for machine-dependent binaries and
-# another for platform-independent scripts.
+# Figure out whether "char" is unsigned. If so, set a
+# #define for __CHAR_UNSIGNED__.
#--------------------------------------------------------------------
-if test "$FRAMEWORK_BUILD" = "1" ; then
- TCL_PACKAGE_PATH="${libdir}/Resources/Scripts"
-elif test "$prefix" != "$exec_prefix"; then
- TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
+echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
+echo "configure:4792: 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
- TCL_PACKAGE_PATH="${prefix}/lib"
+ if test "$GCC" = yes; then
+ # GCC predefines this symbol on systems where it applies.
+cat > conftest.$ac_ext <<EOF
+#line 4799 "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 4821 "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:4831: \"$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
+
#--------------------------------------------------------------------
-# The statements below define various symbols relating to Tcl
-# stub support.
+# 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.
#--------------------------------------------------------------------
-# Replace ${VERSION} with contents of ${TCL_VERSION}
-eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
-# Replace DBGX with TCL_DBGX
-eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
-if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}\${TCL_DBGX}"
+ echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:4864: checking for strtod" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
else
- TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
+ cat > conftest.$ac_ext <<EOF
+#line 4869 "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:4892: \"$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
-TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
-TCL_STUB_LIB_SPEC="-L${libdir} ${TCL_STUB_LIB_FLAG}"
-TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}"
-TCL_STUB_LIB_PATH="${libdir}/${TCL_STUB_LIB_FILE}"
+if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_strtod=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_strtod=0
+fi
-# Install time header dir can be set via --includedir
-eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
+ if test "$tcl_strtod" = 1; then
+ echo $ac_n "checking for Solaris2.4/Tru64 strtod bugs""... $ac_c" 1>&6
+echo "configure:4914: checking for Solaris2.4/Tru64 strtod bugs" >&5
+ if eval "test \"`echo '$''{'tcl_cv_strtod_buggy'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ if test "$cross_compiling" = yes; then
+ tcl_cv_strtod_buggy=0
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4923 "configure"
+#include "confdefs.h"
-#------------------------------------------------------------------------
-# tclConfig.sh refers to this by a different name
-#------------------------------------------------------------------------
+ extern double strtod();
+ int main() {
+ char *infString="Inf", *nanString="NaN", *spaceString=" ";
+ char *term;
+ double value;
+ value = strtod(infString, &term);
+ if ((term != infString) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(nanString, &term);
+ if ((term != nanString) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(spaceString, &term);
+ if (term == (spaceString+1)) {
+ exit(1);
+ }
+ exit(0);
+ }
+EOF
+if { (eval echo configure:4946: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tcl_cv_strtod_buggy=1
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ tcl_cv_strtod_buggy=0
+fi
+rm -fr conftest*
+fi
-TCL_SHARED_BUILD=${SHARED_BUILD}
+fi
+ if test "$tcl_cv_strtod_buggy" = 1; then
+ echo "$ac_t""ok" 1>&6
+ else
+ echo "$ac_t""buggy" 1>&6
+ LIBOBJS="$LIBOBJS fixstrtod.o"
+ 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.
+#--------------------------------------------------------------------
+eval eval "TK_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}"
+eval eval "TK_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}"
+if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then
+ SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \${TCL_STUB_LIB_SPEC}"
+ TCL_STUB_FLAGS="-DUSE_TCL_STUBS"
+else
+ TCL_STUB_FLAGS=""
+fi
+TK_LIB_FILE=libtk${LIB_SUFFIX}
+eval "TK_LIB_FILE=${TK_LIB_FILE}"
+
+# Note: in the following variable, it's important to use the absolute
+# path name of the Tcl directory rather than "..": this is because
+# AIX remembers this path and will attempt to use it at run-time to look
+# up the Tcl library.
+
+if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then
+ if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ eval TK_LIB_FLAG="-ltk${VERSION}\${TK_DBGX}"
+ else
+ eval TK_LIB_FLAG="-ltk`echo ${VERSION} | tr -d .`\${TK_DBGX}"
+ fi
+ TK_BUILD_LIB_SPEC="-L`pwd` ${TK_LIB_FLAG}"
+ TK_LIB_SPEC="-L${libdir} ${TK_LIB_FLAG}"
+ TK_BUILD_EXP_FILE=""
+ TK_EXP_FILE=""
+else
+ TK_BUILD_EXP_FILE="lib.exp"
+ eval "TK_EXP_FILE=libtk${TCL_EXPORT_FILE_SUFFIX}"
+
+ if test "$GCC" = "yes" ; then
+ TK_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TK_BUILD_EXP_FILE} -L`pwd`"
+ TK_LIB_SPEC="-Wl,-bI:${libdir}/${TK_EXP_FILE} -L`pwd`"
+ else
+ TK_BUILD_LIB_SPEC="-bI:`pwd`/${TK_BUILD_EXP_FILE}"
+ TK_LIB_SPEC="-bI:${libdir}/${TK_EXP_FILE}"
+ fi
+fi
+TK_SHARED_BUILD=${SHARED_BUILD}
+
+#--------------------------------------------------------------------
+# The statements below define various symbols relating to creating
+# the stub'd version of the Tk library
+#
+# For now, linking to Tcl stubs is not supported with Tk. It causes
+# too many problems with linking. When Tk is a fully loadable
+# extension, linking the the Tcl stubs will be supported.
+#--------------------------------------------------------------------
+
+# Replace ${VERSION} with contents of ${TK_VERSION}
+eval "TK_STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}"
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ eval TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}\${TK_DBGX}"
+else
+ eval TK_STUB_LIB_FLAG="-ltkstub`echo ${TK_VERSION} | tr -d .`\${TK_DBGX}"
+fi
+
+TK_BUILD_STUB_LIB_SPEC="-L`pwd` ${TK_STUB_LIB_FLAG}"
+TK_STUB_LIB_SPEC="-L${libdir} ${TK_STUB_LIB_FLAG}"
+TK_BUILD_STUB_LIB_PATH="`pwd`/${TK_STUB_LIB_FILE}"
+TK_STUB_LIB_PATH="${libdir}/${TK_STUB_LIB_FILE}"
+
+eval "TK_LIB_FILE=${TK_LIB_FILE}"
@@ -7315,7 +5185,7 @@ done
ac_given_srcdir=$srcdir
-trap 'rm -fr `echo "Makefile dltest/Makefile tclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+trap 'rm -fr `echo "Makefile tkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
@@ -7351,9 +5221,15 @@ s%@MKLINKS_FLAGS@%$MKLINKS_FLAGS%g
s%@CC@%$CC%g
s%@CPP@%$CPP%g
s%@TCL_THREADS@%$TCL_THREADS%g
-s%@LIBOBJS@%$LIBOBJS%g
-s%@TCL_LIBS@%$TCL_LIBS%g
-s%@MATH_LIBS@%$MATH_LIBS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
+s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
+s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
s%@AR@%$AR%g
s%@RANLIB@%$RANLIB%g
s%@DL_LIBS@%$DL_LIBS%g
@@ -7381,38 +5257,32 @@ s%@INSTALL_LIB@%$INSTALL_LIB%g
s%@INSTALL_STUB_LIB@%$INSTALL_STUB_LIB%g
s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
-s%@MEM_DEBUG_FLAGS@%$MEM_DEBUG_FLAGS%g
-s%@TCL_VERSION@%$TCL_VERSION%g
-s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
-s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
-s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
-s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
-s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
-s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
-s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
-s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
-s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
-s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g
-s%@TCL_INCLUDE_SPEC@%$TCL_INCLUDE_SPEC%g
-s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
-s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
-s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
-s%@TCL_DBGX@%$TCL_DBGX%g
-s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g
-s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g
-s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g
-s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
+s%@TK_VERSION@%$TK_VERSION%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_DBGX@%$TK_DBGX%g
+s%@TK_STUB_LIB_FILE@%$TK_STUB_LIB_FILE%g
+s%@TK_STUB_LIB_FLAG@%$TK_STUB_LIB_FLAG%g
+s%@TK_BUILD_STUB_LIB_SPEC@%$TK_BUILD_STUB_LIB_SPEC%g
+s%@TK_STUB_LIB_SPEC@%$TK_STUB_LIB_SPEC%g
+s%@TK_BUILD_STUB_LIB_PATH@%$TK_BUILD_STUB_LIB_PATH%g
+s%@TK_STUB_LIB_PATH@%$TK_STUB_LIB_PATH%g
+s%@TK_STUB_FLAGS@%$TK_STUB_FLAGS%g
+s%@TK_BUILD_EXP_FILE@%$TK_BUILD_EXP_FILE%g
+s%@TK_EXP_FILE@%$TK_EXP_FILE%g
+s%@TCL_STUB_FLAGS@%$TCL_STUB_FLAGS%g
s%@LD_LIBRARY_PATH_VAR@%$LD_LIBRARY_PATH_VAR%g
-s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
-s%@TCL_NEEDS_EXP_FILE@%$TCL_NEEDS_EXP_FILE%g
-s%@TCL_BUILD_EXP_FILE@%$TCL_BUILD_EXP_FILE%g
-s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g
-s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
-s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
-s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
-s%@TCL_HAS_LONGLONG@%$TCL_HAS_LONGLONG%g
-s%@BUILD_DLTEST@%$BUILD_DLTEST%g
-s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%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_SRC_DIR@%$TK_SRC_DIR%g
+s%@XINCLUDES@%$XINCLUDES%g
+s%@XLIBSW@%$XLIBSW%g
+s%@TK_SHARED_BUILD@%$TK_SHARED_BUILD%g
+s%@LOCALES@%$LOCALES%g
CEOF
EOF
@@ -7454,7 +5324,7 @@ EOF
cat >> $CONFIG_STATUS <<EOF
-CONFIG_FILES=\${CONFIG_FILES-"Makefile dltest/Makefile tclConfig.sh"}
+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
diff --git a/tcl/unix/configure.in b/tcl/unix/configure.in
index da46dc2d3e4..7841d8d2097 100755
--- a/tcl/unix/configure.in
+++ b/tcl/unix/configure.in
@@ -1,18 +1,19 @@
#! /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 Tcl installation
+dnl generate the file "configure", which is run during Tk installation
dnl to configure the system for the local environment.
#
# RCS: @(#) $Id$
-AC_INIT(../generic/tcl.h)
+AC_INIT(../generic/tk.h)
AC_PREREQ(2.13)
-TCL_VERSION=8.4
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=4
-TCL_PATCH_LEVEL=".0"
-VERSION=${TCL_VERSION}
+TK_VERSION=8.4
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=4
+TK_PATCH_LEVEL=".0"
+VERSION=${TK_VERSION}
+LOCALES="cs de el en en_gb es fr it nl ru"
#------------------------------------------------------------------------
# Handle the --prefix=... option
@@ -26,7 +27,9 @@ if test "${exec_prefix}" = "NONE"; then
fi
# libdir must be a fully qualified path and (not ${exec_prefix}/lib)
eval libdir="$libdir"
-TCL_SRC_DIR=`cd $srcdir/..; pwd`
+# Make sure srcdir is fully qualified!
+srcdir=`cd $srcdir ; pwd`
+TK_SRC_DIR=`cd $srcdir/..; pwd`
#------------------------------------------------------------------------
# Compress and/or soft link the manpages?
@@ -44,6 +47,11 @@ if test "${CFLAGS+set}" != "set" ; then
fi
AC_PROG_CC
+
+#------------------------------------------------------------------------
+# I'm not sure why these need to come before all of the other tests
+#------------------------------------------------------------------------
+
AC_HAVE_HEADERS(unistd.h limits.h)
#------------------------------------------------------------------------
@@ -52,10 +60,10 @@ AC_HAVE_HEADERS(unistd.h limits.h)
SC_ENABLE_THREADS
-#------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# If we're using GCC, see if the compiler understands -pipe. If so, use it.
# It makes compiling go faster. (This is only a performance feature.)
-#------------------------------------------------------------------------
+#------------------------------------------------------------------------------
if test -z "$no_pipe"; then
if test -n "$GCC"; then
@@ -78,188 +86,101 @@ SC_TCL_EARLY_FLAGS
SC_TCL_64BIT_FLAGS
#--------------------------------------------------------------------
-# Check endianness because we can optimize comparisons of
-# Tcl_UniChar strings to memcmp on big-endian systems.
+# Find and load the tclConfig.sh file
#--------------------------------------------------------------------
-AC_C_BIGENDIAN
+SC_PATH_TCLCONFIG
+SC_LOAD_TCLCONFIG
#--------------------------------------------------------------------
-# Supply substitutes for missing POSIX library procedures, or
-# set flags so Tcl uses alternate procedures.
+# Recompute the necessary flags to run the compiler
#--------------------------------------------------------------------
-# Check if Posix compliant getcwd exists, if not we'll use getwd.
-AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD)])
-# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
-# define USEGETWD even if the posix getcwd exists. Add a test ?
-
-AC_REPLACE_FUNCS(opendir strstr)
-
-AC_REPLACE_FUNCS(strtol strtoll strtoull tmpnam waitpid)
-AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR)])
-AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD)])
-AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3)])
-AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME)])
-AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH)])
+SC_ENABLE_SHARED
-#--------------------------------------------------------------------
-# Supply substitutes for missing POSIX header files. Special
-# notes:
-# - stdlib.h doesn't define strtol, strtoul, or
-# strtod insome versions of SunOS
-# - some versions of string.h don't declare procedures such
-# as strstr
-#--------------------------------------------------------------------
+SC_CONFIG_CFLAGS
-SC_MISSING_POSIX_HEADERS
+SC_ENABLE_SYMBOLS
-#---------------------------------------------------------------------------
-# Determine which interface to use to talk to the serial port.
-# Note that #include lines must begin in leftmost column for
-# some compilers to recognize them as preprocessor directives.
-#---------------------------------------------------------------------------
+LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}'
-SC_SERIAL_PORT
+TK_DBGX=${DBGX}
-#--------------------------------------------------------------------
-# 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.
-#--------------------------------------------------------------------
+#------------------------------------------------------------------------
+# If Tcl and Tk are installed in different places, adjust the library
+# search path to reflect this.
+#------------------------------------------------------------------------
-AC_MSG_CHECKING([for fd_set in sys/types])
-AC_CACHE_VAL(tcl_cv_type_fd_set,
- AC_TRY_COMPILE([#include <sys/types.h>],[fd_set readMask, writeMask;],
- tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no))
-AC_MSG_RESULT($tcl_cv_type_fd_set)
-tk_ok=$tcl_cv_type_fd_set
-if test $tcl_cv_type_fd_set = no; then
- AC_MSG_CHECKING([for fd_mask in sys/select])
- AC_CACHE_VAL(tcl_cv_grep_fd_mask,
- AC_HEADER_EGREP(fd_mask, sys/select.h,
- tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing))
- AC_MSG_RESULT($tcl_cv_grep_fd_mask)
- if test $tcl_cv_grep_fd_mask = present; then
- AC_DEFINE(HAVE_SYS_SELECT_H)
- tk_ok=yes
- fi
+if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then
+ LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib"
fi
-if test $tk_ok = no; then
- AC_DEFINE(NO_FD_SET)
-fi
-
-#------------------------------------------------------------------------------
-# Find out all about time handling differences.
-#------------------------------------------------------------------------------
-
-SC_TIME_HANDLER
#--------------------------------------------------------------------
-# Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
-# in struct stat. But we might be able to use fstatfs instead.
+# 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").
#--------------------------------------------------------------------
-AC_STRUCT_ST_BLKSIZE
-AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS)])
-#--------------------------------------------------------------------
-# Some system have no memcmp or it does not work with 8 bit
-# data, this checks it and add memcmp.o to LIBOBJS if needed
-#--------------------------------------------------------------------
-AC_FUNC_MEMCMP
+AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
+AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
#--------------------------------------------------------------------
-# Some system like SunOS 4 and other BSD like systems
-# have no memmove (we assume they have bcopy instead).
-# {The replacement define is in compat/string.h}
+# On AIX systems, libbsd.a has to be linked in to support
+# non-blocking file IO. This library has to be linked in after
+# the MATH_LIBS or it breaks the pow() function. The way to
+# insure proper sequencing, is to add it to the tail of MATH_LIBS.
+# This library also supplies gettimeofday.
#--------------------------------------------------------------------
-AC_CHECK_FUNC(memmove, , [AC_DEFINE(NO_MEMMOVE) AC_DEFINE(NO_STRING_H)])
+libbsd=no
+if test "`uname -s`" = "AIX" ; then
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
+ fi
+fi
#--------------------------------------------------------------------
-# On some systems strstr is broken: it returns a pointer even
-# even if the original string is empty.
+# 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([proper strstr implementation])
-AC_TRY_RUN([
-extern int strstr();
-int main()
-{
- exit(strstr("\0test", "test") ? 1 : 0);
-}
-], tcl_ok=yes, tcl_ok=no, tcl_ok=no)
-if test $tcl_ok = yes; then
- AC_MSG_RESULT(yes)
-else
- AC_MSG_RESULT([broken, using substitute])
- LIBOBJS="$LIBOBJS strstr.o"
+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 strtoul function. This is tricky because under some
-# versions of AIX strtoul returns an incorrect terminator
-# pointer for the string "0".
-#--------------------------------------------------------------------
-
-AC_CHECK_FUNC(strtoul, tcl_ok=1, tcl_ok=0)
-AC_TRY_RUN([
-extern int strtoul();
-int main()
-{
- char *string = "0";
- char *term;
- int value;
- value = strtoul(string, &term, 0);
- if ((value != 0) || (term != (string+1))) {
- exit(1);
- }
- exit(0);
-}], , tcl_ok=0, tcl_ok=0)
-if test "$tcl_ok" = 0; then
- test -n "$verbose" && echo " Adding strtoul.o."
- LIBOBJS="$LIBOBJS strtoul.o"
-fi
-
+# 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.
#--------------------------------------------------------------------
-# Check for the strtod function. This is tricky because in some
-# versions of Linux strtod mis-parses strings starting with "+".
-#--------------------------------------------------------------------
-
-AC_CHECK_FUNC(strtod, tcl_ok=1, tcl_ok=0)
-AC_TRY_RUN([
-extern double strtod();
-int main()
-{
- char *string = " +69";
- char *term;
- double value;
- value = strtod(string, &term);
- if ((value != 69) || (term != (string+4))) {
- exit(1);
- }
- exit(0);
-}], , tcl_ok=0, tcl_ok=0)
-if test "$tcl_ok" = 0; then
- test -n "$verbose" && echo " Adding strtod.o."
- LIBOBJS="$LIBOBJS strtod.o"
-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" that corrects the error.
-#--------------------------------------------------------------------
-
-SC_BUGGY_STRTOD
+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.
+# Check for various typedefs and provide substitutes if
+# they don't exist.
#--------------------------------------------------------------------
AC_TYPE_MODE_T
@@ -267,323 +188,259 @@ AC_TYPE_PID_T
AC_TYPE_SIZE_T
AC_TYPE_UID_T
-AC_MSG_CHECKING([for socklen_t])
-AC_CACHE_VAL(ac_cv_type_socklen_t,[AC_EGREP_CPP(changequote(<<,>>)dnl
-<<(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]>>dnl
-changequote([,]),[
- #include <sys/types.h>
- #include <sys/socket.h>
- #if STDC_HEADERS
- #include <stdlib.h>
- #include <stddef.h>
- #endif
- ], ac_cv_type_socklen_t=yes, ac_cv_type_socklen_t=no)])
-AC_MSG_RESULT($ac_cv_type_socklen_t)
-if test $ac_cv_type_socklen_t = no; then
- AC_DEFINE(socklen_t, unsigned)
-fi
+#------------------------------------------------------------------------------
+# Find out about time handling differences.
+#------------------------------------------------------------------------------
-#--------------------------------------------------------------------
-# If a system doesn't have an opendir function (man, that's old!)
-# then we have to supply a different version of dirent.h which
-# is compatible with the substitute version of opendir that's
-# provided. This version only works with V7-style directories.
-#--------------------------------------------------------------------
+AC_CHECK_HEADERS(sys/time.h)
+AC_HEADER_TIME
-AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H)])
+#-------------------------------------------
+# In OS/390 struct pwd has no pw_gecos field
+#-------------------------------------------
+
+AC_MSG_CHECKING([pw_gecos in struct pwd])
+AC_TRY_COMPILE([#include <pwd.h>],
+ [struct passwd pwd; pwd.pw_gecos;], tk_ok=yes, tk_ok=no)
+AC_MSG_RESULT($tk_ok)
+if test $tk_ok = yes; then
+ AC_DEFINE(HAVE_PW_GECOS)
+fi
#--------------------------------------------------------------------
-# The check below checks whether <sys/wait.h> defines the type
-# "union wait" correctly. It's needed because of weirdness in
-# HP-UX where "union wait" is defined in both the BSD and SYS-V
-# environments. Checking the usability of WIFEXITED seems to do
-# the trick.
+# 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_MSG_CHECKING([union wait])
-AC_CACHE_VAL(tcl_cv_union_wait,
- AC_TRY_LINK([#include <sys/types.h>
-#include <sys/wait.h>], [
-union wait x;
-WIFEXITED(x); /* Generates compiler error if WIFEXITED
- * uses an int. */
- ], tcl_cv_union_wait=yes, tcl_cv_union_wait=no))
-AC_MSG_RESULT($tcl_cv_union_wait)
-if test $tcl_cv_union_wait = no; then
- AC_DEFINE(NO_UNION_WAIT)
-fi
+SC_PATH_X
#--------------------------------------------------------------------
-# Check whether there is an strncasecmp function on this system.
-# This is a bit tricky because under SCO it's in -lsocket and
-# under Sequent Dynix it's in -linet.
+# 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.
#--------------------------------------------------------------------
-AC_CHECK_FUNC(strncasecmp, tcl_ok=1, tcl_ok=0)
-if test "$tcl_ok" = 0; then
- AC_CHECK_LIB(socket, strncasecmp, tcl_ok=1, tcl_ok=0)
-fi
-if test "$tcl_ok" = 0; then
- AC_CHECK_LIB(inet, strncasecmp, tcl_ok=1, tcl_ok=0)
+if test "x${x_libraries}" != "x"; then
+ LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${x_libraries}"
fi
-if test "$tcl_ok" = 0; then
- LIBOBJS="$LIBOBJS strncasecmp.o"
+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 code below deals with several issues related to gettimeofday:
-# 1. Some systems don't provide a gettimeofday function at all
-# (set NO_GETTOD if this is the case).
-# 2. SGI systems don't use the BSD form of the gettimeofday function,
-# but they have a BSDgettimeofday function that can be used instead.
-# 3. See if gettimeofday is declared in the <sys/time.h> header file.
-# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
-# declare it.
-#--------------------------------------------------------------------
-
-AC_CHECK_FUNC(BSDgettimeofday,
- [AC_DEFINE(HAVE_BSDGETTIMEOFDAY)], [
- AC_CHECK_FUNC(gettimeofday, , [AC_DEFINE(NO_GETTOD)])
-])
-AC_MSG_CHECKING([for gettimeofday declaration])
-AC_CACHE_VAL(tcl_cv_grep_gettimeofday,
- AC_EGREP_HEADER(gettimeofday, sys/time.h,
- tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing))
-AC_MSG_RESULT($tcl_cv_grep_gettimeofday)
-if test $tcl_cv_grep_gettimeofday = missing ; then
- AC_DEFINE(GETTOD_NOT_DECLARED)
+# The statement below is very tricky! It actually *evaluates* the
+# string in TCL_CC_SEARCH_FLAGS and TCL_LD_SEARCH_FLAGS which
+# causes a substitution of the variable LIB_RUNTIME_DIR.
+
+eval "CC_SEARCH_FLAGS=\"$TCL_CC_SEARCH_FLAGS\""
+eval "LD_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\""
+
+#--------------------------------------------------------------------
+# 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"])])
-#--------------------------------------------------------------------
-# The following code checks to see whether it is possible to get
-# signed chars on this platform. This is needed in order to
-# properly generate sign-extended ints from character values.
-#--------------------------------------------------------------------
+# Add the threads support libraries
-AC_C_CHAR_UNSIGNED
-AC_MSG_CHECKING([signed char declarations])
-AC_CACHE_VAL(tcl_cv_char_signed,
- AC_TRY_COMPILE(, [
- signed char *p;
- p = 0;
- ], tcl_cv_char_signed=yes, tcl_cv_char_signed=no))
-AC_MSG_RESULT($tcl_cv_char_signed)
-if test $tcl_cv_char_signed = yes; then
- AC_DEFINE(HAVE_SIGNED_CHAR)
-fi
+LIBS="$LIBS$THREADS_LIBS"
#--------------------------------------------------------------------
-# Does putenv() copy or not? We need to know to avoid memory leaks.
-#--------------------------------------------------------------------
-
-AC_MSG_CHECKING([for a putenv() that copies the buffer])
-AC_CACHE_VAL(tcl_cv_putenv_copy,
- AC_TRY_RUN([
- #include <stdlib.h>
- #define OURVAR "havecopy=yes"
- int main (int argc, char *argv[])
- {
- char *foo, *bar;
- foo = (char *)strdup(OURVAR);
- putenv(foo);
- strcpy((char *)(strchr(foo, '=') + 1), "no");
- bar = getenv("havecopy");
- if (!strcmp(bar, "no")) {
- /* doesnt copy */
- return 0;
- } else {
- /* does copy */
- return 1;
- }
- }
- ],
- tcl_cv_putenv_copy=no,
- tcl_cv_putenv_copy=yes,
- tcl_cv_putenv_copy=no)
-)
-AC_MSG_RESULT($tcl_cv_putenv_copy)
-if test $tcl_cv_putenv_copy = yes; then
- AC_DEFINE(HAVE_PUTENV_THAT_COPIES)
+# 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
#--------------------------------------------------------------------
-# Check for support of nl_langinfo function
+# 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").
#--------------------------------------------------------------------
-SC_ENABLE_LANGINFO
+MATH_LIBS=""
+AC_CHECK_FUNC(sin, , MATH_LIBS="-lm")
+AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
#--------------------------------------------------------------------
-# Look for libraries that we will need when compiling the Tcl shell
+# Figure out whether "char" is unsigned. If so, set a
+# #define for __CHAR_UNSIGNED__.
#--------------------------------------------------------------------
-SC_TCL_LINK_LIBS
-
-# Add the threads support libraries
-
-LIBS="$LIBS$THREADS_LIBS"
-
-SC_ENABLE_SHARED
-
-#--------------------------------------------------------------------
-# The statements below define a collection of compile flags. This
-# macro depends on the value of SHARED_BUILD, and should be called
-# after SC_ENABLE_SHARED checks the configure switches.
-#--------------------------------------------------------------------
-
-SC_CONFIG_CFLAGS
-
-SC_ENABLE_SYMBOLS
-SC_ENABLE_MEMDEBUG
-
-TCL_DBGX=${DBGX}
+AC_C_CHAR_UNSIGNED
#--------------------------------------------------------------------
-# The statements below check for systems where POSIX-style
-# non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented.
-# On these systems (mostly older ones), use the old BSD-style
-# FIONBIO approach instead.
+# 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.
#--------------------------------------------------------------------
-SC_BLOCKING_STYLE
+SC_BUGGY_STRTOD
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
-# building libtcl as a shared library instead of a static library.
+# building libtk as a shared library instead of a static library.
#--------------------------------------------------------------------
-TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
-TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
-eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"
+eval eval "TK_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}"
+eval eval "TK_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}"
-SC_ENABLE_FRAMEWORK
-
-# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
-# so that the backslashes quoting the DBX braces are dropped.
-
-# Trick to replace DBGX with TCL_DBGX
-DBGX='${TCL_DBGX}'
-eval "TCL_LIB_FILE=${TCL_LIB_FILE}"
+if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then
+ SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \${TCL_STUB_LIB_SPEC}"
+ TCL_STUB_FLAGS="-DUSE_TCL_STUBS"
+else
+ TCL_STUB_FLAGS=""
+fi
+TK_LIB_FILE=libtk${LIB_SUFFIX}
+eval "TK_LIB_FILE=${TK_LIB_FILE}"
# Note: in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..": this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.
-if test "$FRAMEWORK_BUILD" = "1" ; then
- TCL_BUILD_LIB_SPEC="-F`pwd` -framework Tcl"
- TCL_LIB_SPEC="-framework Tcl"
- TCL_LIB_FILE="Tcl"
-elif test "$SHARED_BUILD" = "0" || test "$TCL_NEEDS_EXP_FILE" = "0"; then
+if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then
if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TCL_LIB_FLAG="-ltcl${TCL_VERSION}\${TCL_DBGX}"
+ eval TK_LIB_FLAG="-ltk${VERSION}\${TK_DBGX}"
else
- TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
+ eval TK_LIB_FLAG="-ltk`echo ${VERSION} | tr -d .`\${TK_DBGX}"
fi
- TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
- TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}"
+ TK_BUILD_LIB_SPEC="-L`pwd` ${TK_LIB_FLAG}"
+ TK_LIB_SPEC="-L${libdir} ${TK_LIB_FLAG}"
+ TK_BUILD_EXP_FILE=""
+ TK_EXP_FILE=""
else
- TCL_BUILD_EXP_FILE="lib.exp"
- eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}"
+ TK_BUILD_EXP_FILE="lib.exp"
+ eval "TK_EXP_FILE=libtk${TCL_EXPORT_FILE_SUFFIX}"
- # Replace DBGX with TCL_DBGX
- eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\""
-
if test "$GCC" = "yes" ; then
- TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`"
- TCL_LIB_SPEC="-Wl,-bI:${libdir}/${TCL_EXP_FILE} -L`pwd`"
+ TK_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TK_BUILD_EXP_FILE} -L`pwd`"
+ TK_LIB_SPEC="-Wl,-bI:${libdir}/${TK_EXP_FILE} -L`pwd`"
else
- TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}"
- TCL_LIB_SPEC="-bI:${libdir}/${TCL_EXP_FILE}"
+ TK_BUILD_LIB_SPEC="-bI:`pwd`/${TK_BUILD_EXP_FILE}"
+ TK_LIB_SPEC="-bI:${libdir}/${TK_EXP_FILE}"
fi
fi
-VERSION='${VERSION}'
-eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
-eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
-eval "CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}"
-VERSION=${TCL_VERSION}
-
-#--------------------------------------------------------------------
-# The statements below define the symbol TCL_PACKAGE_PATH, which
-# gives a list of directories that may contain packages. The list
-# consists of one directory for machine-dependent binaries and
-# another for platform-independent scripts.
-#--------------------------------------------------------------------
-
-if test "$FRAMEWORK_BUILD" = "1" ; then
- TCL_PACKAGE_PATH="${libdir}/Resources/Scripts"
-elif test "$prefix" != "$exec_prefix"; then
- TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
-else
- TCL_PACKAGE_PATH="${prefix}/lib"
-fi
+TK_SHARED_BUILD=${SHARED_BUILD}
#--------------------------------------------------------------------
-# The statements below define various symbols relating to Tcl
-# stub support.
+# The statements below define various symbols relating to creating
+# the stub'd version of the Tk library
+#
+# For now, linking to Tcl stubs is not supported with Tk. It causes
+# too many problems with linking. When Tk is a fully loadable
+# extension, linking the the Tcl stubs will be supported.
#--------------------------------------------------------------------
-# Replace ${VERSION} with contents of ${TCL_VERSION}
-eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
-# Replace DBGX with TCL_DBGX
-eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
+# Replace ${VERSION} with contents of ${TK_VERSION}
+eval "TK_STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}"
if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}\${TCL_DBGX}"
+ eval TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}\${TK_DBGX}"
else
- TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
+ eval TK_STUB_LIB_FLAG="-ltkstub`echo ${TK_VERSION} | tr -d .`\${TK_DBGX}"
fi
-TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
-TCL_STUB_LIB_SPEC="-L${libdir} ${TCL_STUB_LIB_FLAG}"
-TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}"
-TCL_STUB_LIB_PATH="${libdir}/${TCL_STUB_LIB_FILE}"
-
-# Install time header dir can be set via --includedir
-eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
+TK_BUILD_STUB_LIB_SPEC="-L`pwd` ${TK_STUB_LIB_FLAG}"
+TK_STUB_LIB_SPEC="-L${libdir} ${TK_STUB_LIB_FLAG}"
+TK_BUILD_STUB_LIB_PATH="`pwd`/${TK_STUB_LIB_FILE}"
+TK_STUB_LIB_PATH="${libdir}/${TK_STUB_LIB_FILE}"
+
+eval "TK_LIB_FILE=${TK_LIB_FILE}"
+
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_MAJOR_VERSION)
+AC_SUBST(TK_MINOR_VERSION)
+AC_SUBST(TK_PATCH_LEVEL)
+AC_SUBST(TK_DBGX)
+
+AC_SUBST(TK_STUB_LIB_FILE)
+AC_SUBST(TK_STUB_LIB_FLAG)
+AC_SUBST(TK_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TK_STUB_LIB_SPEC)
+AC_SUBST(TK_BUILD_STUB_LIB_PATH)
+AC_SUBST(TK_STUB_LIB_PATH)
+AC_SUBST(TK_STUB_FLAGS)
+AC_SUBST(TK_BUILD_EXP_FILE)
+AC_SUBST(TK_EXP_FILE)
+
+AC_SUBST(TCL_STUB_FLAGS)
+AC_SUBST(TK_BUILD_EXP_FILE)
+AC_SUBST(TK_EXP_FILE)
-#------------------------------------------------------------------------
-# tclConfig.sh refers to this by a different name
-#------------------------------------------------------------------------
-
-TCL_SHARED_BUILD=${SHARED_BUILD}
-
-AC_SUBST(TCL_VERSION)
-AC_SUBST(TCL_MAJOR_VERSION)
-AC_SUBST(TCL_MINOR_VERSION)
-AC_SUBST(TCL_PATCH_LEVEL)
-
-AC_SUBST(TCL_LIB_FILE)
-AC_SUBST(TCL_LIB_FLAG)
-AC_SUBST(TCL_LIB_SPEC)
-AC_SUBST(TCL_STUB_LIB_FILE)
-AC_SUBST(TCL_STUB_LIB_FLAG)
-AC_SUBST(TCL_STUB_LIB_SPEC)
-AC_SUBST(TCL_STUB_LIB_PATH)
-AC_SUBST(TCL_INCLUDE_SPEC)
-AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
-AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
-
-AC_SUBST(TCL_SRC_DIR)
-AC_SUBST(TCL_DBGX)
-AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
-AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
-AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
-
-AC_SUBST(TCL_SHARED_BUILD)
AC_SUBST(LD_LIBRARY_PATH_VAR)
-AC_SUBST(TCL_BUILD_LIB_SPEC)
-AC_SUBST(TCL_NEEDS_EXP_FILE)
-AC_SUBST(TCL_BUILD_EXP_FILE)
-AC_SUBST(TCL_EXP_FILE)
-
-AC_SUBST(TCL_LIB_VERSIONS_OK)
-AC_SUBST(TCL_SHARED_LIB_SUFFIX)
-AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
-
-AC_SUBST(TCL_HAS_LONGLONG)
-
-AC_SUBST(BUILD_DLTEST)
-AC_SUBST(TCL_PACKAGE_PATH)
-
-AC_OUTPUT(Makefile dltest/Makefile tclConfig.sh)
+AC_SUBST(MATH_LIBS)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIB_FILE)
+AC_SUBST(TK_LIB_FLAG)
+AC_SUBST(TK_LIB_SPEC)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(XINCLUDES)
+AC_SUBST(XLIBSW)
+AC_SUBST(TK_SHARED_BUILD)
+AC_SUBST(LOCALES)
+
+AC_OUTPUT(Makefile tkConfig.sh)
diff --git a/tcl/unix/license.terms b/tcl/unix/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tcl/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/tcl/unix/mkLinks b/tcl/unix/mkLinks
index a41ea06d37f..adb3559b721 100755
--- a/tcl/unix/mkLinks
+++ b/tcl/unix/mkLinks
@@ -56,1802 +56,1128 @@ if test "$y" != "xyzzyTestingaverylongfilename.foo"; then
CASEINSENSITIVEFS=1
fi
-if test -r Access.3; then
- rm -f Access.3.*
- $ZIP Access.3
- rm -f Tcl_Access.3 Tcl_Access.3.*
- rm -f Tcl_Stat.3 Tcl_Stat.3.*
- ln $S Access.3$Z Tcl_Access.3$Z
- ln $S Access.3$Z Tcl_Stat.3$Z
-fi
-if test -r AddErrInfo.3; then
- rm -f AddErrInfo.3.*
- $ZIP AddErrInfo.3
- rm -f Tcl_AddObjErrorInfo.3 Tcl_AddObjErrorInfo.3.*
- rm -f Tcl_AddErrorInfo.3 Tcl_AddErrorInfo.3.*
- rm -f Tcl_SetObjErrorCode.3 Tcl_SetObjErrorCode.3.*
- rm -f Tcl_SetErrorCode.3 Tcl_SetErrorCode.3.*
- rm -f Tcl_SetErrorCodeVA.3 Tcl_SetErrorCodeVA.3.*
- rm -f Tcl_PosixError.3 Tcl_PosixError.3.*
- rm -f Tcl_LogCommandInfo.3 Tcl_LogCommandInfo.3.*
- ln $S AddErrInfo.3$Z Tcl_AddObjErrorInfo.3$Z
- ln $S AddErrInfo.3$Z Tcl_AddErrorInfo.3$Z
- ln $S AddErrInfo.3$Z Tcl_SetObjErrorCode.3$Z
- ln $S AddErrInfo.3$Z Tcl_SetErrorCode.3$Z
- ln $S AddErrInfo.3$Z Tcl_SetErrorCodeVA.3$Z
- ln $S AddErrInfo.3$Z Tcl_PosixError.3$Z
- ln $S AddErrInfo.3$Z Tcl_LogCommandInfo.3$Z
-fi
-if test -r Alloc.3; then
- rm -f Alloc.3.*
- $ZIP Alloc.3
- rm -f Tcl_Alloc.3 Tcl_Alloc.3.*
- rm -f Tcl_Free.3 Tcl_Free.3.*
- rm -f Tcl_Realloc.3 Tcl_Realloc.3.*
- rm -f Tcl_AttemptAlloc.3 Tcl_AttemptAlloc.3.*
- rm -f Tcl_AttemptRealloc.3 Tcl_AttemptRealloc.3.*
- rm -f ckalloc.3 ckalloc.3.*
- rm -f ckfree.3 ckfree.3.*
- rm -f ckrealloc.3 ckrealloc.3.*
- rm -f attemptckalloc.3 attemptckalloc.3.*
- rm -f attemptckrealloc.3 attemptckrealloc.3.*
- ln $S Alloc.3$Z Tcl_Alloc.3$Z
- ln $S Alloc.3$Z Tcl_Free.3$Z
- ln $S Alloc.3$Z Tcl_Realloc.3$Z
- ln $S Alloc.3$Z Tcl_AttemptAlloc.3$Z
- ln $S Alloc.3$Z Tcl_AttemptRealloc.3$Z
- ln $S Alloc.3$Z ckalloc.3$Z
- ln $S Alloc.3$Z ckfree.3$Z
- ln $S Alloc.3$Z ckrealloc.3$Z
- ln $S Alloc.3$Z attemptckalloc.3$Z
- ln $S Alloc.3$Z attemptckrealloc.3$Z
-fi
-if test -r AllowExc.3; then
- rm -f AllowExc.3.*
- $ZIP AllowExc.3
- rm -f Tcl_AllowExceptions.3 Tcl_AllowExceptions.3.*
- ln $S AllowExc.3$Z Tcl_AllowExceptions.3$Z
-fi
-if test -r AppInit.3; then
- rm -f AppInit.3.*
- $ZIP AppInit.3
- rm -f Tcl_AppInit.3 Tcl_AppInit.3.*
- ln $S AppInit.3$Z Tcl_AppInit.3$Z
-fi
-if test -r AssocData.3; then
- rm -f AssocData.3.*
- $ZIP AssocData.3
- rm -f Tcl_GetAssocData.3 Tcl_GetAssocData.3.*
- rm -f Tcl_SetAssocData.3 Tcl_SetAssocData.3.*
- rm -f Tcl_DeleteAssocData.3 Tcl_DeleteAssocData.3.*
- ln $S AssocData.3$Z Tcl_GetAssocData.3$Z
- ln $S AssocData.3$Z Tcl_SetAssocData.3$Z
- ln $S AssocData.3$Z Tcl_DeleteAssocData.3$Z
-fi
-if test -r Async.3; then
- rm -f Async.3.*
- $ZIP Async.3
- rm -f Tcl_AsyncCreate.3 Tcl_AsyncCreate.3.*
- rm -f Tcl_AsyncMark.3 Tcl_AsyncMark.3.*
- rm -f Tcl_AsyncInvoke.3 Tcl_AsyncInvoke.3.*
- rm -f Tcl_AsyncDelete.3 Tcl_AsyncDelete.3.*
- rm -f Tcl_AsyncReady.3 Tcl_AsyncReady.3.*
- ln $S Async.3$Z Tcl_AsyncCreate.3$Z
- ln $S Async.3$Z Tcl_AsyncMark.3$Z
- ln $S Async.3$Z Tcl_AsyncInvoke.3$Z
- ln $S Async.3$Z Tcl_AsyncDelete.3$Z
- ln $S Async.3$Z Tcl_AsyncReady.3$Z
-fi
-if test -r BackgdErr.3; then
- rm -f BackgdErr.3.*
- $ZIP BackgdErr.3
- rm -f Tcl_BackgroundError.3 Tcl_BackgroundError.3.*
- ln $S BackgdErr.3$Z Tcl_BackgroundError.3$Z
-fi
-if test -r Backslash.3; then
- rm -f Backslash.3.*
- $ZIP Backslash.3
- rm -f Tcl_Backslash.3 Tcl_Backslash.3.*
- ln $S Backslash.3$Z Tcl_Backslash.3$Z
-fi
-if test -r BoolObj.3; then
- rm -f BoolObj.3.*
- $ZIP BoolObj.3
- rm -f Tcl_NewBooleanObj.3 Tcl_NewBooleanObj.3.*
- rm -f Tcl_SetBooleanObj.3 Tcl_SetBooleanObj.3.*
- rm -f Tcl_GetBooleanFromObj.3 Tcl_GetBooleanFromObj.3.*
- ln $S BoolObj.3$Z Tcl_NewBooleanObj.3$Z
- ln $S BoolObj.3$Z Tcl_SetBooleanObj.3$Z
- ln $S BoolObj.3$Z Tcl_GetBooleanFromObj.3$Z
-fi
-if test -r ByteArrObj.3; then
- rm -f ByteArrObj.3.*
- $ZIP ByteArrObj.3
- rm -f Tcl_NewByteArrayObj.3 Tcl_NewByteArrayObj.3.*
- rm -f Tcl_SetByteArrayObj.3 Tcl_SetByteArrayObj.3.*
- rm -f Tcl_GetByteArrayFromObj.3 Tcl_GetByteArrayFromObj.3.*
- rm -f Tcl_SetByteArrayLength.3 Tcl_SetByteArrayLength.3.*
- ln $S ByteArrObj.3$Z Tcl_NewByteArrayObj.3$Z
- ln $S ByteArrObj.3$Z Tcl_SetByteArrayObj.3$Z
- ln $S ByteArrObj.3$Z Tcl_GetByteArrayFromObj.3$Z
- ln $S ByteArrObj.3$Z Tcl_SetByteArrayLength.3$Z
-fi
-if test -r CallDel.3; then
- rm -f CallDel.3.*
- $ZIP CallDel.3
- rm -f Tcl_CallWhenDeleted.3 Tcl_CallWhenDeleted.3.*
- rm -f Tcl_DontCallWhenDeleted.3 Tcl_DontCallWhenDeleted.3.*
- ln $S CallDel.3$Z Tcl_CallWhenDeleted.3$Z
- ln $S CallDel.3$Z Tcl_DontCallWhenDeleted.3$Z
-fi
-if test -r ChnlStack.3; then
- rm -f ChnlStack.3.*
- $ZIP ChnlStack.3
- rm -f Tcl_StackChannel.3 Tcl_StackChannel.3.*
- rm -f Tcl_UnstackChannel.3 Tcl_UnstackChannel.3.*
- rm -f Tcl_GetStackedChannel.3 Tcl_GetStackedChannel.3.*
- rm -f Tcl_GetTopChannel.3 Tcl_GetTopChannel.3.*
- ln $S ChnlStack.3$Z Tcl_StackChannel.3$Z
- ln $S ChnlStack.3$Z Tcl_UnstackChannel.3$Z
- ln $S ChnlStack.3$Z Tcl_GetStackedChannel.3$Z
- ln $S ChnlStack.3$Z Tcl_GetTopChannel.3$Z
-fi
-if test -r CmdCmplt.3; then
- rm -f CmdCmplt.3.*
- $ZIP CmdCmplt.3
- rm -f Tcl_CommandComplete.3 Tcl_CommandComplete.3.*
- ln $S CmdCmplt.3$Z Tcl_CommandComplete.3$Z
-fi
-if test -r Concat.3; then
- rm -f Concat.3.*
- $ZIP Concat.3
- rm -f Tcl_Concat.3 Tcl_Concat.3.*
- ln $S Concat.3$Z Tcl_Concat.3$Z
-fi
-if test -r CrtChannel.3; then
- rm -f CrtChannel.3.*
- $ZIP CrtChannel.3
- rm -f Tcl_CreateChannel.3 Tcl_CreateChannel.3.*
- rm -f Tcl_GetChannelInstanceData.3 Tcl_GetChannelInstanceData.3.*
- rm -f Tcl_GetChannelType.3 Tcl_GetChannelType.3.*
- rm -f Tcl_GetChannelName.3 Tcl_GetChannelName.3.*
- rm -f Tcl_GetChannelHandle.3 Tcl_GetChannelHandle.3.*
- rm -f Tcl_GetChannelMode.3 Tcl_GetChannelMode.3.*
- rm -f Tcl_GetChannelBufferSize.3 Tcl_GetChannelBufferSize.3.*
- rm -f Tcl_SetChannelBufferSize.3 Tcl_SetChannelBufferSize.3.*
- rm -f Tcl_NotifyChannel.3 Tcl_NotifyChannel.3.*
- rm -f Tcl_BadChannelOption.3 Tcl_BadChannelOption.3.*
- rm -f Tcl_ChannelName.3 Tcl_ChannelName.3.*
- rm -f Tcl_ChannelVersion.3 Tcl_ChannelVersion.3.*
- rm -f Tcl_ChannelBlockModeProc.3 Tcl_ChannelBlockModeProc.3.*
- rm -f Tcl_ChannelCloseProc.3 Tcl_ChannelCloseProc.3.*
- rm -f Tcl_ChannelClose2Proc.3 Tcl_ChannelClose2Proc.3.*
- rm -f Tcl_ChannelInputProc.3 Tcl_ChannelInputProc.3.*
- rm -f Tcl_ChannelOutputProc.3 Tcl_ChannelOutputProc.3.*
- rm -f Tcl_ChannelSeekProc.3 Tcl_ChannelSeekProc.3.*
- rm -f Tcl_ChannelWideSeekProc.3 Tcl_ChannelWideSeekProc.3.*
- rm -f Tcl_ChannelSetOptionProc.3 Tcl_ChannelSetOptionProc.3.*
- rm -f Tcl_ChannelGetOptionProc.3 Tcl_ChannelGetOptionProc.3.*
- rm -f Tcl_ChannelWatchProc.3 Tcl_ChannelWatchProc.3.*
- rm -f Tcl_ChannelGetHandleProc.3 Tcl_ChannelGetHandleProc.3.*
- rm -f Tcl_ChannelFlushProc.3 Tcl_ChannelFlushProc.3.*
- rm -f Tcl_ChannelHandlerProc.3 Tcl_ChannelHandlerProc.3.*
- rm -f Tcl_IsChannelShared.3 Tcl_IsChannelShared.3.*
- rm -f Tcl_IsChannelRegistered.3 Tcl_IsChannelRegistered.3.*
- rm -f Tcl_CutChannel.3 Tcl_CutChannel.3.*
- rm -f Tcl_SpliceChannel.3 Tcl_SpliceChannel.3.*
- rm -f Tcl_IsChannelExisting.3 Tcl_IsChannelExisting.3.*
- rm -f Tcl_ClearChannelHandlers.3 Tcl_ClearChannelHandlers.3.*
- rm -f Tcl_GetChannelThread.3 Tcl_GetChannelThread.3.*
- rm -f Tcl_ChannelBuffered.3 Tcl_ChannelBuffered.3.*
- ln $S CrtChannel.3$Z Tcl_CreateChannel.3$Z
- ln $S CrtChannel.3$Z Tcl_GetChannelInstanceData.3$Z
- ln $S CrtChannel.3$Z Tcl_GetChannelType.3$Z
- ln $S CrtChannel.3$Z Tcl_GetChannelName.3$Z
- ln $S CrtChannel.3$Z Tcl_GetChannelHandle.3$Z
- ln $S CrtChannel.3$Z Tcl_GetChannelMode.3$Z
- ln $S CrtChannel.3$Z Tcl_GetChannelBufferSize.3$Z
- ln $S CrtChannel.3$Z Tcl_SetChannelBufferSize.3$Z
- ln $S CrtChannel.3$Z Tcl_NotifyChannel.3$Z
- ln $S CrtChannel.3$Z Tcl_BadChannelOption.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelName.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelVersion.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelBlockModeProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelCloseProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelClose2Proc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelInputProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelOutputProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelSeekProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelWideSeekProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelSetOptionProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelGetOptionProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelWatchProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelGetHandleProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelFlushProc.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelHandlerProc.3$Z
- ln $S CrtChannel.3$Z Tcl_IsChannelShared.3$Z
- ln $S CrtChannel.3$Z Tcl_IsChannelRegistered.3$Z
- ln $S CrtChannel.3$Z Tcl_CutChannel.3$Z
- ln $S CrtChannel.3$Z Tcl_SpliceChannel.3$Z
- ln $S CrtChannel.3$Z Tcl_IsChannelExisting.3$Z
- ln $S CrtChannel.3$Z Tcl_ClearChannelHandlers.3$Z
- ln $S CrtChannel.3$Z Tcl_GetChannelThread.3$Z
- ln $S CrtChannel.3$Z Tcl_ChannelBuffered.3$Z
-fi
-if test -r CrtChnlHdlr.3; then
- rm -f CrtChnlHdlr.3.*
- $ZIP CrtChnlHdlr.3
- rm -f Tcl_CreateChannelHandler.3 Tcl_CreateChannelHandler.3.*
- rm -f Tcl_DeleteChannelHandler.3 Tcl_DeleteChannelHandler.3.*
- ln $S CrtChnlHdlr.3$Z Tcl_CreateChannelHandler.3$Z
- ln $S CrtChnlHdlr.3$Z Tcl_DeleteChannelHandler.3$Z
-fi
-if test -r CrtCloseHdlr.3; then
- rm -f CrtCloseHdlr.3.*
- $ZIP CrtCloseHdlr.3
- rm -f Tcl_CreateCloseHandler.3 Tcl_CreateCloseHandler.3.*
- rm -f Tcl_DeleteCloseHandler.3 Tcl_DeleteCloseHandler.3.*
- ln $S CrtCloseHdlr.3$Z Tcl_CreateCloseHandler.3$Z
- ln $S CrtCloseHdlr.3$Z Tcl_DeleteCloseHandler.3$Z
-fi
-if test -r CrtCommand.3; then
- rm -f CrtCommand.3.*
- $ZIP CrtCommand.3
- rm -f Tcl_CreateCommand.3 Tcl_CreateCommand.3.*
- ln $S CrtCommand.3$Z Tcl_CreateCommand.3$Z
-fi
-if test -r CrtFileHdlr.3; then
- rm -f CrtFileHdlr.3.*
- $ZIP CrtFileHdlr.3
- rm -f Tcl_CreateFileHandler.3 Tcl_CreateFileHandler.3.*
- rm -f Tcl_DeleteFileHandler.3 Tcl_DeleteFileHandler.3.*
- ln $S CrtFileHdlr.3$Z Tcl_CreateFileHandler.3$Z
- ln $S CrtFileHdlr.3$Z Tcl_DeleteFileHandler.3$Z
-fi
-if test -r CrtInterp.3; then
- rm -f CrtInterp.3.*
- $ZIP CrtInterp.3
- rm -f Tcl_CreateInterp.3 Tcl_CreateInterp.3.*
- rm -f Tcl_DeleteInterp.3 Tcl_DeleteInterp.3.*
- rm -f Tcl_InterpDeleted.3 Tcl_InterpDeleted.3.*
- ln $S CrtInterp.3$Z Tcl_CreateInterp.3$Z
- ln $S CrtInterp.3$Z Tcl_DeleteInterp.3$Z
- ln $S CrtInterp.3$Z Tcl_InterpDeleted.3$Z
-fi
-if test -r CrtMathFnc.3; then
- rm -f CrtMathFnc.3.*
- $ZIP CrtMathFnc.3
- rm -f Tcl_CreateMathFunc.3 Tcl_CreateMathFunc.3.*
- rm -f Tcl_GetMathFuncInfo.3 Tcl_GetMathFuncInfo.3.*
- rm -f Tcl_ListMathFuncs.3 Tcl_ListMathFuncs.3.*
- ln $S CrtMathFnc.3$Z Tcl_CreateMathFunc.3$Z
- ln $S CrtMathFnc.3$Z Tcl_GetMathFuncInfo.3$Z
- ln $S CrtMathFnc.3$Z Tcl_ListMathFuncs.3$Z
-fi
-if test -r CrtObjCmd.3; then
- rm -f CrtObjCmd.3.*
- $ZIP CrtObjCmd.3
- rm -f Tcl_CreateObjCommand.3 Tcl_CreateObjCommand.3.*
- rm -f Tcl_DeleteCommand.3 Tcl_DeleteCommand.3.*
- rm -f Tcl_DeleteCommandFromToken.3 Tcl_DeleteCommandFromToken.3.*
- rm -f Tcl_GetCommandInfo.3 Tcl_GetCommandInfo.3.*
- rm -f Tcl_GetCommandInfoFromToken.3 Tcl_GetCommandInfoFromToken.3.*
- rm -f Tcl_SetCommandInfo.3 Tcl_SetCommandInfo.3.*
- rm -f Tcl_SetCommandInfoFromToken.3 Tcl_SetCommandInfoFromToken.3.*
- rm -f Tcl_GetCommandName.3 Tcl_GetCommandName.3.*
- rm -f Tcl_GetCommandFullName.3 Tcl_GetCommandFullName.3.*
- rm -f Tcl_GetCommandFromObj.3 Tcl_GetCommandFromObj.3.*
- ln $S CrtObjCmd.3$Z Tcl_CreateObjCommand.3$Z
- ln $S CrtObjCmd.3$Z Tcl_DeleteCommand.3$Z
- ln $S CrtObjCmd.3$Z Tcl_DeleteCommandFromToken.3$Z
- ln $S CrtObjCmd.3$Z Tcl_GetCommandInfo.3$Z
- ln $S CrtObjCmd.3$Z Tcl_GetCommandInfoFromToken.3$Z
- ln $S CrtObjCmd.3$Z Tcl_SetCommandInfo.3$Z
- ln $S CrtObjCmd.3$Z Tcl_SetCommandInfoFromToken.3$Z
- ln $S CrtObjCmd.3$Z Tcl_GetCommandName.3$Z
- ln $S CrtObjCmd.3$Z Tcl_GetCommandFullName.3$Z
- ln $S CrtObjCmd.3$Z Tcl_GetCommandFromObj.3$Z
-fi
-if test -r CrtSlave.3; then
- rm -f CrtSlave.3.*
- $ZIP CrtSlave.3
- rm -f Tcl_IsSafe.3 Tcl_IsSafe.3.*
- rm -f Tcl_MakeSafe.3 Tcl_MakeSafe.3.*
- rm -f Tcl_CreateSlave.3 Tcl_CreateSlave.3.*
- rm -f Tcl_GetSlave.3 Tcl_GetSlave.3.*
- rm -f Tcl_GetMaster.3 Tcl_GetMaster.3.*
- rm -f Tcl_GetInterpPath.3 Tcl_GetInterpPath.3.*
- rm -f Tcl_CreateAlias.3 Tcl_CreateAlias.3.*
- rm -f Tcl_CreateAliasObj.3 Tcl_CreateAliasObj.3.*
- rm -f Tcl_GetAlias.3 Tcl_GetAlias.3.*
- rm -f Tcl_GetAliasObj.3 Tcl_GetAliasObj.3.*
- rm -f Tcl_ExposeCommand.3 Tcl_ExposeCommand.3.*
- rm -f Tcl_HideCommand.3 Tcl_HideCommand.3.*
- ln $S CrtSlave.3$Z Tcl_IsSafe.3$Z
- ln $S CrtSlave.3$Z Tcl_MakeSafe.3$Z
- ln $S CrtSlave.3$Z Tcl_CreateSlave.3$Z
- ln $S CrtSlave.3$Z Tcl_GetSlave.3$Z
- ln $S CrtSlave.3$Z Tcl_GetMaster.3$Z
- ln $S CrtSlave.3$Z Tcl_GetInterpPath.3$Z
- ln $S CrtSlave.3$Z Tcl_CreateAlias.3$Z
- ln $S CrtSlave.3$Z Tcl_CreateAliasObj.3$Z
- ln $S CrtSlave.3$Z Tcl_GetAlias.3$Z
- ln $S CrtSlave.3$Z Tcl_GetAliasObj.3$Z
- ln $S CrtSlave.3$Z Tcl_ExposeCommand.3$Z
- ln $S CrtSlave.3$Z Tcl_HideCommand.3$Z
-fi
-if test -r CrtTimerHdlr.3; then
- rm -f CrtTimerHdlr.3.*
- $ZIP CrtTimerHdlr.3
- rm -f Tcl_CreateTimerHandler.3 Tcl_CreateTimerHandler.3.*
- rm -f Tcl_DeleteTimerHandler.3 Tcl_DeleteTimerHandler.3.*
- ln $S CrtTimerHdlr.3$Z Tcl_CreateTimerHandler.3$Z
- ln $S CrtTimerHdlr.3$Z Tcl_DeleteTimerHandler.3$Z
-fi
-if test -r CrtTrace.3; then
- rm -f CrtTrace.3.*
- $ZIP CrtTrace.3
- rm -f Tcl_CreateTrace.3 Tcl_CreateTrace.3.*
- rm -f Tcl_CreateObjTrace.3 Tcl_CreateObjTrace.3.*
- rm -f Tcl_DeleteTrace.3 Tcl_DeleteTrace.3.*
- ln $S CrtTrace.3$Z Tcl_CreateTrace.3$Z
- ln $S CrtTrace.3$Z Tcl_CreateObjTrace.3$Z
- ln $S CrtTrace.3$Z Tcl_DeleteTrace.3$Z
-fi
-if test -r DString.3; then
- rm -f DString.3.*
- $ZIP DString.3
- rm -f Tcl_DStringInit.3 Tcl_DStringInit.3.*
- rm -f Tcl_DStringAppend.3 Tcl_DStringAppend.3.*
- rm -f Tcl_DStringAppendElement.3 Tcl_DStringAppendElement.3.*
- rm -f Tcl_DStringStartSublist.3 Tcl_DStringStartSublist.3.*
- rm -f Tcl_DStringEndSublist.3 Tcl_DStringEndSublist.3.*
- rm -f Tcl_DStringLength.3 Tcl_DStringLength.3.*
- rm -f Tcl_DStringValue.3 Tcl_DStringValue.3.*
- rm -f Tcl_DStringSetLength.3 Tcl_DStringSetLength.3.*
- rm -f Tcl_DStringTrunc.3 Tcl_DStringTrunc.3.*
- rm -f Tcl_DStringFree.3 Tcl_DStringFree.3.*
- rm -f Tcl_DStringResult.3 Tcl_DStringResult.3.*
- rm -f Tcl_DStringGetResult.3 Tcl_DStringGetResult.3.*
- ln $S DString.3$Z Tcl_DStringInit.3$Z
- ln $S DString.3$Z Tcl_DStringAppend.3$Z
- ln $S DString.3$Z Tcl_DStringAppendElement.3$Z
- ln $S DString.3$Z Tcl_DStringStartSublist.3$Z
- ln $S DString.3$Z Tcl_DStringEndSublist.3$Z
- ln $S DString.3$Z Tcl_DStringLength.3$Z
- ln $S DString.3$Z Tcl_DStringValue.3$Z
- ln $S DString.3$Z Tcl_DStringSetLength.3$Z
- ln $S DString.3$Z Tcl_DStringTrunc.3$Z
- ln $S DString.3$Z Tcl_DStringFree.3$Z
- ln $S DString.3$Z Tcl_DStringResult.3$Z
- ln $S DString.3$Z Tcl_DStringGetResult.3$Z
-fi
-if test -r DetachPids.3; then
- rm -f DetachPids.3.*
- $ZIP DetachPids.3
- rm -f Tcl_DetachPids.3 Tcl_DetachPids.3.*
- rm -f Tcl_ReapDetachedProcs.3 Tcl_ReapDetachedProcs.3.*
- rm -f Tcl_WaitPid.3 Tcl_WaitPid.3.*
- ln $S DetachPids.3$Z Tcl_DetachPids.3$Z
- ln $S DetachPids.3$Z Tcl_ReapDetachedProcs.3$Z
- ln $S DetachPids.3$Z Tcl_WaitPid.3$Z
-fi
-if test -r DoOneEvent.3; then
- rm -f DoOneEvent.3.*
- $ZIP DoOneEvent.3
- rm -f Tcl_DoOneEvent.3 Tcl_DoOneEvent.3.*
- ln $S DoOneEvent.3$Z Tcl_DoOneEvent.3$Z
-fi
-if test -r DoWhenIdle.3; then
- rm -f DoWhenIdle.3.*
- $ZIP DoWhenIdle.3
- rm -f Tcl_DoWhenIdle.3 Tcl_DoWhenIdle.3.*
- rm -f Tcl_CancelIdleCall.3 Tcl_CancelIdleCall.3.*
- ln $S DoWhenIdle.3$Z Tcl_DoWhenIdle.3$Z
- ln $S DoWhenIdle.3$Z Tcl_CancelIdleCall.3$Z
-fi
-if test -r DoubleObj.3; then
- rm -f DoubleObj.3.*
- $ZIP DoubleObj.3
- rm -f Tcl_NewDoubleObj.3 Tcl_NewDoubleObj.3.*
- rm -f Tcl_SetDoubleObj.3 Tcl_SetDoubleObj.3.*
- rm -f Tcl_GetDoubleFromObj.3 Tcl_GetDoubleFromObj.3.*
- ln $S DoubleObj.3$Z Tcl_NewDoubleObj.3$Z
- ln $S DoubleObj.3$Z Tcl_SetDoubleObj.3$Z
- ln $S DoubleObj.3$Z Tcl_GetDoubleFromObj.3$Z
-fi
-if test -r DumpActiveMemory.3; then
- rm -f DumpActiveMemory.3.*
- $ZIP DumpActiveMemory.3
- rm -f Tcl_DumpActiveMemory.3 Tcl_DumpActiveMemory.3.*
- rm -f Tcl_InitMemory.3 Tcl_InitMemory.3.*
- rm -f Tcl_ValidateAllMemory.3 Tcl_ValidateAllMemory.3.*
- ln $S DumpActiveMemory.3$Z Tcl_DumpActiveMemory.3$Z
- ln $S DumpActiveMemory.3$Z Tcl_InitMemory.3$Z
- ln $S DumpActiveMemory.3$Z Tcl_ValidateAllMemory.3$Z
-fi
-if test -r Encoding.3; then
- rm -f Encoding.3.*
- $ZIP Encoding.3
- rm -f Tcl_GetEncoding.3 Tcl_GetEncoding.3.*
- rm -f Tcl_FreeEncoding.3 Tcl_FreeEncoding.3.*
- rm -f Tcl_ExternalToUtfDString.3 Tcl_ExternalToUtfDString.3.*
- rm -f Tcl_ExternalToUtf.3 Tcl_ExternalToUtf.3.*
- rm -f Tcl_UtfToExternalDString.3 Tcl_UtfToExternalDString.3.*
- rm -f Tcl_UtfToExternal.3 Tcl_UtfToExternal.3.*
- rm -f Tcl_WinTCharToUtf.3 Tcl_WinTCharToUtf.3.*
- rm -f Tcl_WinUtfToTChar.3 Tcl_WinUtfToTChar.3.*
- rm -f Tcl_GetEncodingName.3 Tcl_GetEncodingName.3.*
- rm -f Tcl_SetSystemEncoding.3 Tcl_SetSystemEncoding.3.*
- rm -f Tcl_GetEncodingNames.3 Tcl_GetEncodingNames.3.*
- rm -f Tcl_CreateEncoding.3 Tcl_CreateEncoding.3.*
- rm -f Tcl_GetDefaultEncodingDir.3 Tcl_GetDefaultEncodingDir.3.*
- rm -f Tcl_SetDefaultEncodingDir.3 Tcl_SetDefaultEncodingDir.3.*
- ln $S Encoding.3$Z Tcl_GetEncoding.3$Z
- ln $S Encoding.3$Z Tcl_FreeEncoding.3$Z
- ln $S Encoding.3$Z Tcl_ExternalToUtfDString.3$Z
- ln $S Encoding.3$Z Tcl_ExternalToUtf.3$Z
- ln $S Encoding.3$Z Tcl_UtfToExternalDString.3$Z
- ln $S Encoding.3$Z Tcl_UtfToExternal.3$Z
- ln $S Encoding.3$Z Tcl_WinTCharToUtf.3$Z
- ln $S Encoding.3$Z Tcl_WinUtfToTChar.3$Z
- ln $S Encoding.3$Z Tcl_GetEncodingName.3$Z
- ln $S Encoding.3$Z Tcl_SetSystemEncoding.3$Z
- ln $S Encoding.3$Z Tcl_GetEncodingNames.3$Z
- ln $S Encoding.3$Z Tcl_CreateEncoding.3$Z
- ln $S Encoding.3$Z Tcl_GetDefaultEncodingDir.3$Z
- ln $S Encoding.3$Z Tcl_SetDefaultEncodingDir.3$Z
-fi
-if test -r Environment.3; then
- rm -f Environment.3.*
- $ZIP Environment.3
- rm -f Tcl_PutEnv.3 Tcl_PutEnv.3.*
- ln $S Environment.3$Z Tcl_PutEnv.3$Z
-fi
-if test -r Eval.3; then
- rm -f Eval.3.*
- $ZIP Eval.3
- rm -f Tcl_EvalObjEx.3 Tcl_EvalObjEx.3.*
- rm -f Tcl_EvalFile.3 Tcl_EvalFile.3.*
- rm -f Tcl_EvalObjv.3 Tcl_EvalObjv.3.*
- rm -f Tcl_Eval.3 Tcl_Eval.3.*
- rm -f Tcl_EvalEx.3 Tcl_EvalEx.3.*
- rm -f Tcl_GlobalEval.3 Tcl_GlobalEval.3.*
- rm -f Tcl_GlobalEvalObj.3 Tcl_GlobalEvalObj.3.*
- rm -f Tcl_VarEval.3 Tcl_VarEval.3.*
- rm -f Tcl_VarEvalVA.3 Tcl_VarEvalVA.3.*
- ln $S Eval.3$Z Tcl_EvalObjEx.3$Z
- ln $S Eval.3$Z Tcl_EvalFile.3$Z
- ln $S Eval.3$Z Tcl_EvalObjv.3$Z
- ln $S Eval.3$Z Tcl_Eval.3$Z
- ln $S Eval.3$Z Tcl_EvalEx.3$Z
- ln $S Eval.3$Z Tcl_GlobalEval.3$Z
- ln $S Eval.3$Z Tcl_GlobalEvalObj.3$Z
- ln $S Eval.3$Z Tcl_VarEval.3$Z
- ln $S Eval.3$Z Tcl_VarEvalVA.3$Z
-fi
-if test -r Exit.3; then
- rm -f Exit.3.*
- $ZIP Exit.3
- rm -f Tcl_Exit.3 Tcl_Exit.3.*
- rm -f Tcl_Finalize.3 Tcl_Finalize.3.*
- rm -f Tcl_CreateExitHandler.3 Tcl_CreateExitHandler.3.*
- rm -f Tcl_DeleteExitHandler.3 Tcl_DeleteExitHandler.3.*
- rm -f Tcl_ExitThread.3 Tcl_ExitThread.3.*
- rm -f Tcl_FinalizeThread.3 Tcl_FinalizeThread.3.*
- rm -f Tcl_CreateThreadExitHandler.3 Tcl_CreateThreadExitHandler.3.*
- rm -f Tcl_DeleteThreadExitHandler.3 Tcl_DeleteThreadExitHandler.3.*
- ln $S Exit.3$Z Tcl_Exit.3$Z
- ln $S Exit.3$Z Tcl_Finalize.3$Z
- ln $S Exit.3$Z Tcl_CreateExitHandler.3$Z
- ln $S Exit.3$Z Tcl_DeleteExitHandler.3$Z
- ln $S Exit.3$Z Tcl_ExitThread.3$Z
- ln $S Exit.3$Z Tcl_FinalizeThread.3$Z
- ln $S Exit.3$Z Tcl_CreateThreadExitHandler.3$Z
- ln $S Exit.3$Z Tcl_DeleteThreadExitHandler.3$Z
-fi
-if test -r ExprLong.3; then
- rm -f ExprLong.3.*
- $ZIP ExprLong.3
- rm -f Tcl_ExprLong.3 Tcl_ExprLong.3.*
- rm -f Tcl_ExprDouble.3 Tcl_ExprDouble.3.*
- rm -f Tcl_ExprBoolean.3 Tcl_ExprBoolean.3.*
- rm -f Tcl_ExprString.3 Tcl_ExprString.3.*
- ln $S ExprLong.3$Z Tcl_ExprLong.3$Z
- ln $S ExprLong.3$Z Tcl_ExprDouble.3$Z
- ln $S ExprLong.3$Z Tcl_ExprBoolean.3$Z
- ln $S ExprLong.3$Z Tcl_ExprString.3$Z
-fi
-if test -r ExprLongObj.3; then
- rm -f ExprLongObj.3.*
- $ZIP ExprLongObj.3
- rm -f Tcl_ExprLongObj.3 Tcl_ExprLongObj.3.*
- rm -f Tcl_ExprDoubleObj.3 Tcl_ExprDoubleObj.3.*
- rm -f Tcl_ExprBooleanObj.3 Tcl_ExprBooleanObj.3.*
- rm -f Tcl_ExprObj.3 Tcl_ExprObj.3.*
- ln $S ExprLongObj.3$Z Tcl_ExprLongObj.3$Z
- ln $S ExprLongObj.3$Z Tcl_ExprDoubleObj.3$Z
- ln $S ExprLongObj.3$Z Tcl_ExprBooleanObj.3$Z
- ln $S ExprLongObj.3$Z Tcl_ExprObj.3$Z
-fi
-if test -r FileSystem.3; then
- rm -f FileSystem.3.*
- $ZIP FileSystem.3
- rm -f Tcl_FSRegister.3 Tcl_FSRegister.3.*
- rm -f Tcl_FSUnregister.3 Tcl_FSUnregister.3.*
- rm -f Tcl_FSData.3 Tcl_FSData.3.*
- rm -f Tcl_FSMountsChanged.3 Tcl_FSMountsChanged.3.*
- rm -f Tcl_FSGetFileSystemForPath.3 Tcl_FSGetFileSystemForPath.3.*
- rm -f Tcl_FSGetPathType.3 Tcl_FSGetPathType.3.*
- rm -f Tcl_FSCopyFile.3 Tcl_FSCopyFile.3.*
- rm -f Tcl_FSCopyDirectory.3 Tcl_FSCopyDirectory.3.*
- rm -f Tcl_FSCreateDirectory.3 Tcl_FSCreateDirectory.3.*
- rm -f Tcl_FSDeleteFile.3 Tcl_FSDeleteFile.3.*
- rm -f Tcl_FSRemoveDirectory.3 Tcl_FSRemoveDirectory.3.*
- rm -f Tcl_FSRenameFile.3 Tcl_FSRenameFile.3.*
- rm -f Tcl_FSListVolumes.3 Tcl_FSListVolumes.3.*
- rm -f Tcl_FSEvalFile.3 Tcl_FSEvalFile.3.*
- rm -f Tcl_FSLoadFile.3 Tcl_FSLoadFile.3.*
- rm -f Tcl_FSMatchInDirectory.3 Tcl_FSMatchInDirectory.3.*
- rm -f Tcl_FSLink.3 Tcl_FSLink.3.*
- rm -f Tcl_FSLstat.3 Tcl_FSLstat.3.*
- rm -f Tcl_FSUtime.3 Tcl_FSUtime.3.*
- rm -f Tcl_FSFileAttrsGet.3 Tcl_FSFileAttrsGet.3.*
- rm -f Tcl_FSFileAttrsSet.3 Tcl_FSFileAttrsSet.3.*
- rm -f Tcl_FSFileAttrStrings.3 Tcl_FSFileAttrStrings.3.*
- rm -f Tcl_FSStat.3 Tcl_FSStat.3.*
- rm -f Tcl_FSAccess.3 Tcl_FSAccess.3.*
- rm -f Tcl_FSOpenFileChannel.3 Tcl_FSOpenFileChannel.3.*
- rm -f Tcl_FSGetCwd.3 Tcl_FSGetCwd.3.*
- rm -f Tcl_FSChdir.3 Tcl_FSChdir.3.*
- rm -f Tcl_FSPathSeparator.3 Tcl_FSPathSeparator.3.*
- rm -f Tcl_FSJoinPath.3 Tcl_FSJoinPath.3.*
- rm -f Tcl_FSSplitPath.3 Tcl_FSSplitPath.3.*
- rm -f Tcl_FSEqualPaths.3 Tcl_FSEqualPaths.3.*
- rm -f Tcl_FSGetNormalizedPath.3 Tcl_FSGetNormalizedPath.3.*
- rm -f Tcl_FSJoinToPath.3 Tcl_FSJoinToPath.3.*
- rm -f Tcl_FSConvertToPathType.3 Tcl_FSConvertToPathType.3.*
- rm -f Tcl_FSGetInternalRep.3 Tcl_FSGetInternalRep.3.*
- rm -f Tcl_FSGetTranslatedPath.3 Tcl_FSGetTranslatedPath.3.*
- rm -f Tcl_FSGetTranslatedStringPath.3 Tcl_FSGetTranslatedStringPath.3.*
- rm -f Tcl_FSNewNativePath.3 Tcl_FSNewNativePath.3.*
- rm -f Tcl_FSGetNativePath.3 Tcl_FSGetNativePath.3.*
- rm -f Tcl_FSFileSystemInfo.3 Tcl_FSFileSystemInfo.3.*
- rm -f Tcl_AllocStatBuf.3 Tcl_AllocStatBuf.3.*
- ln $S FileSystem.3$Z Tcl_FSRegister.3$Z
- ln $S FileSystem.3$Z Tcl_FSUnregister.3$Z
- ln $S FileSystem.3$Z Tcl_FSData.3$Z
- ln $S FileSystem.3$Z Tcl_FSMountsChanged.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetFileSystemForPath.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetPathType.3$Z
- ln $S FileSystem.3$Z Tcl_FSCopyFile.3$Z
- ln $S FileSystem.3$Z Tcl_FSCopyDirectory.3$Z
- ln $S FileSystem.3$Z Tcl_FSCreateDirectory.3$Z
- ln $S FileSystem.3$Z Tcl_FSDeleteFile.3$Z
- ln $S FileSystem.3$Z Tcl_FSRemoveDirectory.3$Z
- ln $S FileSystem.3$Z Tcl_FSRenameFile.3$Z
- ln $S FileSystem.3$Z Tcl_FSListVolumes.3$Z
- ln $S FileSystem.3$Z Tcl_FSEvalFile.3$Z
- ln $S FileSystem.3$Z Tcl_FSLoadFile.3$Z
- ln $S FileSystem.3$Z Tcl_FSMatchInDirectory.3$Z
- ln $S FileSystem.3$Z Tcl_FSLink.3$Z
- ln $S FileSystem.3$Z Tcl_FSLstat.3$Z
- ln $S FileSystem.3$Z Tcl_FSUtime.3$Z
- ln $S FileSystem.3$Z Tcl_FSFileAttrsGet.3$Z
- ln $S FileSystem.3$Z Tcl_FSFileAttrsSet.3$Z
- ln $S FileSystem.3$Z Tcl_FSFileAttrStrings.3$Z
- ln $S FileSystem.3$Z Tcl_FSStat.3$Z
- ln $S FileSystem.3$Z Tcl_FSAccess.3$Z
- ln $S FileSystem.3$Z Tcl_FSOpenFileChannel.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetCwd.3$Z
- ln $S FileSystem.3$Z Tcl_FSChdir.3$Z
- ln $S FileSystem.3$Z Tcl_FSPathSeparator.3$Z
- ln $S FileSystem.3$Z Tcl_FSJoinPath.3$Z
- ln $S FileSystem.3$Z Tcl_FSSplitPath.3$Z
- ln $S FileSystem.3$Z Tcl_FSEqualPaths.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetNormalizedPath.3$Z
- ln $S FileSystem.3$Z Tcl_FSJoinToPath.3$Z
- ln $S FileSystem.3$Z Tcl_FSConvertToPathType.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetInternalRep.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetTranslatedPath.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetTranslatedStringPath.3$Z
- ln $S FileSystem.3$Z Tcl_FSNewNativePath.3$Z
- ln $S FileSystem.3$Z Tcl_FSGetNativePath.3$Z
- ln $S FileSystem.3$Z Tcl_FSFileSystemInfo.3$Z
- ln $S FileSystem.3$Z Tcl_AllocStatBuf.3$Z
-fi
-if test -r FindExec.3; then
- rm -f FindExec.3.*
- $ZIP FindExec.3
- rm -f Tcl_FindExecutable.3 Tcl_FindExecutable.3.*
- rm -f Tcl_GetNameOfExecutable.3 Tcl_GetNameOfExecutable.3.*
- ln $S FindExec.3$Z Tcl_FindExecutable.3$Z
- ln $S FindExec.3$Z Tcl_GetNameOfExecutable.3$Z
-fi
-if test -r GetCwd.3; then
- rm -f GetCwd.3.*
- $ZIP GetCwd.3
- rm -f Tcl_GetCwd.3 Tcl_GetCwd.3.*
- rm -f Tcl_Chdir.3 Tcl_Chdir.3.*
- ln $S GetCwd.3$Z Tcl_GetCwd.3$Z
- ln $S GetCwd.3$Z Tcl_Chdir.3$Z
-fi
-if test -r GetHostName.3; then
- rm -f GetHostName.3.*
- $ZIP GetHostName.3
- rm -f Tcl_GetHostName.3 Tcl_GetHostName.3.*
- ln $S GetHostName.3$Z Tcl_GetHostName.3$Z
-fi
-if test -r GetIndex.3; then
- rm -f GetIndex.3.*
- $ZIP GetIndex.3
- rm -f Tcl_GetIndexFromObj.3 Tcl_GetIndexFromObj.3.*
- rm -f Tcl_GetIndexFromObjStruct.3 Tcl_GetIndexFromObjStruct.3.*
- ln $S GetIndex.3$Z Tcl_GetIndexFromObj.3$Z
- ln $S GetIndex.3$Z Tcl_GetIndexFromObjStruct.3$Z
-fi
-if test -r GetInt.3; then
- rm -f GetInt.3.*
- $ZIP GetInt.3
- rm -f Tcl_GetInt.3 Tcl_GetInt.3.*
- rm -f Tcl_GetDouble.3 Tcl_GetDouble.3.*
- rm -f Tcl_GetBoolean.3 Tcl_GetBoolean.3.*
- ln $S GetInt.3$Z Tcl_GetInt.3$Z
- ln $S GetInt.3$Z Tcl_GetDouble.3$Z
- ln $S GetInt.3$Z Tcl_GetBoolean.3$Z
-fi
-if test -r GetOpnFl.3; then
- rm -f GetOpnFl.3.*
- $ZIP GetOpnFl.3
- rm -f Tcl_GetOpenFile.3 Tcl_GetOpenFile.3.*
- ln $S GetOpnFl.3$Z Tcl_GetOpenFile.3$Z
-fi
-if test -r GetStdChan.3; then
- rm -f GetStdChan.3.*
- $ZIP GetStdChan.3
- rm -f Tcl_GetStdChannel.3 Tcl_GetStdChannel.3.*
- rm -f Tcl_SetStdChannel.3 Tcl_SetStdChannel.3.*
- ln $S GetStdChan.3$Z Tcl_GetStdChannel.3$Z
- ln $S GetStdChan.3$Z Tcl_SetStdChannel.3$Z
-fi
-if test -r GetTime.3; then
- rm -f GetTime.3.*
- $ZIP GetTime.3
- rm -f Tcl_GetTime.3 Tcl_GetTime.3.*
- ln $S GetTime.3$Z Tcl_GetTime.3$Z
-fi
-if test -r GetVersion.3; then
- rm -f GetVersion.3.*
- $ZIP GetVersion.3
- rm -f Tcl_GetVersion.3 Tcl_GetVersion.3.*
- ln $S GetVersion.3$Z Tcl_GetVersion.3$Z
-fi
-if test -r Hash.3; then
- rm -f Hash.3.*
- $ZIP Hash.3
- rm -f Tcl_InitHashTable.3 Tcl_InitHashTable.3.*
- rm -f Tcl_InitCustomHashTable.3 Tcl_InitCustomHashTable.3.*
- rm -f Tcl_InitObjHashTable.3 Tcl_InitObjHashTable.3.*
- rm -f Tcl_DeleteHashTable.3 Tcl_DeleteHashTable.3.*
- rm -f Tcl_CreateHashEntry.3 Tcl_CreateHashEntry.3.*
- rm -f Tcl_DeleteHashEntry.3 Tcl_DeleteHashEntry.3.*
- rm -f Tcl_FindHashEntry.3 Tcl_FindHashEntry.3.*
- rm -f Tcl_GetHashValue.3 Tcl_GetHashValue.3.*
- rm -f Tcl_SetHashValue.3 Tcl_SetHashValue.3.*
- rm -f Tcl_GetHashKey.3 Tcl_GetHashKey.3.*
- rm -f Tcl_FirstHashEntry.3 Tcl_FirstHashEntry.3.*
- rm -f Tcl_NextHashEntry.3 Tcl_NextHashEntry.3.*
- rm -f Tcl_HashStats.3 Tcl_HashStats.3.*
- ln $S Hash.3$Z Tcl_InitHashTable.3$Z
- ln $S Hash.3$Z Tcl_InitCustomHashTable.3$Z
- ln $S Hash.3$Z Tcl_InitObjHashTable.3$Z
- ln $S Hash.3$Z Tcl_DeleteHashTable.3$Z
- ln $S Hash.3$Z Tcl_CreateHashEntry.3$Z
- ln $S Hash.3$Z Tcl_DeleteHashEntry.3$Z
- ln $S Hash.3$Z Tcl_FindHashEntry.3$Z
- ln $S Hash.3$Z Tcl_GetHashValue.3$Z
- ln $S Hash.3$Z Tcl_SetHashValue.3$Z
- ln $S Hash.3$Z Tcl_GetHashKey.3$Z
- ln $S Hash.3$Z Tcl_FirstHashEntry.3$Z
- ln $S Hash.3$Z Tcl_NextHashEntry.3$Z
- ln $S Hash.3$Z Tcl_HashStats.3$Z
-fi
-if test -r Init.3; then
- rm -f Init.3.*
- $ZIP Init.3
- rm -f Tcl_Init.3 Tcl_Init.3.*
- ln $S Init.3$Z Tcl_Init.3$Z
-fi
-if test -r InitStubs.3; then
- rm -f InitStubs.3.*
- $ZIP InitStubs.3
- rm -f Tcl_InitStubs.3 Tcl_InitStubs.3.*
- ln $S InitStubs.3$Z Tcl_InitStubs.3$Z
-fi
-if test -r IntObj.3; then
- rm -f IntObj.3.*
- $ZIP IntObj.3
- rm -f Tcl_NewIntObj.3 Tcl_NewIntObj.3.*
- rm -f Tcl_NewLongObj.3 Tcl_NewLongObj.3.*
- rm -f Tcl_NewWideIntObj.3 Tcl_NewWideIntObj.3.*
- rm -f Tcl_SetIntObj.3 Tcl_SetIntObj.3.*
- rm -f Tcl_SetLongObj.3 Tcl_SetLongObj.3.*
- rm -f Tcl_SetWideIntObj.3 Tcl_SetWideIntObj.3.*
- rm -f Tcl_GetIntFromObj.3 Tcl_GetIntFromObj.3.*
- rm -f Tcl_GetLongFromObj.3 Tcl_GetLongFromObj.3.*
- rm -f Tcl_GetWideIntFromObj.3 Tcl_GetWideIntFromObj.3.*
- ln $S IntObj.3$Z Tcl_NewIntObj.3$Z
- ln $S IntObj.3$Z Tcl_NewLongObj.3$Z
- ln $S IntObj.3$Z Tcl_NewWideIntObj.3$Z
- ln $S IntObj.3$Z Tcl_SetIntObj.3$Z
- ln $S IntObj.3$Z Tcl_SetLongObj.3$Z
- ln $S IntObj.3$Z Tcl_SetWideIntObj.3$Z
- ln $S IntObj.3$Z Tcl_GetIntFromObj.3$Z
- ln $S IntObj.3$Z Tcl_GetLongFromObj.3$Z
- ln $S IntObj.3$Z Tcl_GetWideIntFromObj.3$Z
-fi
-if test -r Interp.3; then
- rm -f Interp.3.*
- $ZIP Interp.3
- rm -f Tcl_Interp.3 Tcl_Interp.3.*
- ln $S Interp.3$Z Tcl_Interp.3$Z
-fi
-if test -r LinkVar.3; then
- rm -f LinkVar.3.*
- $ZIP LinkVar.3
- rm -f Tcl_LinkVar.3 Tcl_LinkVar.3.*
- rm -f Tcl_UnlinkVar.3 Tcl_UnlinkVar.3.*
- rm -f Tcl_UpdateLinkedVar.3 Tcl_UpdateLinkedVar.3.*
- ln $S LinkVar.3$Z Tcl_LinkVar.3$Z
- ln $S LinkVar.3$Z Tcl_UnlinkVar.3$Z
- ln $S LinkVar.3$Z Tcl_UpdateLinkedVar.3$Z
-fi
-if test -r ListObj.3; then
- rm -f ListObj.3.*
- $ZIP ListObj.3
- rm -f Tcl_ListObjAppendList.3 Tcl_ListObjAppendList.3.*
- rm -f Tcl_ListObjAppendElement.3 Tcl_ListObjAppendElement.3.*
- rm -f Tcl_NewListObj.3 Tcl_NewListObj.3.*
- rm -f Tcl_SetListObj.3 Tcl_SetListObj.3.*
- rm -f Tcl_ListObjGetElements.3 Tcl_ListObjGetElements.3.*
- rm -f Tcl_ListObjLength.3 Tcl_ListObjLength.3.*
- rm -f Tcl_ListObjIndex.3 Tcl_ListObjIndex.3.*
- rm -f Tcl_ListObjReplace.3 Tcl_ListObjReplace.3.*
- ln $S ListObj.3$Z Tcl_ListObjAppendList.3$Z
- ln $S ListObj.3$Z Tcl_ListObjAppendElement.3$Z
- ln $S ListObj.3$Z Tcl_NewListObj.3$Z
- ln $S ListObj.3$Z Tcl_SetListObj.3$Z
- ln $S ListObj.3$Z Tcl_ListObjGetElements.3$Z
- ln $S ListObj.3$Z Tcl_ListObjLength.3$Z
- ln $S ListObj.3$Z Tcl_ListObjIndex.3$Z
- ln $S ListObj.3$Z Tcl_ListObjReplace.3$Z
-fi
-if test -r Macintosh.3; then
- rm -f Macintosh.3.*
- $ZIP Macintosh.3
- rm -f Tcl_MacSetEventProc.3 Tcl_MacSetEventProc.3.*
- rm -f Tcl_MacConvertTextResource.3 Tcl_MacConvertTextResource.3.*
- rm -f Tcl_MacEvalResource.3 Tcl_MacEvalResource.3.*
- rm -f Tcl_MacFindResource.3 Tcl_MacFindResource.3.*
- rm -f Tcl_GetOSTypeFromObj.3 Tcl_GetOSTypeFromObj.3.*
- rm -f Tcl_SetOSTypeObj.3 Tcl_SetOSTypeObj.3.*
- rm -f Tcl_NewOSTypeObj.3 Tcl_NewOSTypeObj.3.*
- ln $S Macintosh.3$Z Tcl_MacSetEventProc.3$Z
- ln $S Macintosh.3$Z Tcl_MacConvertTextResource.3$Z
- ln $S Macintosh.3$Z Tcl_MacEvalResource.3$Z
- ln $S Macintosh.3$Z Tcl_MacFindResource.3$Z
- ln $S Macintosh.3$Z Tcl_GetOSTypeFromObj.3$Z
- ln $S Macintosh.3$Z Tcl_SetOSTypeObj.3$Z
- ln $S Macintosh.3$Z Tcl_NewOSTypeObj.3$Z
-fi
-if test -r Notifier.3; then
- rm -f Notifier.3.*
- $ZIP Notifier.3
- rm -f Tcl_CreateEventSource.3 Tcl_CreateEventSource.3.*
- rm -f Tcl_DeleteEventSource.3 Tcl_DeleteEventSource.3.*
- rm -f Tcl_SetMaxBlockTime.3 Tcl_SetMaxBlockTime.3.*
- rm -f Tcl_QueueEvent.3 Tcl_QueueEvent.3.*
- rm -f Tcl_ThreadQueueEvent.3 Tcl_ThreadQueueEvent.3.*
- rm -f Tcl_ThreadAlert.3 Tcl_ThreadAlert.3.*
- rm -f Tcl_GetCurrentThread.3 Tcl_GetCurrentThread.3.*
- rm -f Tcl_DeleteEvents.3 Tcl_DeleteEvents.3.*
- rm -f Tcl_InitNotifier.3 Tcl_InitNotifier.3.*
- rm -f Tcl_FinalizeNotifier.3 Tcl_FinalizeNotifier.3.*
- rm -f Tcl_WaitForEvent.3 Tcl_WaitForEvent.3.*
- rm -f Tcl_AlertNotifier.3 Tcl_AlertNotifier.3.*
- rm -f Tcl_SetTimer.3 Tcl_SetTimer.3.*
- rm -f Tcl_ServiceAll.3 Tcl_ServiceAll.3.*
- rm -f Tcl_ServiceEvent.3 Tcl_ServiceEvent.3.*
- rm -f Tcl_GetServiceMode.3 Tcl_GetServiceMode.3.*
- rm -f Tcl_SetServiceMode.3 Tcl_SetServiceMode.3.*
- ln $S Notifier.3$Z Tcl_CreateEventSource.3$Z
- ln $S Notifier.3$Z Tcl_DeleteEventSource.3$Z
- ln $S Notifier.3$Z Tcl_SetMaxBlockTime.3$Z
- ln $S Notifier.3$Z Tcl_QueueEvent.3$Z
- ln $S Notifier.3$Z Tcl_ThreadQueueEvent.3$Z
- ln $S Notifier.3$Z Tcl_ThreadAlert.3$Z
- ln $S Notifier.3$Z Tcl_GetCurrentThread.3$Z
- ln $S Notifier.3$Z Tcl_DeleteEvents.3$Z
- ln $S Notifier.3$Z Tcl_InitNotifier.3$Z
- ln $S Notifier.3$Z Tcl_FinalizeNotifier.3$Z
- ln $S Notifier.3$Z Tcl_WaitForEvent.3$Z
- ln $S Notifier.3$Z Tcl_AlertNotifier.3$Z
- ln $S Notifier.3$Z Tcl_SetTimer.3$Z
- ln $S Notifier.3$Z Tcl_ServiceAll.3$Z
- ln $S Notifier.3$Z Tcl_ServiceEvent.3$Z
- ln $S Notifier.3$Z Tcl_GetServiceMode.3$Z
- ln $S Notifier.3$Z Tcl_SetServiceMode.3$Z
-fi
-if test -r Object.3; then
- rm -f Object.3.*
- $ZIP Object.3
- rm -f Tcl_NewObj.3 Tcl_NewObj.3.*
- rm -f Tcl_DuplicateObj.3 Tcl_DuplicateObj.3.*
- rm -f Tcl_IncrRefCount.3 Tcl_IncrRefCount.3.*
- rm -f Tcl_DecrRefCount.3 Tcl_DecrRefCount.3.*
- rm -f Tcl_IsShared.3 Tcl_IsShared.3.*
- rm -f Tcl_InvalidateStringRep.3 Tcl_InvalidateStringRep.3.*
- ln $S Object.3$Z Tcl_NewObj.3$Z
- ln $S Object.3$Z Tcl_DuplicateObj.3$Z
- ln $S Object.3$Z Tcl_IncrRefCount.3$Z
- ln $S Object.3$Z Tcl_DecrRefCount.3$Z
- ln $S Object.3$Z Tcl_IsShared.3$Z
- ln $S Object.3$Z Tcl_InvalidateStringRep.3$Z
-fi
-if test -r ObjectType.3; then
- rm -f ObjectType.3.*
- $ZIP ObjectType.3
- rm -f Tcl_RegisterObjType.3 Tcl_RegisterObjType.3.*
- rm -f Tcl_GetObjType.3 Tcl_GetObjType.3.*
- rm -f Tcl_AppendAllObjTypes.3 Tcl_AppendAllObjTypes.3.*
- rm -f Tcl_ConvertToType.3 Tcl_ConvertToType.3.*
- ln $S ObjectType.3$Z Tcl_RegisterObjType.3$Z
- ln $S ObjectType.3$Z Tcl_GetObjType.3$Z
- ln $S ObjectType.3$Z Tcl_AppendAllObjTypes.3$Z
- ln $S ObjectType.3$Z Tcl_ConvertToType.3$Z
-fi
-if test -r OpenFileChnl.3; then
- rm -f OpenFileChnl.3.*
- $ZIP OpenFileChnl.3
- rm -f Tcl_OpenFileChannel.3 Tcl_OpenFileChannel.3.*
- rm -f Tcl_OpenCommandChannel.3 Tcl_OpenCommandChannel.3.*
- rm -f Tcl_MakeFileChannel.3 Tcl_MakeFileChannel.3.*
- rm -f Tcl_GetChannel.3 Tcl_GetChannel.3.*
- rm -f Tcl_GetChannelNames.3 Tcl_GetChannelNames.3.*
- rm -f Tcl_GetChannelNamesEx.3 Tcl_GetChannelNamesEx.3.*
- rm -f Tcl_RegisterChannel.3 Tcl_RegisterChannel.3.*
- rm -f Tcl_UnregisterChannel.3 Tcl_UnregisterChannel.3.*
- rm -f Tcl_DetachChannel.3 Tcl_DetachChannel.3.*
- rm -f Tcl_IsStandardChannel.3 Tcl_IsStandardChannel.3.*
- rm -f Tcl_Close.3 Tcl_Close.3.*
- rm -f Tcl_ReadChars.3 Tcl_ReadChars.3.*
- rm -f Tcl_Read.3 Tcl_Read.3.*
- rm -f Tcl_GetsObj.3 Tcl_GetsObj.3.*
- rm -f Tcl_Gets.3 Tcl_Gets.3.*
- rm -f Tcl_WriteObj.3 Tcl_WriteObj.3.*
- rm -f Tcl_WriteChars.3 Tcl_WriteChars.3.*
- rm -f Tcl_Write.3 Tcl_Write.3.*
- rm -f Tcl_Flush.3 Tcl_Flush.3.*
- rm -f Tcl_Seek.3 Tcl_Seek.3.*
- rm -f Tcl_Tell.3 Tcl_Tell.3.*
- rm -f Tcl_GetChannelOption.3 Tcl_GetChannelOption.3.*
- rm -f Tcl_SetChannelOption.3 Tcl_SetChannelOption.3.*
- rm -f Tcl_Eof.3 Tcl_Eof.3.*
- rm -f Tcl_InputBlocked.3 Tcl_InputBlocked.3.*
- rm -f Tcl_InputBuffered.3 Tcl_InputBuffered.3.*
- rm -f Tcl_OutputBuffered.3 Tcl_OutputBuffered.3.*
- rm -f Tcl_Ungets.3 Tcl_Ungets.3.*
- rm -f Tcl_ReadRaw.3 Tcl_ReadRaw.3.*
- rm -f Tcl_WriteRaw.3 Tcl_WriteRaw.3.*
- ln $S OpenFileChnl.3$Z Tcl_OpenFileChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_OpenCommandChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_MakeFileChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_GetChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_GetChannelNames.3$Z
- ln $S OpenFileChnl.3$Z Tcl_GetChannelNamesEx.3$Z
- ln $S OpenFileChnl.3$Z Tcl_RegisterChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_UnregisterChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_DetachChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_IsStandardChannel.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Close.3$Z
- ln $S OpenFileChnl.3$Z Tcl_ReadChars.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Read.3$Z
- ln $S OpenFileChnl.3$Z Tcl_GetsObj.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Gets.3$Z
- ln $S OpenFileChnl.3$Z Tcl_WriteObj.3$Z
- ln $S OpenFileChnl.3$Z Tcl_WriteChars.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Write.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Flush.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Seek.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Tell.3$Z
- ln $S OpenFileChnl.3$Z Tcl_GetChannelOption.3$Z
- ln $S OpenFileChnl.3$Z Tcl_SetChannelOption.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Eof.3$Z
- ln $S OpenFileChnl.3$Z Tcl_InputBlocked.3$Z
- ln $S OpenFileChnl.3$Z Tcl_InputBuffered.3$Z
- ln $S OpenFileChnl.3$Z Tcl_OutputBuffered.3$Z
- ln $S OpenFileChnl.3$Z Tcl_Ungets.3$Z
- ln $S OpenFileChnl.3$Z Tcl_ReadRaw.3$Z
- ln $S OpenFileChnl.3$Z Tcl_WriteRaw.3$Z
-fi
-if test -r OpenTcp.3; then
- rm -f OpenTcp.3.*
- $ZIP OpenTcp.3
- rm -f Tcl_OpenTcpClient.3 Tcl_OpenTcpClient.3.*
- rm -f Tcl_MakeTcpClientChannel.3 Tcl_MakeTcpClientChannel.3.*
- rm -f Tcl_OpenTcpServer.3 Tcl_OpenTcpServer.3.*
- ln $S OpenTcp.3$Z Tcl_OpenTcpClient.3$Z
- ln $S OpenTcp.3$Z Tcl_MakeTcpClientChannel.3$Z
- ln $S OpenTcp.3$Z Tcl_OpenTcpServer.3$Z
-fi
-if test -r Panic.3; then
- rm -f Panic.3.*
- $ZIP Panic.3
- rm -f Tcl_Panic.3 Tcl_Panic.3.*
- rm -f Tcl_PanicVA.3 Tcl_PanicVA.3.*
- rm -f Tcl_SetPanicProc.3 Tcl_SetPanicProc.3.*
- if test "${CASEINSENSITIVEFS:-}" != "1"; then rm -f panic.3 panic.3.* ; fi
- rm -f panicVA.3 panicVA.3.*
- ln $S Panic.3$Z Tcl_Panic.3$Z
- ln $S Panic.3$Z Tcl_PanicVA.3$Z
- ln $S Panic.3$Z Tcl_SetPanicProc.3$Z
- if test "${CASEINSENSITIVEFS:-}" != "1"; then ln $S Panic.3$Z panic.3$Z ; fi
- ln $S Panic.3$Z panicVA.3$Z
-fi
-if test -r ParseCmd.3; then
- rm -f ParseCmd.3.*
- $ZIP ParseCmd.3
- rm -f Tcl_ParseCommand.3 Tcl_ParseCommand.3.*
- rm -f Tcl_ParseExpr.3 Tcl_ParseExpr.3.*
- rm -f Tcl_ParseBraces.3 Tcl_ParseBraces.3.*
- rm -f Tcl_ParseQuotedString.3 Tcl_ParseQuotedString.3.*
- rm -f Tcl_ParseVarName.3 Tcl_ParseVarName.3.*
- rm -f Tcl_ParseVar.3 Tcl_ParseVar.3.*
- rm -f Tcl_FreeParse.3 Tcl_FreeParse.3.*
- rm -f Tcl_EvalTokens.3 Tcl_EvalTokens.3.*
- rm -f Tcl_EvalTokensStandard.3 Tcl_EvalTokensStandard.3.*
- ln $S ParseCmd.3$Z Tcl_ParseCommand.3$Z
- ln $S ParseCmd.3$Z Tcl_ParseExpr.3$Z
- ln $S ParseCmd.3$Z Tcl_ParseBraces.3$Z
- ln $S ParseCmd.3$Z Tcl_ParseQuotedString.3$Z
- ln $S ParseCmd.3$Z Tcl_ParseVarName.3$Z
- ln $S ParseCmd.3$Z Tcl_ParseVar.3$Z
- ln $S ParseCmd.3$Z Tcl_FreeParse.3$Z
- ln $S ParseCmd.3$Z Tcl_EvalTokens.3$Z
- ln $S ParseCmd.3$Z Tcl_EvalTokensStandard.3$Z
-fi
-if test -r PkgRequire.3; then
- rm -f PkgRequire.3.*
- $ZIP PkgRequire.3
- rm -f Tcl_PkgRequire.3 Tcl_PkgRequire.3.*
- rm -f Tcl_PkgRequireEx.3 Tcl_PkgRequireEx.3.*
- rm -f Tcl_PkgPresent.3 Tcl_PkgPresent.3.*
- rm -f Tcl_PkgPresentEx.3 Tcl_PkgPresentEx.3.*
- rm -f Tcl_PkgProvide.3 Tcl_PkgProvide.3.*
- rm -f Tcl_PkgProvideEx.3 Tcl_PkgProvideEx.3.*
- ln $S PkgRequire.3$Z Tcl_PkgRequire.3$Z
- ln $S PkgRequire.3$Z Tcl_PkgRequireEx.3$Z
- ln $S PkgRequire.3$Z Tcl_PkgPresent.3$Z
- ln $S PkgRequire.3$Z Tcl_PkgPresentEx.3$Z
- ln $S PkgRequire.3$Z Tcl_PkgProvide.3$Z
- ln $S PkgRequire.3$Z Tcl_PkgProvideEx.3$Z
-fi
-if test -r Preserve.3; then
- rm -f Preserve.3.*
- $ZIP Preserve.3
- rm -f Tcl_Preserve.3 Tcl_Preserve.3.*
- rm -f Tcl_Release.3 Tcl_Release.3.*
- rm -f Tcl_EventuallyFree.3 Tcl_EventuallyFree.3.*
- ln $S Preserve.3$Z Tcl_Preserve.3$Z
- ln $S Preserve.3$Z Tcl_Release.3$Z
- ln $S Preserve.3$Z Tcl_EventuallyFree.3$Z
-fi
-if test -r PrintDbl.3; then
- rm -f PrintDbl.3.*
- $ZIP PrintDbl.3
- rm -f Tcl_PrintDouble.3 Tcl_PrintDouble.3.*
- ln $S PrintDbl.3$Z Tcl_PrintDouble.3$Z
-fi
-if test -r RecEvalObj.3; then
- rm -f RecEvalObj.3.*
- $ZIP RecEvalObj.3
- rm -f Tcl_RecordAndEvalObj.3 Tcl_RecordAndEvalObj.3.*
- ln $S RecEvalObj.3$Z Tcl_RecordAndEvalObj.3$Z
-fi
-if test -r RecordEval.3; then
- rm -f RecordEval.3.*
- $ZIP RecordEval.3
- rm -f Tcl_RecordAndEval.3 Tcl_RecordAndEval.3.*
- ln $S RecordEval.3$Z Tcl_RecordAndEval.3$Z
-fi
-if test -r RegExp.3; then
- rm -f RegExp.3.*
- $ZIP RegExp.3
- rm -f Tcl_RegExpMatch.3 Tcl_RegExpMatch.3.*
- rm -f Tcl_RegExpCompile.3 Tcl_RegExpCompile.3.*
- rm -f Tcl_RegExpExec.3 Tcl_RegExpExec.3.*
- rm -f Tcl_RegExpRange.3 Tcl_RegExpRange.3.*
- rm -f Tcl_GetRegExpFromObj.3 Tcl_GetRegExpFromObj.3.*
- rm -f Tcl_RegExpMatchObj.3 Tcl_RegExpMatchObj.3.*
- rm -f Tcl_RegExpExecObj.3 Tcl_RegExpExecObj.3.*
- rm -f Tcl_RegExpGetInfo.3 Tcl_RegExpGetInfo.3.*
- ln $S RegExp.3$Z Tcl_RegExpMatch.3$Z
- ln $S RegExp.3$Z Tcl_RegExpCompile.3$Z
- ln $S RegExp.3$Z Tcl_RegExpExec.3$Z
- ln $S RegExp.3$Z Tcl_RegExpRange.3$Z
- ln $S RegExp.3$Z Tcl_GetRegExpFromObj.3$Z
- ln $S RegExp.3$Z Tcl_RegExpMatchObj.3$Z
- ln $S RegExp.3$Z Tcl_RegExpExecObj.3$Z
- ln $S RegExp.3$Z Tcl_RegExpGetInfo.3$Z
-fi
-if test -r SaveResult.3; then
- rm -f SaveResult.3.*
- $ZIP SaveResult.3
- rm -f Tcl_SaveResult.3 Tcl_SaveResult.3.*
- rm -f Tcl_RestoreResult.3 Tcl_RestoreResult.3.*
- rm -f Tcl_DiscardResult.3 Tcl_DiscardResult.3.*
- ln $S SaveResult.3$Z Tcl_SaveResult.3$Z
- ln $S SaveResult.3$Z Tcl_RestoreResult.3$Z
- ln $S SaveResult.3$Z Tcl_DiscardResult.3$Z
-fi
-if test -r SetErrno.3; then
- rm -f SetErrno.3.*
- $ZIP SetErrno.3
- rm -f Tcl_SetErrno.3 Tcl_SetErrno.3.*
- rm -f Tcl_GetErrno.3 Tcl_GetErrno.3.*
- rm -f Tcl_ErrnoId.3 Tcl_ErrnoId.3.*
- rm -f Tcl_ErrnoMsg.3 Tcl_ErrnoMsg.3.*
- ln $S SetErrno.3$Z Tcl_SetErrno.3$Z
- ln $S SetErrno.3$Z Tcl_GetErrno.3$Z
- ln $S SetErrno.3$Z Tcl_ErrnoId.3$Z
- ln $S SetErrno.3$Z Tcl_ErrnoMsg.3$Z
-fi
-if test -r SetRecLmt.3; then
- rm -f SetRecLmt.3.*
- $ZIP SetRecLmt.3
- rm -f Tcl_SetRecursionLimit.3 Tcl_SetRecursionLimit.3.*
- ln $S SetRecLmt.3$Z Tcl_SetRecursionLimit.3$Z
-fi
-if test -r SetResult.3; then
- rm -f SetResult.3.*
- $ZIP SetResult.3
- rm -f Tcl_SetObjResult.3 Tcl_SetObjResult.3.*
- rm -f Tcl_GetObjResult.3 Tcl_GetObjResult.3.*
- rm -f Tcl_SetResult.3 Tcl_SetResult.3.*
- rm -f Tcl_GetStringResult.3 Tcl_GetStringResult.3.*
- rm -f Tcl_AppendResult.3 Tcl_AppendResult.3.*
- rm -f Tcl_AppendResultVA.3 Tcl_AppendResultVA.3.*
- rm -f Tcl_AppendElement.3 Tcl_AppendElement.3.*
- rm -f Tcl_ResetResult.3 Tcl_ResetResult.3.*
- rm -f Tcl_FreeResult.3 Tcl_FreeResult.3.*
- ln $S SetResult.3$Z Tcl_SetObjResult.3$Z
- ln $S SetResult.3$Z Tcl_GetObjResult.3$Z
- ln $S SetResult.3$Z Tcl_SetResult.3$Z
- ln $S SetResult.3$Z Tcl_GetStringResult.3$Z
- ln $S SetResult.3$Z Tcl_AppendResult.3$Z
- ln $S SetResult.3$Z Tcl_AppendResultVA.3$Z
- ln $S SetResult.3$Z Tcl_AppendElement.3$Z
- ln $S SetResult.3$Z Tcl_ResetResult.3$Z
- ln $S SetResult.3$Z Tcl_FreeResult.3$Z
-fi
-if test -r SetVar.3; then
- rm -f SetVar.3.*
- $ZIP SetVar.3
- rm -f Tcl_SetVar2Ex.3 Tcl_SetVar2Ex.3.*
- rm -f Tcl_SetVar.3 Tcl_SetVar.3.*
- rm -f Tcl_SetVar2.3 Tcl_SetVar2.3.*
- rm -f Tcl_ObjSetVar2.3 Tcl_ObjSetVar2.3.*
- rm -f Tcl_GetVar2Ex.3 Tcl_GetVar2Ex.3.*
- rm -f Tcl_GetVar.3 Tcl_GetVar.3.*
- rm -f Tcl_GetVar2.3 Tcl_GetVar2.3.*
- rm -f Tcl_ObjGetVar2.3 Tcl_ObjGetVar2.3.*
- rm -f Tcl_UnsetVar.3 Tcl_UnsetVar.3.*
- rm -f Tcl_UnsetVar2.3 Tcl_UnsetVar2.3.*
- ln $S SetVar.3$Z Tcl_SetVar2Ex.3$Z
- ln $S SetVar.3$Z Tcl_SetVar.3$Z
- ln $S SetVar.3$Z Tcl_SetVar2.3$Z
- ln $S SetVar.3$Z Tcl_ObjSetVar2.3$Z
- ln $S SetVar.3$Z Tcl_GetVar2Ex.3$Z
- ln $S SetVar.3$Z Tcl_GetVar.3$Z
- ln $S SetVar.3$Z Tcl_GetVar2.3$Z
- ln $S SetVar.3$Z Tcl_ObjGetVar2.3$Z
- ln $S SetVar.3$Z Tcl_UnsetVar.3$Z
- ln $S SetVar.3$Z Tcl_UnsetVar2.3$Z
-fi
-if test -r Signal.3; then
- rm -f Signal.3.*
- $ZIP Signal.3
- rm -f Tcl_SignalId.3 Tcl_SignalId.3.*
- rm -f Tcl_SignalMsg.3 Tcl_SignalMsg.3.*
- ln $S Signal.3$Z Tcl_SignalId.3$Z
- ln $S Signal.3$Z Tcl_SignalMsg.3$Z
-fi
-if test -r Sleep.3; then
- rm -f Sleep.3.*
- $ZIP Sleep.3
- rm -f Tcl_Sleep.3 Tcl_Sleep.3.*
- ln $S Sleep.3$Z Tcl_Sleep.3$Z
-fi
-if test -r SourceRCFile.3; then
- rm -f SourceRCFile.3.*
- $ZIP SourceRCFile.3
- rm -f Tcl_SourceRCFile.3 Tcl_SourceRCFile.3.*
- ln $S SourceRCFile.3$Z Tcl_SourceRCFile.3$Z
-fi
-if test -r SplitList.3; then
- rm -f SplitList.3.*
- $ZIP SplitList.3
- rm -f Tcl_SplitList.3 Tcl_SplitList.3.*
- rm -f Tcl_Merge.3 Tcl_Merge.3.*
- rm -f Tcl_ScanElement.3 Tcl_ScanElement.3.*
- rm -f Tcl_ConvertElement.3 Tcl_ConvertElement.3.*
- rm -f Tcl_ScanCountedElement.3 Tcl_ScanCountedElement.3.*
- rm -f Tcl_ConvertCountedElement.3 Tcl_ConvertCountedElement.3.*
- ln $S SplitList.3$Z Tcl_SplitList.3$Z
- ln $S SplitList.3$Z Tcl_Merge.3$Z
- ln $S SplitList.3$Z Tcl_ScanElement.3$Z
- ln $S SplitList.3$Z Tcl_ConvertElement.3$Z
- ln $S SplitList.3$Z Tcl_ScanCountedElement.3$Z
- ln $S SplitList.3$Z Tcl_ConvertCountedElement.3$Z
-fi
-if test -r SplitPath.3; then
- rm -f SplitPath.3.*
- $ZIP SplitPath.3
- rm -f Tcl_SplitPath.3 Tcl_SplitPath.3.*
- rm -f Tcl_JoinPath.3 Tcl_JoinPath.3.*
- rm -f Tcl_GetPathType.3 Tcl_GetPathType.3.*
- ln $S SplitPath.3$Z Tcl_SplitPath.3$Z
- ln $S SplitPath.3$Z Tcl_JoinPath.3$Z
- ln $S SplitPath.3$Z Tcl_GetPathType.3$Z
-fi
-if test -r StaticPkg.3; then
- rm -f StaticPkg.3.*
- $ZIP StaticPkg.3
- rm -f Tcl_StaticPackage.3 Tcl_StaticPackage.3.*
- ln $S StaticPkg.3$Z Tcl_StaticPackage.3$Z
-fi
-if test -r StdChannels.3; then
- rm -f StdChannels.3.*
- $ZIP StdChannels.3
- rm -f Tcl_StandardChannels.3 Tcl_StandardChannels.3.*
- ln $S StdChannels.3$Z Tcl_StandardChannels.3$Z
-fi
-if test -r StrMatch.3; then
- rm -f StrMatch.3.*
- $ZIP StrMatch.3
- rm -f Tcl_StringMatch.3 Tcl_StringMatch.3.*
- rm -f Tcl_StringCaseMatch.3 Tcl_StringCaseMatch.3.*
- ln $S StrMatch.3$Z Tcl_StringMatch.3$Z
- ln $S StrMatch.3$Z Tcl_StringCaseMatch.3$Z
-fi
-if test -r StringObj.3; then
- rm -f StringObj.3.*
- $ZIP StringObj.3
- rm -f Tcl_NewStringObj.3 Tcl_NewStringObj.3.*
- rm -f Tcl_NewUnicodeObj.3 Tcl_NewUnicodeObj.3.*
- rm -f Tcl_SetStringObj.3 Tcl_SetStringObj.3.*
- rm -f Tcl_SetUnicodeObj.3 Tcl_SetUnicodeObj.3.*
- rm -f Tcl_GetStringFromObj.3 Tcl_GetStringFromObj.3.*
- rm -f Tcl_GetString.3 Tcl_GetString.3.*
- rm -f Tcl_GetUnicodeFromObj.3 Tcl_GetUnicodeFromObj.3.*
- rm -f Tcl_GetUnicode.3 Tcl_GetUnicode.3.*
- rm -f Tcl_GetUniChar.3 Tcl_GetUniChar.3.*
- rm -f Tcl_GetCharLength.3 Tcl_GetCharLength.3.*
- rm -f Tcl_GetRange.3 Tcl_GetRange.3.*
- rm -f Tcl_AppendToObj.3 Tcl_AppendToObj.3.*
- rm -f Tcl_AppendUnicodeToObj.3 Tcl_AppendUnicodeToObj.3.*
- rm -f Tcl_AppendStringsToObj.3 Tcl_AppendStringsToObj.3.*
- rm -f Tcl_AppendStringsToObjVA.3 Tcl_AppendStringsToObjVA.3.*
- rm -f Tcl_AppendObjToObj.3 Tcl_AppendObjToObj.3.*
- rm -f Tcl_SetObjLength.3 Tcl_SetObjLength.3.*
- rm -f Tcl_ConcatObj.3 Tcl_ConcatObj.3.*
- rm -f Tcl_AttemptSetObjLength.3 Tcl_AttemptSetObjLength.3.*
- ln $S StringObj.3$Z Tcl_NewStringObj.3$Z
- ln $S StringObj.3$Z Tcl_NewUnicodeObj.3$Z
- ln $S StringObj.3$Z Tcl_SetStringObj.3$Z
- ln $S StringObj.3$Z Tcl_SetUnicodeObj.3$Z
- ln $S StringObj.3$Z Tcl_GetStringFromObj.3$Z
- ln $S StringObj.3$Z Tcl_GetString.3$Z
- ln $S StringObj.3$Z Tcl_GetUnicodeFromObj.3$Z
- ln $S StringObj.3$Z Tcl_GetUnicode.3$Z
- ln $S StringObj.3$Z Tcl_GetUniChar.3$Z
- ln $S StringObj.3$Z Tcl_GetCharLength.3$Z
- ln $S StringObj.3$Z Tcl_GetRange.3$Z
- ln $S StringObj.3$Z Tcl_AppendToObj.3$Z
- ln $S StringObj.3$Z Tcl_AppendUnicodeToObj.3$Z
- ln $S StringObj.3$Z Tcl_AppendStringsToObj.3$Z
- ln $S StringObj.3$Z Tcl_AppendStringsToObjVA.3$Z
- ln $S StringObj.3$Z Tcl_AppendObjToObj.3$Z
- ln $S StringObj.3$Z Tcl_SetObjLength.3$Z
- ln $S StringObj.3$Z Tcl_ConcatObj.3$Z
- ln $S StringObj.3$Z Tcl_AttemptSetObjLength.3$Z
-fi
-if test -r SubstObj.3; then
- rm -f SubstObj.3.*
- $ZIP SubstObj.3
- rm -f Tcl_SubstObj.3 Tcl_SubstObj.3.*
- ln $S SubstObj.3$Z Tcl_SubstObj.3$Z
-fi
-if test -r TCL_MEM_DEBUG.3; then
- rm -f TCL_MEM_DEBUG.3.*
- $ZIP TCL_MEM_DEBUG.3
-fi
-if test -r Tcl.n; then
- rm -f Tcl.n.*
- $ZIP Tcl.n
-fi
-if test -r Tcl_Main.3; then
- rm -f Tcl_Main.3.*
- $ZIP Tcl_Main.3
- rm -f Tcl_SetMainLoop.3 Tcl_SetMainLoop.3.*
- ln $S Tcl_Main.3$Z Tcl_SetMainLoop.3$Z
-fi
-if test -r Thread.3; then
- rm -f Thread.3.*
- $ZIP Thread.3
- rm -f Tcl_ConditionNotify.3 Tcl_ConditionNotify.3.*
- rm -f Tcl_ConditionWait.3 Tcl_ConditionWait.3.*
- rm -f Tcl_ConditionFinalize.3 Tcl_ConditionFinalize.3.*
- rm -f Tcl_GetThreadData.3 Tcl_GetThreadData.3.*
- rm -f Tcl_MutexLock.3 Tcl_MutexLock.3.*
- rm -f Tcl_MutexUnlock.3 Tcl_MutexUnlock.3.*
- rm -f Tcl_MutexFinalize.3 Tcl_MutexFinalize.3.*
- rm -f Tcl_CreateThread.3 Tcl_CreateThread.3.*
- rm -f Tcl_JoinThread.3 Tcl_JoinThread.3.*
- ln $S Thread.3$Z Tcl_ConditionNotify.3$Z
- ln $S Thread.3$Z Tcl_ConditionWait.3$Z
- ln $S Thread.3$Z Tcl_ConditionFinalize.3$Z
- ln $S Thread.3$Z Tcl_GetThreadData.3$Z
- ln $S Thread.3$Z Tcl_MutexLock.3$Z
- ln $S Thread.3$Z Tcl_MutexUnlock.3$Z
- ln $S Thread.3$Z Tcl_MutexFinalize.3$Z
- ln $S Thread.3$Z Tcl_CreateThread.3$Z
- ln $S Thread.3$Z Tcl_JoinThread.3$Z
-fi
-if test -r ToUpper.3; then
- rm -f ToUpper.3.*
- $ZIP ToUpper.3
- rm -f Tcl_UniCharToUpper.3 Tcl_UniCharToUpper.3.*
- rm -f Tcl_UniCharToLower.3 Tcl_UniCharToLower.3.*
- rm -f Tcl_UniCharToTitle.3 Tcl_UniCharToTitle.3.*
- rm -f Tcl_UtfToUpper.3 Tcl_UtfToUpper.3.*
- rm -f Tcl_UtfToLower.3 Tcl_UtfToLower.3.*
- rm -f Tcl_UtfToTitle.3 Tcl_UtfToTitle.3.*
- ln $S ToUpper.3$Z Tcl_UniCharToUpper.3$Z
- ln $S ToUpper.3$Z Tcl_UniCharToLower.3$Z
- ln $S ToUpper.3$Z Tcl_UniCharToTitle.3$Z
- ln $S ToUpper.3$Z Tcl_UtfToUpper.3$Z
- ln $S ToUpper.3$Z Tcl_UtfToLower.3$Z
- ln $S ToUpper.3$Z Tcl_UtfToTitle.3$Z
-fi
-if test -r TraceCmd.3; then
- rm -f TraceCmd.3.*
- $ZIP TraceCmd.3
- rm -f Tcl_CommandTraceInfo.3 Tcl_CommandTraceInfo.3.*
- rm -f Tcl_TraceCommand.3 Tcl_TraceCommand.3.*
- rm -f Tcl_UntraceCommand.3 Tcl_UntraceCommand.3.*
- ln $S TraceCmd.3$Z Tcl_CommandTraceInfo.3$Z
- ln $S TraceCmd.3$Z Tcl_TraceCommand.3$Z
- ln $S TraceCmd.3$Z Tcl_UntraceCommand.3$Z
-fi
-if test -r TraceVar.3; then
- rm -f TraceVar.3.*
- $ZIP TraceVar.3
- rm -f Tcl_TraceVar.3 Tcl_TraceVar.3.*
- rm -f Tcl_TraceVar2.3 Tcl_TraceVar2.3.*
- rm -f Tcl_UntraceVar.3 Tcl_UntraceVar.3.*
- rm -f Tcl_UntraceVar2.3 Tcl_UntraceVar2.3.*
- rm -f Tcl_VarTraceInfo.3 Tcl_VarTraceInfo.3.*
- rm -f Tcl_VarTraceInfo2.3 Tcl_VarTraceInfo2.3.*
- ln $S TraceVar.3$Z Tcl_TraceVar.3$Z
- ln $S TraceVar.3$Z Tcl_TraceVar2.3$Z
- ln $S TraceVar.3$Z Tcl_UntraceVar.3$Z
- ln $S TraceVar.3$Z Tcl_UntraceVar2.3$Z
- ln $S TraceVar.3$Z Tcl_VarTraceInfo.3$Z
- ln $S TraceVar.3$Z Tcl_VarTraceInfo2.3$Z
-fi
-if test -r Translate.3; then
- rm -f Translate.3.*
- $ZIP Translate.3
- rm -f Tcl_TranslateFileName.3 Tcl_TranslateFileName.3.*
- ln $S Translate.3$Z Tcl_TranslateFileName.3$Z
-fi
-if test -r UniCharIsAlpha.3; then
- rm -f UniCharIsAlpha.3.*
- $ZIP UniCharIsAlpha.3
- rm -f Tcl_UniCharIsAlnum.3 Tcl_UniCharIsAlnum.3.*
- rm -f Tcl_UniCharIsAlpha.3 Tcl_UniCharIsAlpha.3.*
- rm -f Tcl_UniCharIsControl.3 Tcl_UniCharIsControl.3.*
- rm -f Tcl_UniCharIsDigit.3 Tcl_UniCharIsDigit.3.*
- rm -f Tcl_UniCharIsGraph.3 Tcl_UniCharIsGraph.3.*
- rm -f Tcl_UniCharIsLower.3 Tcl_UniCharIsLower.3.*
- rm -f Tcl_UniCharIsPrint.3 Tcl_UniCharIsPrint.3.*
- rm -f Tcl_UniCharIsPunct.3 Tcl_UniCharIsPunct.3.*
- rm -f Tcl_UniCharIsSpace.3 Tcl_UniCharIsSpace.3.*
- rm -f Tcl_UniCharIsUpper.3 Tcl_UniCharIsUpper.3.*
- rm -f Tcl_UniCharIsWordChar.3 Tcl_UniCharIsWordChar.3.*
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsAlnum.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsAlpha.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsControl.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsDigit.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsGraph.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsLower.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsPrint.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsPunct.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsSpace.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsUpper.3$Z
- ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsWordChar.3$Z
-fi
-if test -r UpVar.3; then
- rm -f UpVar.3.*
- $ZIP UpVar.3
- rm -f Tcl_UpVar.3 Tcl_UpVar.3.*
- rm -f Tcl_UpVar2.3 Tcl_UpVar2.3.*
- ln $S UpVar.3$Z Tcl_UpVar.3$Z
- ln $S UpVar.3$Z Tcl_UpVar2.3$Z
-fi
-if test -r Utf.3; then
- rm -f Utf.3.*
- $ZIP Utf.3
- rm -f Tcl_UniChar.3 Tcl_UniChar.3.*
- rm -f Tcl_UniCharCaseMatch.3 Tcl_UniCharCaseMatch.3.*
- rm -f Tcl_UniCharNcasecmp.3 Tcl_UniCharNcasecmp.3.*
- rm -f Tcl_UniCharToUtf.3 Tcl_UniCharToUtf.3.*
- rm -f Tcl_UtfToUniChar.3 Tcl_UtfToUniChar.3.*
- rm -f Tcl_UniCharToUtfDString.3 Tcl_UniCharToUtfDString.3.*
- rm -f Tcl_UtfToUniCharDString.3 Tcl_UtfToUniCharDString.3.*
- rm -f Tcl_UniCharLen.3 Tcl_UniCharLen.3.*
- rm -f Tcl_UniCharNcmp.3 Tcl_UniCharNcmp.3.*
- rm -f Tcl_UtfCharComplete.3 Tcl_UtfCharComplete.3.*
- rm -f Tcl_NumUtfChars.3 Tcl_NumUtfChars.3.*
- rm -f Tcl_UtfFindFirst.3 Tcl_UtfFindFirst.3.*
- rm -f Tcl_UtfFindLast.3 Tcl_UtfFindLast.3.*
- rm -f Tcl_UtfNext.3 Tcl_UtfNext.3.*
- rm -f Tcl_UtfPrev.3 Tcl_UtfPrev.3.*
- rm -f Tcl_UniCharAtIndex.3 Tcl_UniCharAtIndex.3.*
- rm -f Tcl_UtfAtIndex.3 Tcl_UtfAtIndex.3.*
- rm -f Tcl_UtfBackslash.3 Tcl_UtfBackslash.3.*
- ln $S Utf.3$Z Tcl_UniChar.3$Z
- ln $S Utf.3$Z Tcl_UniCharCaseMatch.3$Z
- ln $S Utf.3$Z Tcl_UniCharNcasecmp.3$Z
- ln $S Utf.3$Z Tcl_UniCharToUtf.3$Z
- ln $S Utf.3$Z Tcl_UtfToUniChar.3$Z
- ln $S Utf.3$Z Tcl_UniCharToUtfDString.3$Z
- ln $S Utf.3$Z Tcl_UtfToUniCharDString.3$Z
- ln $S Utf.3$Z Tcl_UniCharLen.3$Z
- ln $S Utf.3$Z Tcl_UniCharNcmp.3$Z
- ln $S Utf.3$Z Tcl_UtfCharComplete.3$Z
- ln $S Utf.3$Z Tcl_NumUtfChars.3$Z
- ln $S Utf.3$Z Tcl_UtfFindFirst.3$Z
- ln $S Utf.3$Z Tcl_UtfFindLast.3$Z
- ln $S Utf.3$Z Tcl_UtfNext.3$Z
- ln $S Utf.3$Z Tcl_UtfPrev.3$Z
- ln $S Utf.3$Z Tcl_UniCharAtIndex.3$Z
- ln $S Utf.3$Z Tcl_UtfAtIndex.3$Z
- ln $S Utf.3$Z Tcl_UtfBackslash.3$Z
-fi
-if test -r WrongNumArgs.3; then
- rm -f WrongNumArgs.3.*
- $ZIP WrongNumArgs.3
- rm -f Tcl_WrongNumArgs.3 Tcl_WrongNumArgs.3.*
- ln $S WrongNumArgs.3$Z Tcl_WrongNumArgs.3$Z
-fi
-if test -r after.n; then
- rm -f after.n.*
- $ZIP after.n
-fi
-if test -r append.n; then
- rm -f append.n.*
- $ZIP append.n
-fi
-if test -r array.n; then
- rm -f array.n.*
- $ZIP array.n
-fi
-if test -r bgerror.n; then
- rm -f bgerror.n.*
- $ZIP bgerror.n
-fi
-if test -r binary.n; then
- rm -f binary.n.*
- $ZIP binary.n
-fi
-if test -r break.n; then
- rm -f break.n.*
- $ZIP break.n
-fi
-if test -r case.n; then
- rm -f case.n.*
- $ZIP case.n
-fi
-if test -r catch.n; then
- rm -f catch.n.*
- $ZIP catch.n
-fi
-if test -r cd.n; then
- rm -f cd.n.*
- $ZIP cd.n
-fi
-if test -r clock.n; then
- rm -f clock.n.*
- $ZIP clock.n
-fi
-if test -r close.n; then
- rm -f close.n.*
- $ZIP close.n
-fi
-if test -r concat.n; then
- rm -f concat.n.*
- $ZIP concat.n
-fi
-if test -r continue.n; then
- rm -f continue.n.*
- $ZIP continue.n
-fi
-if test -r dde.n; then
- rm -f dde.n.*
- $ZIP dde.n
-fi
-if test -r encoding.n; then
- rm -f encoding.n.*
- $ZIP encoding.n
-fi
-if test -r eof.n; then
- rm -f eof.n.*
- $ZIP eof.n
-fi
-if test -r error.n; then
- rm -f error.n.*
- $ZIP error.n
-fi
-if test -r eval.n; then
- rm -f eval.n.*
- $ZIP eval.n
-fi
-if test -r exec.n; then
- rm -f exec.n.*
- $ZIP exec.n
-fi
-if test -r exit.n; then
- rm -f exit.n.*
- $ZIP exit.n
-fi
-if test -r expr.n; then
- rm -f expr.n.*
- $ZIP expr.n
-fi
-if test -r fblocked.n; then
- rm -f fblocked.n.*
- $ZIP fblocked.n
-fi
-if test -r fconfigure.n; then
- rm -f fconfigure.n.*
- $ZIP fconfigure.n
-fi
-if test -r fcopy.n; then
- rm -f fcopy.n.*
- $ZIP fcopy.n
-fi
-if test -r file.n; then
- rm -f file.n.*
- $ZIP file.n
-fi
-if test -r fileevent.n; then
- rm -f fileevent.n.*
- $ZIP fileevent.n
-fi
-if test -r filename.n; then
- rm -f filename.n.*
- $ZIP filename.n
-fi
-if test -r flush.n; then
- rm -f flush.n.*
- $ZIP flush.n
-fi
-if test -r for.n; then
- rm -f for.n.*
- $ZIP for.n
-fi
-if test -r foreach.n; then
- rm -f foreach.n.*
- $ZIP foreach.n
-fi
-if test -r format.n; then
- rm -f format.n.*
- $ZIP format.n
-fi
-if test -r gets.n; then
- rm -f gets.n.*
- $ZIP gets.n
-fi
-if test -r glob.n; then
- rm -f glob.n.*
- $ZIP glob.n
-fi
-if test -r global.n; then
- rm -f global.n.*
- $ZIP global.n
-fi
-if test -r history.n; then
- rm -f history.n.*
- $ZIP history.n
-fi
-if test -r http.n; then
- rm -f http.n.*
- $ZIP http.n
-fi
-if test -r if.n; then
- rm -f if.n.*
- $ZIP if.n
-fi
-if test -r incr.n; then
- rm -f incr.n.*
- $ZIP incr.n
-fi
-if test -r info.n; then
- rm -f info.n.*
- $ZIP info.n
-fi
-if test -r interp.n; then
- rm -f interp.n.*
- $ZIP interp.n
-fi
-if test -r join.n; then
- rm -f join.n.*
- $ZIP join.n
-fi
-if test -r lappend.n; then
- rm -f lappend.n.*
- $ZIP lappend.n
-fi
-if test -r library.n; then
- rm -f library.n.*
- $ZIP library.n
- rm -f auto_execok.n auto_execok.n.*
- rm -f auto_import.n auto_import.n.*
- rm -f auto_load.n auto_load.n.*
- rm -f auto_mkindex.n auto_mkindex.n.*
- rm -f auto_mkindex_old.n auto_mkindex_old.n.*
- rm -f auto_qualify.n auto_qualify.n.*
- rm -f auto_reset.n auto_reset.n.*
- rm -f tcl_findLibrary.n tcl_findLibrary.n.*
- rm -f parray.n parray.n.*
- rm -f tcl_endOfWord.n tcl_endOfWord.n.*
- rm -f tcl_startOfNextWord.n tcl_startOfNextWord.n.*
- rm -f tcl_startOfPreviousWord.n tcl_startOfPreviousWord.n.*
- rm -f tcl_wordBreakAfter.n tcl_wordBreakAfter.n.*
- rm -f tcl_wordBreakBefore.n tcl_wordBreakBefore.n.*
- ln $S library.n$Z auto_execok.n$Z
- ln $S library.n$Z auto_import.n$Z
- ln $S library.n$Z auto_load.n$Z
- ln $S library.n$Z auto_mkindex.n$Z
- ln $S library.n$Z auto_mkindex_old.n$Z
- ln $S library.n$Z auto_qualify.n$Z
- ln $S library.n$Z auto_reset.n$Z
- ln $S library.n$Z tcl_findLibrary.n$Z
- ln $S library.n$Z parray.n$Z
- ln $S library.n$Z tcl_endOfWord.n$Z
- ln $S library.n$Z tcl_startOfNextWord.n$Z
- ln $S library.n$Z tcl_startOfPreviousWord.n$Z
- ln $S library.n$Z tcl_wordBreakAfter.n$Z
- ln $S library.n$Z tcl_wordBreakBefore.n$Z
-fi
-if test -r lindex.n; then
- rm -f lindex.n.*
- $ZIP lindex.n
-fi
-if test -r linsert.n; then
- rm -f linsert.n.*
- $ZIP linsert.n
-fi
-if test -r list.n; then
- rm -f list.n.*
- $ZIP list.n
-fi
-if test -r llength.n; then
- rm -f llength.n.*
- $ZIP llength.n
-fi
-if test -r load.n; then
- rm -f load.n.*
- $ZIP load.n
-fi
-if test -r lrange.n; then
- rm -f lrange.n.*
- $ZIP lrange.n
-fi
-if test -r lreplace.n; then
- rm -f lreplace.n.*
- $ZIP lreplace.n
-fi
-if test -r lsearch.n; then
- rm -f lsearch.n.*
- $ZIP lsearch.n
-fi
-if test -r lset.n; then
- rm -f lset.n.*
- $ZIP lset.n
-fi
-if test -r lsort.n; then
- rm -f lsort.n.*
- $ZIP lsort.n
-fi
-if test -r memory.n; then
- rm -f memory.n.*
- $ZIP memory.n
-fi
-if test -r msgcat.n; then
- rm -f msgcat.n.*
- $ZIP msgcat.n
-fi
-if test -r namespace.n; then
- rm -f namespace.n.*
- $ZIP namespace.n
-fi
-if test -r open.n; then
- rm -f open.n.*
- $ZIP open.n
-fi
-if test -r package.n; then
- rm -f package.n.*
- $ZIP package.n
-fi
-if test -r packagens.n; then
- rm -f packagens.n.*
- $ZIP packagens.n
- rm -f pkg::create.n pkg::create.n.*
- ln $S packagens.n$Z pkg::create.n$Z
-fi
-if test -r pid.n; then
- rm -f pid.n.*
- $ZIP pid.n
-fi
-if test -r pkgMkIndex.n; then
- rm -f pkgMkIndex.n.*
- $ZIP pkgMkIndex.n
- rm -f pkg_mkIndex.n pkg_mkIndex.n.*
- ln $S pkgMkIndex.n$Z pkg_mkIndex.n$Z
-fi
-if test -r proc.n; then
- rm -f proc.n.*
- $ZIP proc.n
-fi
-if test -r puts.n; then
- rm -f puts.n.*
- $ZIP puts.n
-fi
-if test -r pwd.n; then
- rm -f pwd.n.*
- $ZIP pwd.n
-fi
-if test -r re_syntax.n; then
- rm -f re_syntax.n.*
- $ZIP re_syntax.n
-fi
-if test -r read.n; then
- rm -f read.n.*
- $ZIP read.n
-fi
-if test -r regexp.n; then
- rm -f regexp.n.*
- $ZIP regexp.n
-fi
-if test -r registry.n; then
- rm -f registry.n.*
- $ZIP registry.n
-fi
-if test -r regsub.n; then
- rm -f regsub.n.*
- $ZIP regsub.n
-fi
-if test -r rename.n; then
- rm -f rename.n.*
- $ZIP rename.n
-fi
-if test -r resource.n; then
- rm -f resource.n.*
- $ZIP resource.n
-fi
-if test -r return.n; then
- rm -f return.n.*
- $ZIP return.n
-fi
-if test -r safe.n; then
- rm -f safe.n.*
- $ZIP safe.n
- rm -f SafeBase.n SafeBase.n.*
- ln $S safe.n$Z SafeBase.n$Z
-fi
-if test -r scan.n; then
- rm -f scan.n.*
- $ZIP scan.n
-fi
-if test -r seek.n; then
- rm -f seek.n.*
- $ZIP seek.n
-fi
-if test -r set.n; then
- rm -f set.n.*
- $ZIP set.n
-fi
-if test -r socket.n; then
- rm -f socket.n.*
- $ZIP socket.n
-fi
-if test -r source.n; then
- rm -f source.n.*
- $ZIP source.n
-fi
-if test -r split.n; then
- rm -f split.n.*
- $ZIP split.n
-fi
-if test -r string.n; then
- rm -f string.n.*
- $ZIP string.n
-fi
-if test -r subst.n; then
- rm -f subst.n.*
- $ZIP subst.n
-fi
-if test -r switch.n; then
- rm -f switch.n.*
- $ZIP switch.n
-fi
-if test -r tclsh.1; then
- rm -f tclsh.1.*
- $ZIP tclsh.1
-fi
-if test -r tcltest.n; then
- rm -f tcltest.n.*
- $ZIP tcltest.n
-fi
-if test -r tclvars.n; then
- rm -f tclvars.n.*
- $ZIP tclvars.n
-fi
-if test -r tell.n; then
- rm -f tell.n.*
- $ZIP tell.n
-fi
-if test -r time.n; then
- rm -f time.n.*
- $ZIP time.n
-fi
-if test -r trace.n; then
- rm -f trace.n.*
- $ZIP trace.n
-fi
-if test -r unknown.n; then
- rm -f unknown.n.*
- $ZIP unknown.n
-fi
-if test -r unset.n; then
- rm -f unset.n.*
- $ZIP unset.n
-fi
-if test -r update.n; then
- rm -f update.n.*
- $ZIP update.n
-fi
-if test -r uplevel.n; then
- rm -f uplevel.n.*
- $ZIP uplevel.n
-fi
-if test -r upvar.n; then
- rm -f upvar.n.*
- $ZIP upvar.n
-fi
-if test -r variable.n; then
- rm -f variable.n.*
- $ZIP variable.n
-fi
-if test -r vwait.n; then
- rm -f vwait.n.*
- $ZIP vwait.n
-fi
-if test -r while.n; then
- rm -f while.n.*
- $ZIP while.n
+if test -r 3DBorder.3; then
+ rm -f 3DBorder.3.*
+ $ZIP 3DBorder.3
+ rm -f Tk_Alloc3DBorderFromObj.3 Tk_Alloc3DBorderFromObj.3.*
+ rm -f Tk_Get3DBorder.3 Tk_Get3DBorder.3.*
+ rm -f Tk_Get3DBorderFromObj.3 Tk_Get3DBorderFromObj.3.*
+ rm -f Tk_Draw3DRectangle.3 Tk_Draw3DRectangle.3.*
+ rm -f Tk_Fill3DRectangle.3 Tk_Fill3DRectangle.3.*
+ rm -f Tk_Draw3DPolygon.3 Tk_Draw3DPolygon.3.*
+ rm -f Tk_Fill3DPolygon.3 Tk_Fill3DPolygon.3.*
+ rm -f Tk_3DVerticalBevel.3 Tk_3DVerticalBevel.3.*
+ rm -f Tk_3DHorizontalBevel.3 Tk_3DHorizontalBevel.3.*
+ rm -f Tk_SetBackgroundFromBorder.3 Tk_SetBackgroundFromBorder.3.*
+ rm -f Tk_NameOf3DBorder.3 Tk_NameOf3DBorder.3.*
+ rm -f Tk_3DBorderColor.3 Tk_3DBorderColor.3.*
+ rm -f Tk_3DBorderGC.3 Tk_3DBorderGC.3.*
+ rm -f Tk_Free3DBorderFromObj.3 Tk_Free3DBorderFromObj.3.*
+ rm -f Tk_Free3DBorder.3 Tk_Free3DBorder.3.*
+ ln $S 3DBorder.3$Z Tk_Alloc3DBorderFromObj.3$Z
+ ln $S 3DBorder.3$Z Tk_Get3DBorder.3$Z
+ ln $S 3DBorder.3$Z Tk_Get3DBorderFromObj.3$Z
+ ln $S 3DBorder.3$Z Tk_Draw3DRectangle.3$Z
+ ln $S 3DBorder.3$Z Tk_Fill3DRectangle.3$Z
+ ln $S 3DBorder.3$Z Tk_Draw3DPolygon.3$Z
+ ln $S 3DBorder.3$Z Tk_Fill3DPolygon.3$Z
+ ln $S 3DBorder.3$Z Tk_3DVerticalBevel.3$Z
+ ln $S 3DBorder.3$Z Tk_3DHorizontalBevel.3$Z
+ ln $S 3DBorder.3$Z Tk_SetBackgroundFromBorder.3$Z
+ ln $S 3DBorder.3$Z Tk_NameOf3DBorder.3$Z
+ ln $S 3DBorder.3$Z Tk_3DBorderColor.3$Z
+ ln $S 3DBorder.3$Z Tk_3DBorderGC.3$Z
+ ln $S 3DBorder.3$Z Tk_Free3DBorderFromObj.3$Z
+ ln $S 3DBorder.3$Z Tk_Free3DBorder.3$Z
+fi
+if test -r AddOption.3; then
+ rm -f AddOption.3.*
+ $ZIP AddOption.3
+ rm -f Tk_AddOption.3 Tk_AddOption.3.*
+ ln $S AddOption.3$Z Tk_AddOption.3$Z
+fi
+if test -r BindTable.3; then
+ rm -f BindTable.3.*
+ $ZIP BindTable.3
+ rm -f Tk_CreateBindingTable.3 Tk_CreateBindingTable.3.*
+ rm -f Tk_DeleteBindingTable.3 Tk_DeleteBindingTable.3.*
+ rm -f Tk_CreateBinding.3 Tk_CreateBinding.3.*
+ rm -f Tk_DeleteBinding.3 Tk_DeleteBinding.3.*
+ rm -f Tk_GetBinding.3 Tk_GetBinding.3.*
+ rm -f Tk_GetAllBindings.3 Tk_GetAllBindings.3.*
+ rm -f Tk_DeleteAllBindings.3 Tk_DeleteAllBindings.3.*
+ rm -f Tk_BindEvent.3 Tk_BindEvent.3.*
+ ln $S BindTable.3$Z Tk_CreateBindingTable.3$Z
+ ln $S BindTable.3$Z Tk_DeleteBindingTable.3$Z
+ ln $S BindTable.3$Z Tk_CreateBinding.3$Z
+ ln $S BindTable.3$Z Tk_DeleteBinding.3$Z
+ ln $S BindTable.3$Z Tk_GetBinding.3$Z
+ ln $S BindTable.3$Z Tk_GetAllBindings.3$Z
+ ln $S BindTable.3$Z Tk_DeleteAllBindings.3$Z
+ ln $S BindTable.3$Z Tk_BindEvent.3$Z
+fi
+if test -r CanvPsY.3; then
+ rm -f CanvPsY.3.*
+ $ZIP CanvPsY.3
+ rm -f Tk_CanvasPsY.3 Tk_CanvasPsY.3.*
+ rm -f Tk_CanvasPsBitmap.3 Tk_CanvasPsBitmap.3.*
+ rm -f Tk_CanvasPsColor.3 Tk_CanvasPsColor.3.*
+ rm -f Tk_CanvasPsFont.3 Tk_CanvasPsFont.3.*
+ rm -f Tk_CanvasPsPath.3 Tk_CanvasPsPath.3.*
+ rm -f Tk_CanvasPsStipple.3 Tk_CanvasPsStipple.3.*
+ ln $S CanvPsY.3$Z Tk_CanvasPsY.3$Z
+ ln $S CanvPsY.3$Z Tk_CanvasPsBitmap.3$Z
+ ln $S CanvPsY.3$Z Tk_CanvasPsColor.3$Z
+ ln $S CanvPsY.3$Z Tk_CanvasPsFont.3$Z
+ ln $S CanvPsY.3$Z Tk_CanvasPsPath.3$Z
+ ln $S CanvPsY.3$Z Tk_CanvasPsStipple.3$Z
+fi
+if test -r CanvTkwin.3; then
+ rm -f CanvTkwin.3.*
+ $ZIP CanvTkwin.3
+ rm -f Tk_CanvasTkwin.3 Tk_CanvasTkwin.3.*
+ rm -f Tk_CanvasGetCoord.3 Tk_CanvasGetCoord.3.*
+ rm -f Tk_CanvasDrawableCoords.3 Tk_CanvasDrawableCoords.3.*
+ rm -f Tk_CanvasSetStippleOrigin.3 Tk_CanvasSetStippleOrigin.3.*
+ rm -f Tk_CanvasWindowCoords.3 Tk_CanvasWindowCoords.3.*
+ rm -f Tk_CanvasEventuallyRedraw.3 Tk_CanvasEventuallyRedraw.3.*
+ rm -f Tk_CanvasTagsOption.3 Tk_CanvasTagsOption.3.*
+ ln $S CanvTkwin.3$Z Tk_CanvasTkwin.3$Z
+ ln $S CanvTkwin.3$Z Tk_CanvasGetCoord.3$Z
+ ln $S CanvTkwin.3$Z Tk_CanvasDrawableCoords.3$Z
+ ln $S CanvTkwin.3$Z Tk_CanvasSetStippleOrigin.3$Z
+ ln $S CanvTkwin.3$Z Tk_CanvasWindowCoords.3$Z
+ ln $S CanvTkwin.3$Z Tk_CanvasEventuallyRedraw.3$Z
+ ln $S CanvTkwin.3$Z Tk_CanvasTagsOption.3$Z
+fi
+if test -r CanvTxtInfo.3; then
+ rm -f CanvTxtInfo.3.*
+ $ZIP CanvTxtInfo.3
+ rm -f Tk_CanvasTextInfo.3 Tk_CanvasTextInfo.3.*
+ ln $S CanvTxtInfo.3$Z Tk_CanvasTextInfo.3$Z
+fi
+if test -r Clipboard.3; then
+ rm -f Clipboard.3.*
+ $ZIP Clipboard.3
+ rm -f Tk_ClipboardClear.3 Tk_ClipboardClear.3.*
+ rm -f Tk_ClipboardAppend.3 Tk_ClipboardAppend.3.*
+ ln $S Clipboard.3$Z Tk_ClipboardClear.3$Z
+ ln $S Clipboard.3$Z Tk_ClipboardAppend.3$Z
+fi
+if test -r ClrSelect.3; then
+ rm -f ClrSelect.3.*
+ $ZIP ClrSelect.3
+ rm -f Tk_ClearSelection.3 Tk_ClearSelection.3.*
+ ln $S ClrSelect.3$Z Tk_ClearSelection.3$Z
+fi
+if test -r ConfigWidg.3; then
+ rm -f ConfigWidg.3.*
+ $ZIP ConfigWidg.3
+ rm -f Tk_ConfigureWidget.3 Tk_ConfigureWidget.3.*
+ rm -f Tk_Offset.3 Tk_Offset.3.*
+ rm -f Tk_ConfigureInfo.3 Tk_ConfigureInfo.3.*
+ rm -f Tk_ConfigureValue.3 Tk_ConfigureValue.3.*
+ rm -f Tk_FreeOptions.3 Tk_FreeOptions.3.*
+ ln $S ConfigWidg.3$Z Tk_ConfigureWidget.3$Z
+ ln $S ConfigWidg.3$Z Tk_Offset.3$Z
+ ln $S ConfigWidg.3$Z Tk_ConfigureInfo.3$Z
+ ln $S ConfigWidg.3$Z Tk_ConfigureValue.3$Z
+ ln $S ConfigWidg.3$Z Tk_FreeOptions.3$Z
+fi
+if test -r ConfigWind.3; then
+ rm -f ConfigWind.3.*
+ $ZIP ConfigWind.3
+ rm -f Tk_ConfigureWindow.3 Tk_ConfigureWindow.3.*
+ rm -f Tk_MoveWindow.3 Tk_MoveWindow.3.*
+ rm -f Tk_ResizeWindow.3 Tk_ResizeWindow.3.*
+ rm -f Tk_MoveResizeWindow.3 Tk_MoveResizeWindow.3.*
+ rm -f Tk_SetWindowBorderWidth.3 Tk_SetWindowBorderWidth.3.*
+ rm -f Tk_ChangeWindowAttributes.3 Tk_ChangeWindowAttributes.3.*
+ rm -f Tk_SetWindowBackground.3 Tk_SetWindowBackground.3.*
+ rm -f Tk_SetWindowBackgroundPixmap.3 Tk_SetWindowBackgroundPixmap.3.*
+ rm -f Tk_SetWindowBorder.3 Tk_SetWindowBorder.3.*
+ rm -f Tk_SetWindowBorderPixmap.3 Tk_SetWindowBorderPixmap.3.*
+ rm -f Tk_SetWindowColormap.3 Tk_SetWindowColormap.3.*
+ rm -f Tk_DefineCursor.3 Tk_DefineCursor.3.*
+ rm -f Tk_UndefineCursor.3 Tk_UndefineCursor.3.*
+ ln $S ConfigWind.3$Z Tk_ConfigureWindow.3$Z
+ ln $S ConfigWind.3$Z Tk_MoveWindow.3$Z
+ ln $S ConfigWind.3$Z Tk_ResizeWindow.3$Z
+ ln $S ConfigWind.3$Z Tk_MoveResizeWindow.3$Z
+ ln $S ConfigWind.3$Z Tk_SetWindowBorderWidth.3$Z
+ ln $S ConfigWind.3$Z Tk_ChangeWindowAttributes.3$Z
+ ln $S ConfigWind.3$Z Tk_SetWindowBackground.3$Z
+ ln $S ConfigWind.3$Z Tk_SetWindowBackgroundPixmap.3$Z
+ ln $S ConfigWind.3$Z Tk_SetWindowBorder.3$Z
+ ln $S ConfigWind.3$Z Tk_SetWindowBorderPixmap.3$Z
+ ln $S ConfigWind.3$Z Tk_SetWindowColormap.3$Z
+ ln $S ConfigWind.3$Z Tk_DefineCursor.3$Z
+ ln $S ConfigWind.3$Z Tk_UndefineCursor.3$Z
+fi
+if test -r CoordToWin.3; then
+ rm -f CoordToWin.3.*
+ $ZIP CoordToWin.3
+ rm -f Tk_CoordsToWindow.3 Tk_CoordsToWindow.3.*
+ ln $S CoordToWin.3$Z Tk_CoordsToWindow.3$Z
+fi
+if test -r CrtCmHdlr.3; then
+ rm -f CrtCmHdlr.3.*
+ $ZIP CrtCmHdlr.3
+ rm -f Tk_CreateClientMessageHandler.3 Tk_CreateClientMessageHandler.3.*
+ rm -f Tk_DeleteClientMessageHandler.3 Tk_DeleteClientMessageHandler.3.*
+ ln $S CrtCmHdlr.3$Z Tk_CreateClientMessageHandler.3$Z
+ ln $S CrtCmHdlr.3$Z Tk_DeleteClientMessageHandler.3$Z
+fi
+if test -r CrtErrHdlr.3; then
+ rm -f CrtErrHdlr.3.*
+ $ZIP CrtErrHdlr.3
+ rm -f Tk_CreateErrorHandler.3 Tk_CreateErrorHandler.3.*
+ rm -f Tk_DeleteErrorHandler.3 Tk_DeleteErrorHandler.3.*
+ ln $S CrtErrHdlr.3$Z Tk_CreateErrorHandler.3$Z
+ ln $S CrtErrHdlr.3$Z Tk_DeleteErrorHandler.3$Z
+fi
+if test -r CrtGenHdlr.3; then
+ rm -f CrtGenHdlr.3.*
+ $ZIP CrtGenHdlr.3
+ rm -f Tk_CreateGenericHandler.3 Tk_CreateGenericHandler.3.*
+ rm -f Tk_DeleteGenericHandler.3 Tk_DeleteGenericHandler.3.*
+ ln $S CrtGenHdlr.3$Z Tk_CreateGenericHandler.3$Z
+ ln $S CrtGenHdlr.3$Z Tk_DeleteGenericHandler.3$Z
+fi
+if test -r CrtImgType.3; then
+ rm -f CrtImgType.3.*
+ $ZIP CrtImgType.3
+ rm -f Tk_CreateImageType.3 Tk_CreateImageType.3.*
+ rm -f Tk_GetImageMasterData.3 Tk_GetImageMasterData.3.*
+ rm -f Tk_InitImageArgs.3 Tk_InitImageArgs.3.*
+ ln $S CrtImgType.3$Z Tk_CreateImageType.3$Z
+ ln $S CrtImgType.3$Z Tk_GetImageMasterData.3$Z
+ ln $S CrtImgType.3$Z Tk_InitImageArgs.3$Z
+fi
+if test -r CrtItemType.3; then
+ rm -f CrtItemType.3.*
+ $ZIP CrtItemType.3
+ rm -f Tk_CreateItemType.3 Tk_CreateItemType.3.*
+ rm -f Tk_GetItemTypes.3 Tk_GetItemTypes.3.*
+ ln $S CrtItemType.3$Z Tk_CreateItemType.3$Z
+ ln $S CrtItemType.3$Z Tk_GetItemTypes.3$Z
+fi
+if test -r CrtPhImgFmt.3; then
+ rm -f CrtPhImgFmt.3.*
+ $ZIP CrtPhImgFmt.3
+ rm -f Tk_CreatePhotoImageFormat.3 Tk_CreatePhotoImageFormat.3.*
+ ln $S CrtPhImgFmt.3$Z Tk_CreatePhotoImageFormat.3$Z
+fi
+if test -r CrtSelHdlr.3; then
+ rm -f CrtSelHdlr.3.*
+ $ZIP CrtSelHdlr.3
+ rm -f Tk_CreateSelHandler.3 Tk_CreateSelHandler.3.*
+ rm -f Tk_DeleteSelHandler.3 Tk_DeleteSelHandler.3.*
+ ln $S CrtSelHdlr.3$Z Tk_CreateSelHandler.3$Z
+ ln $S CrtSelHdlr.3$Z Tk_DeleteSelHandler.3$Z
+fi
+if test -r CrtWindow.3; then
+ rm -f CrtWindow.3.*
+ $ZIP CrtWindow.3
+ rm -f Tk_CreateWindow.3 Tk_CreateWindow.3.*
+ rm -f Tk_CreateWindowFromPath.3 Tk_CreateWindowFromPath.3.*
+ rm -f Tk_DestroyWindow.3 Tk_DestroyWindow.3.*
+ rm -f Tk_MakeWindowExist.3 Tk_MakeWindowExist.3.*
+ ln $S CrtWindow.3$Z Tk_CreateWindow.3$Z
+ ln $S CrtWindow.3$Z Tk_CreateWindowFromPath.3$Z
+ ln $S CrtWindow.3$Z Tk_DestroyWindow.3$Z
+ ln $S CrtWindow.3$Z Tk_MakeWindowExist.3$Z
+fi
+if test -r DeleteImg.3; then
+ rm -f DeleteImg.3.*
+ $ZIP DeleteImg.3
+ rm -f Tk_DeleteImage.3 Tk_DeleteImage.3.*
+ ln $S DeleteImg.3$Z Tk_DeleteImage.3$Z
+fi
+if test -r DrawFocHlt.3; then
+ rm -f DrawFocHlt.3.*
+ $ZIP DrawFocHlt.3
+ rm -f Tk_DrawFocusHighlight.3 Tk_DrawFocusHighlight.3.*
+ ln $S DrawFocHlt.3$Z Tk_DrawFocusHighlight.3$Z
+fi
+if test -r EventHndlr.3; then
+ rm -f EventHndlr.3.*
+ $ZIP EventHndlr.3
+ rm -f Tk_CreateEventHandler.3 Tk_CreateEventHandler.3.*
+ rm -f Tk_DeleteEventHandler.3 Tk_DeleteEventHandler.3.*
+ ln $S EventHndlr.3$Z Tk_CreateEventHandler.3$Z
+ ln $S EventHndlr.3$Z Tk_DeleteEventHandler.3$Z
+fi
+if test -r FindPhoto.3; then
+ rm -f FindPhoto.3.*
+ $ZIP FindPhoto.3
+ rm -f Tk_FindPhoto.3 Tk_FindPhoto.3.*
+ rm -f Tk_PhotoPutBlock.3 Tk_PhotoPutBlock.3.*
+ rm -f Tk_PhotoPutZoomedBlock.3 Tk_PhotoPutZoomedBlock.3.*
+ rm -f Tk_PhotoGetImage.3 Tk_PhotoGetImage.3.*
+ rm -f Tk_PhotoBlank.3 Tk_PhotoBlank.3.*
+ rm -f Tk_PhotoExpand.3 Tk_PhotoExpand.3.*
+ rm -f Tk_PhotoGetSize.3 Tk_PhotoGetSize.3.*
+ rm -f Tk_PhotoSetSize.3 Tk_PhotoSetSize.3.*
+ ln $S FindPhoto.3$Z Tk_FindPhoto.3$Z
+ ln $S FindPhoto.3$Z Tk_PhotoPutBlock.3$Z
+ ln $S FindPhoto.3$Z Tk_PhotoPutZoomedBlock.3$Z
+ ln $S FindPhoto.3$Z Tk_PhotoGetImage.3$Z
+ ln $S FindPhoto.3$Z Tk_PhotoBlank.3$Z
+ ln $S FindPhoto.3$Z Tk_PhotoExpand.3$Z
+ ln $S FindPhoto.3$Z Tk_PhotoGetSize.3$Z
+ ln $S FindPhoto.3$Z Tk_PhotoSetSize.3$Z
+fi
+if test -r FontId.3; then
+ rm -f FontId.3.*
+ $ZIP FontId.3
+ rm -f Tk_FontId.3 Tk_FontId.3.*
+ rm -f Tk_GetFontMetrics.3 Tk_GetFontMetrics.3.*
+ rm -f Tk_PostscriptFontName.3 Tk_PostscriptFontName.3.*
+ ln $S FontId.3$Z Tk_FontId.3$Z
+ ln $S FontId.3$Z Tk_GetFontMetrics.3$Z
+ ln $S FontId.3$Z Tk_PostscriptFontName.3$Z
+fi
+if test -r FreeXId.3; then
+ rm -f FreeXId.3.*
+ $ZIP FreeXId.3
+ rm -f Tk_FreeXId.3 Tk_FreeXId.3.*
+ ln $S FreeXId.3$Z Tk_FreeXId.3$Z
+fi
+if test -r GeomReq.3; then
+ rm -f GeomReq.3.*
+ $ZIP GeomReq.3
+ rm -f Tk_GeometryRequest.3 Tk_GeometryRequest.3.*
+ rm -f Tk_SetMinimumRequestSize.3 Tk_SetMinimumRequestSize.3.*
+ rm -f Tk_SetInternalBorder.3 Tk_SetInternalBorder.3.*
+ rm -f Tk_SetInternalBorderEx.3 Tk_SetInternalBorderEx.3.*
+ ln $S GeomReq.3$Z Tk_GeometryRequest.3$Z
+ ln $S GeomReq.3$Z Tk_SetMinimumRequestSize.3$Z
+ ln $S GeomReq.3$Z Tk_SetInternalBorder.3$Z
+ ln $S GeomReq.3$Z Tk_SetInternalBorderEx.3$Z
+fi
+if test -r GetAnchor.3; then
+ rm -f GetAnchor.3.*
+ $ZIP GetAnchor.3
+ rm -f Tk_GetAnchorFromObj.3 Tk_GetAnchorFromObj.3.*
+ rm -f Tk_GetAnchor.3 Tk_GetAnchor.3.*
+ rm -f Tk_NameOfAnchor.3 Tk_NameOfAnchor.3.*
+ ln $S GetAnchor.3$Z Tk_GetAnchorFromObj.3$Z
+ ln $S GetAnchor.3$Z Tk_GetAnchor.3$Z
+ ln $S GetAnchor.3$Z Tk_NameOfAnchor.3$Z
+fi
+if test -r GetBitmap.3; then
+ rm -f GetBitmap.3.*
+ $ZIP GetBitmap.3
+ rm -f Tk_AllocBitmapFromObj.3 Tk_AllocBitmapFromObj.3.*
+ rm -f Tk_GetBitmap.3 Tk_GetBitmap.3.*
+ rm -f Tk_GetBitmapFromObj.3 Tk_GetBitmapFromObj.3.*
+ rm -f Tk_DefineBitmap.3 Tk_DefineBitmap.3.*
+ rm -f Tk_NameOfBitmap.3 Tk_NameOfBitmap.3.*
+ rm -f Tk_SizeOfBitmap.3 Tk_SizeOfBitmap.3.*
+ rm -f Tk_FreeBitmapFromObj.3 Tk_FreeBitmapFromObj.3.*
+ rm -f Tk_FreeBitmap.3 Tk_FreeBitmap.3.*
+ ln $S GetBitmap.3$Z Tk_AllocBitmapFromObj.3$Z
+ ln $S GetBitmap.3$Z Tk_GetBitmap.3$Z
+ ln $S GetBitmap.3$Z Tk_GetBitmapFromObj.3$Z
+ ln $S GetBitmap.3$Z Tk_DefineBitmap.3$Z
+ ln $S GetBitmap.3$Z Tk_NameOfBitmap.3$Z
+ ln $S GetBitmap.3$Z Tk_SizeOfBitmap.3$Z
+ ln $S GetBitmap.3$Z Tk_FreeBitmapFromObj.3$Z
+ ln $S GetBitmap.3$Z Tk_FreeBitmap.3$Z
+fi
+if test -r GetCapStyl.3; then
+ rm -f GetCapStyl.3.*
+ $ZIP GetCapStyl.3
+ rm -f Tk_GetCapStyle.3 Tk_GetCapStyle.3.*
+ rm -f Tk_NameOfCapStyle.3 Tk_NameOfCapStyle.3.*
+ ln $S GetCapStyl.3$Z Tk_GetCapStyle.3$Z
+ ln $S GetCapStyl.3$Z Tk_NameOfCapStyle.3$Z
+fi
+if test -r GetClrmap.3; then
+ rm -f GetClrmap.3.*
+ $ZIP GetClrmap.3
+ rm -f Tk_GetColormap.3 Tk_GetColormap.3.*
+ rm -f Tk_FreeColormap.3 Tk_FreeColormap.3.*
+ ln $S GetClrmap.3$Z Tk_GetColormap.3$Z
+ ln $S GetClrmap.3$Z Tk_FreeColormap.3$Z
+fi
+if test -r GetColor.3; then
+ rm -f GetColor.3.*
+ $ZIP GetColor.3
+ rm -f Tk_AllocColorFromObj.3 Tk_AllocColorFromObj.3.*
+ rm -f Tk_GetColor.3 Tk_GetColor.3.*
+ rm -f Tk_GetColorFromObj.3 Tk_GetColorFromObj.3.*
+ rm -f Tk_GetColorByValue.3 Tk_GetColorByValue.3.*
+ rm -f Tk_NameOfColor.3 Tk_NameOfColor.3.*
+ rm -f Tk_FreeColorFromObj.3 Tk_FreeColorFromObj.3.*
+ rm -f Tk_FreeColor.3 Tk_FreeColor.3.*
+ ln $S GetColor.3$Z Tk_AllocColorFromObj.3$Z
+ ln $S GetColor.3$Z Tk_GetColor.3$Z
+ ln $S GetColor.3$Z Tk_GetColorFromObj.3$Z
+ ln $S GetColor.3$Z Tk_GetColorByValue.3$Z
+ ln $S GetColor.3$Z Tk_NameOfColor.3$Z
+ ln $S GetColor.3$Z Tk_FreeColorFromObj.3$Z
+ ln $S GetColor.3$Z Tk_FreeColor.3$Z
+fi
+if test -r GetCursor.3; then
+ rm -f GetCursor.3.*
+ $ZIP GetCursor.3
+ rm -f Tk_AllocCursorFromObj.3 Tk_AllocCursorFromObj.3.*
+ rm -f Tk_GetCursor.3 Tk_GetCursor.3.*
+ rm -f Tk_GetCursorFromObj.3 Tk_GetCursorFromObj.3.*
+ rm -f Tk_GetCursorFromData.3 Tk_GetCursorFromData.3.*
+ rm -f Tk_NameOfCursor.3 Tk_NameOfCursor.3.*
+ rm -f Tk_FreeCursorFromObj.3 Tk_FreeCursorFromObj.3.*
+ rm -f Tk_FreeCursor.3 Tk_FreeCursor.3.*
+ ln $S GetCursor.3$Z Tk_AllocCursorFromObj.3$Z
+ ln $S GetCursor.3$Z Tk_GetCursor.3$Z
+ ln $S GetCursor.3$Z Tk_GetCursorFromObj.3$Z
+ ln $S GetCursor.3$Z Tk_GetCursorFromData.3$Z
+ ln $S GetCursor.3$Z Tk_NameOfCursor.3$Z
+ ln $S GetCursor.3$Z Tk_FreeCursorFromObj.3$Z
+ ln $S GetCursor.3$Z Tk_FreeCursor.3$Z
+fi
+if test -r GetDash.3; then
+ rm -f GetDash.3.*
+ $ZIP GetDash.3
+ rm -f Tk_GetDash.3 Tk_GetDash.3.*
+ ln $S GetDash.3$Z Tk_GetDash.3$Z
+fi
+if test -r GetFont.3; then
+ rm -f GetFont.3.*
+ $ZIP GetFont.3
+ rm -f Tk_AllocFontFromObj.3 Tk_AllocFontFromObj.3.*
+ rm -f Tk_GetFont.3 Tk_GetFont.3.*
+ rm -f Tk_GetFontFromObj.3 Tk_GetFontFromObj.3.*
+ rm -f Tk_NameOfFont.3 Tk_NameOfFont.3.*
+ rm -f Tk_FreeFontFromObj.3 Tk_FreeFontFromObj.3.*
+ rm -f Tk_FreeFont.3 Tk_FreeFont.3.*
+ ln $S GetFont.3$Z Tk_AllocFontFromObj.3$Z
+ ln $S GetFont.3$Z Tk_GetFont.3$Z
+ ln $S GetFont.3$Z Tk_GetFontFromObj.3$Z
+ ln $S GetFont.3$Z Tk_NameOfFont.3$Z
+ ln $S GetFont.3$Z Tk_FreeFontFromObj.3$Z
+ ln $S GetFont.3$Z Tk_FreeFont.3$Z
+fi
+if test -r GetGC.3; then
+ rm -f GetGC.3.*
+ $ZIP GetGC.3
+ rm -f Tk_GetGC.3 Tk_GetGC.3.*
+ rm -f Tk_FreeGC.3 Tk_FreeGC.3.*
+ ln $S GetGC.3$Z Tk_GetGC.3$Z
+ ln $S GetGC.3$Z Tk_FreeGC.3$Z
+fi
+if test -r GetHINSTANCE.3; then
+ rm -f GetHINSTANCE.3.*
+ $ZIP GetHINSTANCE.3
+ rm -f Tk_GetHINSTANCE.3 Tk_GetHINSTANCE.3.*
+ ln $S GetHINSTANCE.3$Z Tk_GetHINSTANCE.3$Z
+fi
+if test -r GetHWND.3; then
+ rm -f GetHWND.3.*
+ $ZIP GetHWND.3
+ rm -f Tk_GetHWND.3 Tk_GetHWND.3.*
+ ln $S GetHWND.3$Z Tk_GetHWND.3$Z
+fi
+if test -r GetImage.3; then
+ rm -f GetImage.3.*
+ $ZIP GetImage.3
+ rm -f Tk_GetImage.3 Tk_GetImage.3.*
+ rm -f Tk_RedrawImage.3 Tk_RedrawImage.3.*
+ rm -f Tk_SizeOfImage.3 Tk_SizeOfImage.3.*
+ rm -f Tk_FreeImage.3 Tk_FreeImage.3.*
+ ln $S GetImage.3$Z Tk_GetImage.3$Z
+ ln $S GetImage.3$Z Tk_RedrawImage.3$Z
+ ln $S GetImage.3$Z Tk_SizeOfImage.3$Z
+ ln $S GetImage.3$Z Tk_FreeImage.3$Z
+fi
+if test -r GetJoinStl.3; then
+ rm -f GetJoinStl.3.*
+ $ZIP GetJoinStl.3
+ rm -f Tk_GetJoinStyle.3 Tk_GetJoinStyle.3.*
+ rm -f Tk_NameOfJoinStyle.3 Tk_NameOfJoinStyle.3.*
+ ln $S GetJoinStl.3$Z Tk_GetJoinStyle.3$Z
+ ln $S GetJoinStl.3$Z Tk_NameOfJoinStyle.3$Z
+fi
+if test -r GetJustify.3; then
+ rm -f GetJustify.3.*
+ $ZIP GetJustify.3
+ rm -f Tk_GetJustifyFromObj.3 Tk_GetJustifyFromObj.3.*
+ rm -f Tk_GetJustify.3 Tk_GetJustify.3.*
+ rm -f Tk_NameOfJustify.3 Tk_NameOfJustify.3.*
+ ln $S GetJustify.3$Z Tk_GetJustifyFromObj.3$Z
+ ln $S GetJustify.3$Z Tk_GetJustify.3$Z
+ ln $S GetJustify.3$Z Tk_NameOfJustify.3$Z
+fi
+if test -r GetOption.3; then
+ rm -f GetOption.3.*
+ $ZIP GetOption.3
+ rm -f Tk_GetOption.3 Tk_GetOption.3.*
+ ln $S GetOption.3$Z Tk_GetOption.3$Z
+fi
+if test -r GetPixels.3; then
+ rm -f GetPixels.3.*
+ $ZIP GetPixels.3
+ rm -f Tk_GetPixelsFromObj.3 Tk_GetPixelsFromObj.3.*
+ rm -f Tk_GetPixels.3 Tk_GetPixels.3.*
+ rm -f Tk_GetMMFromObj.3 Tk_GetMMFromObj.3.*
+ rm -f Tk_GetScreenMM.3 Tk_GetScreenMM.3.*
+ ln $S GetPixels.3$Z Tk_GetPixelsFromObj.3$Z
+ ln $S GetPixels.3$Z Tk_GetPixels.3$Z
+ ln $S GetPixels.3$Z Tk_GetMMFromObj.3$Z
+ ln $S GetPixels.3$Z Tk_GetScreenMM.3$Z
+fi
+if test -r GetPixmap.3; then
+ rm -f GetPixmap.3.*
+ $ZIP GetPixmap.3
+ rm -f Tk_GetPixmap.3 Tk_GetPixmap.3.*
+ rm -f Tk_FreePixmap.3 Tk_FreePixmap.3.*
+ ln $S GetPixmap.3$Z Tk_GetPixmap.3$Z
+ ln $S GetPixmap.3$Z Tk_FreePixmap.3$Z
+fi
+if test -r GetRelief.3; then
+ rm -f GetRelief.3.*
+ $ZIP GetRelief.3
+ rm -f Tk_GetReliefFromObj.3 Tk_GetReliefFromObj.3.*
+ rm -f Tk_GetRelief.3 Tk_GetRelief.3.*
+ rm -f Tk_NameOfRelief.3 Tk_NameOfRelief.3.*
+ ln $S GetRelief.3$Z Tk_GetReliefFromObj.3$Z
+ ln $S GetRelief.3$Z Tk_GetRelief.3$Z
+ ln $S GetRelief.3$Z Tk_NameOfRelief.3$Z
+fi
+if test -r GetRootCrd.3; then
+ rm -f GetRootCrd.3.*
+ $ZIP GetRootCrd.3
+ rm -f Tk_GetRootCoords.3 Tk_GetRootCoords.3.*
+ ln $S GetRootCrd.3$Z Tk_GetRootCoords.3$Z
+fi
+if test -r GetScroll.3; then
+ rm -f GetScroll.3.*
+ $ZIP GetScroll.3
+ rm -f Tk_GetScrollInfo.3 Tk_GetScrollInfo.3.*
+ rm -f Tk_GetScrollInfoObj.3 Tk_GetScrollInfoObj.3.*
+ ln $S GetScroll.3$Z Tk_GetScrollInfo.3$Z
+ ln $S GetScroll.3$Z Tk_GetScrollInfoObj.3$Z
+fi
+if test -r GetSelect.3; then
+ rm -f GetSelect.3.*
+ $ZIP GetSelect.3
+ rm -f Tk_GetSelection.3 Tk_GetSelection.3.*
+ ln $S GetSelect.3$Z Tk_GetSelection.3$Z
+fi
+if test -r GetUid.3; then
+ rm -f GetUid.3.*
+ $ZIP GetUid.3
+ rm -f Tk_GetUid.3 Tk_GetUid.3.*
+ rm -f Tk_Uid.3 Tk_Uid.3.*
+ ln $S GetUid.3$Z Tk_GetUid.3$Z
+ ln $S GetUid.3$Z Tk_Uid.3$Z
+fi
+if test -r GetVRoot.3; then
+ rm -f GetVRoot.3.*
+ $ZIP GetVRoot.3
+ rm -f Tk_GetVRootGeometry.3 Tk_GetVRootGeometry.3.*
+ ln $S GetVRoot.3$Z Tk_GetVRootGeometry.3$Z
+fi
+if test -r GetVisual.3; then
+ rm -f GetVisual.3.*
+ $ZIP GetVisual.3
+ rm -f Tk_GetVisual.3 Tk_GetVisual.3.*
+ ln $S GetVisual.3$Z Tk_GetVisual.3$Z
+fi
+if test -r Grab.3; then
+ rm -f Grab.3.*
+ $ZIP Grab.3
+ rm -f Tk_Grab.3 Tk_Grab.3.*
+ rm -f Tk_Ungrab.3 Tk_Ungrab.3.*
+ ln $S Grab.3$Z Tk_Grab.3$Z
+ ln $S Grab.3$Z Tk_Ungrab.3$Z
+fi
+if test -r HWNDToWindow.3; then
+ rm -f HWNDToWindow.3.*
+ $ZIP HWNDToWindow.3
+ rm -f Tk_HWNDToWindow.3 Tk_HWNDToWindow.3.*
+ ln $S HWNDToWindow.3$Z Tk_HWNDToWindow.3$Z
+fi
+if test -r HandleEvent.3; then
+ rm -f HandleEvent.3.*
+ $ZIP HandleEvent.3
+ rm -f Tk_HandleEvent.3 Tk_HandleEvent.3.*
+ ln $S HandleEvent.3$Z Tk_HandleEvent.3$Z
+fi
+if test -r IdToWindow.3; then
+ rm -f IdToWindow.3.*
+ $ZIP IdToWindow.3
+ rm -f Tk_IdToWindow.3 Tk_IdToWindow.3.*
+ ln $S IdToWindow.3$Z Tk_IdToWindow.3$Z
+fi
+if test -r ImgChanged.3; then
+ rm -f ImgChanged.3.*
+ $ZIP ImgChanged.3
+ rm -f Tk_ImageChanged.3 Tk_ImageChanged.3.*
+ ln $S ImgChanged.3$Z Tk_ImageChanged.3$Z
+fi
+if test -r InternAtom.3; then
+ rm -f InternAtom.3.*
+ $ZIP InternAtom.3
+ rm -f Tk_InternAtom.3 Tk_InternAtom.3.*
+ rm -f Tk_GetAtomName.3 Tk_GetAtomName.3.*
+ ln $S InternAtom.3$Z Tk_InternAtom.3$Z
+ ln $S InternAtom.3$Z Tk_GetAtomName.3$Z
+fi
+if test -r MainLoop.3; then
+ rm -f MainLoop.3.*
+ $ZIP MainLoop.3
+ rm -f Tk_MainLoop.3 Tk_MainLoop.3.*
+ ln $S MainLoop.3$Z Tk_MainLoop.3$Z
+fi
+if test -r MainWin.3; then
+ rm -f MainWin.3.*
+ $ZIP MainWin.3
+ rm -f Tk_MainWindow.3 Tk_MainWindow.3.*
+ rm -f Tk_GetNumMainWindows.3 Tk_GetNumMainWindows.3.*
+ ln $S MainWin.3$Z Tk_MainWindow.3$Z
+ ln $S MainWin.3$Z Tk_GetNumMainWindows.3$Z
+fi
+if test -r MaintGeom.3; then
+ rm -f MaintGeom.3.*
+ $ZIP MaintGeom.3
+ rm -f Tk_MaintainGeometry.3 Tk_MaintainGeometry.3.*
+ rm -f Tk_UnmaintainGeometry.3 Tk_UnmaintainGeometry.3.*
+ ln $S MaintGeom.3$Z Tk_MaintainGeometry.3$Z
+ ln $S MaintGeom.3$Z Tk_UnmaintainGeometry.3$Z
+fi
+if test -r ManageGeom.3; then
+ rm -f ManageGeom.3.*
+ $ZIP ManageGeom.3
+ rm -f Tk_ManageGeometry.3 Tk_ManageGeometry.3.*
+ ln $S ManageGeom.3$Z Tk_ManageGeometry.3$Z
+fi
+if test -r MapWindow.3; then
+ rm -f MapWindow.3.*
+ $ZIP MapWindow.3
+ rm -f Tk_MapWindow.3 Tk_MapWindow.3.*
+ rm -f Tk_UnmapWindow.3 Tk_UnmapWindow.3.*
+ ln $S MapWindow.3$Z Tk_MapWindow.3$Z
+ ln $S MapWindow.3$Z Tk_UnmapWindow.3$Z
+fi
+if test -r MeasureChar.3; then
+ rm -f MeasureChar.3.*
+ $ZIP MeasureChar.3
+ rm -f Tk_MeasureChars.3 Tk_MeasureChars.3.*
+ rm -f Tk_TextWidth.3 Tk_TextWidth.3.*
+ rm -f Tk_DrawChars.3 Tk_DrawChars.3.*
+ rm -f Tk_UnderlineChars.3 Tk_UnderlineChars.3.*
+ ln $S MeasureChar.3$Z Tk_MeasureChars.3$Z
+ ln $S MeasureChar.3$Z Tk_TextWidth.3$Z
+ ln $S MeasureChar.3$Z Tk_DrawChars.3$Z
+ ln $S MeasureChar.3$Z Tk_UnderlineChars.3$Z
+fi
+if test -r MoveToplev.3; then
+ rm -f MoveToplev.3.*
+ $ZIP MoveToplev.3
+ rm -f Tk_MoveToplevelWindow.3 Tk_MoveToplevelWindow.3.*
+ ln $S MoveToplev.3$Z Tk_MoveToplevelWindow.3$Z
+fi
+if test -r Name.3; then
+ rm -f Name.3.*
+ $ZIP Name.3
+ rm -f Tk_Name.3 Tk_Name.3.*
+ rm -f Tk_PathName.3 Tk_PathName.3.*
+ rm -f Tk_NameToWindow.3 Tk_NameToWindow.3.*
+ ln $S Name.3$Z Tk_Name.3$Z
+ ln $S Name.3$Z Tk_PathName.3$Z
+ ln $S Name.3$Z Tk_NameToWindow.3$Z
+fi
+if test -r NameOfImg.3; then
+ rm -f NameOfImg.3.*
+ $ZIP NameOfImg.3
+ rm -f Tk_NameOfImage.3 Tk_NameOfImage.3.*
+ ln $S NameOfImg.3$Z Tk_NameOfImage.3$Z
+fi
+if test -r OwnSelect.3; then
+ rm -f OwnSelect.3.*
+ $ZIP OwnSelect.3
+ rm -f Tk_OwnSelection.3 Tk_OwnSelection.3.*
+ ln $S OwnSelect.3$Z Tk_OwnSelection.3$Z
+fi
+if test -r ParseArgv.3; then
+ rm -f ParseArgv.3.*
+ $ZIP ParseArgv.3
+ rm -f Tk_ParseArgv.3 Tk_ParseArgv.3.*
+ ln $S ParseArgv.3$Z Tk_ParseArgv.3$Z
+fi
+if test -r QWinEvent.3; then
+ rm -f QWinEvent.3.*
+ $ZIP QWinEvent.3
+ rm -f Tk_CollapseMotionEvents.3 Tk_CollapseMotionEvents.3.*
+ rm -f Tk_QueueWindowEvent.3 Tk_QueueWindowEvent.3.*
+ ln $S QWinEvent.3$Z Tk_CollapseMotionEvents.3$Z
+ ln $S QWinEvent.3$Z Tk_QueueWindowEvent.3$Z
+fi
+if test -r Restack.3; then
+ rm -f Restack.3.*
+ $ZIP Restack.3
+ rm -f Tk_RestackWindow.3 Tk_RestackWindow.3.*
+ ln $S Restack.3$Z Tk_RestackWindow.3$Z
+fi
+if test -r RestrictEv.3; then
+ rm -f RestrictEv.3.*
+ $ZIP RestrictEv.3
+ rm -f Tk_RestrictEvents.3 Tk_RestrictEvents.3.*
+ ln $S RestrictEv.3$Z Tk_RestrictEvents.3$Z
+fi
+if test -r SetAppName.3; then
+ rm -f SetAppName.3.*
+ $ZIP SetAppName.3
+ rm -f Tk_SetAppName.3 Tk_SetAppName.3.*
+ ln $S SetAppName.3$Z Tk_SetAppName.3$Z
+fi
+if test -r SetCaret.3; then
+ rm -f SetCaret.3.*
+ $ZIP SetCaret.3
+ rm -f Tk_SetCaretPos.3 Tk_SetCaretPos.3.*
+ ln $S SetCaret.3$Z Tk_SetCaretPos.3$Z
+fi
+if test -r SetClass.3; then
+ rm -f SetClass.3.*
+ $ZIP SetClass.3
+ rm -f Tk_SetClass.3 Tk_SetClass.3.*
+ rm -f Tk_Class.3 Tk_Class.3.*
+ ln $S SetClass.3$Z Tk_SetClass.3$Z
+ ln $S SetClass.3$Z Tk_Class.3$Z
+fi
+if test -r SetClassProcs.3; then
+ rm -f SetClassProcs.3.*
+ $ZIP SetClassProcs.3
+ rm -f Tk_SetClassProcs.3 Tk_SetClassProcs.3.*
+ ln $S SetClassProcs.3$Z Tk_SetClassProcs.3$Z
+fi
+if test -r SetGrid.3; then
+ rm -f SetGrid.3.*
+ $ZIP SetGrid.3
+ rm -f Tk_SetGrid.3 Tk_SetGrid.3.*
+ rm -f Tk_UnsetGrid.3 Tk_UnsetGrid.3.*
+ ln $S SetGrid.3$Z Tk_SetGrid.3$Z
+ ln $S SetGrid.3$Z Tk_UnsetGrid.3$Z
+fi
+if test -r SetOptions.3; then
+ rm -f SetOptions.3.*
+ $ZIP SetOptions.3
+ rm -f Tk_CreateOptionTable.3 Tk_CreateOptionTable.3.*
+ rm -f Tk_DeleteOptionTable.3 Tk_DeleteOptionTable.3.*
+ rm -f Tk_InitOptions.3 Tk_InitOptions.3.*
+ rm -f Tk_SetOptions.3 Tk_SetOptions.3.*
+ rm -f Tk_FreeSavedOptions.3 Tk_FreeSavedOptions.3.*
+ rm -f Tk_RestoreSavedOptions.3 Tk_RestoreSavedOptions.3.*
+ rm -f Tk_GetOptionValue.3 Tk_GetOptionValue.3.*
+ rm -f Tk_GetOptionInfo.3 Tk_GetOptionInfo.3.*
+ rm -f Tk_FreeConfigOptions.3 Tk_FreeConfigOptions.3.*
+ rm -f Tk_Offset.3 Tk_Offset.3.*
+ ln $S SetOptions.3$Z Tk_CreateOptionTable.3$Z
+ ln $S SetOptions.3$Z Tk_DeleteOptionTable.3$Z
+ ln $S SetOptions.3$Z Tk_InitOptions.3$Z
+ ln $S SetOptions.3$Z Tk_SetOptions.3$Z
+ ln $S SetOptions.3$Z Tk_FreeSavedOptions.3$Z
+ ln $S SetOptions.3$Z Tk_RestoreSavedOptions.3$Z
+ ln $S SetOptions.3$Z Tk_GetOptionValue.3$Z
+ ln $S SetOptions.3$Z Tk_GetOptionInfo.3$Z
+ ln $S SetOptions.3$Z Tk_FreeConfigOptions.3$Z
+ ln $S SetOptions.3$Z Tk_Offset.3$Z
+fi
+if test -r SetVisual.3; then
+ rm -f SetVisual.3.*
+ $ZIP SetVisual.3
+ rm -f Tk_SetWindowVisual.3 Tk_SetWindowVisual.3.*
+ ln $S SetVisual.3$Z Tk_SetWindowVisual.3$Z
+fi
+if test -r StrictMotif.3; then
+ rm -f StrictMotif.3.*
+ $ZIP StrictMotif.3
+ rm -f Tk_StrictMotif.3 Tk_StrictMotif.3.*
+ ln $S StrictMotif.3$Z Tk_StrictMotif.3$Z
+fi
+if test -r TextLayout.3; then
+ rm -f TextLayout.3.*
+ $ZIP TextLayout.3
+ rm -f Tk_ComputeTextLayout.3 Tk_ComputeTextLayout.3.*
+ rm -f Tk_FreeTextLayout.3 Tk_FreeTextLayout.3.*
+ rm -f Tk_DrawTextLayout.3 Tk_DrawTextLayout.3.*
+ rm -f Tk_UnderlineTextLayout.3 Tk_UnderlineTextLayout.3.*
+ rm -f Tk_PointToChar.3 Tk_PointToChar.3.*
+ rm -f Tk_CharBbox.3 Tk_CharBbox.3.*
+ rm -f Tk_DistanceToTextLayout.3 Tk_DistanceToTextLayout.3.*
+ rm -f Tk_IntersectTextLayout.3 Tk_IntersectTextLayout.3.*
+ rm -f Tk_TextLayoutToPostscript.3 Tk_TextLayoutToPostscript.3.*
+ ln $S TextLayout.3$Z Tk_ComputeTextLayout.3$Z
+ ln $S TextLayout.3$Z Tk_FreeTextLayout.3$Z
+ ln $S TextLayout.3$Z Tk_DrawTextLayout.3$Z
+ ln $S TextLayout.3$Z Tk_UnderlineTextLayout.3$Z
+ ln $S TextLayout.3$Z Tk_PointToChar.3$Z
+ ln $S TextLayout.3$Z Tk_CharBbox.3$Z
+ ln $S TextLayout.3$Z Tk_DistanceToTextLayout.3$Z
+ ln $S TextLayout.3$Z Tk_IntersectTextLayout.3$Z
+ ln $S TextLayout.3$Z Tk_TextLayoutToPostscript.3$Z
+fi
+if test -r TkInitStubs.3; then
+ rm -f TkInitStubs.3.*
+ $ZIP TkInitStubs.3
+ rm -f Tk_InitStubs.3 Tk_InitStubs.3.*
+ ln $S TkInitStubs.3$Z Tk_InitStubs.3$Z
+fi
+if test -r Tk_Init.3; then
+ rm -f Tk_Init.3.*
+ $ZIP Tk_Init.3
+ rm -f Tk_SafeInit.3 Tk_SafeInit.3.*
+ ln $S Tk_Init.3$Z Tk_SafeInit.3$Z
+fi
+if test -r Tk_Main.3; then
+ rm -f Tk_Main.3.*
+ $ZIP Tk_Main.3
+fi
+if test -r WindowId.3; then
+ rm -f WindowId.3.*
+ $ZIP WindowId.3
+ rm -f Tk_WindowId.3 Tk_WindowId.3.*
+ rm -f Tk_Parent.3 Tk_Parent.3.*
+ rm -f Tk_Display.3 Tk_Display.3.*
+ rm -f Tk_DisplayName.3 Tk_DisplayName.3.*
+ rm -f Tk_ScreenNumber.3 Tk_ScreenNumber.3.*
+ rm -f Tk_Screen.3 Tk_Screen.3.*
+ rm -f Tk_X.3 Tk_X.3.*
+ rm -f Tk_Y.3 Tk_Y.3.*
+ rm -f Tk_Width.3 Tk_Width.3.*
+ rm -f Tk_Height.3 Tk_Height.3.*
+ rm -f Tk_Changes.3 Tk_Changes.3.*
+ rm -f Tk_Attributes.3 Tk_Attributes.3.*
+ rm -f Tk_IsContainer.3 Tk_IsContainer.3.*
+ rm -f Tk_IsEmbedded.3 Tk_IsEmbedded.3.*
+ rm -f Tk_IsMapped.3 Tk_IsMapped.3.*
+ rm -f Tk_IsTopLevel.3 Tk_IsTopLevel.3.*
+ rm -f Tk_ReqWidth.3 Tk_ReqWidth.3.*
+ rm -f Tk_ReqHeight.3 Tk_ReqHeight.3.*
+ rm -f Tk_MinReqWidth.3 Tk_MinReqWidth.3.*
+ rm -f Tk_MinReqHeight.3 Tk_MinReqHeight.3.*
+ rm -f Tk_InternalBorderLeft.3 Tk_InternalBorderLeft.3.*
+ rm -f Tk_InternalBorderRight.3 Tk_InternalBorderRight.3.*
+ rm -f Tk_InternalBorderTop.3 Tk_InternalBorderTop.3.*
+ rm -f Tk_InternalBorderBottom.3 Tk_InternalBorderBottom.3.*
+ rm -f Tk_Visual.3 Tk_Visual.3.*
+ rm -f Tk_Depth.3 Tk_Depth.3.*
+ rm -f Tk_Colormap.3 Tk_Colormap.3.*
+ ln $S WindowId.3$Z Tk_WindowId.3$Z
+ ln $S WindowId.3$Z Tk_Parent.3$Z
+ ln $S WindowId.3$Z Tk_Display.3$Z
+ ln $S WindowId.3$Z Tk_DisplayName.3$Z
+ ln $S WindowId.3$Z Tk_ScreenNumber.3$Z
+ ln $S WindowId.3$Z Tk_Screen.3$Z
+ ln $S WindowId.3$Z Tk_X.3$Z
+ ln $S WindowId.3$Z Tk_Y.3$Z
+ ln $S WindowId.3$Z Tk_Width.3$Z
+ ln $S WindowId.3$Z Tk_Height.3$Z
+ ln $S WindowId.3$Z Tk_Changes.3$Z
+ ln $S WindowId.3$Z Tk_Attributes.3$Z
+ ln $S WindowId.3$Z Tk_IsContainer.3$Z
+ ln $S WindowId.3$Z Tk_IsEmbedded.3$Z
+ ln $S WindowId.3$Z Tk_IsMapped.3$Z
+ ln $S WindowId.3$Z Tk_IsTopLevel.3$Z
+ ln $S WindowId.3$Z Tk_ReqWidth.3$Z
+ ln $S WindowId.3$Z Tk_ReqHeight.3$Z
+ ln $S WindowId.3$Z Tk_MinReqWidth.3$Z
+ ln $S WindowId.3$Z Tk_MinReqHeight.3$Z
+ ln $S WindowId.3$Z Tk_InternalBorderLeft.3$Z
+ ln $S WindowId.3$Z Tk_InternalBorderRight.3$Z
+ ln $S WindowId.3$Z Tk_InternalBorderTop.3$Z
+ ln $S WindowId.3$Z Tk_InternalBorderBottom.3$Z
+ ln $S WindowId.3$Z Tk_Visual.3$Z
+ ln $S WindowId.3$Z Tk_Depth.3$Z
+ ln $S WindowId.3$Z Tk_Colormap.3$Z
+fi
+if test -r bell.n; then
+ rm -f bell.n.*
+ $ZIP bell.n
+fi
+if test -r bind.n; then
+ rm -f bind.n.*
+ $ZIP bind.n
+fi
+if test -r bindtags.n; then
+ rm -f bindtags.n.*
+ $ZIP bindtags.n
+fi
+if test -r bitmap.n; then
+ rm -f bitmap.n.*
+ $ZIP bitmap.n
+fi
+if test -r button.n; then
+ rm -f button.n.*
+ $ZIP button.n
+fi
+if test -r canvas.n; then
+ rm -f canvas.n.*
+ $ZIP canvas.n
+fi
+if test -r checkbutton.n; then
+ rm -f checkbutton.n.*
+ $ZIP checkbutton.n
+fi
+if test -r chooseColor.n; then
+ rm -f chooseColor.n.*
+ $ZIP chooseColor.n
+ rm -f tk_chooseColor.n tk_chooseColor.n.*
+ ln $S chooseColor.n$Z tk_chooseColor.n$Z
+fi
+if test -r chooseDirectory.n; then
+ rm -f chooseDirectory.n.*
+ $ZIP chooseDirectory.n
+ rm -f tk_chooseDirectory.n tk_chooseDirectory.n.*
+ ln $S chooseDirectory.n$Z tk_chooseDirectory.n$Z
+fi
+if test -r clipboard.n; then
+ rm -f clipboard.n.*
+ $ZIP clipboard.n
+fi
+if test -r colors.n; then
+ rm -f colors.n.*
+ $ZIP colors.n
+fi
+if test -r console.n; then
+ rm -f console.n.*
+ $ZIP console.n
+fi
+if test -r cursors.n; then
+ rm -f cursors.n.*
+ $ZIP cursors.n
+fi
+if test -r destroy.n; then
+ rm -f destroy.n.*
+ $ZIP destroy.n
+fi
+if test -r dialog.n; then
+ rm -f dialog.n.*
+ $ZIP dialog.n
+ rm -f tk_dialog.n tk_dialog.n.*
+ ln $S dialog.n$Z tk_dialog.n$Z
+fi
+if test -r entry.n; then
+ rm -f entry.n.*
+ $ZIP entry.n
+fi
+if test -r event.n; then
+ rm -f event.n.*
+ $ZIP event.n
+fi
+if test -r focus.n; then
+ rm -f focus.n.*
+ $ZIP focus.n
+fi
+if test -r focusNext.n; then
+ rm -f focusNext.n.*
+ $ZIP focusNext.n
+ rm -f tk_focusNext.n tk_focusNext.n.*
+ rm -f tk_focusPrev.n tk_focusPrev.n.*
+ rm -f tk_focusFollowsMouse.n tk_focusFollowsMouse.n.*
+ ln $S focusNext.n$Z tk_focusNext.n$Z
+ ln $S focusNext.n$Z tk_focusPrev.n$Z
+ ln $S focusNext.n$Z tk_focusFollowsMouse.n$Z
+fi
+if test -r font.n; then
+ rm -f font.n.*
+ $ZIP font.n
+fi
+if test -r frame.n; then
+ rm -f frame.n.*
+ $ZIP frame.n
+fi
+if test -r getOpenFile.n; then
+ rm -f getOpenFile.n.*
+ $ZIP getOpenFile.n
+ rm -f tk_getOpenFile.n tk_getOpenFile.n.*
+ rm -f tk_getSaveFile.n tk_getSaveFile.n.*
+ ln $S getOpenFile.n$Z tk_getOpenFile.n$Z
+ ln $S getOpenFile.n$Z tk_getSaveFile.n$Z
+fi
+if test -r grab.n; then
+ rm -f grab.n.*
+ $ZIP grab.n
+fi
+if test -r grid.n; then
+ rm -f grid.n.*
+ $ZIP grid.n
+fi
+if test -r image.n; then
+ rm -f image.n.*
+ $ZIP image.n
+fi
+if test -r keysyms.n; then
+ rm -f keysyms.n.*
+ $ZIP keysyms.n
+fi
+if test -r label.n; then
+ rm -f label.n.*
+ $ZIP label.n
+fi
+if test -r labelframe.n; then
+ rm -f labelframe.n.*
+ $ZIP labelframe.n
+fi
+if test -r listbox.n; then
+ rm -f listbox.n.*
+ $ZIP listbox.n
+fi
+if test -r loadTk.n; then
+ rm -f loadTk.n.*
+ $ZIP loadTk.n
+fi
+if test -r lower.n; then
+ rm -f lower.n.*
+ $ZIP lower.n
+fi
+if test -r menu.n; then
+ rm -f menu.n.*
+ $ZIP menu.n
+ rm -f tk_menuSetFocus.n tk_menuSetFocus.n.*
+ ln $S menu.n$Z tk_menuSetFocus.n$Z
+fi
+if test -r menubar.n; then
+ rm -f menubar.n.*
+ $ZIP menubar.n
+ rm -f tk_menuBar.n tk_menuBar.n.*
+ rm -f tk_bindForTraversal.n tk_bindForTraversal.n.*
+ ln $S menubar.n$Z tk_menuBar.n$Z
+ ln $S menubar.n$Z tk_bindForTraversal.n$Z
+fi
+if test -r menubutton.n; then
+ rm -f menubutton.n.*
+ $ZIP menubutton.n
+fi
+if test -r message.n; then
+ rm -f message.n.*
+ $ZIP message.n
+fi
+if test -r messageBox.n; then
+ rm -f messageBox.n.*
+ $ZIP messageBox.n
+ rm -f tk_messageBox.n tk_messageBox.n.*
+ ln $S messageBox.n$Z tk_messageBox.n$Z
+fi
+if test -r option.n; then
+ rm -f option.n.*
+ $ZIP option.n
+fi
+if test -r optionMenu.n; then
+ rm -f optionMenu.n.*
+ $ZIP optionMenu.n
+ rm -f tk_optionMenu.n tk_optionMenu.n.*
+ ln $S optionMenu.n$Z tk_optionMenu.n$Z
+fi
+if test -r options.n; then
+ rm -f options.n.*
+ $ZIP options.n
+fi
+if test -r pack-old.n; then
+ rm -f pack-old.n.*
+ $ZIP pack-old.n
+fi
+if test -r pack.n; then
+ rm -f pack.n.*
+ $ZIP pack.n
+fi
+if test -r palette.n; then
+ rm -f palette.n.*
+ $ZIP palette.n
+ rm -f tk_setPalette.n tk_setPalette.n.*
+ rm -f tk_bisque.n tk_bisque.n.*
+ ln $S palette.n$Z tk_setPalette.n$Z
+ ln $S palette.n$Z tk_bisque.n$Z
+fi
+if test -r panedwindow.n; then
+ rm -f panedwindow.n.*
+ $ZIP panedwindow.n
+fi
+if test -r photo.n; then
+ rm -f photo.n.*
+ $ZIP photo.n
+fi
+if test -r place.n; then
+ rm -f place.n.*
+ $ZIP place.n
+fi
+if test -r popup.n; then
+ rm -f popup.n.*
+ $ZIP popup.n
+ rm -f tk_popup.n tk_popup.n.*
+ ln $S popup.n$Z tk_popup.n$Z
+fi
+if test -r radiobutton.n; then
+ rm -f radiobutton.n.*
+ $ZIP radiobutton.n
+fi
+if test -r raise.n; then
+ rm -f raise.n.*
+ $ZIP raise.n
+fi
+if test -r scale.n; then
+ rm -f scale.n.*
+ $ZIP scale.n
+fi
+if test -r scrollbar.n; then
+ rm -f scrollbar.n.*
+ $ZIP scrollbar.n
+fi
+if test -r selection.n; then
+ rm -f selection.n.*
+ $ZIP selection.n
+fi
+if test -r send.n; then
+ rm -f send.n.*
+ $ZIP send.n
+fi
+if test -r spinbox.n; then
+ rm -f spinbox.n.*
+ $ZIP spinbox.n
+fi
+if test -r text.n; then
+ rm -f text.n.*
+ $ZIP text.n
+ rm -f tk_textCopy.n tk_textCopy.n.*
+ rm -f tk_textCut.n tk_textCut.n.*
+ rm -f tk_textPaste.n tk_textPaste.n.*
+ ln $S text.n$Z tk_textCopy.n$Z
+ ln $S text.n$Z tk_textCut.n$Z
+ ln $S text.n$Z tk_textPaste.n$Z
+fi
+if test -r tk.n; then
+ rm -f tk.n.*
+ $ZIP tk.n
+fi
+if test -r tkerror.n; then
+ rm -f tkerror.n.*
+ $ZIP tkerror.n
+fi
+if test -r tkvars.n; then
+ rm -f tkvars.n.*
+ $ZIP tkvars.n
+fi
+if test -r tkwait.n; then
+ rm -f tkwait.n.*
+ $ZIP tkwait.n
+fi
+if test -r toplevel.n; then
+ rm -f toplevel.n.*
+ $ZIP toplevel.n
+fi
+if test -r winfo.n; then
+ rm -f winfo.n.*
+ $ZIP winfo.n
+fi
+if test -r wish.1; then
+ rm -f wish.1.*
+ $ZIP wish.1
+fi
+if test -r wm.n; then
+ rm -f wm.n.*
+ $ZIP wm.n
fi
exit 0
diff --git a/tcl/unix/tk.spec b/tcl/unix/tk.spec
new file mode 100644
index 00000000000..c85701933ea
--- /dev/null
+++ b/tcl/unix/tk.spec
@@ -0,0 +1,52 @@
+# $Id$
+# This file is the basis for a binary Tk Linux RPM.
+
+%define version 8.4.0
+%define directory /usr/local
+
+Summary: Tk graphical toolkit for the Tcl scripting language.
+Name: tk
+Version: %{version}
+Release: 1
+Copyright: BSD
+Group: Development/Languages
+Source: http://prdownloads.sourceforge.net/tcl/tk%{version}-src.tar.gz
+URL: http://www.tcl.tk/
+Packager: Carina
+Buildroot: /var/tmp/%{name}%{version}
+Requires: XFree86-libs >= 3.3.3, XFree86-devel >= 3.3.3, tcl = 8.4.0
+
+%description
+The Tcl (Tool Command Language) provides a powerful platform for
+creating integration applications that tie together diverse
+applications, protocols, devices, and frameworks. When paired with
+the Tk toolkit, Tcl provides the fastest and most powerful way to
+create GUI applications that run on PCs, Unix, and the Macintosh. Tcl
+can also be used for a variety of web-related tasks and for creating
+powerful command languages for applications.
+
+%prep
+
+%build
+./configure --prefix %{directory} --exec-prefix %{directory}
+make CFLAGS=$RPM_OPT_FLAGS
+
+%install
+rm -rf $RPM_BUILD_ROOT
+make INSTALL_ROOT=$RPM_BUILD_ROOT install
+
+%clean
+rm -rf $RPM_BUILD_ROOT
+
+# to create the tcl files list, comment out tk in the install section above,
+# then run "rpm -bi" then do a find from the build root directory,
+# and remove the files in specific directories which suffice by themselves,
+# then to create the files list for tk, uncomment tk, comment out tcl,
+# then rm -rf $RPM_BUILD_ROOT then rpm --short-circuit -bi then redo a find,
+# and remove the files in specific directories which suffice by themselves.
+%files -n tk
+%defattr(-,root,root)
+%{directory}/lib
+%{directory}/bin
+%{directory}/include
+%{directory}/man
diff --git a/tcl/unix/tkAppInit.c b/tcl/unix/tkAppInit.c
new file mode 100644
index 00000000000..296586a18b0
--- /dev/null
+++ b/tcl/unix/tkAppInit.c
@@ -0,0 +1,136 @@
+/*
+ * tkAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in wish and similar Tk-based applications.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "locale.h"
+
+#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. */
+{
+ /*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TK_LOCAL_APPINIT
+#define TK_LOCAL_APPINIT Tcl_AppInit
+#endif
+ extern int TK_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+ /*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tk_Main()
+ */
+
+#ifdef TK_LOCAL_MAIN_HOOK
+ extern int TK_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+ TK_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tk_Main(argc, argv, TK_LOCAL_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 the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Tk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+#ifdef TK_TEST
+ if (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/tcl/unix/tkConfig.sh.in b/tcl/unix/tkConfig.sh.in
new file mode 100644
index 00000000000..764c9a27f04
--- /dev/null
+++ b/tcl/unix/tkConfig.sh.in
@@ -0,0 +1,93 @@
+# 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@
+
+# This indicates if Tk was build with debugging symbols
+TK_DBGX=@TK_DBGX@
+
+# The name of the Tk library (may be either a .a file or a shared library):
+TK_LIB_FILE='@TK_LIB_FILE@'
+
+# Additional libraries to use when linking Tk.
+TK_LIBS='@XLIBSW@ @DL_LIBS@ @LIBS@ @MATH_LIBS@'
+
+# Top-level directory in which Tcl's platform-independent files are
+# installed.
+TK_PREFIX='@prefix@'
+
+# Top-level directory in which Tcl's platform-specific files (e.g.
+# executables) are installed.
+TK_EXEC_PREFIX='@exec_prefix@'
+
+# -I switch(es) to use to make all of the X11 include files accessible:
+TK_XINCLUDES='@XINCLUDES@'
+
+# Linker switch(es) to use to link with the X11 library archive.
+TK_XLIBSW='@XLIBSW@'
+
+# -l flag to pass to the linker to pick up the Tcl library
+TK_LIB_FLAG='@TK_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tk library from its
+# build directory.
+TK_BUILD_LIB_SPEC='@TK_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tk library from its
+# installed directory.
+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='@CC_SEARCH_FLAGS@'
+TK_LD_SEARCH_FLAGS='@LD_SEARCH_FLAGS@'
+
+# The name of the Tk stub library (.a):
+TK_STUB_LIB_FILE='@TK_STUB_LIB_FILE@'
+
+# -l flag to pass to the linker to pick up the Tk stub library
+TK_STUB_LIB_FLAG='@TK_STUB_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tk stub library from its
+# build directory.
+TK_BUILD_STUB_LIB_SPEC='@TK_BUILD_STUB_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tk stub library from its
+# installed directory.
+TK_STUB_LIB_SPEC='@TK_STUB_LIB_SPEC@'
+
+# Path to the Tk stub library in the build directory.
+TK_BUILD_STUB_LIB_PATH='@TK_BUILD_STUB_LIB_PATH@'
+
+# Path to the Tk stub library in the install directory.
+TK_STUB_LIB_PATH='@TK_STUB_LIB_PATH@'
diff --git a/tcl/unix/tkUnix.c b/tcl/unix/tkUnix.c
new file mode 100644
index 00000000000..ebb8bfe7353
--- /dev/null
+++ b/tcl/unix/tkUnix.c
@@ -0,0 +1,108 @@
+/*
+ * 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[8 + TCL_INTEGER_SPACE * 2];
+ char buffer2[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
+ ProtocolRevision(Tk_Display(tkwin)));
+ sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
+ Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
+ buffer2, (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+TkGetDefaultScreenName(interp, screenName)
+ Tcl_Interp *interp; /* Interp used to find environment variables. */
+ CONST char *screenName; /* Screen name from command line, or NULL. */
+{
+ if ((screenName == NULL) || (screenName[0] == '\0')) {
+ screenName = Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY);
+ }
+ return screenName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdatePointer --
+ *
+ * Unused function in UNIX
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UpdatePointer(tkwin, x, y, state)
+ Tk_Window tkwin; /* Window to which pointer event
+ * is reported. May be NULL. */
+ int x, y; /* Pointer location in root coords. */
+ int state; /* Modifier state mask. */
+{
+ /*
+ * This function intentionally left blank
+ */
+}
diff --git a/tcl/unix/tkUnix3d.c b/tcl/unix/tkUnix3d.c
new file mode 100644
index 00000000000..b6a6b4682cd
--- /dev/null
+++ b/tcl/unix/tkUnix3d.c
@@ -0,0 +1,501 @@
+/*
+ * 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>
+
+#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK))
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * 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++) {
+ /*
+ * X Dimensions are 16-bit, so avoid wraparound or display errors
+ * by limiting these here.
+ */
+ if (x1 < -32767)
+ x1 = -32767;
+ if (x2 > 32767)
+ x2 = 32767;
+
+ /*
+ * 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;
+ int r, g, b;
+ 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.
+ * But if the background is already very dark, make the
+ * dark color a little lighter than the background by increasing
+ * each color component 1/4th of the way to MAX_INTENSITY.
+ *
+ * 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).
+ * But if the background is already very bright, instead choose a
+ * slightly darker color for the light shadow by reducing each
+ * color component by 10%.
+ *
+ * Compute the colors using integers, not using lightColor.red
+ * etc.: these are shorts and may have problems with integer
+ * overflow.
+ */
+
+ /*
+ * Compute the dark shadow color
+ */
+
+ r = (int) borderPtr->bgColorPtr->red;
+ g = (int) borderPtr->bgColorPtr->green;
+ b = (int) borderPtr->bgColorPtr->blue;
+
+ if (r*0.5*r + g*1.0*g + b*0.28*b < MAX_INTENSITY*0.05*MAX_INTENSITY) {
+ darkColor.red = (MAX_INTENSITY + 3*r)/4;
+ darkColor.green = (MAX_INTENSITY + 3*g)/4;
+ darkColor.blue = (MAX_INTENSITY + 3*b)/4;
+ } else {
+ darkColor.red = (60 * r)/100;
+ darkColor.green = (60 * g)/100;
+ darkColor.blue = (60 * b)/100;
+ }
+
+ /*
+ * Allocate the dark shadow color and its GC
+ */
+
+ borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor);
+ gcValues.foreground = borderPtr->darkColorPtr->pixel;
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+
+ /*
+ * Compute the light shadow color
+ */
+
+ if (g > MAX_INTENSITY*0.95) {
+ lightColor.red = (90 * r)/100;
+ lightColor.green = (90 * g)/100;
+ lightColor.blue = (90 * b)/100;
+ } else {
+ tmp1 = (14 * r)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + r)/2;
+ lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * g)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + g)/2;
+ lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * b)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + b)/2;
+ lightColor.blue = (tmp1 > tmp2) ? tmp1 : tmp2;
+ }
+
+ /*
+ * Allocate the light shadow color and its GC
+ */
+
+ 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/tcl/unix/tkUnixButton.c b/tcl/unix/tkUnixButton.c
new file mode 100644
index 00000000000..8db0636d3a1
--- /dev/null
+++ b/tcl/unix/tkUnixButton.c
@@ -0,0 +1,684 @@
+/*
+ * tkUnixButton.c --
+ *
+ * This file implements the Unix specific portion of the button
+ * widgets.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ */
+
+Tk_ClassProcs tkpButtonProcs = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkButtonWorldChanged, /* worldChangedProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ Tk_Window tkwin = butPtr->tkwin;
+ int width, height, fullWidth, fullHeight;
+ int imageXOffset, imageYOffset, textXOffset, textYOffset;
+ int haveImage = 0, haveText = 0;
+ int offset; /* 1 means this is a button widget, so we
+ * offset the text to make the button appear
+ * to move up and down as the relief changes.
+ */
+
+ butPtr->flags &= ~REDRAW_PENDING;
+ if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ border = butPtr->normalBorder;
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
+ gc = butPtr->disabledGC;
+ } else if ((butPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(butPtr->tkwin)) {
+ gc = butPtr->activeTextGC;
+ border = butPtr->activeBorder;
+ } else {
+ gc = butPtr->normalTextGC;
+ }
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
+ && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
+ border = butPtr->selectBorder;
+ }
+
+ /*
+ * Override the relief specified for the button if this is a
+ * checkbutton or radiobutton and there's no indicator. The new
+ * relief is as follows:
+ * If the button is select --> "sunken"
+ * If relief==overrelief --> relief
+ * Otherwise --> overrelief
+ *
+ * The effect we are trying to achieve is as follows:
+ *
+ * value mouse-over? --> relief
+ * ------- ------------ --------
+ * off no flat
+ * off yes raised
+ * on no sunken
+ * on yes sunken
+ *
+ * This is accomplished by configuring the checkbutton or radiobutton
+ * like this:
+ *
+ * -indicatoron 0 -overrelief raised -offrelief flat
+ *
+ * Bindings (see library/button.tcl) will copy the -overrelief into
+ * -relief on mouseover. Hence, we can tell if we are in mouse-over by
+ * comparing relief against overRelief. This is an aweful kludge, but
+ * it gives use the desired behavior while keeping the code backwards
+ * compatible.
+ */
+
+ relief = butPtr->relief;
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
+ if (butPtr->flags & SELECTED) {
+ relief = TK_RELIEF_SUNKEN;
+ } else if (butPtr->overRelief != relief) {
+ relief = butPtr->offRelief;
+ }
+ }
+
+ 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 != NULL) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+ haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ imageXOffset = 0;
+ imageYOffset = 0;
+ textXOffset = 0;
+ textYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (butPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + butPtr->padY;
+ } else {
+ imageYOffset = butPtr->textHeight + butPtr->padY;
+ }
+ fullHeight = height + butPtr->textHeight + butPtr->padY;
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ if (butPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + butPtr->padX;
+ } else {
+ imageXOffset = butPtr->textWidth + butPtr->padX;
+ }
+ fullWidth = butPtr->textWidth + butPtr->padX + width;
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + fullWidth, fullHeight, &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 + imageXOffset,
+ y + imageYOffset);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width,
+ height, pixmap, x + imageXOffset, y + imageYOffset);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x + imageXOffset,
+ y + imageYOffset);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc,
+ 0, 0, (unsigned int) width,
+ (unsigned int) height, x + imageXOffset,
+ y + imageYOffset, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+
+ Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
+ x + textXOffset, y + textYOffset, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, gc,
+ butPtr->textLayout, x + textXOffset, y + textYOffset,
+ butPtr->underline);
+ y += fullHeight/2;
+ } else {
+ if (haveImage) {
+ 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 {
+ 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;
+ if (butPtr->state != STATE_DISABLED &&
+ butPtr->selectBorder != NULL) {
+ gc = Tk_3DBorderGC(tkwin, butPtr->selectBorder,
+ TK_3D_FLAT_GC);
+ } else {
+ gc = Tk_3DBorderGC(tkwin, 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;
+
+ if (butPtr->state != STATE_DISABLED &&
+ butPtr->selectBorder != NULL) {
+ gc = Tk_3DBorderGC(tkwin, butPtr->selectBorder, TK_3D_FLAT_GC);
+ } else {
+ gc = Tk_3DBorderGC(tkwin, 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 == STATE_DISABLED)
+ && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->selectBorder)->pixel);
+ }
+ XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
+ 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 == DEFAULT_ACTIVE) {
+ /*
+ * Draw the default ring with 2 pixels of space between the
+ * default ring and the button and the default ring and the
+ * focus ring. Note that we need to explicitly draw the space
+ * in the highlightBorder color to ensure that we overwrite any
+ * overflow text and/or a different button background color.
+ */
+
+ 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 == DEFAULT_NORMAL) {
+ /*
+ * Leave room for the default ring and write over any text or
+ * background color.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0,
+ 0, Tk_Width(tkwin), Tk_Height(tkwin), 5, TK_RELIEF_FLAT);
+ inset += 5;
+ }
+
+ /*
+ * Draw the button border.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, border, inset, inset,
+ Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
+ butPtr->borderWidth, relief);
+ }
+ if (butPtr->highlightWidth > 0) {
+ GC gc;
+
+ if (butPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(butPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(Tk_3DBorderColor(butPtr->highlightBorder),
+ pixmap);
+ }
+
+ /*
+ * Make sure the focus ring shrink-wraps the actual button, not the
+ * padding space left for a default ring.
+ */
+
+ if (butPtr->defaultState == DEFAULT_NORMAL) {
+ TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth,
+ pixmap, 5);
+ } else {
+ Tk_DrawFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap);
+ }
+ }
+
+ /*
+ * 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, txtWidth, txtHeight;
+ int haveImage = 0, haveText = 0;
+ Tk_FontMetrics fm;
+
+ butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;
+
+ /*
+ * Leave room for the default ring if needed.
+ */
+
+ if (butPtr->defaultState != DEFAULT_DISABLED) {
+ butPtr->inset += 5;
+ }
+ butPtr->indicatorSpace = 0;
+
+ width = 0;
+ height = 0;
+ txtWidth = 0;
+ txtHeight = 0;
+ avgWidth = 0;
+
+ if (butPtr->image != NULL) {
+ Tk_SizeOfImage(butPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+
+ if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) {
+ Tk_FreeTextLayout(butPtr->textLayout);
+
+ butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
+
+ txtWidth = butPtr->textWidth;
+ txtHeight = butPtr->textHeight;
+ avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
+ Tk_GetFontMetrics(butPtr->tkfont, &fm);
+ haveText = (txtWidth != 0 && txtHeight != 0);
+ }
+
+ /*
+ * If the button is compound (ie, it shows both an image and text),
+ * the new geometry is a combination of the image and text geometry.
+ * We only honor the compound bit if the button has both text and an
+ * image, because otherwise it is not really a compound button.
+ */
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ height += txtHeight + butPtr->padY;
+ width = (width > txtWidth ? width : txtWidth);
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ width += txtWidth + butPtr->padX;
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ width = (width > txtWidth ? width : txtWidth);
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ 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;
+ }
+ }
+
+ width += 2*butPtr->padX;
+ height += 2*butPtr->padY;
+
+ } else {
+ if (haveImage) {
+ 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 {
+ width = txtWidth;
+ height = txtHeight;
+
+ 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/tcl/unix/tkUnixColor.c b/tcl/unix/tkUnixColor.c
new file mode 100644
index 00000000000..d927351833b
--- /dev/null
+++ b/tcl/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/tcl/unix/tkUnixConfig.c b/tcl/unix/tkUnixConfig.c
new file mode 100644
index 00000000000..d450d7d811e
--- /dev/null
+++ b/tcl/unix/tkUnixConfig.c
@@ -0,0 +1,45 @@
+/*
+ * tkUnixConfig.c --
+ *
+ * This module implements the Unix system defaults for
+ * the configuration package.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "tkInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetSystemDefault --
+ *
+ * Given a dbName and className for a configuration option,
+ * return a string representation of the option.
+ *
+ * Results:
+ * Returns a Tk_Uid that is the string identifier that identifies
+ * this option. Returns NULL if there are no system defaults
+ * that match this pair.
+ *
+ * Side effects:
+ * None, once the package is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkpGetSystemDefault(tkwin, dbName, className)
+ Tk_Window tkwin; /* A window to use. */
+ CONST char *dbName; /* The option database name. */
+ CONST char *className; /* The name of the option class. */
+{
+ return NULL;
+}
diff --git a/tcl/unix/tkUnixCursor.c b/tcl/unix/tkUnixCursor.c
new file mode 100644
index 00000000000..41069ac7368
--- /dev/null
+++ b/tcl/unix/tkUnixCursor.c
@@ -0,0 +1,410 @@
+/*
+ * tkUnixCursor.c --
+ *
+ * This file contains X specific cursor manipulation routines.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+ CONST 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) {
+ Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC);
+ goto cleanup;
+ }
+ }
+ cursor = XCreateGlyphCursor(display, dispPtr->cursorFont,
+ dispPtr->cursorFont, namePtr->shape, maskIndex,
+ &fg, &bg);
+ } else {
+ 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)) {
+ Tcl_SetResult(interp,
+ "source and mask bitmaps have different sizes",
+ TCL_STATIC);
+ goto cleanup;
+ }
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[2],
+ &fg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[2],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ 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:
+ if (argv) {
+ ckfree((char *) argv);
+ }
+ 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. */
+ CONST char *source; /* Bitmap data for cursor shape. */
+ CONST 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeCursor --
+ *
+ * This procedure is called to release a cursor allocated by
+ * TkGetCursorByName.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor data structure is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeCursor(cursorPtr)
+ TkCursor *cursorPtr;
+{
+ TkUnixCursor *unixCursorPtr = (TkUnixCursor *) cursorPtr;
+ XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor);
+ Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor);
+}
diff --git a/tcl/unix/tkUnixDefault.h b/tcl/unix/tkUnixDefault.h
new file mode 100644
index 00000000000..7699c07ab94
--- /dev/null
+++ b/tcl/unix/tkUnixDefault.h
@@ -0,0 +1,519 @@
+/*
+ * 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_COMPOUND "none"
+#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_COLOR DEF_BUTTON_BG_COLOR
+#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO
+#define DEF_BUTTON_HIGHLIGHT BLACK
+#define DEF_LABEL_HIGHLIGHT_WIDTH "0"
+#define DEF_BUTTON_HIGHLIGHT_WIDTH "1"
+#define DEF_BUTTON_IMAGE (char *) NULL
+#define DEF_BUTTON_INDICATOR "1"
+#define DEF_BUTTON_JUSTIFY "center"
+#define DEF_BUTTON_OFF_VALUE "0"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_OVER_RELIEF ""
+#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_REPEAT_DELAY "0"
+#define DEF_BUTTON_REPEAT_INTERVAL "0"
+#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_DISABLED_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_DISABLED_BG_MONO WHITE
+#define DEF_ENTRY_DISABLED_FG DISABLED
+#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_READONLY_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_READONLY_BG_MONO WHITE
+#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_LABEL ""
+#define DEF_FRAME_PADX "0"
+#define DEF_FRAME_PADY "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for labelframes:
+ */
+
+#define DEF_LABELFRAME_BORDER_WIDTH "2"
+#define DEF_LABELFRAME_CLASS "Labelframe"
+#define DEF_LABELFRAME_RELIEF "groove"
+#define DEF_LABELFRAME_FG BLACK
+#define DEF_LABELFRAME_FONT "Helvetica -12 bold"
+#define DEF_LABELFRAME_TEXT ""
+#define DEF_LABELFRAME_LABELANCHOR "nw"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_ACTIVE_STYLE "underline"
+#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_DISABLED_FG DISABLED
+#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_LIST_VARIABLE ""
+#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_STATE "normal"
+#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_COMPOUND "none"
+#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_COLOR DEF_MENUBUTTON_BG_COLOR
+#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO
+#define DEF_MENUBUTTON_HIGHLIGHT BLACK
+#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0"
+#define DEF_MENUBUTTON_IMAGE (char *) NULL
+#define DEF_MENUBUTTON_INDICATOR "0"
+#define DEF_MENUBUTTON_JUSTIFY "center"
+#define DEF_MENUBUTTON_MENU ""
+#define DEF_MENUBUTTON_PADX "4p"
+#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 panedwindows
+ */
+
+#define DEF_PANEDWINDOW_BG_COLOR NORMAL_BG
+#define DEF_PANEDWINDOW_BG_MONO WHITE
+#define DEF_PANEDWINDOW_BORDERWIDTH "2"
+#define DEF_PANEDWINDOW_CURSOR ""
+#define DEF_PANEDWINDOW_HANDLEPAD "8"
+#define DEF_PANEDWINDOW_HANDLESIZE "8"
+#define DEF_PANEDWINDOW_HEIGHT ""
+#define DEF_PANEDWINDOW_OPAQUERESIZE "0"
+#define DEF_PANEDWINDOW_ORIENT "horizontal"
+#define DEF_PANEDWINDOW_RELIEF "flat"
+#define DEF_PANEDWINDOW_SASHCURSOR ""
+#define DEF_PANEDWINDOW_SASHPAD "2"
+#define DEF_PANEDWINDOW_SASHRELIEF "raised"
+#define DEF_PANEDWINDOW_SASHWIDTH "2"
+#define DEF_PANEDWINDOW_SHOWHANDLE "1"
+#define DEF_PANEDWINDOW_WIDTH ""
+
+/*
+ * Defaults for panedwindow panes
+ */
+
+#define DEF_PANEDWINDOW_PANE_AFTER ""
+#define DEF_PANEDWINDOW_PANE_BEFORE ""
+#define DEF_PANEDWINDOW_PANE_HEIGHT ""
+#define DEF_PANEDWINDOW_PANE_MINSIZE "0"
+#define DEF_PANEDWINDOW_PANE_PADX "0"
+#define DEF_PANEDWINDOW_PANE_PADY "0"
+#define DEF_PANEDWINDOW_PANE_STICKY "nsew"
+#define DEF_PANEDWINDOW_PANE_WIDTH ""
+
+/*
+ * 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_COLOR DEF_SCALE_BG_COLOR
+#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO
+#define DEF_SCALE_HIGHLIGHT BLACK
+#define DEF_SCALE_HIGHLIGHT_WIDTH "1"
+#define DEF_SCALE_LABEL ""
+#define DEF_SCALE_LENGTH "100"
+#define DEF_SCALE_ORIENT "vertical"
+#define DEF_SCALE_RELIEF "flat"
+#define DEF_SCALE_REPEAT_DELAY "300"
+#define DEF_SCALE_REPEAT_INTERVAL "100"
+#define DEF_SCALE_RESOLUTION "1"
+#define DEF_SCALE_TROUGH_COLOR TROUGH
+#define DEF_SCALE_TROUGH_MONO WHITE
+#define DEF_SCALE_SHOW_VALUE "1"
+#define DEF_SCALE_SLIDER_LENGTH "30"
+#define DEF_SCALE_SLIDER_RELIEF "raised"
+#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_AUTO_SEPARATORS "1"
+#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_MAX_UNDO "0"
+#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_UNDO "0"
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+
+/*
+ * 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 ""
+#define DEF_TOPLEVEL_USE ""
+
+#endif /* _TKUNIXDEFAULT */
diff --git a/tcl/unix/tkUnixDialog.c b/tcl/unix/tkUnixDialog.c
new file mode 100644
index 00000000000..6fb99eae655
--- /dev/null
+++ b/tcl/unix/tkUnixDialog.c
@@ -0,0 +1,207 @@
+/*
+ * 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, "tk::ColorDialog", 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
+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;
+
+ if (Tk_StrictMotif(tkwin)) {
+ return EvalArgv(interp, "tk::MotifFDialog", argc, argv);
+ } else {
+ return EvalArgv(interp, "tk::FDialog", 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;
+
+ if (Tk_StrictMotif(tkwin)) {
+ return EvalArgv(interp, "tk::MotifFDialog", argc, argv);
+ } else {
+ return EvalArgv(interp, "tk::FDialog", 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, "tk::MessageBox", argc, argv);
+}
+
diff --git a/tcl/unix/tkUnixDraw.c b/tcl/unix/tkUnixDraw.c
new file mode 100644
index 00000000000..2f603f9af32
--- /dev/null
+++ b/tcl/unix/tkUnixDraw.c
@@ -0,0 +1,211 @@
+/*
+ * 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"
+
+#if !defined(__WIN32__) && !defined(MAC_TCL)
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * The following structure is used to pass information to
+ * ScrollRestrictProc from TkScrollWindow.
+ */
+
+typedef struct ScrollInfo {
+ 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);
+
+ if (XEmptyRegion((Region) damageRgn)) {
+ return 0;
+ } else {
+ return 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawHighlightBorder --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus.
+ *
+ * On Unix, we just draw the simple inset ring. On other sytems,
+ * e.g. the Mac, the focus ring is a little more complicated, so we
+ * need this abstraction.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawHighlightBorder(tkwin, fgGC, bgGC, highlightWidth, drawable)
+ Tk_Window tkwin;
+ GC fgGC;
+ GC bgGC;
+ int highlightWidth;
+ Drawable drawable;
+{
+ TkDrawInsetFocusHighlight(tkwin, fgGC, highlightWidth, drawable, 0);
+}
diff --git a/tcl/unix/tkUnixEmbed.c b/tcl/unix/tkUnixEmbed.c
new file mode 100644
index 00000000000..c28b84525b9
--- /dev/null
+++ b/tcl/unix/tkUnixEmbed.c
@@ -0,0 +1,1034 @@
+/*
+ * 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;
+
+typedef struct ThreadSpecificData {
+ Container *firstContainerPtr; /* First in list of all containers
+ * managed by this process. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for static procedures defined in this file:
+ */
+
+static void ContainerEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+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 the interp's result if
+ * interp is non-NULL.
+ *
+ * Side effects:
+ * Changes the colormap and other visual information to match that
+ * of the parent window given by "string".
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ CONST char *string; /* String identifying an X window to use
+ * for tkwin; must be an integer value. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *usePtr;
+ int id, anyError;
+ Window parent;
+ Tk_ErrorHandler handler;
+ Container *containerPtr;
+ XWindowAttributes parentAtts;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->window != None) {
+ panic("TkUseWindow: X window already assigned");
+ }
+ if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ parent = (Window) id;
+
+ usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent);
+ if (usePtr != NULL) {
+ if (!(usePtr->flags & TK_CONTAINER)) {
+ Tcl_AppendResult(interp, "window \"", usePtr->pathName,
+ "\" doesn't have -container option set", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * 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 = tsdPtr->firstContainerPtr; containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->parent == parent) {
+ winPtr->flags |= TK_BOTH_HALVES;
+ containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
+ break;
+ }
+ }
+ if (containerPtr == NULL) {
+ containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr->parent = parent;
+ containerPtr->parentRoot = parentAtts.root;
+ containerPtr->parentPtr = NULL;
+ containerPtr->wrapper = None;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
+ }
+ containerPtr->embeddedPtr = winPtr;
+ winPtr->flags |= TK_EMBEDDED;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ /*
+ * This window is embedded. Don't create the new window in the
+ * given parent; instead, create it as a child of the root window
+ * of the container's screen. The window will get reparented
+ * into a wrapper window later.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr; ;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr == NULL) {
+ panic("TkMakeWindow couldn't find container for window");
+ }
+ if (containerPtr->embeddedPtr == winPtr) {
+ break;
+ }
+ }
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Register the window as a container so that, for example, we can
+ * find out later if the embedded app. is in the same process.
+ */
+
+ Tk_MakeWindowExist(tkwin);
+ containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr->parent = Tk_WindowId(tkwin);
+ containerPtr->parentRoot = RootWindowOfScreen(Tk_Screen(tkwin));
+ containerPtr->parentPtr = winPtr;
+ containerPtr->wrapper = None;
+ containerPtr->embeddedPtr = NULL;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
+ winPtr->flags |= TK_CONTAINER;
+
+ /*
+ * Request SubstructureNotify events so that we can find out when
+ * the embedded application creates its window or attempts to
+ * resize it. Also watch Configure events on the container so that
+ * we can resize the child to match.
+ */
+
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Ignore any X protocol errors that happen in this procedure
+ * (almost any operation could fail, for example, if the embedded
+ * application has deleted its window).
+ */
+
+ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+
+ /*
+ * Find the Container structure associated with the parent window.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr->parent != eventPtr->xmaprequest.parent;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr == NULL) {
+ panic("ContainerEventProc couldn't find Container record");
+ }
+ }
+
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ return containerPtr->parentPtr;
+ } else if (containerPtr->parentPtr == winPtr) {
+ return containerPtr->embeddedPtr;
+ }
+ }
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * 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_HIERARCHY) {
+ 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 = tsdPtr->firstContainerPtr;
+ containerPtr->embeddedPtr != winPtr;
+ containerPtr = containerPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ saved = eventPtr->xkey.window;
+ eventPtr->xkey.window = containerPtr->parent;
+ XSendEvent(eventPtr->xkey.display, eventPtr->xkey.window, False,
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!(topLevelPtr->flags & TK_EMBEDDED)) {
+ return;
+ }
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr->embeddedPtr != topLevelPtr;
+ containerPtr = containerPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+
+ event.xfocus.type = FocusIn;
+ event.xfocus.serial = LastKnownRequestProcessed(topLevelPtr->display);
+ 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. */
+ CONST char **argv; /* Argument strings. */
+{
+ int all;
+ Container *containerPtr;
+ Tcl_DString dString;
+ char buffer[50];
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if ((argc > 1) && (strcmp(argv[1], "all") == 0)) {
+ all = 1;
+ } else {
+ all = 0;
+ }
+ Tcl_DStringInit(&dString);
+ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ Tcl_DStringStartSublist(&dString);
+ if (containerPtr->parent == None) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ if (all) {
+ sprintf(buffer, "0x%x", (int) containerPtr->parent);
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the Container structure for this window work. Delete the
+ * information about the embedded application and free the container's
+ * record.
+ */
+
+ prevPtr = NULL;
+ containerPtr = tsdPtr->firstContainerPtr;
+ while (1) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ containerPtr->wrapper = None;
+ containerPtr->embeddedPtr = NULL;
+ break;
+ }
+ if (containerPtr->parentPtr == winPtr) {
+ containerPtr->parentPtr = NULL;
+ break;
+ }
+ prevPtr = containerPtr;
+ containerPtr = containerPtr->nextPtr;
+ }
+ if ((containerPtr->embeddedPtr == NULL)
+ && (containerPtr->parentPtr == NULL)) {
+ if (prevPtr == NULL) {
+ tsdPtr->firstContainerPtr = containerPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = containerPtr->nextPtr;
+ }
+ ckfree((char *) containerPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL; containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ return containerPtr->parent;
+ }
+ }
+ panic("TkUnixContainerId couldn't find window");
+ return None;
+}
diff --git a/tcl/unix/tkUnixEvent.c b/tcl/unix/tkUnixEvent.c
new file mode 100644
index 00000000000..a4debe3f7f6
--- /dev/null
+++ b/tcl/unix/tkUnixEvent.c
@@ -0,0 +1,619 @@
+/*
+ * 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
+ * in the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for procedures that are referenced only in this file:
+ */
+
+static void DisplayCheckProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static void DisplayExitHandler _ANSI_ARGS_((
+ ClientData clientData));
+static void DisplayFileProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static void DisplaySetupProc _ANSI_ARGS_((ClientData clientData,
+ int flags));
+static void TransferXEventsToTcl _ANSI_ARGS_((Display *display));
+#ifdef TK_USE_INPUT_METHODS
+static void OpenIM _ANSI_ARGS_((TkDisplay *dispPtr));
+#endif
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->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. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
+ tsdPtr->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)
+ CONST char *display_name;
+{
+ TkDisplay *dispPtr;
+ Display *display = XOpenDisplay(display_name);
+
+ if (display == NULL) {
+ return NULL;
+ }
+ dispPtr = (TkDisplay *) ckalloc(sizeof(TkDisplay));
+ memset(dispPtr, 0, sizeof(TkDisplay));
+ dispPtr->display = display;
+#ifdef TK_USE_INPUT_METHODS
+ OpenIM(dispPtr);
+#endif
+ 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 and unix-specific resources.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpCloseDisplay(dispPtr)
+ TkDisplay *dispPtr;
+{
+ TkSendCleanup(dispPtr);
+
+ TkFreeXId(dispPtr);
+
+ TkWmCleanup(dispPtr);
+
+#ifdef TK_USE_INPUT_METHODS
+#if TK_XIM_SPOT
+ if (dispPtr->inputXfs) {
+ XFreeFontSet(dispPtr->display, dispPtr->inputXfs);
+ }
+#endif
+ if (dispPtr->inputMethod) {
+ /*
+ * This caused core dumps on some systems (Solaris 2.3 1/6/95).
+ * The most likely cause of this is a bug in X that accesses
+ * memory that was already deallocated inside XCloseIM().
+ * One can work around this issue by making sure a XDestroyIC()
+ * gets invoked for each XCreateIC().
+ */
+ XCloseIM(dispPtr->inputMethod);
+ }
+#endif
+
+ if (dispPtr->display != 0) {
+ Tcl_DeleteFileHandler(ConnectionNumber(dispPtr->display));
+ (void) XSync(dispPtr->display, False);
+ (void) XCloseDisplay(dispPtr->display);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+
+ /*
+ * Flush the display. If data is pending on the X queue, set
+ * the block time to zero. This ensures that we won't block
+ * in the notifier if there is data in the X queue, but not on
+ * the server socket.
+ */
+
+ XFlush(dispPtr->display);
+ if (QLength(dispPtr->display) > 0) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransferXEventsToTcl
+ *
+ * Transfer events from the X event queue to the Tk event queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves queued X events onto the Tcl event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TransferXEventsToTcl(display)
+ Display *display;
+{
+ int numFound;
+ XEvent event;
+
+ numFound = QLength(display);
+
+ /*
+ * Transfer events from the X event queue to the Tk event queue.
+ */
+
+ while (numFound > 0) {
+ XNextEvent(display, &event);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ numFound--;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayCheckProc --
+ *
+ * This procedure checks for events sitting in the X event
+ * 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;
+
+ if (!(flags & TCL_WINDOW_EVENTS)) {
+ return;
+ }
+
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XFlush(dispPtr->display);
+ TransferXEventsToTcl(dispPtr->display);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayFileProc --
+ *
+ * This procedure implements the file handler for the X connection.
+ *
+ * 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;
+ 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);
+ }
+
+ TransferXEventsToTcl(display);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XFlush(dispPtr->display);
+ if (QLength(dispPtr->display) > 0) {
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ }
+ fd = ConnectionNumber(dispPtr->display);
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+ readMask[index] |= bit;
+ 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 = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ fd = ConnectionNumber(dispPtr->display);
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+ if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) {
+ DisplayFileProc((ClientData)dispPtr, TCL_READABLE);
+ }
+ }
+ if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ return 1;
+ }
+
+ /*
+ * 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. */
+{
+ XSync(display, False);
+
+ /*
+ * Transfer events from the X event queue to the Tk event queue.
+ */
+ TransferXEventsToTcl(display);
+}
+#ifdef TK_USE_INPUT_METHODS
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ unsigned short i;
+ XIMStyles *stylePtr;
+ char *modifier_list;
+
+ if ((modifier_list = XSetLocaleModifiers("")) == NULL) {
+ goto error;
+ }
+
+ 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;
+ }
+#if TK_XIM_SPOT
+ /*
+ * If we want to do over-the-spot XIM, we have to check that this
+ * mode is supported. If not we will fall-through to the check below.
+ */
+ for (i = 0; i < stylePtr->count_styles; i++) {
+ if (stylePtr->supported_styles[i]
+ == (XIMPreeditPosition | XIMStatusNothing)) {
+ dispPtr->flags |= TK_DISPLAY_XIM_SPOT;
+ XFree(stylePtr);
+ return;
+ }
+ }
+#endif
+ for (i = 0; i < stylePtr->count_styles; i++) {
+ if (stylePtr->supported_styles[i]
+ == (XIMPreeditNothing | XIMStatusNothing)) {
+ XFree(stylePtr);
+ return;
+ }
+ }
+ XFree(stylePtr);
+
+ error:
+
+ if (dispPtr->inputMethod) {
+ /*
+ * This call should not suffer from any core dumping problems
+ * since we have not allocated any input contexts.
+ */
+ XCloseIM(dispPtr->inputMethod);
+ dispPtr->inputMethod = NULL;
+ }
+}
+#endif /* TK_USE_INPUT_METHODS */
diff --git a/tcl/unix/tkUnixFocus.c b/tcl/unix/tkUnixFocus.c
new file mode 100644
index 00000000000..d7f450b7d38
--- /dev/null
+++ b/tcl/unix/tkUnixFocus.c
@@ -0,0 +1,148 @@
+/*
+ * 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"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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/tcl/unix/tkUnixFont.c b/tcl/unix/tkUnixFont.c
new file mode 100644
index 00000000000..ce240df7ebb
--- /dev/null
+++ b/tcl/unix/tkUnixFont.c
@@ -0,0 +1,2830 @@
+/*
+ * tkUnixFont.c --
+ *
+ * Contains the Unix implementation of the platform-independant
+ * font package interface.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkUnixInt.h"
+#include "tkFont.h"
+#include <netinet/in.h> /* for htons() prototype */
+#include <arpa/inet.h> /* inet_ntoa() */
+
+/*
+ * The preferred font encodings.
+ */
+
+static CONST char *encodingList[] = {
+ "iso8859-1", "jis0208", "jis0212", NULL
+};
+
+/*
+ * The following structure represents a font family. It is assumed that
+ * all screen fonts constructed from the same "font family" share certain
+ * properties; all screen fonts with the same "font family" point to a
+ * shared instance of this structure. The most important shared property
+ * is the character existence metrics, used to determine if a screen font
+ * can display a given Unicode character.
+ *
+ * Under Unix, there are three attributes that uniquely identify a "font
+ * family": the foundry, face name, and charset.
+ */
+
+#define FONTMAP_SHIFT 10
+
+#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
+#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT)
+
+typedef struct FontFamily {
+ struct FontFamily *nextPtr; /* Next in list of all known font families. */
+ int refCount; /* How many SubFonts are referring to this
+ * FontFamily. When the refCount drops to
+ * zero, this FontFamily may be freed. */
+ /*
+ * Key.
+ */
+
+ Tk_Uid foundry; /* Foundry key for this FontFamily. */
+ Tk_Uid faceName; /* Face name key for this FontFamily. */
+ Tcl_Encoding encoding; /* Encoding key for this FontFamily. */
+
+ /*
+ * Derived properties.
+ */
+
+ int isTwoByteFont; /* 1 if this is a double-byte font, 0
+ * otherwise. */
+ char *fontMap[FONTMAP_PAGES];
+ /* Two-level sparse table used to determine
+ * quickly if the specified character exists.
+ * As characters are encountered, more pages
+ * in this table are dynamically alloced. The
+ * contents of each page is a bitmask
+ * consisting of FONTMAP_BITSPERPAGE bits,
+ * representing whether this font can be used
+ * to display the given character at the
+ * corresponding bit position. The high bits
+ * of the character are used to pick which
+ * page of the table is used. */
+} FontFamily;
+
+/*
+ * The following structure encapsulates an individual screen font. A font
+ * object is made up of however many SubFonts are necessary to display a
+ * stream of multilingual characters.
+ */
+
+typedef struct SubFont {
+ char **fontMap; /* Pointer to font map from the FontFamily,
+ * cached here to save a dereference. */
+ XFontStruct *fontStructPtr; /* The specific screen font that will be
+ * used when displaying/measuring chars
+ * belonging to the FontFamily. */
+ FontFamily *familyPtr; /* The FontFamily for this SubFont. */
+} SubFont;
+
+/*
+ * The following structure represents Unix's implementation of a font
+ * object.
+ */
+
+#define SUBFONT_SPACE 3
+#define BASE_CHARS 256
+
+typedef struct UnixFont {
+ TkFont font; /* Stuff used by generic font package. Must
+ * be first in structure. */
+ SubFont staticSubFonts[SUBFONT_SPACE];
+ /* Builtin space for a limited number of
+ * SubFonts. */
+ int numSubFonts; /* Length of following array. */
+ SubFont *subFontArray; /* Array of SubFonts that have been loaded
+ * in order to draw/measure all the characters
+ * encountered by this font so far. All fonts
+ * start off with one SubFont initialized by
+ * AllocFont() from the original set of font
+ * attributes. Usually points to
+ * staticSubFonts, but may point to malloced
+ * space if there are lots of SubFonts. */
+ SubFont controlSubFont; /* Font to use to display control-character
+ * expansions. */
+
+ Display *display; /* Display that owns font. */
+ int pixelSize; /* Original pixel size used when font was
+ * constructed. */
+ TkXLFDAttributes xa; /* Additional attributes that specify the
+ * preferred foundry and encoding to use when
+ * constructing additional SubFonts. */
+ int widths[BASE_CHARS]; /* Widths of first 256 chars in the base
+ * font, for handling common case. */
+ int underlinePos; /* Offset from baseline to origin of
+ * underline bar (used when drawing underlined
+ * font) (pixels). */
+ int barHeight; /* Height of underline or overstrike bar
+ * (used when drawing underlined or strikeout
+ * font) (pixels). */
+} UnixFont;
+
+/*
+ * The following structure and definition is used to keep track of the
+ * alternative names for various encodings. Asking for an encoding that
+ * matches one of the alias patterns will result in actually getting the
+ * encoding by its real name.
+ */
+
+typedef struct EncodingAlias {
+ char *realName; /* The real name of the encoding to load if
+ * the provided name matched the pattern. */
+ char *aliasPattern; /* Pattern for encoding name, of the form
+ * that is acceptable to Tcl_StringMatch. */
+} EncodingAlias;
+
+/*
+ * Just some utility structures used for passing around values in helper
+ * procedures.
+ */
+
+typedef struct FontAttributes {
+ TkFontAttributes fa;
+ TkXLFDAttributes xa;
+} FontAttributes;
+
+
+typedef struct ThreadSpecificData {
+ FontFamily *fontFamilyList; /* The list of font families that are
+ * currently loaded. As screen fonts
+ * are loaded, this list grows to hold
+ * information about what characters
+ * exist in each font family. */
+ FontFamily controlFamily; /* FontFamily used to handle control
+ * character expansions. The encoding
+ * of this FontFamily converts UTF-8 to
+ * backslashed escape sequences. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The set of builtin encoding alises to convert the XLFD names for the
+ * encodings into the names expected by the Tcl encoding package.
+ */
+
+static EncodingAlias encodingAliases[] = {
+ {"gb2312", "gb2312*"},
+ {"big5", "big5*"},
+ {"cns11643-1", "cns11643*-1"},
+ {"cns11643-1", "cns11643*.1-0"},
+ {"cns11643-2", "cns11643*-2"},
+ {"cns11643-2", "cns11643*.2-0"},
+ {"jis0201", "jisx0201*"},
+ {"jis0201", "jisx0202*"},
+ {"jis0208", "jisc6226*"},
+ {"jis0208", "jisx0208*"},
+ {"jis0212", "jisx0212*"},
+ {"tis620", "tis620*"},
+ {"ksc5601", "ksc5601*"},
+ {"dingbats", "*dingbats"},
+ {"ucs-2be", "iso10646-1"},
+ {NULL, NULL}
+};
+
+/*
+ * Procedures used only in this file.
+ */
+
+static void FontPkgCleanup _ANSI_ARGS_((ClientData clientData));
+static FontFamily * AllocFontFamily _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, int base));
+static SubFont * CanUseFallback _ANSI_ARGS_((UnixFont *fontPtr,
+ CONST char *fallbackName, int ch));
+static SubFont * CanUseFallbackWithAliases _ANSI_ARGS_((
+ UnixFont *fontPtr, char *fallbackName,
+ int ch, Tcl_DString *nameTriedPtr));
+static int ControlUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static XFontStruct * CreateClosestFont _ANSI_ARGS_((Tk_Window tkwin,
+ CONST TkFontAttributes *faPtr,
+ CONST TkXLFDAttributes *xaPtr));
+static SubFont * FindSubFontForChar _ANSI_ARGS_((UnixFont *fontPtr,
+ int ch));
+static void FontMapInsert _ANSI_ARGS_((SubFont *subFontPtr,
+ int ch));
+static void FontMapLoadPage _ANSI_ARGS_((SubFont *subFontPtr,
+ int row));
+static int FontMapLookup _ANSI_ARGS_((SubFont *subFontPtr,
+ int ch));
+static void FreeFontFamily _ANSI_ARGS_((FontFamily *afPtr));
+static CONST char * GetEncodingAlias _ANSI_ARGS_((CONST char *name));
+static int GetFontAttributes _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, FontAttributes *faPtr));
+static XFontStruct * GetScreenFont _ANSI_ARGS_((Display *display,
+ FontAttributes *wantPtr, char **nameList,
+ int bestIdx[], unsigned int bestScore[]));
+static XFontStruct * GetSystemFont _ANSI_ARGS_((Display *display));
+static int IdentifySymbolEncodings _ANSI_ARGS_((
+ FontAttributes *faPtr));
+static void InitFont _ANSI_ARGS_((Tk_Window tkwin,
+ XFontStruct *fontStructPtr, UnixFont *fontPtr));
+static void InitSubFont _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, int base,
+ SubFont *subFontPtr));
+static char ** ListFonts _ANSI_ARGS_((Display *display,
+ CONST char *faceName, int *numNamesPtr));
+static char ** ListFontOrAlias _ANSI_ARGS_((Display *display,
+ CONST char *faceName, int *numNamesPtr));
+static unsigned int RankAttributes _ANSI_ARGS_((FontAttributes *wantPtr,
+ FontAttributes *gotPtr));
+static void ReleaseFont _ANSI_ARGS_((UnixFont *fontPtr));
+static void ReleaseSubFont _ANSI_ARGS_((Display *display,
+ SubFont *subFontPtr));
+static int SeenName _ANSI_ARGS_((CONST char *name,
+ Tcl_DString *dsPtr));
+static int Ucs2beToUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static int UtfToUcs2beProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontPkgCleanup --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependent code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases thread-specific resources used by font pkg.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontPkgCleanup(ClientData clientData)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->controlFamily.encoding != NULL) {
+ FontFamily *familyPtr = &tsdPtr->controlFamily;
+ int i;
+
+ Tcl_FreeEncoding(familyPtr->encoding);
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+ tsdPtr->controlFamily.encoding = NULL;
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependent code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_EncodingType type;
+ SubFont dummy;
+ int i;
+
+ if (tsdPtr->controlFamily.encoding == NULL) {
+ type.encodingName = "X11ControlChars";
+ type.toUtfProc = ControlUtfProc;
+ type.fromUtfProc = ControlUtfProc;
+ type.freeProc = NULL;
+ type.clientData = NULL;
+ type.nullSize = 0;
+
+ tsdPtr->controlFamily.refCount = 2;
+ tsdPtr->controlFamily.encoding = Tcl_CreateEncoding(&type);
+ tsdPtr->controlFamily.isTwoByteFont = 0;
+
+ dummy.familyPtr = &tsdPtr->controlFamily;
+ dummy.fontMap = tsdPtr->controlFamily.fontMap;
+ for (i = 0x00; i < 0x20; i++) {
+ FontMapInsert(&dummy, i);
+ FontMapInsert(&dummy, i + 0x80);
+ }
+
+ /*
+ * UCS-2BE is unicode in big-endian format.
+ * It is used in iso10646 fonts.
+ */
+
+ type.encodingName = "ucs-2be";
+ type.toUtfProc = Ucs2beToUtfProc;
+ type.fromUtfProc = UtfToUcs2beProc;
+ type.freeProc = NULL;
+ type.clientData = NULL;
+ type.nullSize = 2;
+ Tcl_CreateEncoding(&type);
+ Tcl_CreateThreadExitHandler(FontPkgCleanup, NULL);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ControlUtfProc --
+ *
+ * Convert from UTF-8 into the ASCII expansion of a control
+ * character.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ControlUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcEnd;
+ char *dstStart, *dstEnd;
+ Tcl_UniChar ch;
+ int result;
+ static char hexChars[] = "0123456789abcdef";
+ static char mapChars[] = {
+ 0, 0, 0, 0, 0, 0, 0,
+ 'a', 'b', 't', 'n', 'v', 'f', 'r'
+ };
+
+ result = TCL_OK;
+
+ srcEnd = src + srcLen;
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - 6;
+
+ for ( ; src < srcEnd; ) {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ src += Tcl_UtfToUniChar(src, &ch);
+ dst[0] = '\\';
+ if ((ch < sizeof(mapChars)) && (mapChars[ch] != 0)) {
+ dst[1] = mapChars[ch];
+ dst += 2;
+ } else if (ch < 256) {
+ dst[1] = 'x';
+ dst[2] = hexChars[(ch >> 4) & 0xf];
+ dst[3] = hexChars[ch & 0xf];
+ dst += 4;
+ } else {
+ dst[1] = 'u';
+ dst[2] = hexChars[(ch >> 12) & 0xf];
+ dst[3] = hexChars[(ch >> 8) & 0xf];
+ dst[4] = hexChars[(ch >> 4) & 0xf];
+ dst[5] = hexChars[ch & 0xf];
+ dst += 6;
+ }
+ }
+ *srcReadPtr = src - srcEnd;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = dst - dstStart;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Ucs2beToUtfProc --
+ *
+ * Convert from UCS-2BE (big-endian 16-bit Unicode) to UTF-8.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Ucs2beToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string in Unicode. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST Tcl_UniChar *wSrc, *wSrcStart, *wSrcEnd;
+ char *dstEnd, *dstStart;
+ int result, numChars;
+
+ result = TCL_OK;
+ if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
+ result = TCL_CONVERT_MULTIBYTE;
+ srcLen /= sizeof(Tcl_UniChar);
+ srcLen *= sizeof(Tcl_UniChar);
+ }
+
+ wSrc = (Tcl_UniChar *) src;
+
+ wSrcStart = (Tcl_UniChar *) src;
+ wSrcEnd = (Tcl_UniChar *) (src + srcLen);
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+ for (numChars = 0; wSrc < wSrcEnd; numChars++) {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ /*
+ * On a little-endian machine (Intel) the UCS-2BE is in the
+ * wrong byte-order in comparison to "unicode", which is
+ * in native host order.
+ */
+ dst += Tcl_UniCharToUtf(htons(*wSrc), dst);
+ wSrc++;
+ }
+
+ *srcReadPtr = (char *) wSrc - (char *) wSrcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * UtfToUcs2beProc --
+ *
+ * Convert from UTF-8 to UCS-2BE.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+UtfToUcs2beProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* TableEncodingData that specifies encoding. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcStart, *srcEnd, *srcClose;
+ Tcl_UniChar *wDst, *wDstStart, *wDstEnd;
+ int result, numChars;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+ srcClose = srcEnd;
+ if ((flags & TCL_ENCODING_END) == 0) {
+ srcClose -= TCL_UTF_MAX;
+ }
+
+ wDst = (Tcl_UniChar *) dst;
+ wDstStart = (Tcl_UniChar *) dst;
+ wDstEnd = (Tcl_UniChar *) (dst + dstLen - sizeof(Tcl_UniChar));
+
+ result = TCL_OK;
+ for (numChars = 0; src < srcEnd; numChars++) {
+ if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ /*
+ * If there is more string to follow, this will ensure that the
+ * last UTF-8 character in the source buffer hasn't been cut off.
+ */
+
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ if (wDst > wDstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ src += Tcl_UtfToUniChar(src, wDst);
+ /*
+ * Byte swap for little-endian machines.
+ */
+ *wDst = htons(*wDst);
+ wDst++;
+ }
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = (char *) wDst - (char *) wDstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkFont *
+TkpGetNativeFont(tkwin, name)
+ Tk_Window tkwin; /* For display where font will be used. */
+ CONST char *name; /* Platform-specific font name. */
+{
+ UnixFont *fontPtr;
+ XFontStruct *fontStructPtr;
+ FontAttributes fa;
+ CONST char *p;
+ int hasSpace, dashes, hasWild;
+
+ /*
+ * The behavior of X when given a name that isn't an XLFD is unspecified.
+ * For example, Exceed 6 returns a valid font for any random string. This
+ * is awkward since system names have higher priority than the other Tk
+ * font syntaxes. So, we need to perform a quick sanity check on the
+ * name and fail if it looks suspicious. We fail if the name:
+ * - contains a space immediately before a dash
+ * - contains a space, but no '*' characters and fewer than 14 dashes
+ */
+
+ hasSpace = dashes = hasWild = 0;
+ for (p = name; *p != '\0'; p++) {
+ if (*p == ' ') {
+ if (p[1] == '-') {
+ return NULL;
+ }
+ hasSpace = 1;
+ } else if (*p == '-') {
+ dashes++;
+ } else if (*p == '*') {
+ hasWild = 1;
+ }
+ }
+ if ((dashes < 14) && !hasWild && hasSpace) {
+ return NULL;
+ }
+
+ fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name);
+ if (fontStructPtr == NULL) {
+ /*
+ * Handle all names that look like XLFDs here. Otherwise, when
+ * TkpGetFontFromAttributes is called from generic code, any
+ * foundry or encoding information specified in the XLFD will have
+ * been parsed out and lost. But make sure we don't have an
+ * "-option value" string since TkFontParseXLFD would return a
+ * false success when attempting to parse it.
+ */
+
+ if (name[0] == '-') {
+ if (name[1] != '*') {
+ char *dash;
+
+ dash = strchr(name + 1, '-');
+ if ((dash == NULL) || (isspace(UCHAR(dash[-1])))) {
+ return NULL;
+ }
+ }
+ } else if (name[0] != '*') {
+ return NULL;
+ }
+ if (TkFontParseXLFD(name, &fa.fa, &fa.xa) != TCL_OK) {
+ return NULL;
+ }
+ fontStructPtr = CreateClosestFont(tkwin, &fa.fa, &fa.xa);
+ }
+ fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
+ InitFont(tkwin, fontStructPtr, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFromAttributes --
+ *
+ * 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:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+TkFont *
+TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
+ TkFont *tkFontPtr; /* If non-NULL, store the information in
+ * this existing TkFont structure, rather than
+ * allocating a new structure to hold the
+ * font; the existing contents of the font
+ * will be released. If NULL, a new TkFont
+ * structure is allocated. */
+ Tk_Window tkwin; /* For display where font will be used. */
+ CONST TkFontAttributes *faPtr;
+ /* Set of attributes to match. */
+{
+ UnixFont *fontPtr;
+ TkXLFDAttributes xa;
+ XFontStruct *fontStructPtr;
+
+ TkInitXLFDAttributes(&xa);
+ fontStructPtr = CreateClosestFont(tkwin, faPtr, &xa);
+
+ fontPtr = (UnixFont *) tkFontPtr;
+ if (fontPtr == NULL) {
+ fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
+ } else {
+ ReleaseFont(fontPtr);
+ }
+ InitFont(tkwin, fontStructPtr, fontPtr);
+
+ fontPtr->font.fa.underline = faPtr->underline;
+ fontPtr->font.fa.overstrike = faPtr->overstrike;
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpDeleteFont --
+ *
+ * Called to release a font allocated by TkpGetNativeFont() or
+ * 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;
+ ReleaseFont(fontPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFamilies --
+ *
+ * Return information about the font families that are available
+ * on the display of the given window.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list of all the available
+ * font families.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkpGetFontFamilies(interp, tkwin)
+ Tcl_Interp *interp; /* Interp to hold result. */
+ Tk_Window tkwin; /* For display to query. */
+{
+ int i, new, numNames;
+ char *family;
+ Tcl_HashTable familyTable;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ char **nameList;
+ Tcl_Obj *resultPtr, *strPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+
+ Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS);
+ nameList = ListFonts(Tk_Display(tkwin), "*", &numNames);
+ for (i = 0; i < numNames; i++) {
+ family = strchr(nameList[i] + 1, '-') + 1;
+ strchr(family, '-')[0] = '\0';
+ Tcl_CreateHashEntry(&familyTable, family, &new);
+ }
+ XFreeFontNames(nameList);
+
+ hPtr = Tcl_FirstHashEntry(&familyTable, &search);
+ while (hPtr != NULL) {
+ strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+
+ Tcl_DeleteHashTable(&familyTable);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpGetSubFonts --
+ *
+ * A function used by the testing package for querying the actual
+ * screen fonts that make up a font object.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list containing the
+ * names of the screen fonts that make up the given font object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpGetSubFonts(interp, tkfont)
+ Tcl_Interp *interp;
+ Tk_Font tkfont;
+{
+ int i;
+ Tcl_Obj *objv[3];
+ Tcl_Obj *resultPtr, *listPtr;
+ UnixFont *fontPtr;
+ FontFamily *familyPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ fontPtr = (UnixFont *) tkfont;
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ familyPtr = fontPtr->subFontArray[i].familyPtr;
+ objv[0] = Tcl_NewStringObj(familyPtr->faceName, -1);
+ objv[1] = Tcl_NewStringObj(familyPtr->foundry, -1);
+ objv[2] = Tcl_NewStringObj(Tcl_GetEncodingName(familyPtr->encoding), -1);
+ listPtr = Tcl_NewListObj(3, objv);
+ Tcl_ListObjAppendElement(NULL, resultPtr, listPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_MeasureChars --
+ *
+ * Determine the number of characters from the string that will fit
+ * in the given horizontal span. The measurement is done under the
+ * assumption that Tk_DrawChars() will be used to actually display
+ * the characters.
+ *
+ * Results:
+ * The return value is the number of bytes from source that
+ * fit into the span that extends from 0 to maxLength. *lengthPtr is
+ * filled with the x-coordinate of the right edge of the last
+ * character that did fit.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_MeasureChars(tkfont, source, numBytes, maxLength, flags, lengthPtr)
+ Tk_Font tkfont; /* Font in which characters will be drawn. */
+ CONST char *source; /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes; /* Maximum number of bytes to consider
+ * from source string. */
+ int maxLength; /* If >= 0, maxLength specifies the longest
+ * permissible line length in pixels; don't
+ * consider any character that would cross
+ * this x-position. If < 0, then line length
+ * is unbounded and the flags argument is
+ * ignored. */
+ int flags; /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ int *lengthPtr; /* Filled with x-location just after the
+ * terminating character. */
+{
+ UnixFont *fontPtr;
+ SubFont *lastSubFontPtr;
+ int curX, curByte;
+
+ /*
+ * Unix does not use kerning or fractional character widths when
+ * displaying text on the screen. So that means we can safely measure
+ * individual characters or spans of characters and add up the widths
+ * w/o any "off-by-one-pixel" errors.
+ */
+
+ fontPtr = (UnixFont *) tkfont;
+
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+
+ if (numBytes == 0) {
+ curX = 0;
+ curByte = 0;
+ } else if (maxLength < 0) {
+ CONST char *p, *end, *next;
+ Tcl_UniChar ch;
+ SubFont *thisSubFontPtr;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+
+ /*
+ * A three step process:
+ * 1. Find a contiguous range of characters that can all be
+ * represented by a single screen font.
+ * 2. Convert those chars to the encoding of that font.
+ * 3. Measure converted chars.
+ */
+
+ curX = 0;
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ if (familyPtr->isTwoByteFont) {
+ curX += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+ } else {
+ curX += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ Tcl_DStringFree(&runString);
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ }
+ p = next;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
+ &runString);
+ if (familyPtr->isTwoByteFont) {
+ curX += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> 1);
+ } else {
+ curX += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ Tcl_DStringFree(&runString);
+ curByte = numBytes;
+ } else {
+ CONST char *p, *end, *next, *term;
+ int newX, termX, sawNonSpace, dstWrote;
+ Tcl_UniChar ch;
+ FontFamily *familyPtr;
+ char buf[16];
+
+ /*
+ * How many chars will fit in the space allotted?
+ * This first version may be inefficient because it measures
+ * every character individually.
+ */
+
+ next = source + Tcl_UtfToUniChar(source, &ch);
+ newX = curX = termX = 0;
+
+ term = source;
+ end = source + numBytes;
+
+ sawNonSpace = (ch > 255) || !isspace(ch);
+ familyPtr = lastSubFontPtr->familyPtr;
+ for (p = source; ; ) {
+ if ((ch < BASE_CHARS) && (fontPtr->widths[ch] != 0)) {
+ newX += fontPtr->widths[ch];
+ } else {
+ lastSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p,
+ 0, NULL, buf, sizeof(buf), NULL, &dstWrote, NULL);
+ if (familyPtr->isTwoByteFont) {
+ newX += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) buf, dstWrote >> 1);
+ } else {
+ newX += XTextWidth(lastSubFontPtr->fontStructPtr, buf,
+ dstWrote);
+ }
+ }
+ if (newX > maxLength) {
+ break;
+ }
+ curX = newX;
+ p = next;
+ if (p >= end) {
+ term = end;
+ termX = curX;
+ break;
+ }
+
+ next += Tcl_UtfToUniChar(next, &ch);
+ if ((ch < 256) && isspace(ch)) {
+ if (sawNonSpace) {
+ term = p;
+ termX = curX;
+ sawNonSpace = 0;
+ }
+ } else {
+ sawNonSpace = 1;
+ }
+ }
+
+ /*
+ * P points to the first character that doesn't fit in the desired
+ * span. Use the flags to figure out what to return.
+ */
+
+ if ((flags & TK_PARTIAL_OK) && (p < end) && (curX < maxLength)) {
+ /*
+ * Include the first character that didn't quite fit in the desired
+ * span. The width returned will include the width of that extra
+ * character.
+ */
+
+ curX = newX;
+ p += Tcl_UtfToUniChar(p, &ch);
+ }
+ if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
+ term = p;
+ termX = curX;
+ if (term == source) {
+ term += Tcl_UtfToUniChar(term, &ch);
+ termX = newX;
+ }
+ } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
+ term = p;
+ termX = curX;
+ }
+
+ curX = termX;
+ curByte = term - source;
+ }
+
+ *lengthPtr = curX;
+ return curByte;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawChars --
+ *
+ * Draw a string of characters on the screen. Tk_DrawChars()
+ * expands control characters that occur in the string to
+ * \xNN sequences.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawChars(display, drawable, gc, tkfont, source, numBytes, x, y)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context for drawing characters. */
+ Tk_Font tkfont; /* Font in which characters will be drawn;
+ * must be the same as font used in GC. */
+ CONST char *source; /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. All Tk meta-characters
+ * (tabs, control characters, and newlines)
+ * should be stripped out of the string that
+ * is passed to this function. If they are
+ * not stripped out, they will be displayed as
+ * regular printing characters. */
+ int numBytes; /* Number of bytes in string. */
+ int x, y; /* Coordinates at which to place origin of
+ * string when drawing. */
+{
+ UnixFont *fontPtr;
+ SubFont *thisSubFontPtr, *lastSubFontPtr;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ int xStart, needWidth, window_width;
+ Tcl_UniChar ch;
+ FontFamily *familyPtr;
+ int rx, ry;
+ unsigned int width, height, border_width, depth;
+ int do_width;
+ Drawable root;
+
+ fontPtr = (UnixFont *) tkfont;
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+
+ xStart = x;
+
+ /*
+ * Get the window width so we can abort drawing outside of the window
+ */
+ if (XGetGeometry(display, drawable, &root, &rx, &ry, &width, &height,
+ &border_width, &depth) == False) {
+ window_width = INT_MAX;
+ } else {
+ window_width = width;
+ }
+
+ end = source + numBytes;
+ needWidth = fontPtr->font.fa.underline + fontPtr->font.fa.overstrike;
+ for (p = source; p <= end; ) {
+ if (p < end) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ } else {
+ next = p + 1;
+ thisSubFontPtr = lastSubFontPtr;
+ }
+ if ((thisSubFontPtr != lastSubFontPtr)
+ || (p == end) || (p-source > 200)) {
+ if (p > source) {
+ do_width = (needWidth || (p != end)) ? 1 : 0;
+ familyPtr = lastSubFontPtr->familyPtr;
+
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ if (familyPtr->isTwoByteFont) {
+ XDrawString16(display, drawable, gc, x, y,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+ if (do_width) {
+ x += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+ }
+ } else {
+ XDrawString(display, drawable, gc, x, y,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ if (do_width) {
+ x += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ }
+ Tcl_DStringFree(&runString);
+ }
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ XSetFont(display, gc, lastSubFontPtr->fontStructPtr->fid);
+ if (x > window_width) {
+ break;
+ }
+ }
+ p = next;
+ }
+
+ if (lastSubFontPtr != &fontPtr->subFontArray[0]) {
+ XSetFont(display, gc, fontPtr->subFontArray[0].fontStructPtr->fid);
+ }
+
+ if (fontPtr->font.fa.underline != 0) {
+ XFillRectangle(display, drawable, gc, xStart,
+ y + fontPtr->underlinePos,
+ (unsigned) (x - xStart), (unsigned) fontPtr->barHeight);
+ }
+ if (fontPtr->font.fa.overstrike != 0) {
+ y -= fontPtr->font.fm.descent + (fontPtr->font.fm.ascent) / 10;
+ XFillRectangle(display, drawable, gc, xStart, y,
+ (unsigned) (x - xStart), (unsigned) fontPtr->barHeight);
+ }
+}
+
+
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CreateClosestFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Given a set of font attributes, construct a close XFontStruct.
+ * If requested face name is not available, automatically
+ * substitutes an alias for requested face name. If encoding is
+ * not specified (or the requested one is not available),
+ * automatically chooses another encoding from the list of
+ * preferred encodings. If the foundry is not specified (or
+ * is not available) automatically prefers "adobe" foundry.
+ * For all other attributes, if the requested value was not
+ * available, the appropriate "close" value will be used.
+ *
+ * Results:
+ * Return value is the XFontStruct that best matched the
+ * requested attributes. The return value is never NULL; some
+ * font will always be returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static XFontStruct *
+CreateClosestFont(tkwin, faPtr, xaPtr)
+ Tk_Window tkwin; /* For display where font will be used. */
+ CONST TkFontAttributes *faPtr;
+ /* Set of generic attributes to match. */
+ CONST TkXLFDAttributes *xaPtr;
+ /* Set of X-specific attributes to match. */
+{
+ FontAttributes want;
+ char **nameList;
+ int numNames, nameIdx;
+ Display *display;
+ XFontStruct *fontStructPtr;
+ int bestIdx[2];
+ unsigned int bestScore[2];
+
+ want.fa = *faPtr;
+ want.xa = *xaPtr;
+
+ if (want.xa.foundry == NULL) {
+ want.xa.foundry = Tk_GetUid("adobe");
+ }
+ if (want.fa.family == NULL) {
+ want.fa.family = Tk_GetUid("fixed");
+ }
+ want.fa.size = -TkFontGetPixels(tkwin, faPtr->size);
+ if (want.xa.charset == NULL || *want.xa.charset == '\0') {
+ want.xa.charset = Tk_GetUid("iso8859-1"); /* locale. */
+ }
+
+ display = Tk_Display(tkwin);
+
+ /*
+ * Algorithm to get the closest font to the name requested.
+ *
+ * try fontname
+ * try all aliases for fontname
+ * foreach fallback for fontname
+ * try the fallback
+ * try all aliases for the fallback
+ */
+
+ nameList = ListFontOrAlias(display, want.fa.family, &numNames);
+ if (numNames == 0) {
+ char ***fontFallbacks;
+ int i, j;
+ char *fallback;
+
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(want.fa.family, fallback) == 0) {
+ break;
+ }
+ }
+ if (fallback != NULL) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ nameList = ListFontOrAlias(display, fallback, &numNames);
+ if (numNames != 0) {
+ goto found;
+ }
+ }
+ }
+ }
+ nameList = ListFonts(display, "fixed", &numNames);
+ if (numNames == 0) {
+ nameList = ListFonts(display, "*", &numNames);
+ }
+ if (numNames == 0) {
+ return GetSystemFont(display);
+ }
+ }
+ found:
+ bestIdx[0] = -1;
+ bestIdx[1] = -1;
+ bestScore[0] = (unsigned int) -1;
+ bestScore[1] = (unsigned int) -1;
+ for (nameIdx = 0; nameIdx < numNames; nameIdx++) {
+ FontAttributes got;
+ int scalable;
+ unsigned int score;
+
+ if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) {
+ continue;
+ }
+ IdentifySymbolEncodings(&got);
+ scalable = (got.fa.size == 0);
+ score = RankAttributes(&want, &got);
+ if (score <= bestScore[scalable]) {
+ bestIdx[scalable] = nameIdx;
+ bestScore[scalable] = score;
+ }
+ if (score == 0) {
+ break;
+ }
+ }
+
+ fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore);
+ XFreeFontNames(nameList);
+
+ if (fontStructPtr == NULL) {
+ return GetSystemFont(display);
+ }
+ return fontStructPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Initializes the memory for a new UnixFont that wraps the
+ * platform-specific data.
+ *
+ * The caller is responsible for initializing the fields of the
+ * TkFont that are used exclusively by the generic TkFont code, and
+ * for releasing those fields before calling TkpDeleteFont().
+ *
+ * Results:
+ * Fills the WinFont structure.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitFont(tkwin, fontStructPtr, fontPtr)
+ Tk_Window tkwin; /* For screen where font will be used. */
+ XFontStruct *fontStructPtr; /* X information about font. */
+ UnixFont *fontPtr; /* Filled with information constructed from
+ * the above arguments. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ unsigned long value;
+ int minHi, maxHi, minLo, maxLo, fixed, width, limit, i, n;
+ FontAttributes fa;
+ TkFontAttributes *faPtr;
+ TkFontMetrics *fmPtr;
+ SubFont *controlPtr, *subFontPtr;
+ char *pageMap;
+ Display *display;
+
+ /*
+ * Get all font attributes and metrics.
+ */
+
+ display = Tk_Display(tkwin);
+ GetFontAttributes(display, fontStructPtr, &fa);
+
+ minHi = fontStructPtr->min_byte1;
+ maxHi = fontStructPtr->max_byte1;
+ minLo = fontStructPtr->min_char_or_byte2;
+ maxLo = fontStructPtr->max_char_or_byte2;
+
+ fixed = 1;
+ if (fontStructPtr->per_char != NULL) {
+ width = 0;
+ limit = (maxHi - minHi + 1) * (maxLo - minLo + 1);
+ for (i = 0; i < limit; i++) {
+ n = fontStructPtr->per_char[i].width;
+ if (n != 0) {
+ if (width == 0) {
+ width = n;
+ } else if (width != n) {
+ fixed = 0;
+ break;
+ }
+ }
+ }
+ }
+
+ fontPtr->font.fid = fontStructPtr->fid;
+
+ faPtr = &fontPtr->font.fa;
+ faPtr->family = fa.fa.family;
+ faPtr->size = TkFontGetPoints(tkwin, fa.fa.size);
+ faPtr->weight = fa.fa.weight;
+ faPtr->slant = fa.fa.slant;
+ faPtr->underline = 0;
+ faPtr->overstrike = 0;
+
+ fmPtr = &fontPtr->font.fm;
+ fmPtr->ascent = fontStructPtr->ascent;
+ fmPtr->descent = fontStructPtr->descent;
+ fmPtr->maxWidth = fontStructPtr->max_bounds.width;
+ fmPtr->fixed = fixed;
+
+ fontPtr->display = display;
+ fontPtr->pixelSize = TkFontGetPixels(tkwin, fa.fa.size);
+ fontPtr->xa = fa.xa;
+
+ fontPtr->numSubFonts = 1;
+ fontPtr->subFontArray = fontPtr->staticSubFonts;
+ InitSubFont(display, fontStructPtr, 1, &fontPtr->subFontArray[0]);
+
+ fontPtr->controlSubFont = fontPtr->subFontArray[0];
+ subFontPtr = FindSubFontForChar(fontPtr, '0');
+ controlPtr = &fontPtr->controlSubFont;
+ controlPtr->fontStructPtr = subFontPtr->fontStructPtr;
+ controlPtr->familyPtr = &tsdPtr->controlFamily;
+ controlPtr->fontMap = tsdPtr->controlFamily.fontMap;
+
+ pageMap = fontPtr->subFontArray[0].fontMap[0];
+ for (i = 0; i < 256; i++) {
+ if ((minHi > 0) || (i < minLo) || (i > maxLo) ||
+ (((pageMap[i >> 3] >> (i & 7)) & 1) == 0)) {
+ n = 0;
+ } else if (fontStructPtr->per_char == NULL) {
+ n = fontStructPtr->max_bounds.width;
+ } else {
+ n = fontStructPtr->per_char[i - minLo].width;
+ }
+ fontPtr->widths[i] = n;
+ }
+
+
+ if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_POSITION, &value)) {
+ fontPtr->underlinePos = value;
+ } else {
+ /*
+ * If the XA_UNDERLINE_POSITION property does not exist, the X
+ * manual recommends using the following value:
+ */
+
+ fontPtr->underlinePos = fontStructPtr->descent / 2;
+ }
+ fontPtr->barHeight = 0;
+ if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_THICKNESS, &value)) {
+ fontPtr->barHeight = value;
+ }
+ if (fontPtr->barHeight == 0) {
+ /*
+ * If the XA_UNDERLINE_THICKNESS property does not exist, the X
+ * manual recommends using the width of the stem on a capital
+ * letter. I don't know of a way to get the stem width of a letter,
+ * 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;
+ }
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseFont --
+ *
+ * Called to release the unix-specific contents of a TkFont.
+ * The caller is responsible for freeing the memory used by the
+ * font itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseFont(fontPtr)
+ UnixFont *fontPtr; /* The font to delete. */
+{
+ int i;
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ ReleaseSubFont(fontPtr->display, &fontPtr->subFontArray[i]);
+ }
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * InitSubFont --
+ *
+ * Wrap a screen font and load the FontFamily that represents
+ * it. Used to prepare a SubFont so that characters can be mapped
+ * from UTF-8 to the charset of the font.
+ *
+ * Results:
+ * The subFontPtr is filled with information about the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+InitSubFont(display, fontStructPtr, base, subFontPtr)
+ Display *display; /* Display in which font will be used. */
+ XFontStruct *fontStructPtr; /* The screen font. */
+ int base; /* Non-zero if this SubFont is being used
+ * as the base font for a font object. */
+ SubFont *subFontPtr; /* Filled with SubFont constructed from
+ * above attributes. */
+{
+ subFontPtr->fontStructPtr = fontStructPtr;
+ subFontPtr->familyPtr = AllocFontFamily(display, fontStructPtr, base);
+ subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseSubFont --
+ *
+ * Called to release the contents of a SubFont. The caller is
+ * responsible for freeing the memory used by the SubFont itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseSubFont(display, subFontPtr)
+ Display *display; /* Display which owns screen font. */
+ SubFont *subFontPtr; /* The SubFont to delete. */
+{
+ XFreeFont(display, subFontPtr->fontStructPtr);
+ FreeFontFamily(subFontPtr->familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * AllocFontFamily --
+ *
+ * Find the FontFamily structure associated with the given font
+ * name. The information should be stored by the caller in a
+ * SubFont and used when determining if that SubFont supports a
+ * character.
+ *
+ * Cannot use the string name used to construct the font as the
+ * key, because the capitalization may not be canonical. Therefore
+ * use the face name actually retrieved from the font metrics as
+ * the key.
+ *
+ * Results:
+ * A pointer to a FontFamily. The reference count in the FontFamily
+ * is automatically incremented. When the SubFont is released, the
+ * reference count is decremented. When no SubFont is using this
+ * FontFamily, it may be deleted.
+ *
+ * Side effects:
+ * A new FontFamily structure will be allocated if this font family
+ * has not been seen. TrueType character existence metrics are
+ * loaded into the FontFamily structure.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static FontFamily *
+AllocFontFamily(display, fontStructPtr, base)
+ Display *display; /* Display in which font will be used. */
+ XFontStruct *fontStructPtr; /* Screen font whose FontFamily is to be
+ * returned. */
+ int base; /* Non-zero if this font family is to be
+ * used in the base font of a font object. */
+{
+ FontFamily *familyPtr;
+ FontAttributes fa;
+ Tcl_Encoding encoding;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ GetFontAttributes(display, fontStructPtr, &fa);
+ encoding = Tcl_GetEncoding(NULL, GetEncodingAlias(fa.xa.charset));
+
+ familyPtr = tsdPtr->fontFamilyList;
+ for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if ((familyPtr->faceName == fa.fa.family)
+ && (familyPtr->foundry == fa.xa.foundry)
+ && (familyPtr->encoding == encoding)) {
+ Tcl_FreeEncoding(encoding);
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
+
+ familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ memset(familyPtr, 0, sizeof(FontFamily));
+ familyPtr->nextPtr = tsdPtr->fontFamilyList;
+ tsdPtr->fontFamilyList = familyPtr;
+
+ /*
+ * Set key for this FontFamily.
+ */
+
+ familyPtr->foundry = fa.xa.foundry;
+ familyPtr->faceName = fa.fa.family;
+ familyPtr->encoding = encoding;
+
+ /*
+ * An initial refCount of 2 means that FontFamily information will
+ * persist even when the SubFont that loaded the FontFamily is released.
+ * Change it to 1 to cause FontFamilies to be unloaded when not in use.
+ */
+
+ familyPtr->refCount = 2;
+
+ /*
+ * One byte/character fonts have both min_byte1 and max_byte1 0,
+ * and max_char_or_byte2 <= 255.
+ * Anything else specifies a two byte/character font.
+ */
+
+ familyPtr->isTwoByteFont = !(
+ (fontStructPtr->min_byte1 == 0) &&
+ (fontStructPtr->max_byte1 == 0) &&
+ (fontStructPtr->max_char_or_byte2 < 256));
+ return familyPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FreeFontFamily --
+ *
+ * Called to free an FontFamily when the SubFont is finished using
+ * it. Frees the contents of the FontFamily and the memory used by
+ * the FontFamily itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FreeFontFamily(familyPtr)
+ FontFamily *familyPtr; /* The FontFamily to delete. */
+{
+ FontFamily **familyPtrPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int i;
+
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ Tcl_FreeEncoding(familyPtr->encoding);
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which screen font is necessary to use to
+ * display the given character. If the font object does not have
+ * a screen font that can display the character, another screen font
+ * may be loaded into the font object, following a set of preferred
+ * fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+FindSubFontForChar(fontPtr, ch)
+ UnixFont *fontPtr; /* The font object with which the character
+ * will be displayed. */
+ int ch; /* The Unicode character to be displayed. */
+{
+ int i, j, k, numNames;
+ Tk_Uid faceName;
+ char *fallback;
+ char **aliases, **nameList, **anyFallbacks;
+ char ***fontFallbacks;
+ SubFont *subFontPtr;
+ Tcl_DString ds;
+
+ if (FontMapLookup(&fontPtr->subFontArray[0], ch)) {
+ return &fontPtr->subFontArray[0];
+ }
+
+ for (i = 1; i < fontPtr->numSubFonts; i++) {
+ if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
+ return &fontPtr->subFontArray[i];
+ }
+ }
+
+ if (FontMapLookup(&fontPtr->controlSubFont, ch)) {
+ return &fontPtr->controlSubFont;
+ }
+
+ /*
+ * Keep track of all face names that we check, so we don't check some
+ * name multiple times if it can be reached by multiple paths.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ /*
+ * Are there any other fonts with the same face name as the base
+ * font that could display this character, e.g., if the base font
+ * is adobe:fixed:iso8859-1, we could might be able to use
+ * misc:fixed:iso8859-8 or sony:fixed:jisx0208.1983-0
+ */
+
+ faceName = fontPtr->font.fa.family;
+ if (SeenName(faceName, &ds) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ aliases = TkFontGetAliasList(faceName);
+
+ subFontPtr = NULL;
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(fallback, faceName) == 0) {
+ /*
+ * If the base font has a fallback...
+ */
+
+ goto tryfallbacks;
+ } else if (aliases != NULL) {
+ /*
+ * Or if an alias for the base font has a fallback...
+ */
+
+ for (k = 0; aliases[k] != NULL; k++) {
+ if (strcasecmp(fallback, aliases[k]) == 0) {
+ goto tryfallbacks;
+ }
+ }
+ }
+ }
+ continue;
+
+ tryfallbacks:
+
+ /*
+ * ...then see if we can use one of the fallbacks, or an
+ * alias for one of the fallbacks.
+ */
+
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ /*
+ * See if we can use something from the global fallback list.
+ */
+
+ anyFallbacks = TkFontGetGlobalClass();
+ for (i = 0; (fallback = anyFallbacks[i]) != NULL; i++) {
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * Try all face names available in the whole system until we
+ * find one that can be used.
+ */
+
+ nameList = ListFonts(fontPtr->display, "*", &numNames);
+ for (i = 0; i < numNames; i++) {
+ fallback = strchr(nameList[i] + 1, '-') + 1;
+ strchr(fallback, '-')[0] = '\0';
+ if (SeenName(fallback, &ds) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, fallback, ch);
+ if (subFontPtr != NULL) {
+ XFreeFontNames(nameList);
+ goto end;
+ }
+ }
+ }
+ XFreeFontNames(nameList);
+
+ end:
+ Tcl_DStringFree(&ds);
+
+ if (subFontPtr == NULL) {
+ /*
+ * No font can display this character, so it will be displayed as a
+ * control character expansion.
+ */
+
+ subFontPtr = &fontPtr->controlSubFont;
+ FontMapInsert(subFontPtr, ch);
+ }
+ return subFontPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLookup --
+ *
+ * See if the screen font can display the given character.
+ *
+ * Results:
+ * The return value is 0 if the screen font cannot display the
+ * character, non-zero otherwise.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FontMapLookup(subFontPtr, ch)
+ SubFont *subFontPtr; /* Contains font mapping cache to be queried
+ * and possibly updated. */
+ int ch; /* Character to be tested. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapInsert --
+ *
+ * Tell the font mapping cache that the given screen font should be
+ * used to display the specified character. This is called when no
+ * font on the system can be be found that can display that
+ * character; we lie to the font and tell it that it can display
+ * the character, otherwise we would end up re-searching the entire
+ * fallback hierarchy every time that character was seen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontMapInsert(subFontPtr, ch)
+ SubFont *subFontPtr; /* Contains font mapping cache to be
+ * updated. */
+ int ch; /* Character to be added to cache. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated screen font can (1) or cannot (0) display
+ * the characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(subFontPtr, row)
+ SubFont *subFontPtr; /* Contains font mapping cache to be
+ * updated. */
+ int row; /* Index of the page to be loaded into
+ * the cache. */
+{
+ char src[TCL_UTF_MAX], buf[16];
+ int minHi, maxHi, minLo, maxLo, scale, checkLo;
+ int i, end, bitOffset, isTwoByteFont, n;
+ Tcl_Encoding encoding;
+ XFontStruct *fontStructPtr;
+ XCharStruct *widths;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ if (subFontPtr->familyPtr == &tsdPtr->controlFamily) {
+ return;
+ }
+
+ fontStructPtr = subFontPtr->fontStructPtr;
+ encoding = subFontPtr->familyPtr->encoding;
+ isTwoByteFont = subFontPtr->familyPtr->isTwoByteFont;
+
+ widths = fontStructPtr->per_char;
+ minHi = fontStructPtr->min_byte1;
+ maxHi = fontStructPtr->max_byte1;
+ minLo = fontStructPtr->min_char_or_byte2;
+ maxLo = fontStructPtr->max_char_or_byte2;
+ scale = maxLo - minLo + 1;
+ checkLo = minLo;
+
+ if (! isTwoByteFont) {
+ if (minLo < 32) {
+ checkLo = 32;
+ }
+ }
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ int hi, lo;
+
+ if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src),
+ TCL_ENCODING_STOPONERROR, NULL, buf, sizeof(buf), NULL,
+ NULL, NULL) != TCL_OK) {
+ continue;
+ }
+ if (isTwoByteFont) {
+ hi = ((unsigned char *) buf)[0];
+ lo = ((unsigned char *) buf)[1];
+ } else {
+ hi = 0;
+ lo = ((unsigned char *) buf)[0];
+ }
+ if ((hi < minHi) || (hi > maxHi) || (lo < checkLo) || (lo > maxLo)) {
+ continue;
+ }
+ n = (hi - minHi) * scale + lo - minLo;
+ if ((widths == NULL) || ((widths[n].width + widths[n].rbearing) != 0)) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(fontPtr, faceName, ch, nameTriedPtr)
+ UnixFont *fontPtr; /* The font object that will own the new
+ * screen font. */
+ char *faceName; /* Desired face name for new screen font. */
+ int ch; /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr; /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ SubFont *subFontPtr;
+ char **aliases;
+ int i;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SeenName(name, dsPtr)
+ CONST char *name; /* The name to check. */
+ Tcl_DString *dsPtr; /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified screen font has not already been loaded
+ * into the font object, determine if the specified screen
+ * font can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont,
+ * owned by the font object. This SubFont can be used to display
+ * the given character. The SubFont represents the screen font
+ * with the base set of font attributes from the font object, but
+ * using the specified face name. NULL is returned if the font
+ * object already holds a reference to the specified font or if
+ * the specified font doesn't exist or cannot display the given
+ * character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(fontPtr, faceName, ch)
+ UnixFont *fontPtr; /* The font object that will own the new
+ * screen font. */
+ CONST char *faceName; /* Desired face name for new screen font. */
+ int ch; /* The Unicode character that the new
+ * screen font must be able to display. */
+{
+ int i, nameIdx, numNames, srcLen;
+ Tk_Uid hateFoundry;
+ int bestIdx[2];
+ CONST char *charset, *hateCharset;
+ unsigned int bestScore[2];
+ char **nameList, **nameListOrig;
+ FontAttributes want, got;
+ char src[TCL_UTF_MAX];
+ Display *display;
+ SubFont subFont;
+ XFontStruct *fontStructPtr;
+ Tcl_DString dsEncodings;
+ int numEncodings;
+ Tcl_Encoding *encodingCachePtr;
+
+ /*
+ * Assume: the face name is times.
+ * Assume: adobe:times:iso8859-1 has already been used.
+ *
+ * Are there any versions of times that can display this
+ * character (e.g., perhaps linotype:times:iso8859-2)?
+ * a. Get list of all times fonts.
+ * b1. Cross out all names whose encodings we've already used.
+ * b2. Cross out all names whose foundry & encoding we've already seen.
+ * c. Cross out all names whose encoding cannot handle the character.
+ * d. Rank each name and pick the best match.
+ * e. If that font cannot actually display the character, cross
+ * out all names with the same foundry and encoding and go
+ * back to (c).
+ */
+
+ display = fontPtr->display;
+ nameList = ListFonts(display, faceName, &numNames);
+ if (numNames == 0) {
+ return NULL;
+ }
+ nameListOrig = nameList;
+
+ srcLen = Tcl_UniCharToUtf(ch, src);
+
+ want.fa = fontPtr->font.fa;
+ want.xa = fontPtr->xa;
+
+ want.fa.family = Tk_GetUid(faceName);
+ want.fa.size = -fontPtr->pixelSize;
+
+ hateFoundry = NULL;
+ hateCharset = NULL;
+ numEncodings = 0;
+ Tcl_DStringInit(&dsEncodings);
+
+ charset = NULL; /* lint, since numNames must be > 0 to get here. */
+
+ retry:
+ bestIdx[0] = -1;
+ bestIdx[1] = -1;
+ bestScore[0] = (unsigned int) -1;
+ bestScore[1] = (unsigned int) -1;
+ for (nameIdx = 0; nameIdx < numNames; nameIdx++) {
+ Tcl_Encoding encoding;
+ char dst[16];
+ int scalable, srcRead, dstWrote;
+ unsigned int score;
+
+ if (nameList[nameIdx] == NULL) {
+ continue;
+ }
+ if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) {
+ goto crossout;
+ }
+ IdentifySymbolEncodings(&got);
+ charset = GetEncodingAlias(got.xa.charset);
+ if (hateFoundry != NULL) {
+ /*
+ * E. If the font we picked cannot actually display the
+ * character, cross out all names with the same foundry and
+ * encoding.
+ */
+
+ if ((hateFoundry == got.xa.foundry)
+ && (strcmp(hateCharset, charset) == 0)) {
+ goto crossout;
+ }
+ } else {
+ /*
+ * B. Cross out all names whose encodings we've already used.
+ */
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ encoding = fontPtr->subFontArray[i].familyPtr->encoding;
+ if (strcmp(charset, Tcl_GetEncodingName(encoding)) == 0) {
+ goto crossout;
+ }
+ }
+ }
+
+ /*
+ * C. Cross out all names whose encoding cannot handle the character.
+ */
+
+ encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings);
+ for (i = numEncodings; --i >= 0; encodingCachePtr++) {
+ encoding = *encodingCachePtr;
+ if (strcmp(Tcl_GetEncodingName(encoding), charset) == 0) {
+ break;
+ }
+ }
+ if (i < 0) {
+ encoding = Tcl_GetEncoding(NULL, charset);
+ if (encoding == NULL) {
+ goto crossout;
+ }
+
+ Tcl_DStringAppend(&dsEncodings, (char *) &encoding,
+ sizeof(encoding));
+ numEncodings++;
+ }
+ Tcl_UtfToExternal(NULL, encoding, src, srcLen,
+ TCL_ENCODING_STOPONERROR, NULL, dst, sizeof(dst), &srcRead,
+ &dstWrote, NULL);
+ if (dstWrote == 0) {
+ goto crossout;
+ }
+
+ /*
+ * D. Rank each name and pick the best match.
+ */
+
+ scalable = (got.fa.size == 0);
+ score = RankAttributes(&want, &got);
+ if (score <= bestScore[scalable]) {
+ bestIdx[scalable] = nameIdx;
+ bestScore[scalable] = score;
+ }
+ if (score == 0) {
+ break;
+ }
+ continue;
+
+ crossout:
+ if (nameList == nameListOrig) {
+ /*
+ * Not allowed to change pointers to memory that X gives you,
+ * so make a copy.
+ */
+
+ nameList = (char **) ckalloc(numNames * sizeof(char *));
+ memcpy(nameList, nameListOrig, numNames * sizeof(char *));
+ }
+ nameList[nameIdx] = NULL;
+ }
+
+ fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore);
+
+ encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings);
+ for (i = numEncodings; --i >= 0; encodingCachePtr++) {
+ Tcl_FreeEncoding(*encodingCachePtr);
+ }
+ Tcl_DStringFree(&dsEncodings);
+ numEncodings = 0;
+
+ if (fontStructPtr == NULL) {
+ if (nameList != nameListOrig) {
+ ckfree((char *) nameList);
+ }
+ XFreeFontNames(nameListOrig);
+ return NULL;
+ }
+
+ InitSubFont(display, fontStructPtr, 0, &subFont);
+ if (FontMapLookup(&subFont, ch) == 0) {
+ /*
+ * E. If the font we picked cannot actually display the character,
+ * cross out all names with the same foundry and encoding and pick
+ * another font.
+ */
+
+ hateFoundry = got.xa.foundry;
+ hateCharset = charset;
+ ReleaseSubFont(display, &subFont);
+ goto retry;
+ }
+ if (nameList != nameListOrig) {
+ ckfree((char *) nameList);
+ }
+ XFreeFontNames(nameListOrig);
+
+ if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
+ SubFont *newPtr;
+
+ newPtr = (SubFont *) ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1));
+ memcpy((char *) newPtr, fontPtr->subFontArray,
+ fontPtr->numSubFonts * sizeof(SubFont));
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+ fontPtr->subFontArray = newPtr;
+ }
+ fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
+ fontPtr->numSubFonts++;
+ return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * RankAttributes --
+ *
+ * Determine how close the attributes of the font in question match
+ * the attributes that we want.
+ *
+ * Results:
+ * The return value is the score; lower numbers are better.
+ * *scalablePtr is set to 0 if the font was not scalable, 1 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static unsigned int
+RankAttributes(wantPtr, gotPtr)
+ FontAttributes *wantPtr; /* The desired attributes. */
+ FontAttributes *gotPtr; /* The attributes we have to live with. */
+{
+ unsigned int penalty;
+
+ penalty = 0;
+ if (gotPtr->xa.foundry != wantPtr->xa.foundry) {
+ penalty += 4500;
+ }
+ if (gotPtr->fa.family != wantPtr->fa.family) {
+ penalty += 9000;
+ }
+ if (gotPtr->fa.weight != wantPtr->fa.weight) {
+ penalty += 90;
+ }
+ if (gotPtr->fa.slant != wantPtr->fa.slant) {
+ penalty += 60;
+ }
+ if (gotPtr->xa.slant != wantPtr->xa.slant) {
+ penalty += 10;
+ }
+ if (gotPtr->xa.setwidth != wantPtr->xa.setwidth) {
+ penalty += 1000;
+ }
+
+ if (gotPtr->fa.size == 0) {
+ /*
+ * A scalable font is almost always acceptable, but the
+ * corresponding bitmapped font would be better.
+ */
+
+ penalty += 10;
+ } else {
+ int diff;
+
+ /*
+ * It's worse to be too large than to be too small.
+ */
+
+ diff = (-gotPtr->fa.size - -wantPtr->fa.size);
+ if (diff > 0) {
+ penalty += 600;
+ } else if (diff < 0) {
+ penalty += 150;
+ diff = -diff;
+ }
+ penalty += 150 * diff;
+ }
+ if (gotPtr->xa.charset != wantPtr->xa.charset) {
+ int i;
+ CONST char *gotAlias, *wantAlias;
+
+ penalty += 65000;
+ gotAlias = GetEncodingAlias(gotPtr->xa.charset);
+ wantAlias = GetEncodingAlias(wantPtr->xa.charset);
+ if (strcmp(gotAlias, wantAlias) != 0) {
+ penalty += 30000;
+ for (i = 0; encodingList[i] != NULL; i++) {
+ if (strcmp(gotAlias, encodingList[i]) == 0) {
+ penalty -= 30000;
+ break;
+ }
+ penalty += 20000;
+ }
+ }
+ }
+ return penalty;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetScreenFont --
+ *
+ * Given the names for the best scalable and best bitmapped font,
+ * actually construct an XFontStruct based on the best XLFD.
+ * This is where all the alias and fallback substitution bottoms
+ * out.
+ *
+ * Results:
+ * The screen font that best corresponds to the set of attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static XFontStruct *
+GetScreenFont(display, wantPtr, nameList, bestIdx, bestScore)
+ Display *display; /* Display for new XFontStruct. */
+ FontAttributes *wantPtr; /* Contains desired actual pixel-size if the
+ * best font was scalable. */
+ char **nameList; /* Array of XLFDs. */
+ int bestIdx[2]; /* Indices into above array for XLFD of
+ * best bitmapped and best scalable font. */
+ unsigned int bestScore[2]; /* Scores of best bitmapped and best
+ * scalable font. XLFD corresponding to
+ * lowest score will be constructed. */
+{
+ XFontStruct *fontStructPtr;
+
+ if ((bestIdx[0] < 0) && (bestIdx[1] < 0)) {
+ return NULL;
+ }
+
+ /*
+ * Now we know which is the closest matching scalable font and the
+ * closest matching bitmapped font. If the scalable font was a
+ * better match, try getting the scalable font; however, if the
+ * scalable font was not actually available in the desired
+ * pointsize, fall back to the closest bitmapped font.
+ */
+
+ fontStructPtr = NULL;
+ if (bestScore[1] < bestScore[0]) {
+ char *str, *rest;
+ char buf[256];
+ int i;
+
+ /*
+ * Fill in the desired pixel size for this font.
+ */
+
+ tryscale:
+ str = nameList[bestIdx[1]];
+ for (i = 0; i < XLFD_PIXEL_SIZE; i++) {
+ str = strchr(str + 1, '-');
+ }
+ rest = str;
+ for (i = XLFD_PIXEL_SIZE; i < XLFD_CHARSET; i++) {
+ rest = strchr(rest + 1, '-');
+ }
+ *str = '\0';
+ sprintf(buf, "%.200s-%d-*-*-*-*-*%s", nameList[bestIdx[1]],
+ -wantPtr->fa.size, rest);
+ *str = '-';
+ fontStructPtr = XLoadQueryFont(display, buf);
+ bestScore[1] = INT_MAX;
+ }
+ if (fontStructPtr == NULL) {
+ fontStructPtr = XLoadQueryFont(display, nameList[bestIdx[0]]);
+ if (fontStructPtr == NULL) {
+ /*
+ * This shouldn't happen because the font name is one of the
+ * names that X gave us to use, but it does anyhow.
+ */
+
+ if (bestScore[1] < INT_MAX) {
+ goto tryscale;
+ }
+ return GetSystemFont(display);
+ }
+ }
+ return fontStructPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetSystemFont --
+ *
+ * Absolute fallback mechanism, called when we need a font and no
+ * other font can be found and/or instantiated.
+ *
+ * Results:
+ * A pointer to a font. Never NULL.
+ *
+ * Side effects:
+ * If there are NO fonts installed on the system, this call will
+ * panic, but how did you get X running in that case?
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static XFontStruct *
+GetSystemFont(display)
+ Display *display; /* Display for new XFontStruct. */
+{
+ XFontStruct *fontStructPtr;
+
+ fontStructPtr = XLoadQueryFont(display, "fixed");
+ if (fontStructPtr == NULL) {
+ fontStructPtr = XLoadQueryFont(display, "*");
+ if (fontStructPtr == NULL) {
+ panic("TkpGetFontFromAttributes: cannot get any font");
+ }
+ }
+ return fontStructPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetFontAttributes --
+ *
+ * Given a screen font, determine its actual attributes, which are
+ * not necessarily the attributes that were used to construct it.
+ *
+ * Results:
+ * *faPtr is filled with the screen font's attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetFontAttributes(display, fontStructPtr, faPtr)
+ Display *display; /* Display that owns the screen font. */
+ XFontStruct *fontStructPtr; /* Screen font to query. */
+ FontAttributes *faPtr; /* For storing attributes of screen font. */
+{
+ unsigned long value;
+ char *name;
+
+ if ((XGetFontProperty(fontStructPtr, XA_FONT, &value) != False) &&
+ (value != 0)) {
+ name = XGetAtomName(display, (Atom) value);
+ if (TkFontParseXLFD(name, &faPtr->fa, &faPtr->xa) != TCL_OK) {
+ faPtr->fa.family = Tk_GetUid(name);
+ faPtr->xa.foundry = Tk_GetUid("");
+ faPtr->xa.charset = Tk_GetUid("");
+ }
+ XFree(name);
+ } else {
+ TkInitFontAttributes(&faPtr->fa);
+ TkInitXLFDAttributes(&faPtr->xa);
+ faPtr->fa.family = Tk_GetUid("");
+ faPtr->xa.foundry = Tk_GetUid("");
+ faPtr->xa.charset = Tk_GetUid("");
+ }
+ return IdentifySymbolEncodings(faPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ListFonts --
+ *
+ * Utility function to return the array of all XLFDs on the system
+ * with the specified face name.
+ *
+ * Results:
+ * The return value is an array of XLFDs, which should be freed with
+ * XFreeFontNames(), or NULL if no XLFDs matched the requested name.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static char **
+ListFonts(display, faceName, numNamesPtr)
+ Display *display; /* Display to query. */
+ CONST char *faceName; /* Desired face name, or "*" for all. */
+ int *numNamesPtr; /* Filled with length of returned array, or
+ * 0 if no names were found. */
+{
+ char buf[256];
+
+ sprintf(buf, "-*-%.80s-*-*-*-*-*-*-*-*-*-*-*-*", faceName);
+ return XListFonts(display, buf, 10000, numNamesPtr);
+}
+
+static char **
+ListFontOrAlias(display, faceName, numNamesPtr)
+ Display *display; /* Display to query. */
+ CONST char *faceName; /* Desired face name, or "*" for all. */
+ int *numNamesPtr; /* Filled with length of returned array, or
+ * 0 if no names were found. */
+{
+ char **nameList, **aliases;
+ int i;
+
+ nameList = ListFonts(display, faceName, numNamesPtr);
+ if (nameList != NULL) {
+ return nameList;
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ nameList = ListFonts(display, aliases[i], numNamesPtr);
+ if (nameList != NULL) {
+ return nameList;
+ }
+ }
+ }
+ *numNamesPtr = 0;
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * IdentifySymbolEncodings --
+ *
+ * If the font attributes refer to a symbol font, update the
+ * charset field of the font attributes so that it reflects the
+ * encoding of that symbol font. In general, the raw value for
+ * the charset field parsed from an XLFD is meaningless for symbol
+ * fonts.
+ *
+ * Symbol fonts are all fonts whose name appears in the symbolClass.
+ *
+ * Results:
+ * The return value is non-zero if the font attributes specify a
+ * symbol font, or 0 otherwise. If a non-zero value is returned
+ * the charset field of the font attributes will be changed to
+ * the string that represents the actual encoding for the symbol font.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+IdentifySymbolEncodings(faPtr)
+ FontAttributes *faPtr;
+{
+ int i, j;
+ char **aliases, **symbolClass;
+
+ symbolClass = TkFontGetSymbolClass();
+ for (i = 0; symbolClass[i] != NULL; i++) {
+ if (strcasecmp(faPtr->fa.family, symbolClass[i]) == 0) {
+ faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(symbolClass[i]));
+ return 1;
+ }
+ aliases = TkFontGetAliasList(symbolClass[i]);
+ for (j = 0; (aliases != NULL) && (aliases[j] != NULL); j++) {
+ if (strcasecmp(faPtr->fa.family, aliases[j]) == 0) {
+ faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(aliases[j]));
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetEncodingAlias --
+ *
+ * Map the name of an encoding to another name that should be used
+ * when actually loading the encoding. For instance, the encodings
+ * "jisc6226.1978", "jisx0208.1983", "jisx0208.1990", and
+ * "jisx0208.1996" are well-known names for the same encoding and
+ * are represented by one encoding table: "jis0208".
+ *
+ * Results:
+ * As above. If the name has no alias, the original name is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static CONST char *
+GetEncodingAlias(name)
+ CONST char *name; /* The name to look up. */
+{
+ EncodingAlias *aliasPtr;
+
+ for (aliasPtr = encodingAliases; aliasPtr->aliasPattern != NULL; ) {
+ if (Tcl_StringMatch((char *) name, aliasPtr->aliasPattern)) {
+ return aliasPtr->realName;
+ }
+ aliasPtr++;
+ }
+ return name;
+}
+
+
diff --git a/tcl/unix/tkUnixInit.c b/tcl/unix/tkUnixInit.c
new file mode 100644
index 00000000000..be439986f98
--- /dev/null
+++ b/tcl/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 the interp's result.
+ *
+ * Side effects:
+ * Sets "tk_library" Tcl variable, runs "tk.tcl" script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(interp)
+ Tcl_Interp *interp;
+{
+ TkCreateXEventSource();
+ return Tcl_Eval(interp, initScript);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ CONST 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)
+ CONST char *msg; /* Message to be displayed. */
+ CONST char *title; /* Title of warning. */
+{
+ Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ if (errChannel) {
+ Tcl_WriteChars(errChannel, title, -1);
+ Tcl_WriteChars(errChannel, ": ", 2);
+ Tcl_WriteChars(errChannel, msg, -1);
+ Tcl_WriteChars(errChannel, "\n", 1);
+ }
+}
diff --git a/tcl/unix/tkUnixInt.h b/tcl/unix/tkUnixInt.h
new file mode 100644
index 00000000000..3b843984bf7
--- /dev/null
+++ b/tcl/unix/tkUnixInt.h
@@ -0,0 +1,29 @@
+/*
+ * tkUnixInt.h --
+ *
+ * This file contains declarations that are shared among the
+ * UNIX-specific parts of Tk but aren't used by the rest of
+ * Tk.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKUNIXINT
+#define _TKUNIXINT
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Prototypes for procedures that are referenced in files other
+ * than the ones they're defined in.
+ */
+#include "tkIntPlatDecls.h"
+
+#endif /* _TKUNIXINT */
diff --git a/tcl/unix/tkUnixKey.c b/tcl/unix/tkUnixKey.c
new file mode 100644
index 00000000000..42f3da2e98b
--- /dev/null
+++ b/tcl/unix/tkUnixKey.c
@@ -0,0 +1,413 @@
+/*
+ * tkUnixKey.c --
+ *
+ * This file contains routines for dealing with international keyboard
+ * input.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetCaretPos --
+ *
+ * This enables correct placement of the XIM caret. This is called
+ * by widgets to indicate their cursor placement, and the caret
+ * location is used by TkpGetString to place the XIM caret.
+ * This is currently only used for over-the-spot XIM.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetCaretPos(tkwin, x, y, height)
+ Tk_Window tkwin;
+ int x;
+ int y;
+ int height;
+{
+ TkCaret *caretPtr = &(((TkWindow *) tkwin)->dispPtr->caret);
+
+ /*
+ * Use height for best placement of the XIM over-the-spot box.
+ */
+
+ caretPtr->winPtr = ((TkWindow *) tkwin);
+ caretPtr->x = x;
+ caretPtr->y = y;
+ caretPtr->height = height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetString --
+ *
+ * Retrieve the UTF string associated with a keyboard event.
+ *
+ * Results:
+ * Returns the UTF string.
+ *
+ * Side effects:
+ * Stores the input string in the specified Tcl_DString. Modifies
+ * the internal input state. This routine can only be called
+ * once for a given event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkpGetString(winPtr, eventPtr, dsPtr)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ XEvent *eventPtr; /* X keyboard event. */
+ Tcl_DString *dsPtr; /* Uninitialized or empty string to hold
+ * result. */
+{
+ int len;
+ Tcl_DString buf;
+ Status status;
+#ifdef TK_USE_INPUT_METHODS
+ TkDisplay *dispPtr = winPtr->dispPtr;
+#endif
+
+ /*
+ * Overallocate the dstring to the maximum stack amount.
+ */
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1);
+
+#ifdef TK_USE_INPUT_METHODS
+ if ((dispPtr->flags & TK_DISPLAY_USE_IM)
+ && (winPtr->inputContext != NULL)
+ && (eventPtr->type == KeyPress)) {
+#if TK_XIM_SPOT
+ XVaNestedList preedit_attr;
+ XPoint spot;
+#endif
+
+ len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
+ Tcl_DStringValue(&buf), Tcl_DStringLength(&buf),
+ (KeySym *) NULL, &status);
+ /*
+ * If the buffer wasn't big enough, grow the buffer and try again.
+ */
+
+ if (status == XBufferOverflow) {
+ Tcl_DStringSetLength(&buf, len);
+ len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
+ Tcl_DStringValue(&buf), len, (KeySym *) NULL, &status);
+ }
+ if ((status != XLookupChars) && (status != XLookupBoth)) {
+ len = 0;
+ }
+
+#if TK_XIM_SPOT
+ /*
+ * Adjust the XIM caret position. We might want to check that
+ * this is the right caret.winPtr as well.
+ */
+ if (dispPtr->flags & TK_DISPLAY_XIM_SPOT) {
+ spot.x = dispPtr->caret.x;
+ spot.y = dispPtr->caret.y + dispPtr->caret.height;
+ preedit_attr = XVaCreateNestedList(0, XNSpotLocation, &spot, NULL);
+ XSetICValues(winPtr->inputContext,
+ XNPreeditAttributes, preedit_attr, NULL);
+ XFree(preedit_attr);
+ }
+#endif
+ } else {
+ len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf), (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+ }
+#else /* TK_USE_INPUT_METHODS */
+ len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf), (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+#endif /* TK_USE_INPUT_METHODS */
+ Tcl_DStringSetLength(&buf, len);
+
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buf), len, dsPtr);
+ Tcl_DStringFree(&buf);
+
+ return Tcl_DStringValue(dsPtr);
+}
+
+/*
+ * 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.
+ */
+
+void
+TkpSetKeycodeAndState(tkwin, keySym, eventPtr)
+ Tk_Window tkwin;
+ KeySym keySym;
+ XEvent *eventPtr;
+{
+ Display *display;
+ int state;
+ KeyCode keycode;
+
+ display = Tk_Display(tkwin);
+
+ if (keySym == NoSymbol) {
+ keycode = 0;
+ } else {
+ keycode = XKeysymToKeycode(display, keySym);
+ }
+ if (keycode != 0) {
+ for (state = 0; state < 4; state++) {
+ if (XKeycodeToKeysym(display, keycode, state) == keySym) {
+ if (state & 1) {
+ eventPtr->xkey.state |= ShiftMask;
+ }
+ if (state & 2) {
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ eventPtr->xkey.state |= dispPtr->modeModMask;
+ }
+ break;
+ }
+ }
+ }
+ eventPtr->xkey.keycode = keycode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetKeySym --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkpGetKeySym(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) {
+ TkpInitKeymapInfo(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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitKeymapInfo --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitKeymapInfo(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);
+}
diff --git a/tcl/unix/tkUnixMenu.c b/tcl/unix/tkUnixMenu.c
new file mode 100644
index 00000000000..dcfb533aeb6
--- /dev/null
+++ b/tcl/unix/tkUnixMenu.c
@@ -0,0 +1,1807 @@
+/*
+ * tkUnixMenu.c --
+ *
+ * This module implements the UNIX platform-specific features of menus.
+ *
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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
+ * the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information get set for mePtr; old resources
+ * get freed, if any need it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpConfigureMenuEntry(mePtr)
+ register TkMenuEntry *mePtr; /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+{
+ /*
+ * If this is a cascade menu, and the child menu exists, check to
+ * see if the child menu is a help menu.
+ */
+
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
+ TkMenuReferences *menuRefPtr;
+
+ menuRefPtr = TkFindMenuReferencesObj(mePtr->menuPtr->interp,
+ mePtr->namePtr);
+ if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) {
+ SetHelpMenu(menuRefPtr->menuPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ if (!mePtr->hideMargin && mePtr->indicatorOn) {
+ if ((mePtr->image != NULL) || (mePtr->bitmapPtr != NULL)) {
+ *widthPtr = (14 * mePtr->height) / 10;
+ *heightPtr = mePtr->height;
+ if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ mePtr->platformEntryData =
+ (TkMenuPlatformEntryData) ((65 * mePtr->height)
+ / 100);
+ } else {
+ mePtr->platformEntryData =
+ (TkMenuPlatformEntryData) ((75 * mePtr->height)
+ / 100);
+ }
+ } else {
+ *widthPtr = *heightPtr = mePtr->height;
+ if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ mePtr->platformEntryData = (TkMenuPlatformEntryData)
+ ((80 * mePtr->height) / 100);
+ } else {
+ mePtr->platformEntryData = (TkMenuPlatformEntryData)
+ mePtr->height;
+ }
+ }
+ } else {
+ int borderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ *heightPtr = 0;
+ *widthPtr = borderWidth;
+ }
+ } else {
+ int borderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ *heightPtr = 0;
+ *widthPtr = borderWidth;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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->accelPtr != NULL)) {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+
+ *widthPtr = Tk_TextWidth(tkfont, 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 == ENTRY_ACTIVE) {
+ int relief;
+ int activeBorderWidth;
+
+ bgBorder = activeBorder;
+
+ if ((menuPtr->menuType == MENUBAR)
+ && ((menuPtr->postedCascade == NULL)
+ || (menuPtr->postedCascade != mePtr))) {
+ relief = TK_RELIEF_FLAT;
+ } else {
+ relief = TK_RELIEF_RAISED;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
+ activeBorderWidth, relief);
+ } else {
+ Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
+ 0, TK_RELIEF_FLAT);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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];
+ int borderWidth, activeBorderWidth;
+
+ /*
+ * Draw accelerator or cascade arrow.
+ */
+
+ if (menuPtr->menuType == MENUBAR) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ if ((mePtr->type == CASCADE_ENTRY) && drawArrow) {
+ points[0].x = x + width - borderWidth - activeBorderWidth
+ - CASCADE_ARROW_WIDTH;
+ points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2;
+ points[1].x = points[0].x;
+ points[1].y = points[0].y + CASCADE_ARROW_HEIGHT;
+ points[2].x = points[0].x + CASCADE_ARROW_WIDTH;
+ points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2;
+ Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 3,
+ DECORATION_BORDER_WIDTH,
+ (menuPtr->postedCascade == mePtr)
+ ? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+ } else if (mePtr->accelPtr != NULL) {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ int left = x + mePtr->labelWidth + activeBorderWidth
+ + mePtr->indicatorSpace;
+
+ if (menuPtr->menuType == MENUBAR) {
+ left += 5;
+ }
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
+ mePtr->accelLength, left,
+ (y + (height + fmPtr->ascent - fmPtr->descent) / 2));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ int activeBorderWidth;
+ Tk_3DBorder border;
+
+ dim = (int) mePtr->platformEntryData;
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ left = x + activeBorderWidth + (mePtr->indicatorSpace - dim)/2;
+ if (menuPtr->menuType == MENUBAR) {
+ left += 5;
+ }
+ top = y + (height - dim)/2;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ menuPtr->borderPtr);
+ Tk_Fill3DRectangle(menuPtr->tkwin, d, border, left, top, dim,
+ dim, DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
+ left += DECORATION_BORDER_WIDTH;
+ top += DECORATION_BORDER_WIDTH;
+ dim -= 2*DECORATION_BORDER_WIDTH;
+ if ((dim > 0) && (mePtr->entryFlags
+ & ENTRY_SELECTED)) {
+ XFillRectangle(menuPtr->display, d, indicatorGC, left, top,
+ (unsigned int) dim, (unsigned int) dim);
+ }
+ }
+
+ /*
+ * Draw radio-button indicator.
+ */
+
+ if ((mePtr->type == RADIO_BUTTON_ENTRY) && mePtr->indicatorOn) {
+ XPoint points[4];
+ int radius;
+ Tk_3DBorder border;
+
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ menuPtr->borderPtr);
+ radius = ((int) mePtr->platformEntryData)/2;
+ points[0].x = x + (mePtr->indicatorSpace
+ - (int) mePtr->platformEntryData)/2;
+ points[0].y = y + (height)/2;
+ points[1].x = points[0].x + radius;
+ points[1].y = points[0].y + radius;
+ points[2].x = points[1].x + radius;
+ points[2].y = points[0].y;
+ points[3].x = points[1].x;
+ points[3].y = points[0].y - radius;
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ XFillPolygon(menuPtr->display, d, indicatorGC, points, 4,
+ Convex, CoordModeOrigin);
+ } else {
+ Tk_Fill3DPolygon(menuPtr->tkwin, d, border, points, 4,
+ DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT);
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 4,
+ DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuSeparator --
+ *
+ * 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];
+ Tk_3DBorder border;
+
+ if (menuPtr->menuType == MENUBAR) {
+ return;
+ }
+
+ points[0].x = x;
+ points[0].y = y + height/2;
+ points[1].x = width - 1;
+ points[1].y = points[0].y;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryLabel --
+ *
+ * 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, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
+ TkMenu *menuPtr; /* The menu we are drawing. */
+ TkMenuEntry *mePtr; /* The entry we are drawing. */
+ Drawable d; /* What we are drawing into. */
+ GC gc; /* The gc we are drawing into.*/
+ Tk_Font tkfont; /* The precalculated font. */
+ CONST Tk_FontMetrics *fmPtr;/* The precalculated font metrics. */
+ int x; /* Left edge. */
+ int y; /* Top edge. */
+ int width; /* width of entry. */
+ int height; /* height of entry. */
+{
+ int indicatorSpace = mePtr->indicatorSpace;
+ int activeBorderWidth;
+ int leftEdge;
+ int imageHeight, imageWidth;
+ int textHeight = 0, textWidth = 0; /* stop GCC warning */
+ int haveImage = 0, haveText = 0;
+ int imageXOffset = 0, imageYOffset = 0;
+ int textXOffset = 0, textYOffset = 0;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
+ if (menuPtr->menuType == MENUBAR) {
+ leftEdge += 5;
+ }
+
+ /*
+ * Work out what we will need to draw first.
+ */
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight);
+ haveImage = 1;
+ }
+ if (!haveImage || (mePtr->compound != COMPOUND_NONE)) {
+ if (mePtr->labelLength > 0) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
+ textHeight = fmPtr->linespace;
+ haveText = 1;
+ }
+ }
+
+ /*
+ * Now work out what the relative positions are.
+ */
+
+ if (haveImage && haveText) {
+ int fullWidth = (imageWidth > textWidth ? imageWidth : textWidth);
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = imageHeight/2 + 2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = -textHeight/2;
+ break;
+ }
+ case COMPOUND_BOTTOM: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = -imageHeight/2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = textHeight/2 + 2;
+ break;
+ }
+ case COMPOUND_LEFT: {
+ textXOffset = imageWidth + 2;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_RIGHT: {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = textWidth + 2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = 0;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ }
+
+ /*
+ * Draw label and/or bitmap or image for entry.
+ */
+
+ if (mePtr->image != NULL) {
+ if ((mePtr->selectImage != NULL)
+ && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ Tk_RedrawImage(mePtr->selectImage, 0, 0,
+ imageWidth, imageHeight, d, leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ } else {
+ Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
+ imageHeight, d, leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ }
+ } else if (mePtr->bitmapPtr != None) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0,
+ (unsigned) imageWidth, (unsigned) imageHeight,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset), 1);
+ }
+ if ((mePtr->compound != COMPOUND_NONE) || !haveImage) {
+ int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+ if (mePtr->labelLength > 0) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,
+ mePtr->labelLength, leftEdge + textXOffset,
+ baseline + textYOffset);
+ DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr,
+ x + textXOffset, y + textYOffset,
+ width, height);
+ }
+ }
+
+ if (mePtr->state == ENTRY_DISABLED) {
+ if (menuPtr->disabledFgPtr == NULL) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
+ (unsigned) width, (unsigned) height);
+ } else if ((mePtr->image != NULL)
+ && (menuPtr->disabledImageGC != None)) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
+ (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 activeBorderWidth;
+ int leftEdge;
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ CONST char *start = Tcl_UtfAtIndex(label, mePtr->underline);
+ CONST char *end = Tcl_UtfNext(start);
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
+ if (menuPtr->menuType == MENUBAR) {
+ leftEdge += 5;
+ }
+
+ Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, label,
+ leftEdge, y + (height + fmPtr->ascent - fmPtr->descent) / 2,
+ start - label, end - label);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPostMenu --
+ *
+ * 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, maxWidth;
+ int maxWindowWidth;
+ int lastRowBreak;
+ int helpMenuIndex = -1;
+ TkMenuEntry *mePtr;
+ int lastEntry;
+ Tk_Font menuFont;
+ int borderWidth;
+ int activeBorderWidth;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ maxWidth = 0;
+ if (menuPtr->numEntries == 0) {
+ height = 0;
+ } else {
+ int borderWidth;
+
+ maxWindowWidth = Tk_Width(menuPtr->tkwin);
+ if (maxWindowWidth == 1) {
+ maxWindowWidth = 0x7ffffff;
+ }
+ currentRowHeight = 0;
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ x = y = borderWidth;
+ lastRowBreak = 0;
+
+ /*
+ * On the Mac especially, getting font metrics can be quite slow,
+ * so we want to do it intelligently. We are going to precalculate
+ * them and pass them down to all of the measureing and drawing
+ * routines. We will measure the font metrics of the menu once,
+ * and if an entry has a font set, we will measure it as we come
+ * to it, and then we decide which set to give the geometry routines.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ mePtr->entryFlags &= ~ENTRY_LAST_COLUMN;
+ if (mePtr->fontPtr != NULL) {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ } else {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ }
+
+ /*
+ * For every entry, we need to check to see whether or not we
+ * wrap. If we do wrap, then we have to adjust all of the previous
+ * entries' height and y position, because when we see them
+ * the first time, we don't know how big its neighbor might
+ * be.
+ */
+
+ if ((mePtr->type == SEPARATOR_ENTRY)
+ || (mePtr->type == TEAROFF_ENTRY)) {
+ mePtr->height = mePtr->width = 0;
+ } else {
+ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width, &height);
+ mePtr->height = height + 2 * activeBorderWidth + 10;
+ mePtr->width = width;
+
+ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr,
+ &width, &height);
+ mePtr->indicatorSpace = width;
+ if (width > 0) {
+ mePtr->width += width;
+ }
+ mePtr->width += 2 * activeBorderWidth + 10;
+ }
+ if (mePtr->entryFlags & ENTRY_HELP_MENU) {
+ helpMenuIndex = i;
+ } else if (x + mePtr->width + borderWidth > maxWindowWidth) {
+
+ if (i == lastRowBreak) {
+ mePtr->y = y;
+ mePtr->x = x;
+ lastRowBreak++;
+ y += mePtr->height;
+ currentRowHeight = 0;
+ } else {
+ x = borderWidth;
+ for (j = lastRowBreak; j < i; j++) {
+ menuPtr->entries[j]->y = y + currentRowHeight
+ - menuPtr->entries[j]->height;
+ menuPtr->entries[j]->x = x;
+ x += menuPtr->entries[j]->width;
+ }
+ lastRowBreak = i;
+ y += currentRowHeight;
+ currentRowHeight = mePtr->height;
+ }
+ if (x > maxWidth) {
+ maxWidth = x;
+ }
+ x = borderWidth;
+ } else {
+ x += mePtr->width;
+ if (mePtr->height > currentRowHeight) {
+ currentRowHeight = mePtr->height;
+ }
+ }
+ }
+
+ lastEntry = menuPtr->numEntries - 1;
+ if (helpMenuIndex == lastEntry) {
+ lastEntry--;
+ }
+ if ((lastEntry >= 0) && (x + menuPtr->entries[lastEntry]->width
+ + borderWidth > maxWidth)) {
+ maxWidth = x + menuPtr->entries[lastEntry]->width + borderWidth;
+ }
+ x = borderWidth;
+ for (j = lastRowBreak; j < menuPtr->numEntries; j++) {
+ if (j == helpMenuIndex) {
+ continue;
+ }
+ menuPtr->entries[j]->y = y + currentRowHeight
+ - menuPtr->entries[j]->height;
+ menuPtr->entries[j]->x = x;
+ x += menuPtr->entries[j]->width;
+ }
+
+
+ if (helpMenuIndex != -1) {
+ mePtr = menuPtr->entries[helpMenuIndex];
+ if (x + mePtr->width + borderWidth > maxWindowWidth) {
+ y += currentRowHeight;
+ currentRowHeight = mePtr->height;
+ x = borderWidth;
+ } else if (mePtr->height > currentRowHeight) {
+ currentRowHeight = mePtr->height;
+ }
+ mePtr->x = maxWindowWidth - borderWidth - mePtr->width;
+ mePtr->y = y + currentRowHeight - mePtr->height;
+ }
+ height = y + currentRowHeight + borderWidth;
+ }
+ width = Tk_Width(menuPtr->tkwin);
+
+ /*
+ * The X server doesn't like zero dimensions, so round up to at least
+ * 1 (a zero-sized menu should never really occur, anyway).
+ */
+
+ 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 segmentWidth, maxX;
+ Tk_3DBorder border;
+
+ if (menuPtr->menuType != MASTER_MENU) {
+ return;
+ }
+
+ points[0].x = x;
+ points[0].y = y + height/2;
+ points[1].y = points[0].y;
+ segmentWidth = 6;
+ maxX = width - 1;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+
+ while (points[0].x < maxX) {
+ points[1].x = points[0].x + segmentWidth;
+ if (points[1].x > maxX) {
+ points[1].x = maxX;
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+ points[0].x += 2 * segmentWidth;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 == ENTRY_ACTIVE) && !strictMotif) {
+ gc = mePtr->activeGC;
+ if (gc == NULL) {
+ gc = menuPtr->activeGC;
+ }
+ } else {
+ TkMenuEntry *cascadeEntryPtr;
+ int parentDisabled = 0;
+
+ for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr->namePtr != NULL) {
+ char *name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr,
+ NULL);
+
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
+ if (cascadeEntryPtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+ }
+
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
+ gc = mePtr->disabledGC;
+ if (gc == NULL) {
+ gc = menuPtr->disabledGC;
+ }
+ } else {
+ gc = mePtr->textGC;
+ if (gc == NULL) {
+ gc = menuPtr->textGC;
+ }
+ }
+ }
+ indicatorGC = mePtr->indicatorGC;
+ if (indicatorGC == NULL) {
+ indicatorGC = menuPtr->indicatorGC;
+ }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL)
+ ? menuPtr->borderPtr : mePtr->borderPtr);
+ if (strictMotif) {
+ activeBorder = bgBorder;
+ } else {
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL)
+ ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
+ }
+
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = menuMetricsPtr;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ /*
+ * Need to draw the entire background, including padding. On Unix,
+ * for menubars, we have to draw the rest of the entry taking
+ * 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;
+ int haveImage = 0;
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
+ haveImage = 1;
+ } else {
+ *heightPtr = 0;
+ *widthPtr = 0;
+ }
+
+ if (haveImage && (mePtr->compound == COMPOUND_NONE)) {
+ /* We don't care about the text in this case */
+ } else {
+ /* Either it is compound or we don't have an image */
+ if (mePtr->labelPtr != NULL) {
+ int textWidth;
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
+
+ if ((mePtr->compound != COMPOUND_NONE) && haveImage) {
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ /* Add text and padding */
+ *heightPtr += fmPtr->linespace + 2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ /* Add text and padding */
+ *widthPtr += textWidth + 2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ /* We don't have an image or we're not compound */
+ *heightPtr = fmPtr->linespace;
+ *widthPtr = textWidth;
+ }
+ } else {
+ /* An empty entry still has this height */
+ *heightPtr = fmPtr->linespace;
+ }
+ }
+ *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, menuFont;
+ Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
+ int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
+ int windowWidth, windowHeight, accelSpace;
+ int i, j, lastColumnBreak = 0;
+ TkMenuEntry *mePtr;
+ int borderWidth, activeBorderWidth;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ x = y = borderWidth;
+ indicatorSpace = labelWidth = accelWidth = 0;
+ windowHeight = windowWidth = 0;
+
+ /*
+ * On the Mac especially, getting font metrics can be quite slow,
+ * so we want to do it intelligently. We are going to precalculate
+ * them and pass them down to all of the measuring and drawing
+ * routines. We will measure the font metrics of the menu once.
+ * If an entry does not have its own font set, then we give
+ * the geometry/drawing routines the menu's font and metrics.
+ * If an entry has its own font, we will measure that font and
+ * give all of the geometry/drawing the entry's font and metrics.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+ accelSpace = Tk_TextWidth(menuFont, "M", 1);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mePtr->fontPtr == NULL) {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ if ((i > 0) && mePtr->columnBreak) {
+ if (accelWidth != 0) {
+ labelWidth += accelSpace;
+ }
+ for (j = lastColumnBreak; j < i; j++) {
+ menuPtr->entries[j]->indicatorSpace = indicatorSpace;
+ menuPtr->entries[j]->labelWidth = labelWidth;
+ menuPtr->entries[j]->width = indicatorSpace + labelWidth
+ + accelWidth + 2 * activeBorderWidth;
+ menuPtr->entries[j]->x = x;
+ menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
+ }
+ x += indicatorSpace + labelWidth + accelWidth
+ + 2 * activeBorderWidth;
+ windowWidth = x;
+ indicatorSpace = labelWidth = accelWidth = 0;
+ lastColumnBreak = i;
+ y = borderWidth;
+ }
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ mePtr->height = height;
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ 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 * activeBorderWidth + MENU_DIVIDER_HEIGHT;
+ }
+ mePtr->y = y;
+ y += mePtr->height;
+ if (y > windowHeight) {
+ windowHeight = y;
+ }
+ }
+
+ if (accelWidth != 0) {
+ labelWidth += accelSpace;
+ }
+ for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
+ menuPtr->entries[j]->indicatorSpace = indicatorSpace;
+ menuPtr->entries[j]->labelWidth = labelWidth;
+ menuPtr->entries[j]->width = indicatorSpace + labelWidth
+ + accelWidth + 2 * activeBorderWidth;
+ menuPtr->entries[j]->x = x;
+ menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
+ }
+ windowWidth = x + indicatorSpace + labelWidth + accelWidth
+ + 2 * activeBorderWidth + 2 * borderWidth;
+
+
+ windowHeight += borderWidth;
+
+ /*
+ * The X server doesn't like zero dimensions, so round up to at least
+ * 1 (a zero-sized menu should never really occur, anyway).
+ */
+
+ if (windowWidth <= 0) {
+ 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.
+ */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuThreadInit --
+ *
+ * Does platform-specific initialization of thread-specific
+ * menu state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuThreadInit()
+{
+ /*
+ * Nothing to do.
+ */
+}
+
diff --git a/tcl/unix/tkUnixMenubu.c b/tcl/unix/tkUnixMenubu.c
new file mode 100644
index 00000000000..a38040db2e2
--- /dev/null
+++ b/tcl/unix/tkUnixMenubu.c
@@ -0,0 +1,448 @@
+/*
+ * 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.
+ */
+
+Tk_ClassProcs tkpMenubuttonClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkMenuButtonWorldChanged, /* worldChangedProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = 0;
+ register Tk_Window tkwin = mbPtr->tkwin;
+ int width, height, fullWidth, fullHeight;
+ int imageXOffset, imageYOffset, textXOffset, textYOffset;
+ int haveImage = 0, haveText = 0;
+
+ mbPtr->flags &= ~REDRAW_PENDING;
+ if ((mbPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) {
+ gc = mbPtr->disabledGC;
+ border = mbPtr->normalBorder;
+ } else if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
+ gc = mbPtr->activeTextGC;
+ border = mbPtr->activeBorder;
+ } else {
+ gc = mbPtr->normalTextGC;
+ border = mbPtr->normalBorder;
+ }
+
+ if (mbPtr->image != None) {
+ Tk_SizeOfImage(mbPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+ haveText = (mbPtr->textWidth != 0 && mbPtr->textHeight != 0);
+
+ /*
+ * 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);
+
+ imageXOffset = 0;
+ imageYOffset = 0;
+ textXOffset = 0;
+ textYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+
+ switch ((enum compound) mbPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (mbPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + mbPtr->padY;
+ } else {
+ imageYOffset = mbPtr->textHeight + mbPtr->padY;
+ }
+ fullHeight = height + mbPtr->textHeight + mbPtr->padY;
+ fullWidth = (width > mbPtr->textWidth ? width :
+ mbPtr->textWidth);
+ textXOffset = (fullWidth - mbPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ if (mbPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + mbPtr->padX;
+ } else {
+ imageXOffset = mbPtr->textWidth + mbPtr->padX;
+ }
+ fullWidth = mbPtr->textWidth + mbPtr->padX + width;
+ fullHeight = (height > mbPtr->textHeight ? height :
+ mbPtr->textHeight);
+ textYOffset = (fullHeight - mbPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ fullWidth = (width > mbPtr->textWidth ? width :
+ mbPtr->textWidth);
+ fullHeight = (height > mbPtr->textHeight ? height :
+ mbPtr->textHeight);
+ textXOffset = (fullWidth - mbPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - mbPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ mbPtr->indicatorWidth + fullWidth, fullHeight,
+ &x, &y);
+
+ if (mbPtr->image != NULL) {
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap,
+ x + imageXOffset, y + imageYOffset);
+ }
+ if (mbPtr->bitmap != None) {
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap,
+ gc, 0, 0, (unsigned) width, (unsigned) height,
+ x + imageXOffset, y + imageYOffset, 1);
+ }
+ if (haveText) {
+ Tk_DrawTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout,
+ x + textXOffset, y + textYOffset ,
+ 0, -1);
+ Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc,
+ mbPtr->textLayout, x + textXOffset, y + textYOffset ,
+ mbPtr->underline);
+ }
+ } else {
+ if (mbPtr->image != NULL) {
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap,
+ x + imageXOffset, y + imageYOffset);
+ } else if (mbPtr->bitmap != None) {
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap,
+ gc, 0, 0, (unsigned) width, (unsigned) height,
+ x + imageXOffset, y + imageYOffset, 1);
+ } 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 + textXOffset, y + textYOffset ,
+ 0, -1);
+ Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc,
+ mbPtr->textLayout, x + textXOffset, y + textYOffset ,
+ mbPtr->underline);
+ }
+ }
+
+ /*
+ * If the menu button is disabled with a stipple rather than a special
+ * foreground color, generate the stippled effect.
+ */
+
+ if ((mbPtr->state == STATE_DISABLED)
+ && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) {
+ XFillRectangle(mbPtr->display, pixmap, mbPtr->disabledGC,
+ mbPtr->inset, mbPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset));
+ }
+
+ /*
+ * 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)
+ TkMenuButton *mbPtr; /* Widget record for menu button. */
+{
+ int width, height, mm, pixels;
+ int avgWidth, txtWidth, txtHeight;
+ int haveImage = 0, haveText = 0;
+ Tk_FontMetrics fm;
+
+ mbPtr->inset = mbPtr->highlightWidth + mbPtr->borderWidth;
+
+ width = 0;
+ height = 0;
+ txtWidth = 0;
+ txtHeight = 0;
+ avgWidth = 0;
+
+ if (mbPtr->image != None) {
+ Tk_SizeOfImage(mbPtr->image, &width, &height);
+ haveImage = 1;
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+
+ if (haveImage == 0 || mbPtr->compound != COMPOUND_NONE) {
+ Tk_FreeTextLayout(mbPtr->textLayout);
+
+ mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->text,
+ -1, mbPtr->wrapLength, mbPtr->justify, 0, &mbPtr->textWidth,
+ &mbPtr->textHeight);
+ txtWidth = mbPtr->textWidth;
+ txtHeight = mbPtr->textHeight;
+ avgWidth = Tk_TextWidth(mbPtr->tkfont, "0", 1);
+ Tk_GetFontMetrics(mbPtr->tkfont, &fm);
+ haveText = (txtWidth != 0 && txtHeight != 0);
+ }
+
+ /*
+ * If the menubutton is compound (ie, it shows both an image and text),
+ * the new geometry is a combination of the image and text geometry.
+ * We only honor the compound bit if the menubutton has both text and
+ * an image, because otherwise it is not really a compound menubutton.
+ */
+
+ if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) mbPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ height += txtHeight + mbPtr->padY;
+ width = (width > txtWidth ? width : txtWidth);
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ width += txtWidth + mbPtr->padX;
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ width = (width > txtWidth ? width : txtWidth);
+ height = (height > txtHeight ? height : txtHeight);
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ if (mbPtr->width > 0) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ width += 2*mbPtr->padX;
+ height += 2*mbPtr->padY;
+ } else {
+ if (haveImage) {
+ if (mbPtr->width > 0) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ } else {
+ width = txtWidth;
+ height = txtHeight;
+ if (mbPtr->width > 0) {
+ width = mbPtr->width * avgWidth;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height * fm.linespace;
+ }
+ }
+ }
+
+ if (! haveImage) {
+ 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/tcl/unix/tkUnixPort.h b/tcl/unix/tkUnixPort.h
new file mode 100644
index 00000000000..1ea655dfe06
--- /dev/null
+++ b/tcl/unix/tkUnixPort.h
@@ -0,0 +1,227 @@
+/*
+ * tkUnixPort.h --
+ *
+ * This file is included by all of the Tk C files. It contains
+ * information that may be configuration-dependent, such as
+ * #includes for system include files and a few other things.
+ *
+ * Copyright (c) 1991-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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
+#include <string.h>
+#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 TkSubtractRegion(a, b, r) XSubtractRegion((Region) a, \
+ (Region) b, (Region) r)
+#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.
+ */
+
+
+/*
+ * These functions do nothing under Unix, so we just eliminate calls to them.
+ */
+
+#define TkpButtonSetDefaults(specPtr) {}
+#define TkpDestroyButton(butPtr) {}
+#define TkSelUpdateClipboard(a,b) {}
+#define TkSetPixmapColormap(p,c) {}
+
+/*
+ * These calls implement native bitmaps which are not supported under
+ * UNIX. The macros eliminate the calls.
+ */
+
+#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.
+ * This should perhaps use the real size of an XID.
+ */
+
+#define TkpPrintWindowId(buf,w) \
+ sprintf((buf), "%#08lx", (unsigned long) (w))
+
+/*
+ * 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.
+ */
+
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
+
+#endif /* _UNIXPORT */
diff --git a/tcl/unix/tkUnixScale.c b/tcl/unix/tkUnixScale.c
new file mode 100644
index 00000000000..455607e0ea5
--- /dev/null
+++ b/tcl/unix/tkUnixScale.c
@@ -0,0 +1,698 @@
+/*
+ * tkUnixScale.c --
+ *
+ * This file implements the X specific portion of the scrollbar
+ * widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 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 "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. It's necessary to do this with
+ * Tcl_EventuallyFree to allow the Tcl_Preserve(scalePtr) to work
+ * as expected in TkpDisplayScale. (hobbs)
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScale(scalePtr)
+ TkScale *scalePtr;
+{
+ Tcl_EventuallyFree((ClientData) scalePtr, TCL_DYNAMIC);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, tickInterval = scalePtr->tickInterval;
+ 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 (tickInterval != 0) {
+ double ticks, maxTicks;
+
+ /*
+ * Ensure that we will only draw enough of the tick values
+ * such that they don't overlap
+ */
+ ticks = fabs((scalePtr->toValue - scalePtr->fromValue)
+ / tickInterval);
+ maxTicks = (double) Tk_Height(tkwin)
+ / (double) scalePtr->fontHeight;
+ if (ticks > maxTicks) {
+ tickInterval *= (ticks / maxTicks);
+ }
+ for (tickValue = scalePtr->fromValue; ;
+ tickValue += 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 == STATE_ACTIVE) {
+ sliderBorder = scalePtr->activeBorder;
+ } else {
+ sliderBorder = scalePtr->bgBorder;
+ }
+ width = scalePtr->width;
+ height = scalePtr->sliderLength/2;
+ x = scalePtr->vertTroughX + scalePtr->borderWidth;
+ y = TkScaleValueToPixel(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 = TkScaleValueToPixel(scalePtr, value) + fm.ascent/2;
+ sprintf(valueString, scalePtr->format, value);
+ length = (int) 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, tickInterval = scalePtr->tickInterval;
+ 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 (tickInterval != 0) {
+ char valueString[PRINT_CHARS];
+ double ticks, maxTicks;
+
+ /*
+ * Ensure that we will only draw enough of the tick values
+ * such that they don't overlap. We base this off the width that
+ * fromValue would take. Not exact, but better than no constraint.
+ */
+ ticks = fabs((scalePtr->toValue - scalePtr->fromValue)
+ / tickInterval);
+ sprintf(valueString, scalePtr->format, scalePtr->fromValue);
+ maxTicks = (double) Tk_Width(tkwin)
+ / (double) Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+ if (ticks > maxTicks) {
+ tickInterval *= (ticks / maxTicks);
+ }
+ for (tickValue = scalePtr->fromValue; ;
+ tickValue += 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 == STATE_ACTIVE) {
+ sliderBorder = scalePtr->activeBorder;
+ } else {
+ sliderBorder = scalePtr->bgBorder;
+ }
+ width = scalePtr->sliderLength/2;
+ height = scalePtr->width;
+ x = TkScaleValueToPixel(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 = TkScaleValueToPixel(scalePtr, value);
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ y = top + fm.ascent;
+ sprintf(valueString, scalePtr->format, value);
+ length = (int) 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;
+
+ scalePtr->flags &= ~REDRAW_PENDING;
+ 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->flags & SCALE_DELETED) {
+ 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->orient == ORIENT_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(
+ Tk_3DBorderColor(scalePtr->highlightBorder), 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->orient == ORIENT_VERTICAL) {
+ if ((x < scalePtr->vertTroughX)
+ || (x >= (scalePtr->vertTroughX + 2*scalePtr->borderWidth +
+ scalePtr->width))) {
+ return OTHER;
+ }
+ if ((y < scalePtr->inset)
+ || (y >= (Tk_Height(scalePtr->tkwin) - scalePtr->inset))) {
+ return OTHER;
+ }
+ sliderFirst = TkScaleValueToPixel(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 = TkScaleValueToPixel(scalePtr, scalePtr->value)
+ - scalePtr->sliderLength/2;
+ if (x < sliderFirst) {
+ return TROUGH1;
+ }
+ if (x < (sliderFirst+scalePtr->sliderLength)) {
+ return SLIDER;
+ }
+ return TROUGH2;
+}
diff --git a/tcl/unix/tkUnixScrlbr.c b/tcl/unix/tkUnixScrlbr.c
new file mode 100644
index 00000000000..c2e7239c146
--- /dev/null
+++ b/tcl/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. All fields except
+ * size are left initialized to NULL, which should happen automatically
+ * since the variable is declared at this scope.
+ */
+
+Tk_ClassProcs tkpScrollbarProcs = {
+ sizeof(Tk_ClassProcs) /* size */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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/tcl/unix/tkUnixSelect.c b/tcl/unix/tkUnixSelect.c
new file mode 100644
index 00000000000..8971f056a3e
--- /dev/null
+++ b/tcl/unix/tkUnixSelect.c
@@ -0,0 +1,1545 @@
+/*
+ * tkUnixSelect.c --
+ *
+ * This file contains X specific routines for manipulating
+ * selections.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+typedef struct ConvertInfo {
+ int offset; /* The starting byte offset into the selection
+ * for the next chunk; -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. */
+ Tcl_EncodingState state; /* The encoding state needed across chunks. */
+ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character
+ * that is split across chunks.*/
+} ConvertInfo;
+
+/*
+ * 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 converts (same as
+ * # of pairs in multAtoms). */
+ ConvertInfo *converts; /* One entry for each pair in multAtoms.
+ * This array is malloc-ed. */
+ char **tempBufs; /* One pointer for each pair in multAtoms;
+ * each pointer is either NULL, or it points
+ * to a small bit of character data that was
+ * left over from the previous chunk. */
+ Tcl_EncodingState *state; /* One state info per pair in multAtoms:
+ * State info for encoding conversions
+ * that span multiple buffers. */
+ int *flags; /* One state flag per pair in multAtoms:
+ * Encoding flags, set to TCL_ENCODING_START
+ * at the beginning of an INCR transfer. */
+ int numIncrs; /* Number of entries in converts 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;
+
+
+typedef struct ThreadSpecificData {
+ IncrInfo *pendingIncrs; /* List of all incr structures
+ * currently active. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Largest property that we'll accept when sending or receiving the
+ * selection:
+ */
+
+#define MAX_PROP_WORDS 100000
+
+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 the interp's 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.encFlags = TCL_ENCODING_START;
+ retr.nextPtr = pendingRetrievals;
+ Tcl_DStringInit(&retr.buf);
+ 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;
+ }
+ }
+ }
+ Tcl_DStringFree(&retr.buf);
+ 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, length, numItems, flags;
+ Tcl_Encoding encoding;
+ int srcLen, dstLen, result, srcRead, dstWrote, soFar;
+ Tcl_DString ds;
+ char *src, *dst;
+ Atom target, formatType;
+ register TkSelHandler *selPtr;
+ long buffer[TK_SEL_WORDS_AT_ONCE];
+ char *propPtr;
+ TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display);
+ Tk_ErrorHandler errorHandler;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * See if this event announces the deletion of a property being
+ * used for an INCR transfer. If so, then add the next chunk of
+ * data to the property.
+ */
+
+ if (eventPtr->xproperty.state != PropertyDelete) {
+ return;
+ }
+ for (incrPtr = tsdPtr->pendingIncrs; incrPtr != NULL;
+ incrPtr = incrPtr->nextPtr) {
+ if (incrPtr->reqWindow != eventPtr->xproperty.window) {
+ continue;
+ }
+
+ /*
+ * For each conversion that has been requested, handle any
+ * chunks that haven't been transmitted yet.
+ */
+
+ for (i = 0; i < incrPtr->numConversions; i++) {
+ if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
+ || (incrPtr->converts[i].offset == -1)) {
+ continue;
+ }
+ target = incrPtr->multAtoms[2*i];
+ incrPtr->idleTime = 0;
+
+ /*
+ * Look for a matching selection handler.
+ */
+
+ for (selPtr = incrPtr->winPtr->selHandlerList; ;
+ selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ /*
+ * No handlers match, so mark the conversion as done.
+ */
+
+ incrPtr->multAtoms[2*i + 1] = None;
+ incrPtr->converts[i].offset = -1;
+ incrPtr->numIncrs --;
+ return;
+ }
+ if ((selPtr->target == target)
+ && (selPtr->selection == incrPtr->selection)) {
+ break;
+ }
+ }
+
+ /*
+ * We found a handler, so get the next chunk from it.
+ */
+
+ formatType = selPtr->format;
+ if (incrPtr->converts[i].offset == -2) {
+ /*
+ * We already got the last chunk, so send a null chunk
+ * to indicate that we are finished.
+ */
+
+ numItems = 0;
+ length = 0;
+ } else {
+ TkSelInProgress ip;
+ ip.selPtr = selPtr;
+ ip.nextPtr = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
+
+ /*
+ * Copy any bytes left over from a partial character at the end
+ * of the previous chunk into the beginning of the buffer.
+ * Pass the rest of the buffer space into the selection
+ * handler.
+ */
+
+ length = strlen(incrPtr->converts[i].buffer);
+ strcpy((char *)buffer, incrPtr->converts[i].buffer);
+
+ numItems = (*selPtr->proc)(selPtr->clientData,
+ incrPtr->converts[i].offset,
+ ((char *) buffer) + length,
+ TK_SEL_BYTES_AT_ONCE - length);
+ TkSelSetInProgress(ip.nextPtr);
+ if (ip.selPtr == NULL) {
+ /*
+ * The selection handler deleted itself.
+ */
+
+ return;
+ }
+ if (numItems < 0) {
+ numItems = 0;
+ }
+ numItems += length;
+ if (numItems > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ }
+ ((char *) buffer)[numItems] = 0;
+
+ /*
+ * Encode the data using the proper format for each type.
+ */
+
+ if ((formatType == XA_STRING)
+ || (dispPtr
+ && (formatType == dispPtr->compoundTextAtom))) {
+ /*
+ * Set up the encoding state based on the format and whether
+ * this is the first and/or last chunk.
+ */
+
+ flags = 0;
+ if (incrPtr->converts[i].offset == 0) {
+ flags |= TCL_ENCODING_START;
+ }
+ if (numItems < TK_SEL_BYTES_AT_ONCE) {
+ flags |= TCL_ENCODING_END;
+ }
+ if (formatType == XA_STRING) {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ }
+
+ /*
+ * Now convert the data.
+ */
+
+ src = (char *)buffer;
+ srcLen = numItems;
+ Tcl_DStringInit(&ds);
+ dst = Tcl_DStringValue(&ds);
+ dstLen = ds.spaceAvl - 1;
+
+
+ /*
+ * Now convert the data, growing the destination buffer
+ * as needed.
+ */
+
+ while (1) {
+ result = Tcl_UtfToExternal(NULL, encoding,
+ src, srcLen, flags,
+ &incrPtr->converts[i].state,
+ dst, dstLen, &srcRead, &dstWrote, NULL);
+ soFar = dst + dstWrote - Tcl_DStringValue(&ds);
+ flags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (result != TCL_CONVERT_NOSPACE) {
+ Tcl_DStringSetLength(&ds, soFar);
+ break;
+ }
+ if (Tcl_DStringLength(&ds) == 0) {
+ Tcl_DStringSetLength(&ds, dstLen);
+ }
+ Tcl_DStringSetLength(&ds,
+ 2 * Tcl_DStringLength(&ds) + 1);
+ dst = Tcl_DStringValue(&ds) + soFar;
+ dstLen = Tcl_DStringLength(&ds) - soFar - 1;
+ }
+ Tcl_DStringSetLength(&ds, soFar);
+
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+
+ /*
+ * Set the property to the encoded string value.
+ */
+
+ errorHandler = Tk_CreateErrorHandler(
+ eventPtr->xproperty.display, -1, -1, -1,
+ (int (*)()) NULL, (ClientData) NULL);
+ XChangeProperty(eventPtr->xproperty.display,
+ eventPtr->xproperty.window,
+ eventPtr->xproperty.atom, formatType, 8,
+ PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tk_DeleteErrorHandler(errorHandler);
+
+ /*
+ * Preserve any left-over bytes.
+ */
+
+ if (srcLen > TCL_UTF_MAX) {
+ panic("selection conversion left too many bytes unconverted");
+ }
+ memcpy(incrPtr->converts[i].buffer, src, (size_t) srcLen+1);
+ Tcl_DStringFree(&ds);
+ } else {
+ propPtr = (char *) SelCvtToX((char *) buffer,
+ formatType, (Tk_Window) incrPtr->winPtr,
+ &numItems);
+
+ /*
+ * Set the property to the encoded string value.
+ */
+
+ errorHandler = Tk_CreateErrorHandler(
+ eventPtr->xproperty.display, -1, -1, -1,
+ (int (*)()) NULL, (ClientData) NULL);
+ XChangeProperty(eventPtr->xproperty.display,
+ eventPtr->xproperty.window,
+ eventPtr->xproperty.atom, formatType, 8,
+ PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&ds), numItems);
+ Tk_DeleteErrorHandler(errorHandler);
+
+ ckfree(propPtr);
+ }
+
+ /*
+ * Compute the next offset value. If this was the last chunk,
+ * then set the offset to -2. If this was an empty chunk,
+ * then set the offset to -1 to indicate we are done.
+ */
+
+ if (numItems < TK_SEL_BYTES_AT_ONCE) {
+ if (numItems <= 0) {
+ incrPtr->converts[i].offset = -1;
+ incrPtr->numIncrs--;
+ } else {
+ incrPtr->converts[i].offset = -2;
+ }
+ } else {
+ /*
+ * Advance over the selection data that was consumed
+ * this time.
+ */
+
+ incrPtr->converts[i].offset += numItems - length;
+ }
+ 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;
+ Tcl_DString ds;
+
+ 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)) {
+ Tcl_Encoding encoding;
+ if (format != 8) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for string selection: wanted \"8\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Convert the X selection data into UTF before passing it
+ * to the selection callback. Note that the COMPOUND_TEXT
+ * uses a modified iso2022 encoding, not the current system
+ * encoding. For now we'll just blindly apply the iso2022
+ * encoding. This is probably wrong, but it's a placeholder
+ * until we figure out what we're really supposed to do. For
+ * STRING, we need to use Latin-1 instead. Again, it's not
+ * really the full iso8859-1 space, but this is close enough.
+ */
+
+ if (type == dispPtr->compoundTextAtom) {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
+ Tcl_ExternalToUtfDString(encoding, propInfo, (int)numItems, &ds);
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+
+ retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+ interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ Tcl_Release((ClientData) interp);
+ } else if (type == dispPtr->utf8Atom) {
+ /*
+ * The X selection data is in UTF-8 format already.
+ * We can't guarantee that propInfo is NULL-terminated,
+ * so we might have to copy the string.
+ */
+ char *propData = propInfo;
+
+ if (format != 8) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for string selection: wanted \"8\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+
+ if (propInfo[numItems] != '\0') {
+ propData = ckalloc((size_t) numItems + 1);
+ strcpy(propData, propInfo);
+ propData[numItems] = '\0';
+ }
+ retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+ retrPtr->interp, propData);
+ if (propData != propInfo) {
+ ckfree((char *) propData);
+ }
+ } 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) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for selection: wanted \"32\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+ string = SelCvtFromX((long *) propInfo, (int) numItems, type,
+ (Tk_Window) winPtr);
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ 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.converts = (ConvertInfo *) ckalloc((unsigned)
+ (incr.numConversions*sizeof(ConvertInfo)));
+ 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.converts[i].offset = -1;
+ incr.converts[i].buffer[0] = '\0';
+
+ 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 = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
+ type = selPtr->format;
+ numItems = (*selPtr->proc)(selPtr->clientData, 0,
+ (char *) buffer, TK_SEL_BYTES_AT_ONCE);
+ TkSelSetInProgress(ip.nextPtr);
+ if ((ip.selPtr == NULL) || (numItems < 0)) {
+ incr.multAtoms[2*i + 1] = None;
+ continue;
+ }
+ if (numItems > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ ((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.converts[i].offset = 0;
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, format, PropModeReplace,
+ (unsigned char *) propPtr, numItems);
+ } else if (type == winPtr->dispPtr->utf8Atom) {
+ /*
+ * This matches selection requests of type UTF8_STRING,
+ * which allows us to pass our utf-8 information untouched.
+ */
+
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, 8, PropModeReplace,
+ (unsigned char *) buffer, numItems);
+ } else if ((type == XA_STRING)
+ || (type == winPtr->dispPtr->compoundTextAtom)) {
+ Tcl_DString ds;
+ Tcl_Encoding encoding;
+
+ /*
+ * STRING is Latin-1, COMPOUND_TEXT is an iso2022 variant.
+ * We need to convert the selection text into these external
+ * forms before modifying the property.
+ */
+
+ if (type == XA_STRING) {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ }
+ Tcl_UtfToExternalDString(encoding, (char*)buffer, -1, &ds);
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, 8, PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+ Tcl_DStringFree(&ds);
+ } 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);
+ 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 = tsdPtr->pendingIncrs;
+ tsdPtr->pendingIncrs = &incr;
+ }
+ if (multiple) {
+ XChangeProperty(reply.display, reply.requestor, reply.property,
+ XA_ATOM, 32, PropModeReplace,
+ (unsigned char *) incr.multAtoms,
+ (int) incr.numConversions*2);
+ } else {
+
+ /*
+ * 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 (tsdPtr->pendingIncrs == &incr) {
+ tsdPtr->pendingIncrs = incr.nextPtr;
+ } else {
+ for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL;
+ incrPtr2 = incrPtr2->nextPtr) {
+ if (incrPtr2->nextPtr == &incr) {
+ incrPtr2->nextPtr = incr.nextPtr;
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * All done. Cleanup and return.
+ */
+
+ ckfree((char *) incr.converts);
+ 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, *dst, *src;
+ Atom type;
+ int format, result, srcLen, dstLen, srcRead, dstWrote, soFar;
+ unsigned long numItems, bytesAfter;
+ Tcl_DString *dstPtr, temp;
+ Tcl_Interp *interp;
+ Tcl_Encoding encoding;
+
+ 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 ((type == XA_STRING)
+ || (type == retrPtr->winPtr->dispPtr->textAtom)
+ || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
+ if (format != 8) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for string selection: wanted \"8\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ goto done;
+ }
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) {
+ encoding = Tcl_GetEncoding(NULL, "iso2022");
+ } else {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
+
+ /*
+ * Check to see if there is any data left over from the previous
+ * chunk. If there is, copy the old data and the new data into
+ * a new buffer.
+ */
+
+ Tcl_DStringInit(&temp);
+ if (Tcl_DStringLength(&retrPtr->buf) > 0) {
+ Tcl_DStringAppend(&temp, Tcl_DStringValue(&retrPtr->buf),
+ Tcl_DStringLength(&retrPtr->buf));
+ if (numItems > 0) {
+ Tcl_DStringAppend(&temp, propInfo, (int)numItems);
+ }
+ src = Tcl_DStringValue(&temp);
+ srcLen = Tcl_DStringLength(&temp);
+ } else if (numItems == 0) {
+ /*
+ * There is no new data, so we're done.
+ */
+
+ retrPtr->result = TCL_OK;
+ Tcl_Release((ClientData) interp);
+ goto done;
+ } else {
+ src = propInfo;
+ srcLen = numItems;
+ }
+
+ /*
+ * Set up the destination buffer so we can use as much space as
+ * is available.
+ */
+
+ dstPtr = &retrPtr->buf;
+ dst = Tcl_DStringValue(dstPtr);
+ dstLen = dstPtr->spaceAvl - 1;
+
+ /*
+ * Now convert the data, growing the destination buffer as needed.
+ */
+
+ while (1) {
+ result = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ retrPtr->encFlags, &retrPtr->encState,
+ dst, dstLen, &srcRead, &dstWrote, NULL);
+ soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+ retrPtr->encFlags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (result != TCL_CONVERT_NOSPACE) {
+ Tcl_DStringSetLength(dstPtr, soFar);
+ break;
+ }
+ if (Tcl_DStringLength(dstPtr) == 0) {
+ Tcl_DStringSetLength(dstPtr, dstLen);
+ }
+ Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
+ dst = Tcl_DStringValue(dstPtr) + soFar;
+ dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
+ }
+ Tcl_DStringSetLength(dstPtr, soFar);
+
+ result = (*retrPtr->proc)(retrPtr->clientData, interp,
+ Tcl_DStringValue(dstPtr));
+ Tcl_Release((ClientData) interp);
+
+ /*
+ * Copy any unused data into the destination buffer so we can
+ * pick it up next time around.
+ */
+
+ Tcl_DStringSetLength(dstPtr, 0);
+ Tcl_DStringAppend(dstPtr, src, srcLen);
+
+ Tcl_DStringFree(&temp);
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+ if (result != TCL_OK) {
+ retrPtr->result = result;
+ }
+ } else if (numItems == 0) {
+ retrPtr->result = TCL_OK;
+ } else {
+ char *string;
+
+ if (format != 32) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for selection: wanted \"32\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
+ retrPtr->result = TCL_ERROR;
+ goto done;
+ }
+ string = SelCvtFromX((long *) propInfo, (int) numItems, type,
+ (Tk_Window) retrPtr->winPtr);
+ interp = retrPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ 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 = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
+ do {
+ chunkSize = (*selPtr->proc)(selPtr->clientData, size,
+ (char *) buffer, TK_SEL_BYTES_AT_ONCE);
+ if (ip.selPtr == NULL) {
+ size = 0;
+ break;
+ }
+ size += chunkSize;
+ } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
+ TkSelSetInProgress(ip.nextPtr);
+ return size;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IncrTimeoutProc --
+ *
+ * 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;
+ CONST 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/tcl/unix/tkUnixSend.c b/tcl/unix/tkUnixSend.c
new file mode 100644
index 00000000000..531f09172cb
--- /dev/null
+++ b/tcl/unix/tkUnixSend.c
@@ -0,0 +1,1899 @@
+/*
+ * tkUnixSend.c --
+ *
+ * This file provides procedures that implement the "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+
+/*
+ * 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. */
+ CONST 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;
+
+typedef struct ThreadSpecificData {
+ PendingCommand *pendingCommands;
+ /* List of all commands currently
+ * being waited for. */
+ RegisteredInterp *interpListPtr;
+ /* List of all interpreters registered
+ * in the current process. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The information below is used for communication between processes
+ * during "send" commands. Each process keeps a private window, never
+ * even mapped, with one property, "Comm". When a command is sent to
+ * an interpreter, the command is appended to the comm property of the
+ * communication window associated with the interp's process. Similarly,
+ * 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,
+ CONST char *name, Window commWindow));
+static void RegClose _ANSI_ARGS_((NameRegistry *regPtr));
+static void RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
+ CONST char *name));
+static Window RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
+ CONST 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,
+ CONST 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
+ * needed, 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. */
+ CONST 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. */
+ CONST 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. */
+ CONST 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. */
+ CONST 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;
+ CONST 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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. */
+ CONST 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 = winPtr->dispPtr;
+ NameRegistry *regPtr;
+ Tcl_Interp *interp;
+ CONST char *actualName;
+ Tcl_DString dString;
+ int offset, i;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ interp = winPtr->mainPtr->interp;
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, winPtr->dispPtr);
+ }
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 1);
+ for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
+ if (riPtr == NULL) {
+
+ /*
+ * This interpreter isn't currently registered; create
+ * the data structure that will be used to register it locally,
+ * plus add the "send" command to the interpreter.
+ */
+
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+ riPtr->dispPtr = winPtr->dispPtr;
+ riPtr->nextPtr = tsdPtr->interpListPtr;
+ tsdPtr->interpListPtr = riPtr;
+ riPtr->name = NULL;
+ Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
+ DeleteProc);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "send", "send");
+ }
+ break;
+ }
+ if (riPtr->interp == interp) {
+ /*
+ * The interpreter is currently registered; remove it from
+ * the name registry.
+ */
+
+ if (riPtr->name) {
+ RegDeleteName(regPtr, riPtr->name);
+ ckfree(riPtr->name);
+ }
+ break;
+ }
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * 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+TCL_INTEGER_SPACE);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ sprintf(Tcl_DStringValue(&dString) + 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 = tsdPtr->interpListPtr; 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. */
+ CONST char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr;
+ Window commWindow;
+ PendingCommand pending;
+ register RegisteredInterp *riPtr;
+ CONST char *destName;
+ int result, c, async, i, firstArg;
+ size_t length;
+ Tk_RestrictProc *prevRestrictProc;
+ ClientData prevArg;
+ TkDisplay *dispPtr;
+ Tcl_Time timeout;
+ NameRegistry *regPtr;
+ Tcl_DString request;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_Interp *localInterp; /* Used when the interpreter to
+ * send the command to is within
+ * the same process. */
+
+ /*
+ * Process options, if any.
+ */
+
+ 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 = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if ((riPtr->dispPtr != dispPtr)
+ || (strcmp(riPtr->name, destName) != 0)) {
+ continue;
+ }
+ Tcl_Preserve((ClientData) riPtr);
+ localInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) localInterp);
+ 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) {
+ Tcl_Obj *errorObjPtr;
+
+ /*
+ * An error occurred, so transfer error information from the
+ * destination interpreter back to our interpreter. Must clear
+ * interp's result before calling Tcl_AddErrorInfo, since
+ * Tcl_AddErrorInfo will store the interp's result in errorInfo
+ * before appending riPtr's $errorInfo; we've already got
+ * everything we need in riPtr's $errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
+ "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
+ errorObjPtr = Tcl_GetVar2Ex(localInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, errorObjPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
+ Tcl_ResetResult(localInterp);
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) localInterp);
+ return result;
+ }
+
+ /*
+ * 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) {
+ char buffer[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buffer, "%x %d",
+ (unsigned int) Tk_WindowId(dispPtr->commTkwin),
+ tkSendSerial);
+ Tcl_DStringAppend(&request, "\0-r ", 4);
+ Tcl_DStringAppend(&request, buffer, -1);
+ }
+ Tcl_DStringAppend(&request, "\0-s ", 4);
+ 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 = tsdPtr->pendingCommands;
+ tsdPtr->pendingCommands = &pending;
+
+ /*
+ * Enter a loop processing X events until the result comes
+ * in or the target is declared to be dead. While waiting
+ * for a result, look only at send-related events so that
+ * the send is synchronous with respect to other events in
+ * the application.
+ */
+
+ prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
+ (ClientData) NULL, &prevArg);
+ Tcl_GetTime(&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 {
+ Tcl_GetTime(&timeout);
+ timeout.sec += 2;
+ }
+ }
+ }
+ (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);
+
+ /*
+ * Unregister the information about the pending command
+ * and return the result.
+ */
+
+ if (tsdPtr->pendingCommands != &pending) {
+ panic("Tk_SendCmd: corrupted send stack");
+ }
+ tsdPtr->pendingCommands = pending.nextPtr;
+ if (pending.errorInfo != NULL) {
+ /*
+ * Special trick: must clear the interp's result before calling
+ * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's
+ * result in errorInfo before appending pending.errorInfo; we've
+ * already got everything we need in pending.errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, pending.errorInfo);
+ ckfree(pending.errorInfo);
+ }
+ if (pending.errorCode != NULL) {
+ Tcl_Obj *errorObjPtr;
+ errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1);
+ Tcl_SetObjErrorCode(interp, errorObjPtr);
+ ckfree(pending.errorCode);
+ }
+ Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
+ return pending.code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetInterpNames --
+ *
+ * This procedure is invoked to fetch a list of all the
+ * interpreter names currently registered for the display
+ * of a particular window.
+ *
+ * Results:
+ * A standard Tcl return value. The interp's result will be set
+ * to hold a list of all the interpreter names defined for
+ * tkwin's display. If an error occurs, then TCL_ERROR
+ * is returned and the interp's result will hold an error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSendCleanup --
+ *
+ * This procedure is called to free resources used by the
+ * communication channels for sending commands and
+ * receiving results.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees various data structures and windows.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkSendCleanup(dispPtr)
+ TkDisplay *dispPtr;
+{
+ if (dispPtr->commTkwin != NULL) {
+ Tk_DeleteEventHandler(dispPtr->commTkwin, PropertyChangeMask,
+ SendEventProc, (ClientData) dispPtr);
+ Tk_DestroyWindow(dispPtr->commTkwin);
+ Tcl_Release((ClientData) dispPtr->commTkwin);
+ dispPtr->commTkwin = NULL;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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!");
+ }
+ Tcl_Preserve((ClientData) dispPtr->commTkwin);
+ 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. */
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ 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 = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
+ if (riPtr == NULL) {
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply,
+ "receiver never heard of interpreter \"", -1);
+ Tcl_DStringAppend(&reply, interpName, -1);
+ Tcl_DStringAppend(&reply, "\"", 1);
+ }
+ 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, Tcl_GetStringResult(remoteInterp),
+ -1);
+ if (result == TCL_ERROR) {
+ CONST 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[TCL_INTEGER_SPACE];
+
+ sprintf(buffer, "%d", result);
+ Tcl_DStringAppend(&reply, "\0-c ", 4);
+ Tcl_DStringAppend(&reply, buffer, -1);
+ }
+ (void) AppendPropCarefully(dispPtr->display, commWindow,
+ dispPtr->commProperty, Tcl_DStringValue(&reply),
+ 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 = tsdPtr->pendingCommands; pcPtr != NULL;
+ pcPtr = pcPtr->nextPtr) {
+ if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
+ continue;
+ }
+ pcPtr->code = code;
+ if (resultString != NULL) {
+ pcPtr->result = (char *) ckalloc((unsigned)
+ (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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (pendingPtr == NULL) {
+ return 0;
+ }
+
+ /*
+ * Make sure this command is still pending.
+ */
+
+ for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
+ pcPtr = pcPtr->nextPtr) {
+ if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
+ pcPtr->result = (char *) ckalloc((unsigned)
+ (strlen(pcPtr->target) + 50));
+ sprintf(pcPtr->result, "no application named \"%s\"",
+ pcPtr->target);
+ pcPtr->code = TCL_ERROR;
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
+ RegDeleteName(regPtr, riPtr->name);
+ RegClose(regPtr);
+
+ if (tsdPtr->interpListPtr == riPtr) {
+ tsdPtr->interpListPtr = riPtr->nextPtr;
+ } else {
+ for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL;
+ riPtr2 = riPtr2->nextPtr) {
+ if (riPtr2->nextPtr == riPtr) {
+ riPtr2->nextPtr = riPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ 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 = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if ((eventPtr->xany.display == dispPtr->display)
+ && (eventPtr->xproperty.window
+ == Tk_WindowId(dispPtr->commTkwin))) {
+ return TK_PROCESS_EVENT;
+ }
+ }
+ return TK_DEFER_EVENT;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_DStringInit(&names);
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ Tcl_DStringAppendElement(&names, riPtr->name);
+ }
+ XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
+ dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&names),
+ Tcl_DStringLength(&names));
+ Tcl_DStringFree(&names);
+}
diff --git a/tcl/unix/tkUnixWm.c b/tcl/unix/tkUnixWm.c
new file mode 100644
index 00000000000..0d21b1d44a0
--- /dev/null
+++ b/tcl/unix/tkUnixWm.c
@@ -0,0 +1,6336 @@
+/*
+ * 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.
+ *
+ * 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. */
+ 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. */
+ TkWindow *masterPtr; /* Master window for TRANSIENT_FOR property,
+ * or NULL. */
+ 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. */
+ CONST 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. */
+ int numTransients; /* number of transients on this window */
+ 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).
+ * WM_TRANSIENT_WITHDRAWN - non-zero means that this is a transient window
+ * that has explicitly been withdrawn. It should
+ * not mirror state changes in the master.
+ */
+
+#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
+#define WM_TRANSIENT_WITHDRAWN 0x4000
+
+/*
+ * This module keeps a list of all top-level windows, primarily to
+ * simplify the job of Tk_CoordsToWindow. The list is called
+ * firstWmPtr and is stored in the TkDisplay structure.
+ */
+
+/*
+ * The following structures are the official type records for geometry
+ * management of top-level and menubar windows.
+ */
+
+static void TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
+ 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. */
+ WmInfo *wmInfoPtr;
+ 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 TkWmStackorderToplevelWrapperMap _ANSI_ARGS_((
+ TkWindow *winPtr,
+ Tcl_HashTable *reparentTable));
+static void TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
+ Tk_Window tkwin));
+static void UpdateCommand _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdateGeometryInfo _ANSI_ARGS_((
+ ClientData clientData));
+static void UpdateHints _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdateSizeHints _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdateVRootGeometry _ANSI_ARGS_((WmInfo *wmPtr));
+static void UpdateWmProtocols _ANSI_ARGS_((WmInfo *wmPtr));
+static void WaitForConfigureNotify _ANSI_ARGS_((TkWindow *winPtr,
+ unsigned long serial));
+static int WaitForEvent _ANSI_ARGS_((Display *display,
+ WmInfo *wmInfoPtr, 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));
+static void WmWaitMapProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+
+static int WmAspectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmAttributesCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmClientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmColormapwindowsCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmCommandCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmDeiconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFocusmodelCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFrameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGeometryCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGridCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGroupCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconbitmapCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconwindowCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMaxsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMinsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmOverrideredirectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmPositionfromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmProtocolCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmResizableCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmSizefromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStackorderCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStateCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTitleCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTransientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr,
+ TkWindow *winPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmCleanup --
+ *
+ * This procedure is invoked to cleanup remaining wm resources
+ * associated with a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All WmInfo structure resources are freed and invalidated.
+ *
+ *--------------------------------------------------------------
+ */
+
+void TkWmCleanup(dispPtr)
+ TkDisplay *dispPtr;
+{
+ WmInfo *wmPtr, *nextPtr;
+ for (wmPtr = dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = nextPtr) {
+ /*
+ * We can't assume we have access to winPtr's anymore, so some
+ * cleanup requiring winPtr data is avoided.
+ */
+ nextPtr = wmPtr->nextPtr;
+ if (wmPtr->title != NULL) {
+ ckfree(wmPtr->title);
+ }
+ if (wmPtr->iconName != NULL) {
+ ckfree(wmPtr->iconName);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ if (wmPtr->menubar != NULL) {
+ Tk_DestroyWindow(wmPtr->menubar);
+ }
+ if (wmPtr->wrapperPtr != NULL) {
+ 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);
+ }
+ ckfree((char *) 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(winPtr)
+ TkWindow *winPtr; /* Newly-created top-level window. */
+{
+ register WmInfo *wmPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
+ memset(wmPtr, 0, sizeof(WmInfo));
+ wmPtr->winPtr = winPtr;
+ wmPtr->reparent = None;
+ wmPtr->masterPtr = NULL;
+ wmPtr->numTransients = 0;
+ 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->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->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->configWidth = -1;
+ wmPtr->configHeight = -1;
+ wmPtr->vRoot = None;
+ wmPtr->flags = WM_NEVER_MAPPED;
+ wmPtr->nextPtr = (WmInfo *) dispPtr->firstWmPtr;
+ dispPtr->firstWmPtr = wmPtr;
+ winPtr->wmInfoPtr = wmPtr;
+
+ UpdateVRootGeometry(wmPtr);
+
+ /*
+ * Arrange for geometry requests to be reflected from the window
+ * to the window manager.
+ */
+
+ 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;
+ Tk_Uid string;
+
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ Tcl_DString ds;
+
+ wmPtr->flags &= ~WM_NEVER_MAPPED;
+
+ /*
+ * This is the first time this window has ever been mapped.
+ * First create the wrapper window that provides space for a
+ * menubar.
+ */
+
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+
+ /*
+ * Store all the window-manager-related information for the
+ * window.
+ */
+
+ string = (wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid;
+ Tcl_UtfToExternalDString(NULL, string, -1, &ds);
+ string = Tcl_DStringValue(&ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+
+ TkWmSetClass(winPtr);
+
+ if (wmPtr->iconName != NULL) {
+ Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
+ XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
+ Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ }
+
+ if (wmPtr->masterPtr != NULL) {
+ /*
+ * Don't map a transient if the master is not mapped.
+ */
+
+ if (!Tk_IsMapped(wmPtr->masterPtr)) {
+ wmPtr->withdrawn = 1;
+ wmPtr->hints.initial_state = WithdrawnState;
+ } else {
+ XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window,
+ wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window);
+ }
+ }
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ UpdateHints(winPtr);
+ UpdateWmProtocols(wmPtr);
+ if (wmPtr->cmdArgv != NULL) {
+ UpdateCommand(winPtr);
+ }
+ if (wmPtr->clientMachine != NULL) {
+ Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
+ &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ }
+ if (wmPtr->hints.initial_state == WithdrawnState) {
+ return;
+ }
+ if (wmPtr->iconFor != NULL) {
+ /*
+ * 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 ((WmInfo *) winPtr->dispPtr->firstWmPtr == wmPtr) {
+ winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
+ } else {
+ register WmInfo *prevPtr;
+
+ for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ;
+ prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ panic("couldn't unlink window in TkWmDeadWindow");
+ }
+ if (prevPtr->nextPtr == wmPtr) {
+ prevPtr->nextPtr = wmPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ 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->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);
+ }
+ /*
+ * Reset all transient windows whose master is the dead window.
+ */
+
+ for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL;
+ wmPtr2 = wmPtr2->nextPtr) {
+ if (wmPtr2->masterPtr == winPtr) {
+ wmPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) wmPtr2->masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) wmPtr2->winPtr);
+ wmPtr2->masterPtr = NULL;
+ if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
+ XSetTransientForHint(wmPtr2->winPtr->display,
+ wmPtr2->wrapperPtr->window, None);
+ /* FIXME: Need a call like Win32's UpdateWrapper() so
+ we can recreate the wrapper and get rid of the
+ transient window decorations. */
+ }
+ }
+ }
+ if (wmPtr->numTransients != 0)
+ panic("numTransients should be 0");
+
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr2 = wmPtr->masterPtr->wmInfoPtr;
+ /*
+ * If we had a master, tell them that we aren't tied
+ * to them anymore
+ */
+ if (wmPtr2 != NULL) {
+ wmPtr2->numTransients--;
+ }
+ Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+ wmPtr->masterPtr = NULL;
+ }
+ 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;
+ Tcl_DString name, class;
+
+ Tcl_UtfToExternalDString(NULL, winPtr->nameUid, -1, &name);
+ Tcl_UtfToExternalDString(NULL, winPtr->classUid, -1, &class);
+ classPtr = XAllocClassHint();
+ classPtr->res_name = Tcl_DStringValue(&name);
+ classPtr->res_class = Tcl_DStringValue(&class);
+ XSetClassHint(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window,
+ classPtr);
+ XFree((char *) classPtr);
+ Tcl_DStringFree(&name);
+ Tcl_DStringFree(&class);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WmObjCmd --
+ *
+ * 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_WmObjCmd(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;
+ static CONST char *optionStrings[] = {
+ "aspect", "attributes", "client", "colormapwindows",
+ "command", "deiconify", "focusmodel", "frame",
+ "geometry", "grid", "group", "iconbitmap",
+ "iconify", "iconmask", "iconname", "iconposition",
+ "iconwindow", "maxsize", "minsize", "overrideredirect",
+ "positionfrom", "protocol", "resizable", "sizefrom",
+ "stackorder", "state", "title", "transient",
+ "withdraw", (char *) NULL };
+ enum options {
+ WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
+ WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
+ WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
+ WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
+ WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
+ WMOPT_WITHDRAW };
+ int index;
+ int length;
+ char *argv1;
+ TkWindow *winPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objc < 2) {
+ wrongNumArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ argv1 = Tcl_GetStringFromObj(objv[1], &length);
+ if ((argv1[0] == 't') && (strncmp(argv1, "tracing", (size_t) length) == 0)
+ && (length >= 3)) {
+ int wmTracing;
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetResult(interp,
+ ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmTracing) {
+ dispPtr->flags |= TK_DISPLAY_WM_TRACING;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
+ }
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc < 3) {
+ goto wrongNumArgs;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case WMOPT_ASPECT:
+ return WmAspectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ATTRIBUTES:
+ return WmAttributesCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_CLIENT:
+ return WmClientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COLORMAPWINDOWS:
+ return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COMMAND:
+ return WmCommandCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_DEICONIFY:
+ return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FOCUSMODEL:
+ return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FRAME:
+ return WmFrameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GEOMETRY:
+ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GRID:
+ return WmGridCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GROUP:
+ return WmGroupCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONBITMAP:
+ return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONIFY:
+ return WmIconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONMASK:
+ return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONNAME:
+ return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPOSITION:
+ return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONWINDOW:
+ return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MAXSIZE:
+ return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MINSIZE:
+ return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_OVERRIDEREDIRECT:
+ return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_POSITIONFROM:
+ return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_PROTOCOL:
+ return WmProtocolCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_RESIZABLE:
+ return WmResizableCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_SIZEFROM:
+ return WmSizefromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STACKORDER:
+ return WmStackorderCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STATE:
+ return WmStateCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TITLE:
+ return WmTitleCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TRANSIENT:
+ return WmTransientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_WITHDRAW:
+ return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAspectCmd --
+ *
+ * This procedure is invoked to process the "wm aspect" 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
+WmAspectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int numer1, denom1, numer2, denom2;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?minNumer minDenom maxNumer maxDenom?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PAspect) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
+ wmPtr->minAspect.y, wmPtr->maxAspect.x,
+ wmPtr->maxAspect.y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~PAspect;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
+ (denom2 <= 0)) {
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ wmPtr->minAspect.x = numer1;
+ wmPtr->minAspect.y = denom1;
+ wmPtr->maxAspect.x = numer2;
+ wmPtr->maxAspect.y = denom2;
+ wmPtr->sizeHintsFlags |= PAspect;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAttributesCmd --
+ *
+ * This procedure is invoked to process the "wm attributes" 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
+WmAttributesCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmClientCmd --
+ *
+ * This procedure is invoked to process the "wm client" 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
+WmClientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->clientMachine != NULL) {
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (argv3[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) (length + 1));
+ strcpy(wmPtr->clientMachine, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XTextProperty textProp;
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
+ &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmColormapwindowsCmd --
+ *
+ * This procedure is invoked to process the "wm colormapwindows"
+ * 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
+WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Window *cmapList;
+ TkWindow *winPtr2;
+ int count, i, windowObjc, gotToplevel;
+ Tcl_Obj **windowObjv;
+ char buffer[20];
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?");
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ if (objc == 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_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (Window *) ckalloc((unsigned)
+ ((windowObjc+1)*sizeof(Window)));
+ gotToplevel = 0;
+ for (i = 0; i < windowObjc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, windowObjv[i],
+ (Tk_Window *) &winPtr2) != TCL_OK)
+ {
+ ckfree((char *) cmapList);
+ 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[windowObjc] = wmPtr->wrapperPtr->window;
+ windowObjc++;
+ } else {
+ wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP;
+ }
+ wmPtr->flags |= WM_COLORMAPS_EXPLICIT;
+ XSetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window,
+ cmapList, windowObjc);
+ ckfree((char *) cmapList);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmCommandCmd --
+ *
+ * This procedure is invoked to process the "wm command" 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
+WmCommandCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int cmdArgc;
+ CONST char **cmdArgv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?value?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->cmdArgv != NULL) {
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (argv3[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, argv3, &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)) {
+ UpdateCommand(winPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmDeiconifyCmd --
+ *
+ * This procedure is invoked to process the "wm deiconify" 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
+WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[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 deiconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) {
+ wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN;
+ }
+ TkpWmSetState(winPtr, NormalState);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFocusmodelCmd --
+ *
+ * This procedure is invoked to process the "wm focusmodel" 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
+WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "active", "passive", (char *) NULL };
+ enum options {
+ OPT_ACTIVE, OPT_PASSIVE };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ACTIVE) {
+ wmPtr->hints.input = False;
+ } else { /* OPT_PASSIVE */
+ wmPtr->hints.input = True;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFrameCmd --
+ *
+ * This procedure is invoked to process the "wm frame" 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
+WmFrameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Window window;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ window = wmPtr->reparent;
+ if (window == None) {
+ window = Tk_WindowId((Tk_Window) winPtr);
+ }
+ sprintf(buf, "0x%x", (unsigned int) window);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGeometryCmd --
+ *
+ * This procedure is invoked to process the "wm geometry" 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
+WmGeometryCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char xSign, ySign;
+ int width, height;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
+ xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
+ ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
+ if (wmPtr->gridWin != NULL) {
+ width = wmPtr->reqGridWidth + (winPtr->changes.width
+ - winPtr->reqWidth)/wmPtr->widthInc;
+ height = wmPtr->reqGridHeight + (winPtr->changes.height
+ - winPtr->reqHeight)/wmPtr->heightInc;
+ } else {
+ width = winPtr->changes.width;
+ height = winPtr->changes.height;
+ }
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\0') {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+ }
+ return ParseGeometry(interp, argv3, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGridCmd --
+ *
+ * This procedure is invoked to process the "wm grid" 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
+WmGridCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int reqWidth, reqHeight, widthInc, heightInc;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?baseWidth baseHeight widthInc heightInc?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PBaseSize) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
+ wmPtr->reqGridHeight, wmPtr->widthInc,
+ wmPtr->heightInc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (reqWidth < 0) {
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (reqHeight < 0) {
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (widthInc < 0) {
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (heightInc < 0) {
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
+ heightInc);
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGroupCmd --
+ *
+ * This procedure is invoked to process the "wm group" 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
+WmGroupCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & WindowGroupHint) {
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (*argv3 == '\0') {
+ wmPtr->hints.flags &= ~WindowGroupHint;
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ while (!Tk_TopWinHierarchy(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);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->hints.window_group = Tk_WindowId(wmPtr2->wrapperPtr);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->leaderName, argv3);
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconbitmapCmd --
+ *
+ * This procedure is invoked to process the "wm iconbitmap" 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
+WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Pixmap pixmap;
+ char *argv3;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tcl_SetResult(interp, (char *)
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\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, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconifyCmd --
+ *
+ * This procedure is invoked to process the "wm iconify" 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
+WmIconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ 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 ", winPtr->pathName,
+ ": 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;
+ }
+ if (TkpWmSetState(winPtr, IconicState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send iconify message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconmaskCmd --
+ *
+ * This procedure is invoked to process the "wm iconmask" 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
+WmIconmaskCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Pixmap pixmap;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tcl_SetResult(interp, (char *)
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\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, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconnameCmd --
+ *
+ * This procedure is invoked to process the "wm iconname" 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
+WmIconnameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->iconName != NULL) {
+ ckfree((char *) wmPtr->iconName);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->iconName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->iconName, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
+ XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
+ Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconpositionCmd --
+ *
+ * This procedure is invoked to process the "wm iconposition"
+ * 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
+WmIconpositionCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPositionHint) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->hints.icon_x,
+ wmPtr->hints.icon_y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->hints.flags &= ~IconPositionHint;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconwindowCmd --
+ *
+ * This procedure is invoked to process the "wm iconwindow" 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
+WmIconwindowCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->icon != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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 {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]),
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[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) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ WaitForMapNotify((TkWindow *) tkwin2, 0);
+ }
+ }
+ UpdateHints(winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMaxsizeCmd --
+ *
+ * This procedure is invoked to process the "wm maxsize" 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
+WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ GetMaxSize(wmPtr, &width, &height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->maxWidth = width;
+ wmPtr->maxHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMinsizeCmd --
+ *
+ * This procedure is invoked to process the "wm minsize" 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
+WmMinsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->minWidth = width;
+ wmPtr->minHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmOverrideredirectCmd --
+ *
+ * This procedure is invoked to process the "wm overrideredirect"
+ * 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
+WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int boolean, curValue;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+ curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
+ if (objc == 3) {
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (curValue != boolean) {
+ /*
+ * Only do this if we are really changing value, because it
+ * causes some funky stuff to occur
+ */
+ 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);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmPositionfromCmd --
+ *
+ * This procedure is invoked to process the "wm positionfrom"
+ * 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
+WmPositionfromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USPosition) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PPosition) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmProtocolCmd --
+ *
+ * This procedure is invoked to process the "wm protocol" 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
+WmProtocolCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ char *cmd;
+ int cmdLength;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?");
+ return TCL_ERROR;
+ }
+ if (objc == 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, Tcl_GetString(objv[3]));
+ if (objc == 4) {
+ /*
+ * Return the command to handle a given protocol.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * 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;
+ }
+ }
+ cmd = Tcl_GetStringFromObj(objv[4], &cmdLength);
+ 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, cmd);
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ UpdateWmProtocols(wmPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmResizableCmd --
+ *
+ * This procedure is invoked to process the "wm resizable" 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
+WmResizableCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
+ (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[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;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmSizefromCmd --
+ *
+ * This procedure is invoked to process the "wm sizefrom" 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
+WmSizefromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USSize) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PSize) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USSize|PSize);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else { /* OPT_PROGRAM */
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStackorderCmd --
+ *
+ * This procedure is invoked to process the "wm stackorder" 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
+WmStackorderCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ TkWindow **windows, **window_ptr;
+ static CONST char *optionStrings[] = {
+ "isabove", "isbelow", (char *) NULL };
+ enum options {
+ OPT_ISABOVE, OPT_ISBELOW };
+ int index;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ windows = TkWmStackorderToplevel(winPtr);
+ if (windows == NULL) {
+ panic("TkWmStackorderToplevel failed");
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ Tcl_AppendElement(interp, (*window_ptr)->pathName);
+ }
+ ckfree((char *) windows);
+ return TCL_OK;
+ }
+ } else {
+ TkWindow *winPtr2;
+ int index1=-1, index2=-1, result;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsTopLevel(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Lookup stacking order of all toplevels that are children
+ * of "." and find the position of winPtr and winPtr2
+ * in the stacking order.
+ */
+
+ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
+
+ if (windows == NULL) {
+ Tcl_AppendResult(interp, "TkWmStackorderToplevel failed",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ if (*window_ptr == winPtr)
+ index1 = (window_ptr - windows);
+ if (*window_ptr == winPtr2)
+ index2 = (window_ptr - windows);
+ }
+ if (index1 == -1)
+ panic("winPtr window not found");
+ if (index2 == -1)
+ panic("winPtr2 window not found");
+
+ ckfree((char *) windows);
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ISABOVE) {
+ result = index1 > index2;
+ } else { /* OPT_ISBELOW */
+ result = index1 < index2;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+ return TCL_OK;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStateCmd --
+ *
+ * This procedure is invoked to process the "wm state" 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
+WmStateCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "normal", "iconic", "withdrawn", (char *) NULL };
+ enum options {
+ OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN };
+ int index;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?state?");
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ",
+ Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == OPT_NORMAL) {
+ if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) {
+ wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN;
+ }
+ (void) TkpWmSetState(winPtr, NormalState);
+ } else if (index == OPT_ICONIC) {
+ 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 (TkpWmSetState(winPtr, IconicState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send iconify message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ } else { /* OPT_WITHDRAWN */
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->flags |= WM_TRANSIENT_WITHDRAWN;
+ }
+ if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+ } else {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else if (wmPtr->withdrawn) {
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ } else if (Tk_IsMapped((Tk_Window) winPtr)
+ || ((wmPtr->flags & WM_NEVER_MAPPED)
+ && (wmPtr->hints.initial_state == NormalState))) {
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTitleCmd --
+ *
+ * This procedure is invoked to process the "wm title" 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
+WmTitleCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (char *)
+ ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->title != NULL) {
+ ckfree((char *) wmPtr->title);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->title = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->title, argv3);
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XTextProperty textProp;
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->title, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
+ XSetWMName(winPtr->display, wmPtr->wrapperPtr->window,
+ &textProp);
+ XFree((char *) textProp.value);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTransientCmd --
+ *
+ * This procedure is invoked to process the "wm transient" 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
+WmTransientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ TkWindow *masterPtr = wmPtr->masterPtr;
+ WmInfo *wmPtr2;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?master?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (masterPtr != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ if (masterPtr != NULL) {
+ /*
+ * If we had a master, tell them that we aren't tied
+ * to them anymore
+ */
+
+ masterPtr->wmInfoPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+
+ /* FIXME: Need a call like Win32's UpdateWrapper() so
+ we can recreate the wrapper and get rid of the
+ transient window decorations. */
+ }
+
+ wmPtr->masterPtr = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3],
+ (Tk_Window *) &masterPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ while (!Tk_TopWinHierarchy(masterPtr)) {
+ /*
+ * Ensure that the master window is actually a Tk toplevel.
+ */
+
+ masterPtr = masterPtr->parentPtr;
+ }
+ Tk_MakeWindowExist((Tk_Window) masterPtr);
+
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[2]),
+ "\" a transient: it is an icon for ",
+ Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ wmPtr2 = masterPtr->wmInfoPtr;
+ if (wmPtr2->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr2);
+ }
+
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[3]),
+ "\" a master: it is an icon for ",
+ Tk_PathName(wmPtr2->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (masterPtr == winPtr) {
+ Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr),
+ "\" its own master",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (masterPtr != wmPtr->masterPtr) {
+ /*
+ * Remove old master map/unmap binding before setting
+ * the new master. The event handler will ensure that
+ * transient states reflect the state of the master.
+ */
+
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->masterPtr->wmInfoPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+ }
+
+ masterPtr->wmInfoPtr->numTransients++;
+ Tk_CreateEventHandler((Tk_Window) masterPtr,
+ StructureNotifyMask,
+ WmWaitMapProc, (ClientData) winPtr);
+
+ wmPtr->masterPtr = masterPtr;
+ }
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) {
+ if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ } else {
+ Window xwin = (wmPtr->masterPtr == NULL) ? None :
+ wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window;
+ XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window,
+ xwin);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmWithdrawCmd --
+ *
+ * This procedure is invoked to process the "wm withdraw" 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
+WmWithdrawCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->flags |= WM_TRANSIENT_WITHDRAWN;
+ }
+ if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ * Invoked by those wm subcommands that affect geometry.
+ * Schedules a geometry update.
+ */
+static void
+WmUpdateGeom(wmPtr, winPtr)
+ WmInfo *wmPtr;
+ TkWindow *winPtr;
+{
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ * Invoked when a MapNotify or UnmapNotify event is delivered for a
+ * toplevel that is the master of a transient toplevel.
+ */
+static void
+WmWaitMapProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr;
+
+ if (masterPtr == NULL)
+ return;
+
+ if (eventPtr->type == MapNotify) {
+ if (!(winPtr->wmInfoPtr->flags & WM_TRANSIENT_WITHDRAWN))
+ (void) TkpWmSetState(winPtr, NormalState);
+ } else if (eventPtr->type == UnmapNotify) {
+ (void) TkpWmSetState(winPtr, WithdrawnState);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ /*
+ * The window is being deleted... just skip this operation.
+ */
+
+ return;
+ }
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ 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_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ /*
+ * The window is being deleted... just skip this operation.
+ */
+
+ return;
+ }
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ 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;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+ Tk_ErrorHandler handler;
+
+ /*
+ * Update size information from the event. There are a couple of
+ * tricky points here:
+ *
+ * 1. If the user changed the size externally then set wmPtr->width
+ * and wmPtr->height just as if a "wm geometry" command had been
+ * invoked with the same information.
+ * 2. However, if the size is changing in response to a request
+ * coming from us (WM_SYNC_PENDING is set), then don't set wmPtr->width
+ * or wmPtr->height if they were previously -1 (otherwise the
+ * window will stop tracking geometry manager requests).
+ */
+
+ if (((wrapperPtr->changes.width != configEventPtr->width)
+ || (wrapperPtr->changes.height != configEventPtr->height))
+ && !(wmPtr->flags & WM_SYNC_PENDING)){
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ 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 (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("ConfigureEvent: %s x = %d y = %d, width = %d, height = %d\n",
+ winPtr->pathName, configEventPtr->x, configEventPtr->y,
+ configEventPtr->width, configEventPtr->height);
+ printf(" send_event = %d, serial = %ld (win %p, wrapper %p)\n",
+ configEventPtr->send_event, configEventPtr->serial,
+ winPtr, wrapperPtr);
+ }
+ 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 (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf(" %s parent == %p, above %p\n",
+ winPtr->pathName, (void *) wmPtr->reparent,
+ (void *) configEventPtr->above);
+ }
+
+ 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. If the menuHeight happens to be zero, we'll get a
+ * BadValue X error that we want to ignore [Bug: 3377]
+ */
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XMoveResizeWindow(winPtr->display, winPtr->window, 0,
+ wmPtr->menuHeight, (unsigned) wrapperPtr->changes.width,
+ (unsigned) (wrapperPtr->changes.height - wmPtr->menuHeight));
+ Tk_DeleteErrorHandler(handler);
+ 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;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+
+ /*
+ * Identify the root window for wrapperPtr. This is tricky because of
+ * virtual root window managers like tvtwm. If the window has a
+ * property named __SWM_ROOT or __WM_ROOT then this property gives
+ * the id for a virtual root window that should be used instead of
+ * the root window of the screen.
+ */
+
+ 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 (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("%s format %d numItems %ld\n",
+ "ReparentEvent got bogus VROOT property:", actualFormat,
+ numItems);
+ }
+ XFree((char *) virtualRootPtr);
+ }
+ Tk_DeleteErrorHandler(handler);
+
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("ReparentEvent: %s (%p) reparented to 0x%x, vRoot = 0x%x\n",
+ wmPtr->winPtr->pathName, wmPtr->winPtr,
+ (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;
+ wmPtr->winPtr->changes.x = reparentEventPtr->x;
+ wmPtr->winPtr->changes.y = reparentEventPtr->y + wmPtr->menuHeight;
+ 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;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+
+ handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ (void) XTranslateCoordinates(wrapperPtr->display, wrapperPtr->window,
+ wmPtr->reparent, 0, 0, &xOffset, &yOffset, &dummy2);
+ status = XGetGeometry(wrapperPtr->display, wmPtr->reparent,
+ &dummy2, &x, &y, (unsigned int *) &width,
+ (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)
+ && ((wrapperPtr->changes.x != (x + wmPtr->xInParent))
+ || (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);
+ }
+ }
+
+ wrapperPtr->changes.x = x + wmPtr->xInParent;
+ wrapperPtr->changes.y = y + wmPtr->yInParent;
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("wrapperPtr %p coords %d,%d\n",
+ wrapperPtr, wrapperPtr->changes.x, wrapperPtr->changes.y);
+ printf(" wmPtr %p coords %d,%d, offsets %d %d\n",
+ wmPtr, 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;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
+
+ wmPtr->flags |= WM_VROOT_OFFSET_STALE;
+ if (eventPtr->type == DestroyNotify) {
+ Tk_ErrorHandler handler;
+
+ if (!(wmPtr->wrapperPtr->flags & TK_ALREADY_DEAD)) {
+ /*
+ * A top-level window was deleted externally (e.g., by the window
+ * manager). This is probably not a good thing, but cleanup as
+ * best we can. The error handler is needed because
+ * Tk_DestroyWindow will try to destroy the window, but of course
+ * it's already gone.
+ */
+
+ handler = Tk_CreateErrorHandler(wmPtr->winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
+ Tk_DeleteErrorHandler(handler);
+ }
+ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ 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 + wmPtr->xInParent == winPtr->changes.x) &&
+ (y + wmPtr->yInParent + wmPtr->menuHeight == 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 (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("UpdateGeometryInfo moving to %d %d, resizing to %d x %d,\n",
+ x, y, width, height);
+ }
+ XMoveResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, x, y,
+ (unsigned) width, (unsigned) height);
+ } else if ((width != wmPtr->configWidth)
+ || (height != wmPtr->configHeight)) {
+ if ((width == wmPtr->wrapperPtr->changes.width)
+ && (height == wmPtr->wrapperPtr->changes.height)) {
+ /*
+ * The window is already just the size we want, so don't bother
+ * to configure it; the X server appears to ignore these
+ * requests, so we won't get back a ConfigureNotify and the
+ * WaitForConfigureNotify call below will hang for a while.
+ */
+
+ return;
+ }
+ wmPtr->configWidth = width;
+ wmPtr->configHeight = height;
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("UpdateGeometryInfo resizing %p to %d x %d\n",
+ (void *)wmPtr->wrapperPtr->window, 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, ConfigureNotify, &event);
+ wmPtr->flags &= ~WM_SYNC_PENDING;
+ if (code != TCL_OK) {
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("WaitForConfigureNotify giving up on %s\n",
+ winPtr->pathName);
+ }
+ break;
+ }
+ diff = event.xconfigure.serial - serial;
+ if (diff >= 0) {
+ gotConfig = 1;
+ }
+ }
+ wmPtr->flags &= ~WM_MOVE_PENDING;
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ 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, wmInfoPtr, type, eventPtr)
+ Display *display; /* Display event is coming from. */
+ WmInfo *wmInfoPtr; /* 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.wmInfoPtr = wmInfoPtr;
+ 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->wmInfoPtr->wrapperPtr->window)
+ && (eventPtr->xany.window != infoPtr->wmInfoPtr->reparent))
+ || (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,
+ 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 (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("WaitForMapNotify giving up on %s\n", winPtr->pathName);
+ }
+ break;
+ }
+ }
+ wmPtr->flags &= ~WM_MOVE_PENDING;
+ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ printf("WaitForMapNotify finished with %s (winPtr %p, wmPtr %p)\n",
+ winPtr->pathName, winPtr, wmPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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
+ * the interp's 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;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ Tk_ErrorHandler handler = NULL;
+
+ /*
+ * Step 1: scan the list of toplevel windows to see if there is a
+ * virtual root for the screen we're interested in. If so, we have
+ * to translate the coordinates from virtual root to root
+ * coordinates.
+ */
+
+ parent = window = RootWindowOfScreen(Tk_Screen(tkwin));
+ x = rootX;
+ y = rootY;
+ for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
+ if (Tk_Screen(wmPtr->winPtr) != Tk_Screen(tkwin)) {
+ continue;
+ }
+ if (wmPtr->vRoot == None) {
+ continue;
+ }
+ UpdateVRootGeometry(wmPtr);
+ 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.
+ */
+
+ handler = Tk_CreateErrorHandler(Tk_Display(tkwin), -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ while (1) {
+ if (XTranslateCoordinates(Tk_Display(tkwin), parent, window,
+ x, y, &childX, &childY, &child) == False) {
+ /*
+ * We can end up here when the window is in the middle of
+ * being deleted
+ */
+ Tk_DeleteErrorHandler(handler);
+ return NULL;
+ }
+ if (child == None) {
+ Tk_DeleteErrorHandler(handler);
+ return NULL;
+ }
+ for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL;
+ wmPtr = wmPtr->nextPtr) {
+ if (wmPtr->reparent == child) {
+ goto gotToplevel;
+ }
+ if (wmPtr->wrapperPtr != NULL) {
+ if (child == wmPtr->wrapperPtr->window) {
+ goto gotToplevel;
+ }
+ } else if (child == wmPtr->winPtr->window) {
+ goto gotToplevel;
+ }
+ }
+ x = childX;
+ y = childY;
+ parent = window;
+ window = child;
+ }
+
+ gotToplevel:
+ if (handler) {
+ /*
+ * Check value of handler, because we can reach this label
+ * from above or below
+ */
+ Tk_DeleteErrorHandler(handler);
+ handler = NULL;
+ }
+ 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_HIERARCHY)) {
+ 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 (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) {
+ 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_HIERARCHY) && (winPtr->parentPtr != NULL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ /* Punt. */
+ *xPtr = 0;
+ *yPtr = 0;
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+
+
+ /*
+ * 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;
+ CONST 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevelWrapperMap --
+ *
+ * This procedure will create a table that maps the reparent wrapper
+ * X id for a toplevel to the TkWindow structure that is wraps.
+ * Tk keeps track of a mapping from the window X id to the TkWindow
+ * structure but that does us no good here since we only get the X
+ * id of the wrapper window. Only those toplevel windows that are
+ * mapped have a position in the stacking order.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds entries to the passed hashtable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TkWmStackorderToplevelWrapperMap(winPtr, table)
+ TkWindow *winPtr; /* TkWindow to recurse on */
+ Tcl_HashTable *table; /* Maps X id to TkWindow */
+{
+ TkWindow *childPtr;
+ Tcl_HashEntry *hPtr;
+ Window wrapper;
+ int newEntry;
+
+ if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) &&
+ !Tk_IsEmbedded(winPtr)) {
+ wrapper = (winPtr->wmInfoPtr->reparent != None)
+ ? winPtr->wmInfoPtr->reparent
+ : winPtr->wmInfoPtr->wrapperPtr->window;
+
+ hPtr = Tcl_CreateHashEntry(table,
+ (char *) wrapper, &newEntry);
+ Tcl_SetHashValue(hPtr, winPtr);
+ }
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ TkWmStackorderToplevelWrapperMap(childPtr, table);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevel --
+ *
+ * This procedure returns the stack order of toplevel windows.
+ *
+ * Results:
+ * An array of pointers to tk window objects in stacking order
+ * or else NULL if there was an error.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow **
+TkWmStackorderToplevel(parentPtr)
+ TkWindow *parentPtr; /* Parent toplevel window. */
+{
+ Window dummy1, dummy2, vRoot;
+ Window *children;
+ unsigned int numChildren, i;
+ TkWindow *childWinPtr, **windows, **window_ptr;
+ Tcl_HashTable table;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Map X Window ids to a TkWindow of the wrapped toplevel.
+ */
+
+ Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS);
+ TkWmStackorderToplevelWrapperMap(parentPtr, &table);
+
+ window_ptr = windows = (TkWindow **) ckalloc((table.numEntries+1)
+ * sizeof(TkWindow *));
+
+ /*
+ * Special cases: If zero or one toplevels were mapped
+ * there is no need to call XQueryTree.
+ */
+
+ switch (table.numEntries) {
+ case 0:
+ windows[0] = NULL;
+ goto done;
+ case 1:
+ hPtr = Tcl_FirstHashEntry(&table, &search);
+ windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr);
+ windows[1] = NULL;
+ goto done;
+ }
+
+ vRoot = parentPtr->wmInfoPtr->vRoot;
+ if (vRoot == None) {
+ vRoot = RootWindowOfScreen(Tk_Screen((Tk_Window) parentPtr));
+ }
+
+ if (XQueryTree(parentPtr->display, vRoot, &dummy1, &dummy2,
+ &children, &numChildren) == 0) {
+ ckfree((char *) windows);
+ windows = NULL;
+ } else {
+ for (i = 0; i < numChildren; i++) {
+ hPtr = Tcl_FindHashEntry(&table, (char *) children[i]);
+ if (hPtr != NULL) {
+ childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr);
+ *window_ptr++ = childWinPtr;
+ }
+ }
+ if ((window_ptr - windows) != table.numEntries)
+ panic("num matched toplevel windows does not equal num children");
+ *window_ptr = NULL;
+ if (numChildren) {
+ XFree((char *) children);
+ }
+ }
+
+ done:
+ Tcl_DeleteHashTable(&table);
+ return windows;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRestackToplevel --
+ *
+ * This procedure restacks a top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr gets restacked as specified by aboveBelow and otherPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ unsigned int mask;
+ TkWindow *wrapperPtr;
+
+ memset(&changes, 0, sizeof(XWindowChanges));
+ changes.stack_mode = aboveBelow;
+ mask = CWStackMode;
+
+ /*
+ * Make sure that winPtr and its wrapper window have been created.
+ */
+ if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(winPtr);
+ }
+ wrapperPtr = winPtr->wmInfoPtr->wrapperPtr;
+
+ if (otherPtr != NULL) {
+ /*
+ * The window is to be restacked with respect to another toplevel.
+ * Make sure it has been created as well.
+ */
+ if (otherPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(otherPtr);
+ }
+ changes.sibling = otherPtr->wmInfoPtr->wrapperPtr->window;
+ mask |= CWSibling;
+ }
+
+ /*
+ * Reconfigure the window. Note that we use XReconfigureWMWindow
+ * instead of XConfigureWindow, in order to handle the case
+ * where the window is to be restacked with respect to another toplevel.
+ * See [ICCCM] 4.1.5 "Configuring the Window" and XReconfigureWMWindow(3)
+ * for details.
+ */
+
+ XReconfigureWMWindow(winPtr->display, wrapperPtr->window,
+ Tk_ScreenNumber((Tk_Window) winPtr), mask, &changes);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_HIERARCHY) {
+ break;
+ }
+ }
+ if (topPtr->wmInfoPtr == NULL) {
+ return;
+ }
+
+ 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_HIERARCHY) {
+ 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 == NULL) {
+ 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_HasWrapper(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;
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCommand --
+ *
+ * Update the WM_COMMAND property, taking care to translate
+ * the command strings into the external encoding.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateCommand(winPtr)
+ TkWindow *winPtr;
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tcl_DString cmds, ds;
+ int i, *offsets;
+ char **cmdArgv;
+
+ /*
+ * Translate the argv strings into the external encoding. To avoid
+ * allocating lots of memory, the strings are appended to a buffer
+ * with nulls between each string.
+ *
+ * This code is tricky because we need to pass and array of pointers
+ * to XSetCommand. However, we can't compute the pointers as we go
+ * because the DString buffer space could get reallocated. So, store
+ * offsets for each element as we go, then compute pointers from the
+ * offsets once the entire DString is done.
+ */
+
+ cmdArgv = (char **) ckalloc(sizeof(char *) * wmPtr->cmdArgc);
+ offsets = (int *) ckalloc( sizeof(int) * wmPtr->cmdArgc);
+ Tcl_DStringInit(&cmds);
+ for (i = 0; i < wmPtr->cmdArgc; i++) {
+ Tcl_UtfToExternalDString(NULL, wmPtr->cmdArgv[i], -1, &ds);
+ offsets[i] = Tcl_DStringLength(&cmds);
+ Tcl_DStringAppend(&cmds, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds)+1);
+ Tcl_DStringFree(&ds);
+ }
+ cmdArgv[0] = Tcl_DStringValue(&cmds);
+ for (i = 1; i < wmPtr->cmdArgc; i++) {
+ cmdArgv[i] = cmdArgv[0] + offsets[i];
+ }
+
+ XSetCommand(winPtr->display, wmPtr->wrapperPtr->window,
+ cmdArgv, wmPtr->cmdArgc);
+ Tcl_DStringFree(&cmds);
+ ckfree((char *) cmdArgv);
+ ckfree((char *) offsets);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWmSetState --
+ *
+ * Sets the window manager state for the wrapper window of a
+ * given toplevel window.
+ *
+ * Results:
+ * 0 on error, 1 otherwise
+ *
+ * Side effects:
+ * May minimize, restore, or withdraw a window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpWmSetState(winPtr, state)
+ TkWindow *winPtr; /* Toplevel window to operate on. */
+ int state; /* One of IconicState, NormalState,
+ * or WithdrawnState. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (state == WithdrawnState) {
+ wmPtr->hints.initial_state = WithdrawnState;
+ wmPtr->withdrawn = 1;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return 1;
+ }
+ if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ winPtr->screenNum) == 0) {
+ return 0;
+ }
+ WaitForMapNotify(winPtr, 0);
+ } else if (state == NormalState) {
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->withdrawn = 0;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return 1;
+ }
+ UpdateHints(winPtr);
+ Tk_MapWindow((Tk_Window) winPtr);
+ } else if (state == IconicState) {
+ wmPtr->hints.initial_state = IconicState;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return 1;
+ }
+ if (wmPtr->withdrawn) {
+ UpdateHints(winPtr);
+ Tk_MapWindow((Tk_Window) winPtr);
+ wmPtr->withdrawn = 0;
+ } else {
+ if (XIconifyWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ winPtr->screenNum) == 0) {
+ return 0;
+ }
+ WaitForMapNotify(winPtr, 0);
+ }
+ }
+
+ return 1;
+}
diff --git a/tcl/unix/tkUnixXId.c b/tcl/unix/tkUnixXId.c
new file mode 100644
index 00000000000..64fb9250c2d
--- /dev/null
+++ b/tcl/unix/tkUnixXId.c
@@ -0,0 +1,613 @@
+/*
+ * 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-1997 Sun Microsystems, 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 "tkUnixInt.h"
+#include "tkPort.h"
+
+/*
+ * A structure of the following type is used to hold one or more
+ * available resource identifiers. There is a list of these structures
+ * for each display.
+ */
+
+#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 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 = (Tcl_TimerToken) 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeXId --
+ *
+ * This procedure is called to free resources for the id allocator
+ * for a given display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the id and window stack pools.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeXId(dispPtr)
+ TkDisplay *dispPtr; /* Tk's information about the
+ * display. */
+{
+ TkIdStack *stackPtr, *freePtr;
+
+ if (dispPtr->idCleanupScheduled) {
+ Tcl_DeleteTimerHandler(dispPtr->idCleanupScheduled);
+ }
+
+ for (stackPtr = dispPtr->idStackPtr; stackPtr != NULL; ) {
+ freePtr = stackPtr;
+ stackPtr = stackPtr->nextPtr;
+ ckfree((char *) freePtr);
+ }
+ dispPtr->idStackPtr = NULL;
+
+ for (stackPtr = dispPtr->windowStackPtr; stackPtr != NULL; ) {
+ freePtr = stackPtr;
+ stackPtr = stackPtr->nextPtr;
+ ckfree((char *) freePtr);
+ }
+ dispPtr->windowStackPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 =
+ 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 = (Tcl_TimerToken) 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 =
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpScanWindowId --
+ *
+ * Given a string, produce the corresponding Window Id.
+ *
+ * Results:
+ * The return value is normally TCL_OK; in this case *idPtr
+ * will be set to the Window value equivalent to string. If
+ * string is improperly formed then TCL_ERROR is returned and
+ * an error message will be left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpScanWindowId(interp, string, idPtr)
+ Tcl_Interp *interp;
+ CONST char *string;
+ Window *idPtr;
+{
+ int value;
+ if (Tcl_GetInt(interp, string, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *idPtr = (Window) value;
+ return TCL_OK;
+}
+
diff --git a/tcl/win/Makefile.in b/tcl/win/Makefile.in
index f558be19590..602265e466d 100644
--- a/tcl/win/Makefile.in
+++ b/tcl/win/Makefile.in
@@ -1,5 +1,4 @@
-#
-# This file is a Makefile for Tcl. If it has the name "Makefile.in"
+# 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
@@ -7,7 +6,8 @@
#
# RCS: @(#) $Id$
-VERSION = @TCL_VERSION@
+TCLVERSION = @TCL_VERSION@
+VERSION = @TK_VERSION@
#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
@@ -34,109 +34,102 @@ mandir = @mandir@
# 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 =
+INSTALL_ROOT =
-# Directory from which applications will reference the library of Tcl
-# scripts (note: you can set the TCL_LIBRARY environment variable at
+# Directory from which applications will reference the library of Tk
+# scripts (note: you can set the TK_LIBRARY environment variable at
# run-time to override this value):
-TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION)
+TK_LIBRARY = $(prefix)/lib/tk$(VERSION)
# Path to use at runtime to refer to LIB_INSTALL_DIR:
LIB_RUNTIME_DIR = $(libdir)
-# Directory in which to install the program tclsh:
+# Directory in which to install the program wish:
BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
-# Directory in which to install the .a or .so binary for the Tcl library:
+# Directory in which to install the .a or .so binary for the Tk library:
LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
-# Path name to use when installing library scripts.
-SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)
-# Directory in which to install the include file tcl.h:
+# Directory in which to install the include file tk.h:
INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
-# Top-level directory in which to install manual entries:
+# Top-level directory for manual entries:
MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir)
-# Directory in which to install manual entry for tclsh:
-MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+# Directory in which to install manual entry for wish:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
-# Directory in which to install manual entries for Tcl's C library
+# Directory in which to install manual entries for Tk's C library
# procedures:
-MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
# Directory in which to install manual entries for the built-in
-# Tcl commands:
-MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+# Tk commands:
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
# Libraries built with optimization switches have this additional extension
-TCL_DBGX = @TCL_DBGX@
+TK_DBGX = @TK_DBGX@
-# warning flags
-CFLAGS_WARNING = @CFLAGS_WARNING@
+# Directory in which to install the pkgIndex.tcl file for loadable Tk
+PKG_INSTALL_DIR = $(LIB_INSTALL_DIR)/tk$(VERSION)$(TK_DBGX)
-# The default switches for optimization or debugging
-CFLAGS_DEBUG = @CFLAGS_DEBUG@
-CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
+# Package index file for loadable Tk
+PKG_INDEX = $(PKG_INSTALL_DIR)/pkgIndex.tcl
-# To change the compiler switches, for example to change from optimization to
-# debugging symbols, change the following line:
-#CFLAGS = $(CFLAGS_DEBUG)
-#CFLAGS = $(CFLAGS_OPTIMIZE)
-#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ @MEM_DEBUG_FLAGS@
+# The directory containing the Tcl source and header files.
+TCL_SRC_DIR = @TCL_SRC_DIR@
-# To enable compilation debugging reverse the comment characters on
-# one of the following lines.
-COMPILE_DEBUG_FLAGS =
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+# The directory containing the Tcl library archive file appropriate
+# for this version of Tk:
+TCL_BIN_DIR = @TCL_BIN_DIR@
-# Special compiler flags to use when building man2tcl on Windows.
-MAN2TCLFLAGS = @MAN2TCLFLAGS@
-
-SRC_DIR = @srcdir@
-ROOT_DIR = @srcdir@/..
-GENERIC_DIR = @srcdir@/../generic
-WIN_DIR = @srcdir@
-COMPAT_DIR = @srcdir@/../compat
+# The directory containing the Tcl sources and headers appropriate
+# for this version of Tk ("srcdir" will be replaced or has already
+# been replaced by the configure script):
+TCL_GENERIC_DIR = @TCL_SRC_DIR@/generic
+TCL_TOOL_DIR = @TCL_SRC_DIR@/tools
# Converts a POSIX path to a Windows native path.
CYGPATH = @CYGPATH@
-GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)')
-WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)')
-ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)')
+# The name of the Tcl library.
+TCL_LIB_FILE = "$(shell $(CYGPATH) '@TCL_BIN_DIR@/@TCL_LIB_FILE@')"
+TCL_STUB_LIB_FILE = "$(shell $(CYGPATH) '@TCL_BIN_DIR@/@TCL_STUB_LIB_FILE@')"
-LIBRARY_DIR = $(shell echo '$(ROOT_DIR_NATIVE)/library' | sed 's/\\/\//g' )
+SRC_DIR = @srcdir@
+ROOT_DIR = $(SRC_DIR)/..
+WIN_DIR = $(SRC_DIR)
+UNIX_DIR = $(SRC_DIR)/../unix
+GENERIC_DIR = $(SRC_DIR)/../generic
+BITMAP_DIR = $(ROOT_DIR)/bitmaps
+XLIB_DIR = $(ROOT_DIR)/xlib
+RC_DIR = $(WIN_DIR)/rc
+
+ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)')
+WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)')
+GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)')
+BITMAP_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)/bitmaps')
+XLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)/xlib')
+TCL_GENERIC_NATIVE = $(shell $(CYGPATH) '$(TCL_GENERIC_DIR)')
+TCL_SRC_DIR_NATIVE = $(shell $(CYGPATH) '$(TCL_SRC_DIR)')
+RC_DIR_NATIVE = $(shell $(CYGPATH) '$(RC_DIR)')
DLLSUFFIX = @DLLSUFFIX@
LIBSUFFIX = @LIBSUFFIX@
EXESUFFIX = @EXESUFFIX@
-TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
-TCL_DLL_FILE = @TCL_DLL_FILE@
-TCL_LIB_FILE = @TCL_LIB_FILE@
-DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX}
-DDE_LIB_FILE = tcldde$(DDEVER)${LIBSUFFIX}
-REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX}
-REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX}
-PIPE_DLL_FILE = tclpip$(VER)${DLLSUFFIX}
+TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@
+TK_LIB_FILE = @TK_LIB_FILE@
+TK_DLL_FILE = @TK_DLL_FILE@
-SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \
- $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE)
-STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE)
+SHARED_LIBRARIES = $(TK_DLL_FILE) $(TK_STUB_LIB_FILE)
+STATIC_LIBRARIES = $(TK_LIB_FILE)
-# TCL_EXE is the name of a tclsh executable that is available *BEFORE*
-# running make for the first time. Certain build targets (make genstubs)
-# need it to be available on the PATH. This executable should *NOT* be
-# required just to do a normal build although it can be required to run
-# make dist.
-TCL_EXE = tclsh
-
-TCLSH = tclsh$(VER)${EXESUFFIX}
-TCLTEST = tcltest${EXEEXT}
+WISH = wish$(VER)${EXESUFFIX}
+TKTEST = tktest${EXEEXT}
CAT32 = cat32$(EXEEXT)
MAN2TCL = man2tcl$(EXEEXT)
@@ -146,17 +139,37 @@ MAN2TCL = man2tcl$(EXEEXT)
# makefile to look into these paths when resolving .c to .obj
# dependencies.
-VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR)
+VPATH = $(GENERIC_DIR):$(WIN_DIR):$(UNIX_DIR):$(XLIB_DIR):$(RC_DIR)
+
+# warning flags
+CFLAGS_WARNING = @CFLAGS_WARNING@
+
+# The default switches for optimization or debugging
+CFLAGS_DEBUG = @CFLAGS_DEBUG@
+CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
+
+# The default switches for optimization or debugging
+LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
+LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
+
+# To change the compiler switches, for example to change from optimization to
+# debugging symbols, change the following line:
+#CFLAGS = $(CFLAGS_DEBUG)
+#CFLAGS = $(CFLAGS_OPTIMIZE)
+#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
+
+# Special compiler flags to use when building man2tcl on Windows.
+MAN2TCLFLAGS = @MAN2TCLFLAGS@
AR = @AR@
RANLIB = @RANLIB@
CC = @CC@
RC = @RC@
RES = @RES@
+TK_RES = @TK_RES@
AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
CPPFLAGS = @CPPFLAGS@
-LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
-LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@
LDFLAGS_WINDOW = @LDFLAGS_WINDOW@
@@ -164,267 +177,239 @@ EXEEXT = @EXEEXT@
OBJEXT = @OBJEXT@
STLIB_LD = @STLIB_LD@
SHLIB_LD = @SHLIB_LD@
-SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS)
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(TCL_STUB_LIB_FILE) $(LIBS)
SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
-VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
-DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
-DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
-DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
-REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
-REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@
-LIBS = @LIBS@
-
+VER = @TK_MAJOR_VERSION@@TK_MINOR_VERSION@
+DOTVER = @TK_MAJOR_VERSION@.@TK_MINOR_VERSION@
+LIBS = @LIBS@ @LIBS_GUI@
RMDIR = rm -rf
MKDIR = mkdir -p
SHELL = @SHELL@
RM = rm -f
COPY = cp
-CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
--I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
-${COMPILE_DEBUG_FLAGS}
+TCLSH_PROG = @TCLSH_PROG@
+
+# TCL_EXE is the name of a tclsh executable that is available *BEFORE*
+# running make for the first time. Certain build targets (make genstubs)
+# need it to be available on the PATH. This executable should *NOT* be
+# required just to do a normal build although it can be required to run
+# make dist.
+TCL_EXE = tclsh
+
+CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
+-I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
+-I"${XLIB_DIR_NATIVE}" -I"${BITMAP_DIR_NATIVE}" \
+ -I"${TCL_GENERIC_NATIVE}" ${AC_FLAGS}
CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
-STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
--I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
-${COMPILE_DEBUG_FLAGS}
-
-TCLTEST_OBJS = \
- tclTest.$(OBJEXT) \
- tclTestObj.$(OBJEXT) \
- tclTestProcBodyObj.$(OBJEXT) \
- tclThreadTest.$(OBJEXT) \
- tclWinTest.$(OBJEXT) \
- testMain.$(OBJEXT)
-
-GENERIC_OBJS = \
- regcomp.$(OBJEXT) \
- regexec.$(OBJEXT) \
- regfree.$(OBJEXT) \
- regerror.$(OBJEXT) \
- tclAlloc.$(OBJEXT) \
- tclAsync.$(OBJEXT) \
- tclBasic.$(OBJEXT) \
- tclBinary.$(OBJEXT) \
- tclCkalloc.$(OBJEXT) \
- tclClock.$(OBJEXT) \
- tclCmdAH.$(OBJEXT) \
- tclCmdIL.$(OBJEXT) \
- tclCmdMZ.$(OBJEXT) \
- tclCompCmds.$(OBJEXT) \
- tclCompExpr.$(OBJEXT) \
- tclCompile.$(OBJEXT) \
- tclDate.$(OBJEXT) \
- tclEncoding.$(OBJEXT) \
- tclEnv.$(OBJEXT) \
- tclEvent.$(OBJEXT) \
- tclExecute.$(OBJEXT) \
- tclFCmd.$(OBJEXT) \
- tclFileName.$(OBJEXT) \
- tclGet.$(OBJEXT) \
- tclHash.$(OBJEXT) \
- tclHistory.$(OBJEXT) \
- tclIndexObj.$(OBJEXT) \
- tclInterp.$(OBJEXT) \
- tclIO.$(OBJEXT) \
- tclIOCmd.$(OBJEXT) \
- tclIOGT.$(OBJEXT) \
- tclIOSock.$(OBJEXT) \
- tclIOUtil.$(OBJEXT) \
- tclLink.$(OBJEXT) \
- tclLiteral.$(OBJEXT) \
- tclListObj.$(OBJEXT) \
- tclLoad.$(OBJEXT) \
- tclMain.$(OBJEXT) \
- tclNamesp.$(OBJEXT) \
- tclNotify.$(OBJEXT) \
- tclObj.$(OBJEXT) \
- tclPanic.$(OBJEXT) \
- tclParse.$(OBJEXT) \
- tclParseExpr.$(OBJEXT) \
- tclPipe.$(OBJEXT) \
- tclPkg.$(OBJEXT) \
- tclPosixStr.$(OBJEXT) \
- tclPreserve.$(OBJEXT) \
- tclProc.$(OBJEXT) \
- tclRegexp.$(OBJEXT) \
- tclResolve.$(OBJEXT) \
- tclResult.$(OBJEXT) \
- tclScan.$(OBJEXT) \
- tclStringObj.$(OBJEXT) \
- tclStubInit.$(OBJEXT) \
- tclStubLib.$(OBJEXT) \
- tclThread.$(OBJEXT) \
- tclThreadAlloc.$(OBJEXT) \
- tclThreadJoin.$(OBJEXT) \
- tclTimer.$(OBJEXT) \
- tclUtf.$(OBJEXT) \
- tclUtil.$(OBJEXT) \
- tclVar.$(OBJEXT)
-
-WIN_OBJS = \
- tclWin32Dll.$(OBJEXT) \
- tclWinChan.$(OBJEXT) \
- tclWinConsole.$(OBJEXT) \
- tclWinSerial.$(OBJEXT) \
- tclWinError.$(OBJEXT) \
- tclWinFCmd.$(OBJEXT) \
- tclWinFile.$(OBJEXT) \
- tclWinInit.$(OBJEXT) \
- tclWinLoad.$(OBJEXT) \
- tclWinMtherr.$(OBJEXT) \
- tclWinNotify.$(OBJEXT) \
- tclWinPipe.$(OBJEXT) \
- tclWinSock.$(OBJEXT) \
- tclWinThrd.$(OBJEXT) \
- tclWinTime.$(OBJEXT)
-
-COMPAT_OBJS = \
- strftime.$(OBJEXT) strtoll.$(OBJEXT) strtoull.$(OBJEXT)
-
-PIPE_OBJS = stub16.$(OBJEXT)
-
-DDE_OBJS = tclWinDde.$(OBJEXT)
-
-REG_OBJS = tclWinReg.$(OBJEXT)
-
-STUB_OBJS = tclStubLib.$(OBJEXT)
-
-TCLSH_OBJS = tclAppInit.$(OBJEXT)
-
-TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} ${COMPAT_OBJS}
-
-TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
+STUB_CC_SWITCHES = ${CC_SWITCHES} -DUSE_TCL_STUBS
+CON_CC_SWITCHES = ${CC_SWITCHES} -DCONSOLE
+
+# 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 = cp
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL}
+
+WISH_OBJS = \
+ winMain.$(OBJEXT)
+
+TKTEST_OBJS = \
+ testMain.$(OBJEXT) \
+ tkSquare.$(OBJEXT) \
+ tkTest.$(OBJEXT) \
+ tkWinTest.$(OBJEXT)
+
+XLIB_OBJS = \
+ xcolors.$(OBJEXT) \
+ xdraw.$(OBJEXT) \
+ xgc.$(OBJEXT) \
+ ximage.$(OBJEXT) \
+ xutil.$(OBJEXT)
+
+TK_OBJS = \
+ tkConsole.$(OBJEXT) \
+ tkUnixMenubu.$(OBJEXT) \
+ tkUnixScale.$(OBJEXT) \
+ $(XLIB_OBJS) \
+ tkWin3d.$(OBJEXT) \
+ tkWin32Dll.$(OBJEXT) \
+ tkWinButton.$(OBJEXT) \
+ tkWinClipboard.$(OBJEXT) \
+ tkWinColor.$(OBJEXT) \
+ tkWinConfig.$(OBJEXT) \
+ tkWinCursor.$(OBJEXT) \
+ tkWinDialog.$(OBJEXT) \
+ tkWinDraw.$(OBJEXT) \
+ tkWinEmbed.$(OBJEXT) \
+ tkWinFont.$(OBJEXT) \
+ tkWinImage.$(OBJEXT) \
+ tkWinInit.$(OBJEXT) \
+ tkWinKey.$(OBJEXT) \
+ tkWinMenu.$(OBJEXT) \
+ tkWinPixmap.$(OBJEXT) \
+ tkWinPointer.$(OBJEXT) \
+ tkWinRegion.$(OBJEXT) \
+ tkWinScrlbr.$(OBJEXT) \
+ tkWinSend.$(OBJEXT) \
+ tkWinWindow.$(OBJEXT) \
+ tkWinWm.$(OBJEXT) \
+ tkWinX.$(OBJEXT) \
+ stubs.$(OBJEXT) \
+ tk3d.$(OBJEXT) \
+ tkArgv.$(OBJEXT) \
+ tkAtom.$(OBJEXT) \
+ tkBind.$(OBJEXT) \
+ tkBitmap.$(OBJEXT) \
+ tkButton.$(OBJEXT) \
+ tkCanvArc.$(OBJEXT) \
+ tkCanvBmap.$(OBJEXT) \
+ tkCanvImg.$(OBJEXT) \
+ tkCanvLine.$(OBJEXT) \
+ tkCanvPoly.$(OBJEXT) \
+ tkCanvPs.$(OBJEXT) \
+ tkCanvText.$(OBJEXT) \
+ tkCanvUtil.$(OBJEXT) \
+ tkCanvWind.$(OBJEXT) \
+ tkCanvas.$(OBJEXT) \
+ tkClipboard.$(OBJEXT) \
+ tkCmds.$(OBJEXT) \
+ tkColor.$(OBJEXT) \
+ tkConfig.$(OBJEXT) \
+ tkCursor.$(OBJEXT) \
+ tkEntry.$(OBJEXT) \
+ tkError.$(OBJEXT) \
+ tkEvent.$(OBJEXT) \
+ tkFileFilter.$(OBJEXT) \
+ tkFocus.$(OBJEXT) \
+ tkFont.$(OBJEXT) \
+ tkFrame.$(OBJEXT) \
+ tkGC.$(OBJEXT) \
+ tkGeometry.$(OBJEXT) \
+ tkGet.$(OBJEXT) \
+ tkGrab.$(OBJEXT) \
+ tkGrid.$(OBJEXT) \
+ tkImage.$(OBJEXT) \
+ tkImgBmap.$(OBJEXT) \
+ tkImgGIF.$(OBJEXT) \
+ tkImgPPM.$(OBJEXT) \
+ tkImgPhoto.$(OBJEXT) \
+ tkImgUtil.$(OBJEXT) \
+ tkListbox.$(OBJEXT) \
+ tkMacWinMenu.$(OBJEXT) \
+ tkMain.$(OBJEXT) \
+ tkMenu.$(OBJEXT) \
+ tkMenubutton.$(OBJEXT) \
+ tkMenuDraw.$(OBJEXT) \
+ tkMessage.$(OBJEXT) \
+ tkPanedWindow.$(OBJEXT) \
+ tkObj.$(OBJEXT) \
+ tkOldConfig.$(OBJEXT) \
+ tkOption.$(OBJEXT) \
+ tkPack.$(OBJEXT) \
+ tkPlace.$(OBJEXT) \
+ tkPointer.$(OBJEXT) \
+ tkRectOval.$(OBJEXT) \
+ tkScale.$(OBJEXT) \
+ tkScrollbar.$(OBJEXT) \
+ tkSelect.$(OBJEXT) \
+ tkStyle.$(OBJEXT) \
+ tkText.$(OBJEXT) \
+ tkTextBTree.$(OBJEXT) \
+ tkTextDisp.$(OBJEXT) \
+ tkTextImage.$(OBJEXT) \
+ tkTextIndex.$(OBJEXT) \
+ tkTextMark.$(OBJEXT) \
+ tkTextTag.$(OBJEXT) \
+ tkTextWind.$(OBJEXT) \
+ tkTrig.$(OBJEXT) \
+ tkUndo.$(OBJEXT) \
+ tkUtil.$(OBJEXT) \
+ tkVisual.$(OBJEXT) \
+ tkStubInit.$(OBJEXT) \
+ tkStubLib.$(OBJEXT) \
+ tkWindow.$(OBJEXT)
+
+STUB_OBJS = \
+ tkStubLib.$(OBJEXT) \
+ tkStubImg.$(OBJEXT)
+
+TCL_DOCS = "$(TCL_SRC_DIR_NATIVE)"/doc/*.[13n]
+TK_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
+CORE_DOCS = $(TCL_DOCS) $(TK_DOCS)
+
+DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget
+
+# Main targets. The default target -- all -- builds the binaries,
+# performs any post processing on libraries or documents.
all: binaries libraries doc
-tcltest: $(TCLTEST)
-
-binaries: @LIBRARIES@ $(TCLSH)
+binaries: @LIBRARIES@ $(WISH)
libraries:
-doc:
-
-winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL)
- TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS)
- hcw /c /e tcl.hpj
-
-$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c
- $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c
-
-$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES)
- $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
-
-$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES)
- $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
-
-cat32.$(OBJEXT): cat.c
- $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-
-$(CAT32): cat32.$(OBJEXT)
- $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
-
-# The following targets are configured by autoconf to generate either
-# a shared library or static library
-
-${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
- @$(RM) ${TCL_STUB_LIB_FILE}
- @MAKE_LIB@ ${STUB_OBJS}
- @POST_MAKE_LIB@
-
-${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES)
- @$(RM) ${TCL_DLL_FILE}
- @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
-
-${TCL_LIB_FILE}: ${TCL_OBJS}
- @$(RM) ${TCL_LIB_FILE}
- @MAKE_LIB@ ${TCL_OBJS}
- @POST_MAKE_LIB@
-
-${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE}
- @$(RM) ${DDE_DLL_FILE}
- @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-
-${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE}
- @$(RM) ${DDE_LIB_FILE}
- @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE}
-
-${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE}
- @$(RM) ${REG_DLL_FILE}
- @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-
-${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE}
- @$(RM) ${REG_LIB_FILE}
- @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE}
-
-# PIPE_DLL_FILE is actually an executable, don't build it
-# like a DLL.
-
-${PIPE_DLL_FILE}: ${PIPE_OBJS}
- @$(RM) ${PIPE_DLL_FILE}
- @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE)
-
-# Add the object extension to the implicit rules. By default .obj is not
-# automatically added.
-
-.SUFFIXES: .${OBJEXT}
-.SUFFIXES: .$(RES)
-.SUFFIXES: .rc
-
-# Special case object targets
-
-tclWinInit.${OBJEXT}: tclWinInit.c
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+$(ROOT_DIR)/doc/man.macros:
+ $(INSTALL_DATA) "$(TCL_SRC_DIR)/doc/man.macros" "$(ROOT_DIR)/doc/man.macros"
-testMain.${OBJEXT}: tclAppInit.c
- $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)
+doc: $(ROOT_DIR)/doc/man.macros
-tclTest.${OBJEXT}: tclTest.c
- $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-
-tclTestObj.${OBJEXT}: tclTestObj.c
- $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-
-tclWinTest.${OBJEXT}: tclWinTest.c
- $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-
-tclAppInit.${OBJEXT} : tclAppInit.c
- $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-
-# The following objects should be built using the stub interfaces
-
-tclWinReg.${OBJEXT} : tclWinReg.c
- $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME)
-
-tclWinDde.${OBJEXT} : tclWinDde.c
- $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME)
+winhelp: $(TCL_SRC_DIR_NATIVE)/tools/man2help.tcl $(MAN2TCL)
+ TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+ TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
+ PATH="$(PATH):$(TCL_BIN_DIR)"; export PATH; \
+ $(TCLSH_PROG) "$(TCL_SRC_DIR_NATIVE)/tools/man2help.tcl" tcl "$(VER)" $(CORE_DOCS)
+ $(COPY) "$(TCL_BIN_DIR)"/tcl.hpj ./
+ hcw /c /e tcl.hpj
+ $(COPY) ./tcl$(VER).cnt ./TCL$(VER).HLP "$(TCL_SRC_DIR_NATIVE)"/tools/
-# The following objects are part of the stub library and should not
-# be built as DLL objects but none of the symbols should be exported
+$(MAN2TCL): $(TCL_SRC_DIR_NATIVE)/tools/man2tcl.c
+ $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(TCL_SRC_DIR_NATIVE)"/tools/man2tcl.c
-tclStubLib.${OBJEXT}: tclStubLib.c
- $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+# Specifying TESTFLAGS on the command line is the standard way to pass
+# args to tcltest, ie:
+# % make test TESTFLAGS="-verbose bps -file fileName.test"
+test: binaries $(TKTEST)
+ @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+ TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
+ PATH="$(PATH):$(TCL_BIN_DIR)"; export PATH; \
+ ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
+ | ./$(CAT32)
-# Implicit rule for all object files that will end up in the Tcl library
+runtest: binaries $(TKTEST)
+ @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+ TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
+ PATH="$(PATH):$(TCL_BIN_DIR)"; export PATH; \
+ ./$(TKTEST) $(TESTFLAGS) $(SCRIPT)
-.c.${OBJEXT}:
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)
+# This target can be used to run wish from the build directory
+# via `make shell` or `make shell SCRIPT=foo.tcl`
+shell: binaries
+ @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+ TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
+ PATH="$(PATH):$(TCL_BIN_DIR)"; export PATH; \
+ ./$(WISH) $(SCRIPT)
-.rc.$(RES):
- $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
+# This target can be used to run wish inside either gdb or insight
+gdb: binaries
+ @echo "set env TCL_LIBRARY=$(TCL_SRC_DIR_NATIVE)/library" > gdb.run
+ @echo "set env TK_LIBRARY=$(ROOT_DIR_NATIVE)/library" >> gdb.run
+ PATH="$(PATH):$(TCL_BIN_DIR)"; export PATH; \
+ gdb ./$(WISH) --command=gdb.run
+ @$(RM) gdb.run
-install: all install-binaries install-libraries install-doc
+install: all install-binaries install-libraries install-doc install-demos
install-binaries: binaries
- @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
+ @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) $(PKG_INSTALL_DIR); \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
@@ -433,165 +418,202 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in dde1.2 reg1.0; \
- do \
- if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
- echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
- $(MKDIR) $(LIB_INSTALL_DIR)/$$i; \
- else true; \
- fi; \
- done;
- @for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \
+ @for i in $(TK_DLL_FILE) $(WISH); \
do \
if [ -f $$i ]; then \
echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
$(COPY) $$i "$(BIN_INSTALL_DIR)"; \
fi; \
done
- @for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
+ @echo "Creating package index $(PKG_INDEX)";
+ @$(RM) $(PKG_INDEX);
+ @(\
+ echo "if {[package vcompare [package provide Tcl]\
+ $(TCLVERSION)] != 0} { return }";\
+ echo "package ifneeded Tk $(VERSION)\
+ [list load [file join \$$dir .. .. bin $(TK_DLL_FILE)] Tk]";\
+ ) > $(PKG_INDEX);
+ @for i in tkConfig.sh $(TK_LIB_FILE) $(TK_STUB_LIB_FILE); \
do \
if [ -f $$i ]; then \
echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
$(COPY) $$i "$(LIB_INSTALL_DIR)"; \
fi; \
done
- @if [ -f $(DDE_DLL_FILE) ]; then \
- echo installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
- $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/dde1.2; \
- fi
- @if [ -f $(DDE_LIB_FILE) ]; then \
- echo installing $(DDE_LIB_FILE); \
- $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
- fi
- @if [ -f $(REG_DLL_FILE) ]; then \
- echo installing $(REG_DLL_FILE); \
- $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.0; \
- $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/reg1.0; \
- fi
- @if [ -f $(REG_LIB_FILE) ]; then \
- echo installing $(REG_LIB_FILE); \
- $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.0; \
- fi
install-libraries: libraries
- @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \
- $(SCRIPT_INSTALL_DIR); \
+ @for i in $(INSTALL_ROOT)$(prefix)/lib \
+ $(INCLUDE_INSTALL_DIR) $(INCLUDE_INSTALL_DIR)/X11 \
+ $(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images \
+ $(SCRIPT_INSTALL_DIR)/msgs; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
$(MKDIR) $$i; \
+ chmod 755 $$i; \
else true; \
fi; \
done;
- @for i in http1.0 http2.4 opt0.4 encoding msgcat1.3 tcltest2.2; \
+ @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
+ @for i in $(GENERIC_DIR)/tk.h $(GENERIC_DIR)/tkPlatDecls.h \
+ $(GENERIC_DIR)/tkIntXlibDecls.h $(GENERIC_DIR)/tkDecls.h ; \
do \
- if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
- echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
- else true; \
- fi; \
+ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
done;
- @echo "Installing header files";
- @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
- "$(GENERIC_DIR)/tclPlatDecls.h" ; \
+ @for i in $(XLIB_DIR)/X11/*.h; \
do \
- $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
+ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR)/X11; \
done;
@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
- @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
+ @for i in $(ROOT_DIR)/library/*.tcl $(GENERIC_DIR)/prolog.ps \
+ $(ROOT_DIR)/library/tclIndex $(UNIX_DIR)/tkAppInit.c; \
do \
- $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
- @echo "Installing library http1.0 directory";
- @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
+ @echo "Installing library images directory";
+ @for i in $(ROOT_DIR)/library/images/*; \
do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/images; \
+ fi; \
+ done;
+ @echo "Installing translation directory";
+ @for i in $(ROOT_DIR)/library/msgs/*.msg; \
+ do \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/msgs; \
+ fi; \
done;
- @echo "Installing library http2.4 directory";
- @for j in $(ROOT_DIR)/library/http/*.tcl; \
+
+install-demos:
+ @for i in $(INSTALL_ROOT)$(prefix)/lib $(SCRIPT_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR)/demos \
+ $(SCRIPT_INSTALL_DIR)/demos/images ; \
do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http2.4"; \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ $(MKDIR) $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
done;
- @echo "Installing library opt0.4 directory";
- @for j in $(ROOT_DIR)/library/opt/*.tcl; \
+ @echo "Installing demos to $(SCRIPT_INSTALL_DIR)/demos/";
+ @for i in $(ROOT_DIR)/library/demos/*; \
do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
+ if [ -f $$i ] ; then \
+ sed -e '3 s|exec $(WISH)|exec $(WISH)|' \
+ $$i > $(SCRIPT_INSTALL_DIR)/demos/`basename $$i`; \
+ fi; \
done;
- @echo "Installing library msgcat1.3 directory";
- @for j in $(ROOT_DIR)/library/msgcat/*.tcl; \
+ @for i in $(DEMOPROGS); \
do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/msgcat1.3"; \
+ chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
done;
- @echo "Installing library tcltest2.2 directory";
- @for j in $(ROOT_DIR)/library/tcltest/*.tcl; \
+ @echo "Installing demo images";
+ @for i in $(ROOT_DIR)/library/demos/images/*; \
do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/tcltest2.2"; \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \
+ fi; \
done;
- @echo "Installing encodings";
- @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
- $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
- done;
install-doc: doc
-# Specifying TESTFLAGS on the command line is the standard way to pass
-# args to tcltest, ie:
-# % make test TESTFLAGS="-verbose bps -file fileName.test"
-test: binaries $(TCLTEST)
- TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- | ./$(CAT32)
+$(WISH): $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) $(WISH_OBJS) wish.$(RES)
+ $(CC) $(CFLAGS) $(WISH_OBJS) $(TCL_LIB_FILE) $(TK_LIB_FILE) $(LIBS) \
+ wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW)
-# Useful target to launch a built tcltest with the proper path,...
-runtest: binaries $(TCLTEST)
- @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLTEST) $(TESTFLAGS) $(SCRIPT)
+tktest : $(TKTEST)
-# This target can be used to run tclsh from the build directory
-# via `make shell SCRIPT=foo.tcl`
-shell: binaries
- @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) $(SCRIPT)
+$(TKTEST): $(TK_LIB_FILE) $(TKTEST_OBJS) wish.$(RES) $(CAT32)
+ $(CC) $(CFLAGS) $(TKTEST_OBJS) $(TCL_LIB_FILE) \
+ $(TK_LIB_FILE) $(LIBS) \
+ wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW)
-# This target can be used to run tclsh inside either gdb or insight
-gdb: binaries
- @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
- gdb ./tclsh --command=gdb.run
- rm gdb.run
+cat32.${OBJEXT}: $(TCL_SRC_DIR)/win/cat.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-depend:
+$(CAT32): cat32.${OBJEXT}
+ $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
-Makefile: $(SRC_DIR)/Makefile.in
- ./config.status
+# The following targets are configured by autoconf to generate either
+# a shared library or static library
+
+${TK_STUB_LIB_FILE}: ${STUB_OBJS}
+ @$(RM) ${TK_STUB_LIB_FILE}
+ @MAKE_LIB@ ${STUB_OBJS}
+ @POST_MAKE_LIB@
+
+${TK_DLL_FILE}: ${TK_OBJS} $(TK_RES)
+ @$(RM) ${TK_DLL_FILE}
+ @MAKE_DLL@ ${TK_OBJS} $(TK_RES) $(SHLIB_LD_LIBS)
+
+${TK_LIB_FILE}: ${TK_OBJS}
+ @$(RM) ${TK_LIB_FILE}
+ @MAKE_LIB@ ${TK_OBJS}
+ @POST_MAKE_LIB@
+
+# Special case object file targets
+
+winMain.$(OBJEXT): winMain.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+testMain.$(OBJEXT): winMain.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ -DTK_TEST $(CC_OBJNAME)
+
+tkTest.$(OBJEXT): tkTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tkWinTest.$(OBJEXT): tkWinTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tkSquare.$(OBJEXT): tkSquare.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+# Add the object extension to the implicit rules. By default .obj is not
+# automatically added.
+
+.SUFFIXES: .${OBJEXT}
+.SUFFIXES: .$(RES)
+.SUFFIXES: .rc
+
+# Implicit rule for all object files that will end up in the Tcl library
+
+.c.$(OBJEXT):
+ $(CC) -c $(STUB_CC_SWITCHES) -DBUILD_tk @DEPARG@ $(CC_OBJNAME)
+
+.rc.$(RES):
+ $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@
+
+depend:
cleanhelp:
- $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe
+ $(RM) *.hlp *.cnt *.hpj *.GID *.rtf man2tcl${EXEEXT}
clean: cleanhelp
- $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
- $(RM) $(TCLSH) $(TCLTEST) $(CAT32)
+ $(RM) *.lib *.a *.exp *.dll *.res *.${OBJEXT} *~ \#* TAGS a.out
+ $(RM) $(WISH) $(TKTEST) $(CAT32)
$(RM) *.pch *.ilk *.pdb
distclean: clean
- $(RM) Makefile config.status config.cache config.log tclConfig.sh \
- tcl.hpj
+ $(RM) Makefile config.status config.cache config.log tkConfig.sh
+
+Makefile: $(SRC_DIR)/Makefile.in
+ ./config.status
#
# Regenerate the stubs files.
#
-$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
- $(GENERIC_DIR)/tclInt.decls
- @echo "Warning: tclStubInit.c may be out of date."
+$(GENERIC_DIR)/tkStubInit.c: $(GENERIC_DIR)/tk.decls \
+ $(GENERIC_DIR)/tkInt.decls
+ @echo "Warning: tkStubInit.c may be out of date."
@echo "Developers may want to run \"make genstubs\" to regenerate."
@echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ $(TCL_EXE) "$(TCL_TOOL_DIR}\genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)\tcl.decls" \
- "$(GENERIC_DIR_NATIVE)\tclInt.decls"
+ "$(GENERIC_DIR_NATIVE)\tk.decls" \
+ "$(GENERIC_DIR_NATIVE)\tkInt.decls"
diff --git a/tcl/win/README b/tcl/win/README
index d1c67d538ab..15cea28f10f 100644
--- a/tcl/win/README
+++ b/tcl/win/README
@@ -1,104 +1,23 @@
-Tcl 8.4 for Windows
+Tk 8.4 for Windows
-RCS: @(#) $Id$
+Originally by Scott Stanton while at Sun Microsystems Labs
-1. Introduction
----------------
+RCS: @(#) $Id$
This is the directory where you configure and compile the Windows
-version of Tcl. This directory also contains source files for Tcl
-that are specific to Microsoft Windows.
-
-The information in this file is maintained on the web at:
- http://www.tcl.tk/doc/howto/compile.html#win
-
-The above URL includes a lengthy discussion of compiler macros necessary
-when compiling Tcl extensions that will be dynamically loaded.
-
-2. Compiling Tcl
-----------------
-
-In order to compile Tcl for Windows, you need the following:
-
- Tcl 8.4 Source Distribution (plus any patches)
-
- and
-
- Visual C++ 5 or newer
-
- or
-
- Msys + Mingw 1.1
-
- http://prdownloads.sourceforge.net/tcl/msys_mingw2.zip
-
- This Msys + Mingw download is the minimal environment
- needed to build Tcl/Tk under Windows. It includes a
- shell environment and gcc. The release is designed to
- make it as easy a possible to build Tcl/Tk. To install,
- you just download the zip file and extract the files
- into a directory. The README.TXT file describes how
- to launch the msys shell, you then run the configure
- script in the tcl/win directory.
-
- or
-
- Cygwin 1.1 or newer (See http://sources.redhat.com/cygwin)
-
- Mingw 1.1 (http://prdownloads.sourceforge.net/mingw/MinGW-1.1.tar.gz)
-
- Extract the contents of the archive file into /usr/local/mingw
- and place /usr/local/mingw/bin at the front of your PATH env var
- before running the configure script in the tcl/win directory.
-
-
-In practice, this release is built with Visual C++ 6.0 and the TEA
-Makefile.
-
-If you are building with Visual C++, in the "win" subdirectory of the
-source release, you will find "makefile.vc". This is the makefile for
-the Visual C++ compiler and uses the stock NMAKE tool. Detailed
-directions for using it, are in the comments of "makefile.vc". A quick
-example would be:
- C:\tcl_source\win\>nmake -f makefile.vc
-
-There is also a Developer Studio workspace and project file, too, if you
-would like to use them.
-
-If you are building with Msys or Cygwin, you can use the configure script
-that lives in the win subdirectory. The Msys or Cygwin based configure/build
-process works just like the UNIX one, so you will want to refer to
-../unix/README for available configure options. An error will be
-generated by the configure script if you try to compile Tcl with
-the Cygwin version of gcc instead of the Mingw version. Check your
-PATH if you get this error. Be aware that gcc will generate
-lots of compile time warnings when building Tcl. Warnings are
-not errors, so please don't file a bug report about them.
-
-In order to use the binaries generated by these makefiles, you will
-need to place the Tcl script library files someplace where Tcl can
-find them. Tcl looks in one of following places for the library files:
-
- 1) The path specified in the environment variable "TCL_LIBRARY".
-
- 2) Relative to the directory containing the current .exe.
- Tcl will look for a directory "..\lib\tcl8.4" relative to the
- directory containing the currently running .exe.
-
-Note that in order to run tclsh84.exe, you must ensure that tcl84.dll
-and tclpip84.dll are on your path, in the system directory, or in the
-directory containing tclsh84.exe.
-
-Note: Tcl no longer provides support for Win32s.
-
-3. Test suite
--------------
-
-This distribution contains an extensive test suite for Tcl. Some of
-the tests are timing dependent and will fail from time to time. If a
-test is failing consistently, please send us a bug report with as much
-detail as you can manage. Please use the online database at
- http://tcl.sourceforge.net/
-
-In order to run the test suite, you build the "test" target using the
-appropriate makefile for your compiler.
+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.
+
+Please see the README and win/README files that come with the
+associated Tcl release for an extensive set of pointers to
+documentation. You will need to obtain and compile the
+Tcl release before using the Tk source distrition.
+
+If you install the Tk sources next to the Tcl sources, then
+the Tk Makefiles (e.g., makefile.vc for VC++) will properly
+locate the necessary Tcl files. Otherwise you may need to
+edit makefile.vc and adjust the path to Tcl accordingly.
+
+Information about compiling for windows is maintained at:
+ http://www.tcl.tk/doc/howto/compile.html
diff --git a/tcl/win/buildall.vc.bat b/tcl/win/buildall.vc.bat
index 2e5d04ed7d1..4b6a820e9b9 100644
--- a/tcl/win/buildall.vc.bat
+++ b/tcl/win/buildall.vc.bat
@@ -12,18 +12,19 @@ echo.
if "%MSVCDir%" == "" call C:\dev\devstudio60\vc98\bin\vcvars32.bat
set INSTALLDIR=C:\progra~1\tcl
+set TCLDIR=..\..\tcl_head
nmake -nologo -f makefile.vc release winhelp OPTS=none
if errorlevel 1 goto error
-nmake -nologo -f makefile.vc release OPTS=static
+nmake -nologo -f makefile.vc release OPTS=static,linkexten
if errorlevel 1 goto error
-nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt
+nmake -nologo -f makefile.vc core OPTS=static,msvcrt
if errorlevel 1 goto error
nmake -nologo -f makefile.vc core OPTS=static,threads
if errorlevel 1 goto error
-nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt,threads
+nmake -nologo -f makefile.vc core OPTS=static,msvcrt,threads
if errorlevel 1 goto error
-nmake -nologo -f makefile.vc shell OPTS=threads
+nmake -nologo -f makefile.vc release OPTS=threads
if errorlevel 1 goto error
goto end
diff --git a/tcl/win/configure b/tcl/win/configure
index e1d77356b04..6ecdf3bc9a2 100755
--- a/tcl/win/configure
+++ b/tcl/win/configure
@@ -20,7 +20,7 @@ ac_help="$ac_help
ac_help="$ac_help
--enable-symbols build with debugging symbols [--disable-symbols]"
ac_help="$ac_help
- --enable-memdebug build with memory debugging [--disable-memdebug]"
+ --with-tcl=DIR use Tcl 8.4 binaries from DIR"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -461,7 +461,7 @@ 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/tcl.h
+ac_unique_file=../generic/tk.h
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
@@ -533,23 +533,11 @@ fi
-TCL_VERSION=8.4
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=4
-TCL_PATCH_LEVEL=".0"
-VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-
-TCL_DDE_VERSION=1.2
-TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=2
-TCL_DDE_PATCH_LEVEL=""
-DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-
-TCL_REG_VERSION=1.0
-TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=0
-TCL_REG_PATCH_LEVEL=""
-REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
+TK_VERSION=8.4
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=4
+TK_PATCH_LEVEL=".0"
+VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION
#------------------------------------------------------------------------
# Handle the --prefix=... option
@@ -561,7 +549,7 @@ fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-# libdir must be a fully qualified path (not ${exec_prefix}/lib)
+# libdir must be a fully qualified path and (not ${exec_prefix}/lib)
eval libdir="$libdir"
#------------------------------------------------------------------------
@@ -577,7 +565,7 @@ 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:581: checking for $ac_word" >&5
+echo "configure:569: 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
@@ -607,7 +595,7 @@ 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:611: checking for $ac_word" >&5
+echo "configure:599: 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
@@ -658,7 +646,7 @@ fi
# 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:662: checking for $ac_word" >&5
+echo "configure:650: 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
@@ -690,7 +678,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:694: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+echo "configure:682: 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.
@@ -701,12 +689,12 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext << EOF
-#line 705 "configure"
+#line 693 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
-if { (eval echo configure:710: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:698: \"$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
@@ -732,12 +720,12 @@ 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:736: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "configure:724: 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:741: checking whether we are using GNU C" >&5
+echo "configure:729: 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
@@ -746,7 +734,7 @@ else
yes;
#endif
EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:750: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:738: \"$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
@@ -765,7 +753,7 @@ 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:769: checking whether ${CC-cc} accepts -g" >&5
+echo "configure:757: 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
@@ -803,12 +791,15 @@ fi
# autoconf 2.50. You can also just set
# the CC, AR, RANLIB, and RC environment
# variables if you want to cross compile.
+#AC_CHECK_TOOL(AR, ar, :)
+#AC_CHECK_TOOL(RANLIB, ranlib, :)
+#AC_CHECK_TOOL(RC, windres, :)
if test "${GCC}" = "yes" ; then
# Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:812: checking for $ac_word" >&5
+echo "configure:803: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -837,7 +828,7 @@ 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:841: checking for $ac_word" >&5
+echo "configure:832: 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
@@ -866,7 +857,7 @@ fi
# 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:870: checking for $ac_word" >&5
+echo "configure:861: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -899,7 +890,7 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
-echo "configure:903: checking whether ${MAKE-make} sets \${MAKE}" >&5
+echo "configure:894: 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
@@ -927,16 +918,16 @@ fi
#--------------------------------------------------------------------
-# Perform additinal compiler tests.
+# These two macros perform additinal compiler test.
#--------------------------------------------------------------------
echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6
-echo "configure:935: checking for Cygwin environment" >&5
+echo "configure:926: 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 940 "configure"
+#line 931 "configure"
#include "confdefs.h"
int main() {
@@ -947,7 +938,7 @@ int main() {
return __CYGWIN__;
; return 0; }
EOF
-if { (eval echo configure:951: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:942: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_cygwin=yes
else
@@ -964,75 +955,18 @@ echo "$ac_t""$ac_cv_cygwin" 1>&6
CYGWIN=
test "$ac_cv_cygwin" = yes && CYGWIN=yes
-if test "$ac_cv_cygwin" = "yes" ; then
- { echo "configure: error: Compiling with the Cygwin version of gcc is not supported.
- Use the Mingw version of gcc from www.mingw.org instead." 1>&2; exit 1; }
-fi
-
-
-echo $ac_n "checking for SEH support in compiler""... $ac_c" 1>&6
-echo "configure:975: checking for SEH support in compiler" >&5
-if eval "test \"`echo '$''{'tcl_cv_seh'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test "$cross_compiling" = yes; then
- tcl_cv_seh=no
-else
- cat > conftest.$ac_ext <<EOF
-#line 983 "configure"
-#include "confdefs.h"
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int main(int argc, char** argv) {
- int a, b = 0;
- __try {
- a = 666 / b;
- }
- __except (EXCEPTION_EXECUTE_HANDLER) {
- return 0;
- }
- return 1;
-}
-
-EOF
-if { (eval echo configure:1002: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_cv_seh=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_seh=no
-fi
-rm -fr conftest*
-fi
-
-
-fi
-
-echo "$ac_t""$tcl_cv_seh" 1>&6
-if test "$tcl_cv_seh" = "no" ; then
- cat >> confdefs.h <<\EOF
-#define HAVE_NO_SEH
-EOF
-
-fi
-
#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
echo $ac_n "checking for object suffix""... $ac_c" 1>&6
-echo "configure:1030: checking for object suffix" >&5
+echo "configure:964: 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:1036: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:970: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
for ac_file in conftest.*; do
case $ac_file in
*.c) ;;
@@ -1050,19 +984,19 @@ OBJEXT=$ac_cv_objext
ac_objext=$ac_cv_objext
echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6
-echo "configure:1054: checking for mingw32 environment" >&5
+echo "configure:988: 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 1059 "configure"
+#line 993 "configure"
#include "confdefs.h"
int main() {
return __MINGW32__;
; return 0; }
EOF
-if { (eval echo configure:1066: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1000: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_mingw32=yes
else
@@ -1081,7 +1015,7 @@ test "$ac_cv_mingw32" = yes && MINGW32=yes
echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
-echo "configure:1085: checking for executable suffix" >&5
+echo "configure:1019: checking for executable suffix" >&5
if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -1091,7 +1025,7 @@ else
rm -f conftest*
echo 'int main () { return 0; }' > conftest.$ac_ext
ac_cv_exeext=
- if { (eval echo configure:1095: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+ if { (eval echo configure:1029: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
for file in conftest.*; do
case $file in
*.c | *.o | *.obj) ;;
@@ -1118,7 +1052,7 @@ ac_exeext=$EXEEXT
echo $ac_n "checking for building with threads""... $ac_c" 1>&6
-echo "configure:1122: checking for building with threads" >&5
+echo "configure:1056: checking for building with threads" >&5
# Check whether --enable-threads or --disable-threads was given.
if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
@@ -1144,12 +1078,12 @@ EOF
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
-# building libtcl as a shared library instead of a static library.
+# building libtk as a shared library instead of a static library.
#--------------------------------------------------------------------
echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
-echo "configure:1153: checking how to build libraries" >&5
+echo "configure:1087: checking how to build libraries" >&5
# Check whether --enable-shared or --disable-shared was given.
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
@@ -1190,7 +1124,7 @@ EOF
# Step 0: Enable 64 bit support?
echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6
-echo "configure:1194: checking if 64bit support is requested" >&5
+echo "configure:1128: checking if 64bit support is requested" >&5
# Check whether --enable-64bit or --disable-64bit was given.
if test "${enable_64bit+set}" = set; then
enableval="$enable_64bit"
@@ -1207,7 +1141,7 @@ fi
# Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1211: checking for $ac_word" >&5
+echo "configure:1145: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CYGPATH'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -1244,7 +1178,7 @@ fi
# set various compiler flags depending on whether we are using gcc or cl
echo $ac_n "checking compiler flags""... $ac_c" 1>&6
-echo "configure:1248: checking compiler flags" >&5
+echo "configure:1182: checking compiler flags" >&5
if test "${GCC}" = "yes" ; then
if test "$do64bit" = "yes" ; then
echo "configure: warning: "64bit mode not supported with GCC on Windows"" 1>&2
@@ -1252,7 +1186,7 @@ echo "configure:1248: checking compiler flags" >&5
SHLIB_LD=""
SHLIB_LD_LIBS=""
LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32"
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
@@ -1393,7 +1327,7 @@ echo "configure:1248: checking compiler flags" >&5
SHLIB_LD="${LINKBIN} -dll -nologo -incremental:no"
SHLIB_LD_LIBS="user32.lib advapi32.lib"
LIBS="user32.lib advapi32.lib"
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib"
RC_OUT=-fo
RC_TYPE=-r
RC_INCLUDE=-i
@@ -1427,64 +1361,11 @@ echo "configure:1248: checking compiler flags" >&5
#--------------------------------------------------------------------
-# Set the default compiler switches based on the --enable-symbols
-# option. This macro depends on C flags, and should be called
-# after SC_CONFIG_CFLAGS macro is called.
-#--------------------------------------------------------------------
-
-
- echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
-echo "configure:1438: checking for build with symbols" >&5
- # Check whether --enable-symbols or --disable-symbols was given.
-if test "${enable_symbols+set}" = set; then
- enableval="$enable_symbols"
- tcl_ok=$enableval
-else
- tcl_ok=no
-fi
-
-
- if test "$tcl_ok" = "yes"; then
- CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
- LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
- DBGX=d
- echo "$ac_t""yes" 1>&6
- else
- CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
- LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
- DBGX=""
- echo "$ac_t""no" 1>&6
- fi
-
-
- echo $ac_n "checking for build with memory debugging""... $ac_c" 1>&6
-echo "configure:1462: checking for build with memory debugging" >&5
- # Check whether --enable-memdebug or --disable-memdebug was given.
-if test "${enable_memdebug+set}" = set; then
- enableval="$enable_memdebug"
- tcl_ok=$enableval
-else
- tcl_ok=no
-fi
-
- if test "$tcl_ok" = "yes"; then
- MEM_DEBUG_FLAGS=-DTCL_MEM_DEBUG
- echo "$ac_t""yes" 1>&6
- else
- MEM_DEBUG_FLAGS=""
- echo "$ac_t""no" 1>&6
- fi
-
-
-
-TCL_DBGX=${DBGX}
-
-#--------------------------------------------------------------------
# man2tcl needs this so that it can use errno.h
#--------------------------------------------------------------------
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:1488: checking how to run the C preprocessor" >&5
+echo "configure:1369: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@@ -1499,13 +1380,13 @@ else
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
-#line 1503 "configure"
+#line 1384 "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:1509: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1390: \"$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
:
@@ -1516,13 +1397,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
-#line 1520 "configure"
+#line 1401 "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:1526: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1407: \"$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
:
@@ -1533,13 +1414,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
-#line 1537 "configure"
+#line 1418 "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:1543: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1424: \"$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
:
@@ -1565,17 +1446,17 @@ echo "$ac_t""$CPP" 1>&6
ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for errno.h""... $ac_c" 1>&6
-echo "configure:1569: checking for errno.h" >&5
+echo "configure:1450: checking for errno.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 1574 "configure"
+#line 1455 "configure"
#include "confdefs.h"
#include <errno.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1579: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1460: \"$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*
@@ -1599,67 +1480,215 @@ fi
+#--------------------------------------------------------------------
+# Set the default compiler switches based on the --enable-symbols
+# option. This macro depends on C flags, and should be called
+# after SC_CONFIG_CFLAGS macro is called.
+#--------------------------------------------------------------------
+
+
+ echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
+echo "configure:1492: checking for build with symbols" >&5
+ # Check whether --enable-symbols or --disable-symbols was given.
+if test "${enable_symbols+set}" = set; then
+ enableval="$enable_symbols"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
+fi
+
+
+ if test "$tcl_ok" = "yes"; then
+ CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
+ DBGX=d
+ echo "$ac_t""yes" 1>&6
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ echo "$ac_t""no" 1>&6
+ fi
+
+
+TK_DBGX=${DBGX}
+
+#--------------------------------------------------------------------
+# Locate and source the tclConfig.sh file.
+#--------------------------------------------------------------------
+
+
+ echo $ac_n "checking the location of tclConfig.sh""... $ac_c" 1>&6
+echo "configure:1523: checking the location of tclConfig.sh" >&5
+
+ if test -d ../../tcl8.4$TK_PATCH_LEVEL/win; then
+ TCL_BIN_DIR_DEFAULT=../../tcl8.4$TK_PATCH_LEVEL/win
+ else
+ TCL_BIN_DIR_DEFAULT=../../tcl8.4/win
+ fi
+
+ # 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_BIN_DIR_DEFAULT; pwd`
+fi
+
+ if test ! -d $TCL_BIN_DIR; then
+ { echo "configure: error: Tcl directory $TCL_BIN_DIR does not exist" 1>&2; exit 1; }
+ fi
+ if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
+ { echo "configure: error: There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+ fi
+ echo "$ac_t""$TCL_BIN_DIR/tclConfig.sh" 1>&6
+
+
+ echo $ac_n "checking for existence of $TCL_BIN_DIR/tclConfig.sh""... $ac_c" 1>&6
+echo "configure:1549: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5
+
+ if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then
+ echo "$ac_t""loading" 1>&6
+ . $TCL_BIN_DIR/tclConfig.sh
+ else
+ echo "$ac_t""file not found" 1>&6
+ fi
+
+ #
+ # If the TCL_BIN_DIR is the build directory (not the install directory),
+ # then set the common variable name to the value of the build variables.
+ # For example, the variable TCL_LIB_SPEC will be set to the value
+ # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
+ # instead of TCL_BUILD_LIB_SPEC since it will work with both an
+ # installed and uninstalled version of Tcl.
+ #
+
+ if test -f $TCL_BIN_DIR/Makefile ; then
+ TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC}
+ TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC}
+ TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
+ fi
+
+ #
+ # eval is required to do the TCL_DBGX substitution
+ #
+
+ eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
+ eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
+ eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
+
+ eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
+ eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
+ eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ echo $ac_n "checking for tclsh""... $ac_c" 1>&6
+echo "configure:1600: checking for tclsh" >&5
+
+ if eval "test \"`echo '$''{'ac_cv_path_tclsh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ search_path=`echo ${exec_prefix}/bin:${prefix}/bin:${TCL_BIN_DIR}:${TCL_BIN_DIR}/../bin:${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \
+ `ls -r $dir/tclsh* 2> /dev/null` ; do
+ if test x"$ac_cv_path_tclsh" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_tclsh=$j
+ break
+ fi
+ fi
+ done
+ done
+
+fi
+
+
+ if test -f "$ac_cv_path_tclsh" ; then
+ TCLSH_PROG=$ac_cv_path_tclsh
+ echo "$ac_t""$TCLSH_PROG" 1>&6
+ else
+ { echo "configure: error: No tclsh found in PATH: $search_path" 1>&2; exit 1; }
+ fi
+
+
+
#------------------------------------------------------------------------
-# tclConfig.sh refers to this by a different name
+# tkConfig.sh refers to this by a different name
#------------------------------------------------------------------------
-TCL_SHARED_BUILD=${SHARED_BUILD}
+TK_SHARED_BUILD=${SHARED_BUILD}
#--------------------------------------------------------------------
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------
-TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
-TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TK_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TK_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TK_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\""
+eval "TK_SRC_DIR=`cd $srcdir/..; pwd`"
-eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
+eval "TK_DLL_FILE=tk$VER${DLLSUFFIX}"
+eval "TK_LIB_FILE=${LIBPREFIX}tk$VER${LIBSUFFIX}"
-eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}"
-# FIMXE: These variables decls are missing
-#TCL_LIB_FLAG
-#TCL_BUILD_LIB_SPEC
-#TCL_LIB_SPEC
+eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${VER}${LIBSUFFIX}"
+# FIXME: All of this var junk needs to be done in tcl.m4 !!!!
+# I left out the other vars that also need to get defined here.
+# we also need to double check about including DBGX in lib names
+# and spaces in file or directory names for the eval
+eval "TK_STUB_LIB_FLAG=\"-ltkstub${VER}${TCL_DBGX}\""
+eval "TK_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TK_STUB_LIB_FLAG}\""
+
+eval "TCL_DLL_FILE=\"tcl$VER${DLLSUFFIX}\""
+eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl$VER${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${TCL_DBGX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\""
-eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
-
-# Install time header dir can be set via --includedir
-eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
-
eval "DLLSUFFIX=${DLLSUFFIX}"
eval "LIBPREFIX=${LIBPREFIX}"
eval "LIBSUFFIX=${LIBSUFFIX}"
eval "EXESUFFIX=${EXESUFFIX}"
-CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
-CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
-CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+CFG_TK_SHARED_LIB_SUFFIX=${TK_SHARED_LIB_SUFFIX}
+CFG_TK_UNSHARED_LIB_SUFFIX=${TK_UNSHARED_LIB_SUFFIX}
+CFG_TK_EXPORT_FILE_SUFFIX=${TK_EXPORT_FILE_SUFFIX}
#--------------------------------------------------------------------
# Adjust the defines for how the resources are built depending
# on symbols and static vs. shared.
#--------------------------------------------------------------------
-if test ${SHARED_BUILD} = 0 ; then
+if test "$SHARED_BUILD" = 0 -o "$TCL_NEEDS_EXP_FILE" = 0; then
if test "${DBGX}" = "d"; then
RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
else
RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
fi
+ TK_RES=""
else
if test "${DBGX}" = "d"; then
RC_DEFINES="${RC_DEFINE} DEBUG"
else
RC_DEFINES=""
fi
+ TK_RES='tk.$(RES)'
fi
@@ -1670,15 +1699,6 @@ fi
-# empty on win
-
-
-
-
-
-
-
-
@@ -1688,7 +1708,6 @@ fi
-# win/tcl.m4 doesn't set (CFLAGS)
@@ -1696,7 +1715,6 @@ fi
-# win/tcl.m4 doesn't set (LDFLAGS)
@@ -1724,7 +1742,6 @@ fi
-# empty on win, but needs sub'ing
@@ -1735,8 +1752,6 @@ fi
-# win only
-
@@ -1744,6 +1759,7 @@ fi
+# undefined at this point for win
@@ -1865,7 +1881,7 @@ done
ac_given_srcdir=$srcdir
-trap 'rm -fr `echo "Makefile tclConfig.sh tcl.hpj" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+trap 'rm -fr `echo "Makefile tkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
@@ -1910,33 +1926,48 @@ s%@DL_LIBS@%$DL_LIBS%g
s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
-s%@MEM_DEBUG_FLAGS@%$MEM_DEBUG_FLAGS%g
s%@CPP@%$CPP%g
s%@MAN2TCLFLAGS@%$MAN2TCLFLAGS%g
s%@TCL_VERSION@%$TCL_VERSION%g
-s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
-s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
-s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
-s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g
-s%@TCL_INCLUDE_SPEC@%$TCL_INCLUDE_SPEC%g
-s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
-s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
+s%@TCLSH_PROG@%$TCLSH_PROG%g
+s%@TK_VERSION@%$TK_VERSION%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_DBGX@%$TK_DBGX%g
+s%@TK_LIB_FILE@%$TK_LIB_FILE%g
+s%@TK_DLL_FILE@%$TK_DLL_FILE%g
+s%@TK_STUB_LIB_FILE@%$TK_STUB_LIB_FILE%g
+s%@TK_STUB_LIB_FLAG@%$TK_STUB_LIB_FLAG%g
+s%@TK_BUILD_STUB_LIB_SPEC@%$TK_BUILD_STUB_LIB_SPEC%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_BIN_DIR@%$TK_BIN_DIR%g
+s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
+s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
+s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
s%@TCL_DLL_FILE@%$TCL_DLL_FILE%g
-s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
-s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
s%@TCL_DBGX@%$TCL_DBGX%g
-s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g
-s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g
-s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g
+s%@CFG_TK_SHARED_LIB_SUFFIX@%$CFG_TK_SHARED_LIB_SUFFIX%g
+s%@CFG_TK_UNSHARED_LIB_SUFFIX@%$CFG_TK_UNSHARED_LIB_SUFFIX%g
+s%@CFG_TK_EXPORT_FILE_SUFFIX@%$CFG_TK_EXPORT_FILE_SUFFIX%g
+s%@TK_SHARED_BUILD@%$TK_SHARED_BUILD%g
+s%@DEPARG@%$DEPARG%g
s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
-s%@DEPARG@%$DEPARG%g
+s%@STLIB_LD@%$STLIB_LD%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
s%@CC_OBJNAME@%$CC_OBJNAME%g
s%@CC_EXENAME@%$CC_EXENAME%g
s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
@@ -1944,12 +1975,13 @@ s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
s%@LDFLAGS_CONSOLE@%$LDFLAGS_CONSOLE%g
s%@LDFLAGS_WINDOW@%$LDFLAGS_WINDOW%g
-s%@STLIB_LD@%$STLIB_LD%g
-s%@SHLIB_LD@%$SHLIB_LD%g
-s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
-s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
-s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
-s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
+s%@RC_OUT@%$RC_OUT%g
+s%@RC_TYPE@%$RC_TYPE%g
+s%@RC_INCLUDE@%$RC_INCLUDE%g
+s%@RC_DEFINE@%$RC_DEFINE%g
+s%@RC_DEFINES@%$RC_DEFINES%g
+s%@TK_RES@%$TK_RES%g
+s%@RES@%$RES%g
s%@LIBS_GUI@%$LIBS_GUI%g
s%@DLLSUFFIX@%$DLLSUFFIX%g
s%@LIBPREFIX@%$LIBPREFIX%g
@@ -1960,28 +1992,14 @@ s%@MAKE_LIB@%$MAKE_LIB%g
s%@POST_MAKE_LIB@%$POST_MAKE_LIB%g
s%@MAKE_DLL@%$MAKE_DLL%g
s%@MAKE_EXE@%$MAKE_EXE%g
-s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
-s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
-s%@TCL_NEEDS_EXP_FILE@%$TCL_NEEDS_EXP_FILE%g
-s%@TCL_BUILD_EXP_FILE@%$TCL_BUILD_EXP_FILE%g
-s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g
-s%@LIBOBJS@%$LIBOBJS%g
-s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
-s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
-s%@TCL_DDE_VERSION@%$TCL_DDE_VERSION%g
-s%@TCL_DDE_MAJOR_VERSION@%$TCL_DDE_MAJOR_VERSION%g
-s%@TCL_DDE_MINOR_VERSION@%$TCL_DDE_MINOR_VERSION%g
-s%@TCL_DDE_PATCH_LEVEL@%$TCL_DDE_PATCH_LEVEL%g
-s%@TCL_REG_VERSION@%$TCL_REG_VERSION%g
-s%@TCL_REG_MAJOR_VERSION@%$TCL_REG_MAJOR_VERSION%g
-s%@TCL_REG_MINOR_VERSION@%$TCL_REG_MINOR_VERSION%g
-s%@TCL_REG_PATCH_LEVEL@%$TCL_REG_PATCH_LEVEL%g
-s%@RC_OUT@%$RC_OUT%g
-s%@RC_TYPE@%$RC_TYPE%g
-s%@RC_INCLUDE@%$RC_INCLUDE%g
-s%@RC_DEFINE@%$RC_DEFINE%g
-s%@RC_DEFINES@%$RC_DEFINES%g
-s%@RES@%$RES%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_FLAG@%$TK_LIB_FLAG%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@TK_STUB_LIB_SPEC@%$TK_STUB_LIB_SPEC%g
+s%@TK_BUILD_STUB_LIB_PATH@%$TK_BUILD_STUB_LIB_PATH%g
+s%@TK_STUB_LIB_PATH@%$TK_STUB_LIB_PATH%g
CEOF
EOF
@@ -2023,7 +2041,7 @@ EOF
cat >> $CONFIG_STATUS <<EOF
-CONFIG_FILES=\${CONFIG_FILES-"Makefile tclConfig.sh tcl.hpj"}
+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
diff --git a/tcl/win/configure.in b/tcl/win/configure.in
index c700e52736f..619cfc4c014 100755
--- a/tcl/win/configure.in
+++ b/tcl/win/configure.in
@@ -1,30 +1,18 @@
#! /bin/bash -norc
# This file is an input file used by the GNU "autoconf" program to
-# generate the file "configure", which is run during Tcl installation
+# generate the file "configure", which is run during Tk installation
# to configure the system for the local environment.
#
# RCS: @(#) $Id$
-AC_INIT(../generic/tcl.h)
+AC_INIT(../generic/tk.h)
AC_PREREQ(2.13)
-TCL_VERSION=8.4
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=4
-TCL_PATCH_LEVEL=".0"
-VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-
-TCL_DDE_VERSION=1.2
-TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=2
-TCL_DDE_PATCH_LEVEL=""
-DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-
-TCL_REG_VERSION=1.0
-TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=0
-TCL_REG_PATCH_LEVEL=""
-REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
+TK_VERSION=8.4
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=4
+TK_PATCH_LEVEL=".0"
+VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION
#------------------------------------------------------------------------
# Handle the --prefix=... option
@@ -36,7 +24,7 @@ fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-# libdir must be a fully qualified path (not ${exec_prefix}/lib)
+# libdir must be a fully qualified path and (not ${exec_prefix}/lib)
eval libdir="$libdir"
#------------------------------------------------------------------------
@@ -57,9 +45,9 @@ AC_PROG_CC
# autoconf 2.50. You can also just set
# the CC, AR, RANLIB, and RC environment
# variables if you want to cross compile.
-dnl AC_CHECK_TOOL(AR, ar, :)
-dnl AC_CHECK_TOOL(RANLIB, ranlib, :)
-dnl AC_CHECK_TOOL(RC, windres, :)
+#AC_CHECK_TOOL(AR, ar, :)
+#AC_CHECK_TOOL(RANLIB, ranlib, :)
+#AC_CHECK_TOOL(RC, windres, :)
if test "${GCC}" = "yes" ; then
AC_CHECK_PROG(AR, ar, ar)
@@ -74,44 +62,11 @@ fi
AC_PROG_MAKE_SET
#--------------------------------------------------------------------
-# Perform additinal compiler tests.
+# These two macros perform additinal compiler test.
#--------------------------------------------------------------------
AC_CYGWIN
-if test "$ac_cv_cygwin" = "yes" ; then
- AC_MSG_ERROR([Compiling with the Cygwin version of gcc is not supported.
- Use the Mingw version of gcc from www.mingw.org instead.])
-fi
-
-
-AC_CACHE_CHECK(for SEH support in compiler,
- tcl_cv_seh,
-AC_TRY_RUN([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int main(int argc, char** argv) {
- int a, b = 0;
- __try {
- a = 666 / b;
- }
- __except (EXCEPTION_EXECUTE_HANDLER) {
- return 0;
- }
- return 1;
-}
-],
- tcl_cv_seh=yes,
- tcl_cv_seh=no,
- tcl_cv_seh=no)
-)
-if test "$tcl_cv_seh" = "no" ; then
- AC_DEFINE(HAVE_NO_SEH,,
- [Defined when mingw does not support SEH])
-fi
-
#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
@@ -127,7 +82,7 @@ SC_ENABLE_THREADS
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
-# building libtcl as a shared library instead of a static library.
+# building libtk as a shared library instead of a static library.
#--------------------------------------------------------------------
SC_ENABLE_SHARED
@@ -141,121 +96,136 @@ SC_ENABLE_SHARED
SC_CONFIG_CFLAGS
#--------------------------------------------------------------------
+# man2tcl needs this so that it can use errno.h
+#--------------------------------------------------------------------
+
+AC_CHECK_HEADER(errno.h, , MAN2TCLFLAGS="-DNO_ERRNO_H")
+AC_SUBST(MAN2TCLFLAGS)
+
+#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option. This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
#--------------------------------------------------------------------
SC_ENABLE_SYMBOLS
-SC_ENABLE_MEMDEBUG
-TCL_DBGX=${DBGX}
+TK_DBGX=${DBGX}
#--------------------------------------------------------------------
-# man2tcl needs this so that it can use errno.h
+# Locate and source the tclConfig.sh file.
#--------------------------------------------------------------------
-AC_CHECK_HEADER(errno.h, , MAN2TCLFLAGS="-DNO_ERRNO_H")
-AC_SUBST(MAN2TCLFLAGS)
+SC_PATH_TCLCONFIG($TK_PATCH_LEVEL)
+SC_LOAD_TCLCONFIG
+
+SC_PROG_TCLSH
#------------------------------------------------------------------------
-# tclConfig.sh refers to this by a different name
+# tkConfig.sh refers to this by a different name
#------------------------------------------------------------------------
-TCL_SHARED_BUILD=${SHARED_BUILD}
+TK_SHARED_BUILD=${SHARED_BUILD}
#--------------------------------------------------------------------
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------
-TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
-TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TK_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TK_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TK_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+
+eval "TK_SRC_DIR=`cd $srcdir/..; pwd`"
-eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\""
+eval "TK_DLL_FILE=tk$VER${DLLSUFFIX}"
+eval "TK_LIB_FILE=${LIBPREFIX}tk$VER${LIBSUFFIX}"
-eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
+eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${VER}${LIBSUFFIX}"
+# FIXME: All of this var junk needs to be done in tcl.m4 !!!!
+# I left out the other vars that also need to get defined here.
+# we also need to double check about including DBGX in lib names
+# and spaces in file or directory names for the eval
+eval "TK_STUB_LIB_FLAG=\"-ltkstub${VER}${TCL_DBGX}\""
+eval "TK_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TK_STUB_LIB_FLAG}\""
-eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}"
-# FIMXE: These variables decls are missing
-#TCL_LIB_FLAG
-#TCL_BUILD_LIB_SPEC
-#TCL_LIB_SPEC
+eval "TCL_DLL_FILE=\"tcl$VER${DLLSUFFIX}\""
+eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl$VER${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${TCL_DBGX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\""
-eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
-
-# Install time header dir can be set via --includedir
-eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
-
eval "DLLSUFFIX=${DLLSUFFIX}"
eval "LIBPREFIX=${LIBPREFIX}"
eval "LIBSUFFIX=${LIBSUFFIX}"
eval "EXESUFFIX=${EXESUFFIX}"
-CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
-CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
-CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+CFG_TK_SHARED_LIB_SUFFIX=${TK_SHARED_LIB_SUFFIX}
+CFG_TK_UNSHARED_LIB_SUFFIX=${TK_UNSHARED_LIB_SUFFIX}
+CFG_TK_EXPORT_FILE_SUFFIX=${TK_EXPORT_FILE_SUFFIX}
#--------------------------------------------------------------------
# Adjust the defines for how the resources are built depending
# on symbols and static vs. shared.
#--------------------------------------------------------------------
-if test ${SHARED_BUILD} = 0 ; then
+if test "$SHARED_BUILD" = 0 -o "$TCL_NEEDS_EXP_FILE" = 0; then
if test "${DBGX}" = "d"; then
RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
else
RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
fi
+ TK_RES=""
else
if test "${DBGX}" = "d"; then
RC_DEFINES="${RC_DEFINE} DEBUG"
else
RC_DEFINES=""
fi
+ TK_RES='tk.$(RES)'
fi
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_MAJOR_VERSION)
+AC_SUBST(TK_MINOR_VERSION)
+AC_SUBST(TK_PATCH_LEVEL)
+AC_SUBST(TK_DBGX)
+AC_SUBST(TK_LIB_FILE)
+AC_SUBST(TK_DLL_FILE)
+AC_SUBST(TK_STUB_LIB_FILE)
+AC_SUBST(TK_STUB_LIB_FLAG)
+AC_SUBST(TK_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(TK_BIN_DIR)
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
-
AC_SUBST(TCL_LIB_FILE)
-AC_SUBST(TCL_LIB_FLAG)
-# empty on win
-AC_SUBST(TCL_LIB_SPEC)
+AC_SUBST(TCL_DLL_FILE)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
-AC_SUBST(TCL_STUB_LIB_SPEC)
-AC_SUBST(TCL_STUB_LIB_PATH)
-AC_SUBST(TCL_INCLUDE_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
-AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
-AC_SUBST(TCL_DLL_FILE)
-
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_DBGX)
-AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
-AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
-AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
+AC_SUBST(CFG_TK_SHARED_LIB_SUFFIX)
+AC_SUBST(CFG_TK_UNSHARED_LIB_SUFFIX)
+AC_SUBST(CFG_TK_EXPORT_FILE_SUFFIX)
+AC_SUBST(TK_SHARED_BUILD)
-# win/tcl.m4 doesn't set (CFLAGS)
-AC_SUBST(CFLAGS_DEFAULT)
-AC_SUBST(EXTRA_CFLAGS)
AC_SUBST(CYGPATH)
AC_SUBST(DEPARG)
+AC_SUBST(CFLAGS_DEFAULT)
+AC_SUBST(EXTRA_CFLAGS)
+AC_SUBST(STLIB_LD)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_SUFFIX)
AC_SUBST(CC_OBJNAME)
AC_SUBST(CC_EXENAME)
-
-# win/tcl.m4 doesn't set (LDFLAGS)
AC_SUBST(LDFLAGS_DEFAULT)
AC_SUBST(LDFLAGS_DEBUG)
AC_SUBST(LDFLAGS_OPTIMIZE)
@@ -263,14 +233,14 @@ AC_SUBST(LDFLAGS_CONSOLE)
AC_SUBST(LDFLAGS_WINDOW)
AC_SUBST(AR)
AC_SUBST(RANLIB)
-
-AC_SUBST(STLIB_LD)
-AC_SUBST(SHLIB_LD)
-AC_SUBST(SHLIB_LD_LIBS)
-AC_SUBST(SHLIB_CFLAGS)
-AC_SUBST(SHLIB_SUFFIX)
-AC_SUBST(TCL_SHARED_BUILD)
-
+AC_SUBST(RC)
+AC_SUBST(RC_OUT)
+AC_SUBST(RC_TYPE)
+AC_SUBST(RC_INCLUDE)
+AC_SUBST(RC_DEFINE)
+AC_SUBST(RC_DEFINES)
+AC_SUBST(TK_RES)
+AC_SUBST(RES)
AC_SUBST(LIBS)
AC_SUBST(LIBS_GUI)
AC_SUBST(DLLSUFFIX)
@@ -283,33 +253,14 @@ AC_SUBST(POST_MAKE_LIB)
AC_SUBST(MAKE_DLL)
AC_SUBST(MAKE_EXE)
-# empty on win, but needs sub'ing
-AC_SUBST(TCL_BUILD_LIB_SPEC)
-AC_SUBST(TCL_LD_SEARCH_FLAGS)
-AC_SUBST(TCL_NEEDS_EXP_FILE)
-AC_SUBST(TCL_BUILD_EXP_FILE)
-AC_SUBST(TCL_EXP_FILE)
-AC_SUBST(DL_LIBS)
-AC_SUBST(LIBOBJS)
-AC_SUBST(TCL_LIB_VERSIONS_OK)
-AC_SUBST(TCL_PACKAGE_PATH)
-
-# win only
-AC_SUBST(TCL_DDE_VERSION)
-AC_SUBST(TCL_DDE_MAJOR_VERSION)
-AC_SUBST(TCL_DDE_MINOR_VERSION)
-AC_SUBST(TCL_DDE_PATCH_LEVEL)
-AC_SUBST(TCL_REG_VERSION)
-AC_SUBST(TCL_REG_MAJOR_VERSION)
-AC_SUBST(TCL_REG_MINOR_VERSION)
-AC_SUBST(TCL_REG_PATCH_LEVEL)
-
-AC_SUBST(RC)
-AC_SUBST(RC_OUT)
-AC_SUBST(RC_TYPE)
-AC_SUBST(RC_INCLUDE)
-AC_SUBST(RC_DEFINE)
-AC_SUBST(RC_DEFINES)
-AC_SUBST(RES)
-
-AC_OUTPUT(Makefile tclConfig.sh tcl.hpj)
+# undefined at this point for win
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_CC_SEARCH_FLAGS)
+AC_SUBST(TK_LD_SEARCH_FLAGS)
+AC_SUBST(TK_LIB_FLAG)
+AC_SUBST(TK_LIB_SPEC)
+AC_SUBST(TK_STUB_LIB_SPEC)
+AC_SUBST(TK_BUILD_STUB_LIB_PATH)
+AC_SUBST(TK_STUB_LIB_PATH)
+
+AC_OUTPUT(Makefile tkConfig.sh)
diff --git a/tcl/win/lamp.bmp b/tcl/win/lamp.bmp
new file mode 100644
index 00000000000..834c0f9a521
--- /dev/null
+++ b/tcl/win/lamp.bmp
Binary files differ
diff --git a/tcl/win/license.terms b/tcl/win/license.terms
index f1dcaa5245c..03ca6fcb319 100644
--- a/tcl/win/license.terms
+++ b/tcl/win/license.terms
@@ -1,8 +1,7 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
+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
@@ -37,4 +36,4 @@ 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.
+terms specified in this license.
diff --git a/tcl/win/makefile.bc b/tcl/win/makefile.bc
index a352f707406..d26d00b448c 100644
--- a/tcl/win/makefile.bc
+++ b/tcl/win/makefile.bc
@@ -1,51 +1,19 @@
#
# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile
-# for Visual C++ that came with tcl 8.3.3
+# for Visual C++ that came with tk 8.3.3
+#
+# Some "not so obvious" details in this makefile are preceded by a comment
+# "maintenance hint", which tries to explain what's going on. Better to
+# leave those in place.
+# Helmut Giese, July 2002
#
# 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.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# Have a look at the complete description on how to build and test Tcl with
-# the current Borland compilers at www.ratiosoft.com/tcl/borland.
-#
-# Usage:
-# - Adapt the paths below to match your compiler's location
-# - Make sure the compiler's bin directory is on your path
-# - Open a console
-# - To make a debug version enter
-# make -fmakefile.bc -DNODEBUG=0 xxx
-# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
-# Please note: I omitted the 'd' suffix for debug versions because Tcl
-# will always call tclpip83.dll and not tclpip83d.dll, causing an error.
-# ^
-# Besides, the debug version goes into a separate directory, so there
-# should be no problem having DLLs and EXEs with the same name.
-# If you prefer your debug version having the 'd' suffix just uncomment
-# the line
-# #DBGX = d
-#
-# - To make a 'normal' version enter
-# make -fmakefile.bc xxx
-# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
-#
-# DISCLAIMER:
-# This makefile has an experimental status - that is those targets which
-# have been modified do in fact compile and link with Borland's C++
-# Builder 5 and with the free Borland compiler (Borland C++ 5.5).
-# However the author assumes no responsiblity for any effect which the use of
-# this makefile or of the resulting programs might have on your system.
-#
-# Not yet modified:
-# - The 'plug-in-DLL' and the associated shell.
-# - The programs to create the windows help files.
-#
-# Suggestions and / or improvements are always welcome.
-#
-# May 2001, H. Giese (hgiese@ratiosoft.com)
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
#
+# RCS: @(#) $Id$
# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from
@@ -56,511 +24,512 @@
#
# ROOT = top of source tree
#
+# TMPDIR = location where .obj files should be stored during build
+#
# TOOLS32 = location of Borland development tools.
#
-# INSTALLDIR = where the install-targets should copy the binaries and
-# support files
+# TCLDIR = location of top of Tcl source hierarchy
#
-ROOT = ..
-INSTALLDIR = c:\program files\tcl
+ROOT = ..
+TCLDIR = ..\..\tcl8.4
+INSTALLDIR = D:\tmp\tcl
# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler
# adapt the following paths as appropriate for your system
-TOOLS32 = c:\dev\bcc55
-TOOLS32_rc = c:\dev\bcc55
-#TOOLS32 = c:\bc55
-#TOOLS32_rc = c:\bc55
-
-cc32 = "$(TOOLS32)\bin\bcc32.exe"
-link32 = "$(TOOLS32)\bin\ilink32.exe"
-lib32 = "$(TOOLS32)\bin\tlib.exe"
-rc32 = "$(TOOLS32_rc)\bin\brcc32.exe"
-include32 = -I"$(TOOLS32)\include"
-libpath32 = -L"$(TOOLS32)\lib"
+TOOLS32 = d:\cbld5
+TOOLS32_rc = d:\cbld5
+#TOOLS32 = c:\bc55
+#TOOLS32_rc = c:\bc55
+
+cc32 = "$(TOOLS32)\bin\bcc32.exe"
+link32 = "$(TOOLS32)\bin\ilink32.exe"
+lib32 = "$(TOOLS32)\bin\tlib.exe"
+rc32 = "$(TOOLS32_rc)\bin\brcc32.exe"
+include32 = -I"$(TOOLS32)\include;$(TOOLS32)\include\mfc"
+libpath32 = -L"$(TOOLS32)\lib"
# Uncomment the following line to compile with thread support
-#THREADDEFINES = -DTCL_THREADS=1
+#THREADDEFINES = -DTCL_THREADS=1
# Allow definition of NDEBUG via command line
# Set NODEBUG to 0 to compile with symbols
!if !defined(NODEBUG)
-NODEBUG = 1
+NODEBUG = 1
!endif
-# The following defines can be used to control the amount of debugging
-# code that is added to the compilation.
-#
-# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
-# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
-# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
-# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
-# of the native malloc implementation. This is
-# needed when using Purify.
-#
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DUSE_TCLALLOC=0
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =-DTCL_MEM_DEBUG
######################################################################
# Do not modify below this line
######################################################################
-NAMEPREFIX = tcl
-STUBPREFIX = $(NAMEPREFIX)stub
-DOTVERSION = 8.4
-VERSION = 84
+TCLNAMEPREFIX = tcl
+TKNAMEPREFIX = tk
+WISHNAMEPREFIX = wish
+VERSION = 84
+DOTVERSION = 8.4
-DDEVERSION = 12
-DDEDOTVERSION = 1.2
+TCLSTUBPREFIX = $(TCLNAMEPREFIX)stub
+TKSTUBPREFIX = $(TKNAMEPREFIX)stub
-REGVERSION = 10
-REGDOTVERSION = 1.0
-BINROOT = ..
+BINROOT = .
!IF "$(NODEBUG)" == "1"
-TMPDIRNAME = Release
-DBGX =
+TMPDIRNAME = Release
+DBGX =
!ELSE
-TMPDIRNAME = Debug
-#DBGX = d
-DBGX =
+TMPDIRNAME = Debug
+DBGX =
+#DBGX = d
!ENDIF
-TMPDIR = $(BINROOT)\$(TMPDIRNAME)
-OUTDIRNAME = $(TMPDIRNAME)
-OUTDIR = $(TMPDIR)
-
-TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
-TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
-TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
-
-TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib
-TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME)
-
-TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
-TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
-TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
-TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
-TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
-TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
-TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
-TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
-TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
-TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
-TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME)
-TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
-CAT32 = $(TMPDIR)\cat32.exe
-RMDIR = .\rmd.bat
-MKDIR = .\mkd.bat
-RM = del
-
-LIB_INSTALL_DIR = $(INSTALLDIR)\lib
-BIN_INSTALL_DIR = $(INSTALLDIR)\bin
-SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION)
-INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
-
-TCLSHOBJS = \
- $(TMPDIR)\tclAppInit.obj
-
-TCLTESTOBJS = \
- $(TMPDIR)\tclTest.obj \
- $(TMPDIR)\tclTestObj.obj \
- $(TMPDIR)\tclTestProcBodyObj.obj \
- $(TMPDIR)\tclThreadTest.obj \
- $(TMPDIR)\tclWinTest.obj \
- $(TMPDIR)\testMain.obj
-
-TCLOBJS = \
- $(TMPDIR)\regcomp.obj \
- $(TMPDIR)\regexec.obj \
- $(TMPDIR)\regfree.obj \
- $(TMPDIR)\regerror.obj \
- $(TMPDIR)\strftime.obj \
- $(TMPDIR)\strtoll.obj \
- $(TMPDIR)\strtoull.obj \
- $(TMPDIR)\tclAlloc.obj \
- $(TMPDIR)\tclAsync.obj \
- $(TMPDIR)\tclBasic.obj \
- $(TMPDIR)\tclBinary.obj \
- $(TMPDIR)\tclCkalloc.obj \
- $(TMPDIR)\tclClock.obj \
- $(TMPDIR)\tclCmdAH.obj \
- $(TMPDIR)\tclCmdIL.obj \
- $(TMPDIR)\tclCmdMZ.obj \
- $(TMPDIR)\tclCompCmds.obj \
- $(TMPDIR)\tclCompExpr.obj \
- $(TMPDIR)\tclCompile.obj \
- $(TMPDIR)\tclDate.obj \
- $(TMPDIR)\tclEncoding.obj \
- $(TMPDIR)\tclEnv.obj \
- $(TMPDIR)\tclEvent.obj \
- $(TMPDIR)\tclExecute.obj \
- $(TMPDIR)\tclFCmd.obj \
- $(TMPDIR)\tclFileName.obj \
- $(TMPDIR)\tclGet.obj \
- $(TMPDIR)\tclHash.obj \
- $(TMPDIR)\tclHistory.obj \
- $(TMPDIR)\tclIndexObj.obj \
- $(TMPDIR)\tclInterp.obj \
- $(TMPDIR)\tclIO.obj \
- $(TMPDIR)\tclIOCmd.obj \
- $(TMPDIR)\tclIOGT.obj \
- $(TMPDIR)\tclIOSock.obj \
- $(TMPDIR)\tclIOUtil.obj \
- $(TMPDIR)\tclLink.obj \
- $(TMPDIR)\tclLiteral.obj \
- $(TMPDIR)\tclListObj.obj \
- $(TMPDIR)\tclLoad.obj \
- $(TMPDIR)\tclMain.obj \
- $(TMPDIR)\tclNamesp.obj \
- $(TMPDIR)\tclNotify.obj \
- $(TMPDIR)\tclObj.obj \
- $(TMPDIR)\tclPanic.obj \
- $(TMPDIR)\tclParse.obj \
- $(TMPDIR)\tclParseExpr.obj \
- $(TMPDIR)\tclPipe.obj \
- $(TMPDIR)\tclPkg.obj \
- $(TMPDIR)\tclPosixStr.obj \
- $(TMPDIR)\tclPreserve.obj \
- $(TMPDIR)\tclProc.obj \
- $(TMPDIR)\tclRegexp.obj \
- $(TMPDIR)\tclResolve.obj \
- $(TMPDIR)\tclResult.obj \
- $(TMPDIR)\tclScan.obj \
- $(TMPDIR)\tclStringObj.obj \
- $(TMPDIR)\tclStubInit.obj \
- $(TMPDIR)\tclStubLib.obj \
- $(TMPDIR)\tclThread.obj \
- $(TMPDIR)\tclThreadJoin.obj \
- $(TMPDIR)\tclTimer.obj \
- $(TMPDIR)\tclUtf.obj \
- $(TMPDIR)\tclUtil.obj \
- $(TMPDIR)\tclVar.obj \
- $(TMPDIR)\tclWin32Dll.obj \
- $(TMPDIR)\tclWinChan.obj \
- $(TMPDIR)\tclWinConsole.obj \
- $(TMPDIR)\tclWinSerial.obj \
- $(TMPDIR)\tclWinError.obj \
- $(TMPDIR)\tclWinFCmd.obj \
- $(TMPDIR)\tclWinFile.obj \
- $(TMPDIR)\tclWinInit.obj \
- $(TMPDIR)\tclWinLoad.obj \
- $(TMPDIR)\tclWinMtherr.obj \
- $(TMPDIR)\tclWinNotify.obj \
- $(TMPDIR)\tclWinPipe.obj \
- $(TMPDIR)\tclWinSock.obj \
- $(TMPDIR)\tclWinThrd.obj \
- $(TMPDIR)\tclWinTime.obj
-
-TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj
-
-WINDIR = $(ROOT)\win
-GENERICDIR = $(ROOT)\generic
-
-TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES)
+TMPDIR = $(BINROOT)\$(TMPDIRNAME)
+OUTDIRNAME = $(TMPDIRNAME)
+OUTDIR = $(TMPDIR)
+
+TCLLIB = $(TCLNAMEPREFIX)$(VERSION)$(DBGX).lib
+TCLPLUGINLIB = $(TCLNAMEPREFIX)$(VERSION)p.lib
+TCLSTUBLIB = $(TCLSTUBPREFIX)$(VERSION)$(DBGX).lib
+TKDLLNAME = $(TKNAMEPREFIX)$(VERSION)$(DBGX).dll
+TKDLL = $(OUTDIR)\$(TKDLLNAME)
+TKLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib
+TKSTUBLIBNAME = $(TKSTUBPREFIX)$(VERSION)$(DBGX).lib
+TKSTUBLIB = $(OUTDIR)\$(TKSTUBLIBNAME)
+TKPLUGINDLLNAME = $(TKNAMEPREFIX)$(VERSION)p$(DBG).dll
+TKPLUGINDLL = $(OUTDIR)\$(TKPLUGINDLLNAME)
+TKPLUGINLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)p$(DBGX).lib
+
+WISH = $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe
+WISHC = $(OUTDIR)\$(WISHNAMEPREFIX)c$(VERSION)$(DBGX).exe
+WISHP = $(OUTDIR)\$(WISHNAMEPREFIX)p$(VERSION)$(DBGX).exe
+TKTEST = $(OUTDIR)\$(TKNAMEPREFIX)test.exe
+CAT32 = $(TMPDIR)\cat32.exe
+
+BIN_INSTALL_DIR = $(INSTALLDIR)\bin
+INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
+LIB_INSTALL_DIR = $(INSTALLDIR)\lib
+SCRIPT_INSTALL_DIR = $(LIB_INSTALL_DIR)\tk$(DOTVERSION)
+
+WISHOBJS = \
+ $(TMPDIR)\winMain.obj
+
+TKTESTOBJS = \
+ $(TMPDIR)\tkTest.obj \
+ $(TMPDIR)\tkSquare.obj \
+ $(TMPDIR)\testMain.obj \
+ $(TMPDIR)\tkWinTest.obj \
+ $(TCLLIBDIR)\tclThreadTest.obj
+
+XLIBOBJS = \
+ $(TMPDIR)\xcolors.obj \
+ $(TMPDIR)\xdraw.obj \
+ $(TMPDIR)\xgc.obj \
+ $(TMPDIR)\ximage.obj \
+ $(TMPDIR)\xutil.obj
+
+TKOBJS = \
+ $(TMPDIR)\tkConsole.obj \
+ $(TMPDIR)\tkUnixMenubu.obj \
+ $(TMPDIR)\tkUnixScale.obj \
+ $(XLIBOBJS) \
+ $(TMPDIR)\tkWin3d.obj \
+ $(TMPDIR)\tkWin32Dll.obj \
+ $(TMPDIR)\tkWinButton.obj \
+ $(TMPDIR)\tkWinClipboard.obj \
+ $(TMPDIR)\tkWinColor.obj \
+ $(TMPDIR)\tkWinConfig.obj \
+ $(TMPDIR)\tkWinCursor.obj \
+ $(TMPDIR)\tkWinDialog.obj \
+ $(TMPDIR)\tkWinDraw.obj \
+ $(TMPDIR)\tkWinEmbed.obj \
+ $(TMPDIR)\tkWinFont.obj \
+ $(TMPDIR)\tkWinImage.obj \
+ $(TMPDIR)\tkWinInit.obj \
+ $(TMPDIR)\tkWinKey.obj \
+ $(TMPDIR)\tkWinMenu.obj \
+ $(TMPDIR)\tkWinPixmap.obj \
+ $(TMPDIR)\tkWinPointer.obj \
+ $(TMPDIR)\tkWinRegion.obj \
+ $(TMPDIR)\tkWinScrlbr.obj \
+ $(TMPDIR)\tkWinSend.obj \
+ $(TMPDIR)\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 \
+ $(TMP_DIR)\tkPanedWindow.obj \
+ $(TMPDIR)\tkObj.obj \
+ $(TMPDIR)\tkOldConfig.obj \
+ $(TMPDIR)\tkOption.obj \
+ $(TMPDIR)\tkPack.obj \
+ $(TMPDIR)\tkPlace.obj \
+ $(TMPDIR)\tkPointer.obj \
+ $(TMPDIR)\tkRectOval.obj \
+ $(TMPDIR)\tkScale.obj \
+ $(TMPDIR)\tkScrollbar.obj \
+ $(TMPDIR)\tkSelect.obj \
+ $(TMPDIR)\tkText.obj \
+ $(TMPDIR)\tkTextBTree.obj \
+ $(TMPDIR)\tkTextDisp.obj \
+ $(TMPDIR)\tkTextImage.obj \
+ $(TMPDIR)\tkTextIndex.obj \
+ $(TMPDIR)\tkTextMark.obj \
+ $(TMPDIR)\tkTextTag.obj \
+ $(TMPDIR)\tkTextWind.obj \
+ $(TMPDIR)\tkTrig.obj \
+ $(TMPDIR)\tkUtil.obj \
+ $(TMPDIR)\tkVisual.obj \
+ $(TMPDIR)\tkStubInit.obj \
+ $(TMPDIR)\tkStubLib.obj \
+ $(TMPDIR)\tkWindow.obj
+
+# Maintenance hint: Please have multiple members of TKSTUBOBJS be separated
+# by exactly one ' ' (see below the rule for making TKSTUBLIB)
+TKSTUBOBJS = $(TMPDIR)\tkStubLib.obj $(TMPDIR)\tkStubImg.obj
+
+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 = -D__WIN32__ $(DEBUGDEFINES) $(THREADDEFINES)
######################################################################
-# Compiler flags
+# Compile flags
######################################################################
!IF "$(NODEBUG)" == "1"
# these macros cause maximum optimization and no symbols
-cdebug = -v- -vi- -O2 -D_DEBUG
+cdebug = -v- -vi- -O2 -D_DEBUG
!ELSE
# these macros enable debugging
-cdebug = -k -Od -r- -v -vi- -y
+cdebug = -k -Od -r- -v -vi- -y
!ENDIF
-SYSDEFINES = _MT;NO_STRICT;_NO_VCL
+SYSDEFINES = _MT;NO_STRICT;_NO_VCL
# declarations common to all compiler options
-cbase = -c -q -3 -a4 -g0 -tWM -Ve -Vx -X-
-WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu
+cbase = -3 -a4 -c -g0 -tWM -Ve -Vx -X-
+WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu
-ccons = -tWC
+ccons = -tWC
-INCLUDEPATH = $(include32) $(TCL_INCLUDES)
+CFLAGS = $(cdebug) $(cbase) $(WARNINGS) -D$(SYSDEFINES)
-CFLAGS = $(cdebug) $(cbase) $(INCLUDEPATH) $(WARNINGS) -D$(SYSDEFINES)
-TCL_CFLAGS = $(CFLAGS) $(TCL_DEFINES)
-CONS_CFLAGS = $(CFLAGS) $(TCL_DEFINES) $(ccons)
+CON_CFLAGS = $(CFLAGS) $(TK_DEFINES) $(include32) $(ccons)
+WISH_CFLAGS = $(CFLAGS) $(include32) $(TK_INCLUDES) $(TK_DEFINES)
+TK_CFLAGS = $(CFLAGS) $(include32) $(TK_INCLUDES) $(TK_DEFINES) \
+ -DUSE_TCL_STUBS
######################################################################
-# Linker flags
+# Link flags
######################################################################
!IF "$(NODEBUG)" == "1"
-ldebug =
+ldebug =
!ELSE
-ldebug = -v
+ldebug = -v
!ENDIF
# declarations common to all linker options
-LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
+LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
# -Gi: create lib file (is -Gl in doc)
# -aa: Windows app, -ap: Windows console app
-LNFLAGS_DLL = -ap -Gi -Tpd
-LNFLAGS_CONS = -ap -Tpe
+LNFLAGS_DLL = -ap -Gi -Tpd
+LNFLAGS_CONS = -ap -Tpe
+LNFLAGS_GUI = -aa -Tpe
-LNLIBS = import32 cw32mt
+LNLIBS = import32 cw32mt
######################################################################
# Project specific targets
######################################################################
-release: setup $(TCLSH) dlls
-dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
-all: setup $(TCLSH) dlls $(CAT32)
-tcltest: setup $(TCLTEST) dlls $(CAT32)
-plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
-install: install-binaries install-libraries
-
-test: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
- $(TCLTEST) $(ROOT)/tests/all.tcl
+all: setup $(WISH) $(CAT32)
+install: install-binaries install-libraries
+plugin: setup $(TKPLUGINDLL) $(WISHP)
+tktest: setup $(TKTEST) $(CAT32)
+
+# Maintenance hint: We want to set environment variables before calling tktest.
+# If we do this in the form of normal commands, they will not persist up to
+# the call of tktest. Therfore we put all commands wanted into a batch file.
+# The normal way of using 'echo >x.bat' and 'echo >>x.bat' does not work here
+# because we cannot write '... > tktest.txt' this way. Hence this advanced
+# form of loop hopping:
+# - Have MAKE produce a temporary file with the content we want.
+# - Use it as input to the COPY command to produce a batch file.
+# - Run the batch file and be happy.
+#
+test: setup $(TKTEST) $(TKLIB) $(CAT32)
+ copy &&!
+ set TCL_LIBRARY=$(TCLDIR)/library
+ set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH)
+ $(TKTEST) $(ROOT)/tests/all.tcl > tktest.txt
+! _test.bat
+ _test.bat
+# del _test.bat
+
+runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
+ echo set TCL_LIBRARY=$(TCLDIR)/library > _test2.bat
+ echo set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH) >> _test2.bat
+ echo $(TKTEST) >> _test2.bat
+ _test2.bat
+# del _test2.bat
+
+console-wish : all $(WISHC)
+
+stubs:
+ $(TCLDIR)\win\$(TMPDIRNAME)\tclsh$(VERSION)$(DBGX) \
+ $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls
setup:
- @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\
- echo *** Created directory '$(OUT_DIR)'
- @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\
- echo *** Created directory '$(TMP_DIR)'
+ @mkd $(TMPDIR)
+ @mkd $(OUTDIR)
+
+install-binaries:
+ @mkd "$(BIN_INSTALL_DIR)"
+ copy $(TKDLL) "$(BIN_INSTALL_DIR)"
+ copy $(WISH) "$(BIN_INSTALL_DIR)"
+ @mkd "$(LIB_INSTALL_DIR)"
+ copy $(TKLIB) "$(LIB_INSTALL_DIR)"
+install-libraries:
+ @mkd "$(INCLUDE_INSTALL_DIR)"
+ @mkd "$(INCLUDE_INSTALL_DIR)\X11"
+ copy "$(GENERICDIR)\tk.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(GENERICDIR)\tkDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(GENERICDIR)\tkPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(GENERICDIR)\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ xcopy "$(XLIBDIR)\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11"
+ @mkd "$(SCRIPT_INSTALL_DIR)"
+ @mkd "$(SCRIPT_INSTALL_DIR)\images"
+ @mkd "$(SCRIPT_INSTALL_DIR)\demos"
+ @mkd "$(SCRIPT_INSTALL_DIR)\demos\images"
+ @mkd "$(SCRIPT_INSTALL_DIR)\msgs"
+ xcopy "$(ROOT)\library" "$(SCRIPT_INSTALL_DIR)"
+ xcopy "$(ROOT)\library\images" "$(SCRIPT_INSTALL_DIR)\images"
+ xcopy "$(ROOT)\library\demos" "$(SCRIPT_INSTALL_DIR)\demos"
+ xcopy "$(ROOT)\library\demos\images" "$(SCRIPT_INSTALL_DIR)\demos\images"
+ xcopy "$(ROOT)\library\msgs" "$(SCRIPT_INSTALL_DIR)\msgs"
+
+$(TKLIB): $(TKDLL) $(TKSTUBLIB)
+
+# Maintenance hint: The macro puts a '+-' before the first member of
+# TKSTUBOBJS, than replaces any ' ' with ' +-' - together putting '+-' in
+# front of any member of TKSTUBOBJS (provided, they are separated in their
+# defintion by just one space).
+#
+# The first time you *make* this target, you will get a warning
+# tkStubLib not found in library
+# This is (probably) because of the '-' option, telling TLIB to remove
+# 'tkStubLib' when it does not yet exist. Forcing a re-make when it already
+# exists avoids this warning.
+#
+$(TKSTUBLIB): $(TKSTUBOBJS)
+ $(lib32) $@ +-$(TKSTUBOBJS: = +-)
-$(TCLLIB): $(TCLDLL)
+# $(lib32) $@ @&&!
+#+-$(TKSTUBOBJS: = &^
+#+-)
+#!
-$(TCLDLL): $(TCLOBJS) $(TMPDIR)\$(NAMEPREFIX).res
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
- $(TCLOBJS), $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+$(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
+ $(TKOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLSTUBLIB),, $(TMPDIR)\tk.res
!
-$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(lib32) /u $@ $(TCLSTUBOBJS)
+$(TKPLUGINLIB): $(TKPLUGINDLL)
-$(TCLPLUGINLIB): $(TCLPLUGINDLL)
+#$(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res
+# $(link32) $(ldebug) $(dlllflags) \
+# -out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLPLUGINLIB) \
+# $(guilibsdll) @<<
+# $(TKOBJS)
+#<<
-$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
- $(link32) $(ldebug) $(dlllflags) \
- -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @&&!
-$(TCLOBJS)
+$(WISH): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_GUI) $(TOOLS32)\lib\c0x32 @&&!
+ $(WISHOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res
!
-$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
- $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
- $(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+$(WISHC): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(WISHOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res
!
-$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
+$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
+ $(guilibsdll) $(TCLLIBDIR)\$(TCLPLUGINLIB) \
+ $(TKPLUGINLIB) $(WISHOBJS)
-$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
- $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
- $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+$(TKTEST): $(TKTESTOBJS) $(TKLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_GUI) $(TOOLS32)\lib\c0x32 @&&!
+ $(TKTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res
!
+# $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
+# $(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(TKTESTOBJS)
-$(TCLPIPEDLL): $(WINDIR)\stub16.c
- $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
- $(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
-
-$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
- $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
- $(TMPDIR)\$(NAMEPREFIX).res
-
-$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
- $(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
- $(TMPDIR)\$(NAMEPREFIX).res
-
-$(CAT32): $(WINDIR)\cat.c
- $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
- $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
-
-install-binaries: $(TCLSH)
- $(MKDIR) "$(BIN_INSTALL_DIR)"
- $(MKDIR) "$(LIB_INSTALL_DIR)"
- @echo installing $(TCLDLLNAME)
- @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
- @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
- @echo installing "$(TCLSH)"
- @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
- @echo installing $(TCLPIPEDLLNAME)
- @copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
- @echo installing $(TCLSTUBLIBNAME)
- @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
+#$(CAT32): $(TCLDIR)\win\cat.c
+# $(cc32) $(CON_CFLAGS) -o$(TMPDIR)\cat.obj $?
+# $(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)
-install-libraries:
- -@$(MKDIR) "$(LIB_INSTALL_DIR)"
- -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
- @echo installing http1.0
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
- -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
- -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
- @echo installing http2.4
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.4"
- -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4"
- -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4"
- @echo installing opt0.4
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
- -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- @echo installing msgcat1.3
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
- -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
- -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
- @echo installing tcltest2.2
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
- -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
- -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
- @echo installing $(TCLDDEDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.1"
- -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.1"
- -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.1"
- @echo installing $(TCLREGDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.0"
- -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.0"
- -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.0"
- @echo installing encoding files
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
- -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
- @echo installing library files
- -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)"
+$(CAT32): $(TCLDIR)\win\cat.c
+ $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
#
# Regenerate the stubs files.
#
genstubs:
- tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
- $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
-
-#
-# Regenerate the windows help files.
-#
-
-TCLTOOLS = $(ROOT)/tools
-MAN2TCL = $(TCLTOOLS)/man2tcl
-TCLRTF = $(TCLTOOLS)/tcl.rtf
-TCLHPJ = $(TCLTOOLS)/tcl.hpj
-MAN2HELP = $(TCLTOOLS)/man2help.tcl
-HCRTF = $(TOOLS32)/bin/hcrtf.exe
-
-winhelp: $(TCLRTF)
- cd $(TCLTOOLS)
- start /wait $(HCRTF) -xn $(TCLHPJ)
-
-$(MAN2TCL).exe: $(MAN2TCL).obj
- cd $(TCLTOOLS)
- $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c
-
-$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
- cd $(TCLTOOLS)
- ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc
+ tclsh$(VERSION) $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls
#
# Special case object file targets
#
-$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $?
-
-$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-# The following objects should be built using the stub interfaces
-# tclWinReg: Produces errors in ANSI mode
-$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
- $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+$(TMPDIR)\testMain.obj: $(WINDIR)\winMain.c
+ $(cc32) $(WISH_CFLAGS) -DTK_TEST -o$@ $?
-# tclWinDde: Produces errors in ANSI mode
-$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
- $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+$(TMPDIR)\tkTest.obj: $(GENERICDIR)\tkTest.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
+$(TMPDIR)\tkWinTest.obj: $(WINDIR)\tkWinTest.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
-# The following objects are part of the stub library and should not
-# be built as DLL objects but none of the symbols should be exported
+$(TMPDIR)\tkSquare.obj: $(GENERICDIR)\tkSquare.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
-$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
- $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+$(TMPDIR)\winMain.obj: $(WINDIR)\winMain.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
-
-# Dedependency rules
-
-$(GENERICDIR)\regcomp.c: \
- $(GENERICDIR)\regguts.h \
- $(GENERICDIR)\regc_lex.c \
- $(GENERICDIR)\regc_color.c \
- $(GENERICDIR)\regc_nfa.c \
- $(GENERICDIR)\regc_cvec.c \
- $(GENERICDIR)\regc_locale.c
-
-$(GENERICDIR)\regcustom.h: \
- $(GENERICDIR)\tclInt.h \
- $(GENERICDIR)\tclPort.h \
- $(GENERICDIR)\regex.h
-
-$(GENERICDIR)\regexec.c: \
- $(GENERICDIR)\rege_dfa.c \
- $(GENERICDIR)\regguts.h
-
-$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+$(TMPDIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c
+ $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -o$@ $?
#
# Implicit rules
#
-{$(WINDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+{$(XLIBDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
-{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+{$(ROOT)\unix}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
-{$(WINDIR)}.rc{$(TMPDIR)}.res:
- $(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
+{$(RCDIR)}.rc{$(TMPDIR)}.res:
+ $(rc32) -I"$(GENERICDIR)" -I"$(TOOLS32)\include" -I"$(TCLDIR)\generic" \
+ -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
clean:
- -@$(RM) $(OUTDIR)\*.exp
- -@$(RM) $(OUTDIR)\*.lib
- -@$(RM) $(OUTDIR)\*.dll
- -@$(RM) $(OUTDIR)\*.exe
- -@$(RM) $(OUTDIR)\*.pdb
- -@$(RM) $(TMPDIR)\*.pch
- -@$(RM) $(TMPDIR)\*.obj
- -@$(RM) $(TMPDIR)\*.res
- -@$(RM) $(TMPDIR)\*.exe
- -@$(RMDIR) $(OUTDIR)
- -@$(RMDIR) $(TMPDIR)
+ -@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)\*.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/tcl/win/makefile.vc b/tcl/win/makefile.vc
index e8de4a25f55..469969fd7e2 100644
--- a/tcl/win/makefile.vc
+++ b/tcl/win/makefile.vc
@@ -27,7 +27,7 @@ the environment. Jump to this line to read the new instructions.
#
# 1) It is now necessary to have MSVCDir set in the environment. This is used
# as a check to see if vcvars32.bat had been run prior to running nmake or
-# during the installation of Microsoft Visual C++, MSVCDir had been set
+# during the install of Microsoft Developer Studio, MSVCDir had been set
# globally and the PATH adjusted. Either way is valid.
#
# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
@@ -40,31 +40,36 @@ the environment. Jump to this line to read the new instructions.
# the 64-bit compiler, if your SDK has it.
#
# 3) Targets are:
-# release -- Builds the core, the shell and the dlls. (default)
-# dlls -- Just builds the windows extensions and the 16-bit DOS
-# pipe/thunk helper app.
-# shell -- Just builds the shell and the core.
-# core -- Only builds the core [tclXX.(dll|lib)].
-# all -- Builds everything.
-# test -- Builds and runs the test suite.
-# tcltest -- Just builds the test shell.
-# install -- Installs the built binaries and libraries to $(INSTALLDIR)
+# release -- builds the core, the shell. (default)
+# core -- Only builds the core.
+# all -- builds everything.
+# test -- builds and runs the test suite.
+# tktest -- just builds the binaries for the test suite.
+# install -- installs the built binaries and libraries to $(INSTALLDIR)
# as the root of the install tree.
-# tidy/clean/hose -- varying levels of cleaning.
-# genstubs -- Rebuilds the Stubs table and support files (dev only).
+# console-wish -- builds a console version of wish.
+# clean -- removes the contents of $(TMP_DIR)
+# hose -- removes the contents of $(TMP_DIR) and $(OUT_DIR)
+# genstubs -- rebuilds the Stubs table and support files (dev only).
# depend -- Generates an accurate set of source dependancies for this
# makefile. Helpful to avoid problems when the sources are
# refreshed and you rebuild, but can "overbuild" when common
-# headers like tclInt.h just get small changes.
-# winhelp -- Builds the windows .hlp file for Tcl from the troff man
-# files found in $(ROOT)\doc .
+# headers like tkInt.h just get small changes.
+# winhelp -- builds the windows .hlp file for Tcl from the troff man
+# files.
#
# 4) Macros usable on the commandline:
+# TCLDIR=<path>
+# Sets the location for where to find the Tcl headers and
+# libraries. The install point is assumed when not specified.
+# Tk does need the source directory, though. Tk comes very close
+# to not needing the sources, but does, in fact, require them.
+#
# INSTALLDIR=<path>
# Sets where to install Tcl from the built binaries.
# C:\Progra~1\Tcl is assumed when not specified.
#
-# OPTS=static,msvcrt,linkexten,threads,symbols,profile,loimpact,none
+# OPTS=static,msvcrt,linkexten,threads,symbols,profile,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
@@ -75,14 +80,11 @@ the environment. Jump to this line to read the new instructions.
# using libcmt(d) as the C runtime [by default] to
# msvcrt(d). This is useful for static embedding
# support.
-# linkexten = Effects the static option only to switch
-# tclshXX.exe to have the dde and reg extension linked
-# inside it.
+# linkexten = Affects the static option only to switch wishXX.exe
+# to have the dde and reg extension linked inside it.
# threads = Turns on full multithreading support.
# symbols = Adds symbols for step debugging.
# profile = Adds profiling hooks. Map file is assumed.
-# loimpact = Adds a flag for how NT treats the heap to keep memory
-# in use, low. This is said to impact alloc performance.
#
# STATS=memdbg,compdbg,none
# Sets optional memory and bytecode compiler debugging code added
@@ -115,17 +117,17 @@ the environment. Jump to this line to read the new instructions.
# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
#
# Standard (no frills)
-# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# c:\tk_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
# Setting environment for using Microsoft Visual C++ tools.
-# c:\tcl_src\win\>nmake -f makefile.vc release
-# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
+# c:\tk_src\win\>nmake -f makefile.vc release
+# c:\tk_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#
# Building for Win64
-# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# c:\tk_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
# Setting environment for using Microsoft Visual C++ tools.
-# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
+# c:\tk_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
# Targeting Windows pre64 RETAIL
-# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
+# c:\tk_src\win\>nmake -f makefile.vc MACHINE=IA64
#
#------------------------------------------------------------------------------
#==============================================================================
@@ -147,188 +149,268 @@ the environment. Jump to this line to read the new instructions.
MSG = ^
You must run this makefile only from the directory it is in.^
Please `cd` to its location first.
-!error $(MSG)
+!error $(MSG)
!endif
-PROJECT = tcl
+PROJECT = tk
!include "rules.vc"
+_INSTALLDIR = $(INSTALLDIR:/=\)
+
+!if !defined(TCLDIR)
+!if exist($(_INSTALLDIR)\include\tcl.h)
+TCLINSTALL = 1
+_TCLDIR = $(_INSTALLDIR)
+!else
+MSG=^
+Don't know where tcl.h is. Set the _TCLDIR macro.
+!error $(MSG)
+!endif
+!else
+_TCLDIR = $(TCLDIR:/=\)
+!if exist($(_TCLDIR)\include\tcl.h)
+TCLINSTALL = 1
+!elseif exist($(_TCLDIR)\generic\tcl.h)
+TCLINSTALL = 0
+!else
+MSG =^
+Don't know where tcl.h is. the TCLDIR macro doesn't appear correct.
+!error $(MSG)
+!endif
+!endif
+
+!if $(TCLINSTALL)
+!message *** Warning: Tk requires the source distribution of Tcl to build from,
+!message *** at this time, sorry. Please set the TCLDIR macro to point to the
+!message *** Tcl sources.
+!endif
+
STUBPREFIX = $(PROJECT)stub
DOTVERSION = 8.4
VERSION = $(DOTVERSION:.=)
-
-DDEDOTVERSION = 1.2
-DDEVERSION = $(DDEDOTVERSION:.=)
-
-REGDOTVERSION = 1.0
-REGVERSION = $(REGDOTVERSION:.=)
+WISHNAMEPREFIX = wish
BINROOT = .
ROOT = ..
-TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
-TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
-
-TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
-TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
-
-TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
-TCLSH = $(OUT_DIR)\$(TCLSHNAME)
-TCLPIPEDLLNAME = $(PROJECT)pip$(VERSION).dll
-TCLPIPEDLL = $(OUT_DIR)\$(TCLPIPEDLLNAME)
-
-TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
-TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
+TCLIMPLIBNAME = tcl$(VERSION)$(SUFX).lib
+TCLLIBNAME = tcl$(VERSION)$(SUFX).$(EXT)
+TCLSTUBLIBNAME = tclstub$(VERSION).lib
+
+TCLREGLIBNAME = tclreg10$(SUFX:t=).lib
+TCLDDELIBNAME = tcldde12$(SUFX:t=).lib
+
+TKIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+TKLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+TKLIB = $(OUT_DIR)\$(TKLIBNAME)
+
+TKSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME)
+
+!if $(TCLINSTALL)
+TCLSH = $(_INSTALLDIR)\bin\tclsh$(VERSION)$(SUFX).exe
+TCLSTUBLIB = $(_INSTALLDIR)\lib\$(TCLSTUBLIBNAME)
+TCLIMPLIB = $(_INSTALLDIR)\lib\$(TCLIMPLIBNAME)
+TCL_LIBRARY = $(_INSTALLDIR)\lib
+TCLREGLIB = $(_INSTALLDIR)\lib\$(TCLREGLIBNAME)
+TCLDDELIB = $(_INSTALLDIR)\lib\$(TCLDDELIBNAME)
+TCLTMP_DIR = \must\have\tcl\sources\to\build\this\target
+COFFBASE = \must\have\tcl\sources\to\build\this\target
+TOOLSDIR = \must\have\tcl\sources\to\build\this\target
+!else
+TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(VERSION)$(SUFX).exe
+TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLSTUBLIBNAME)
+TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLIMPLIBNAME)
+TCL_LIBRARY = $(_TCLDIR)\library
+TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLREGLIBNAME)
+TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLDDELIBNAME)
+TCLTMP_DIR = $(_TCLDIR)\win\$(TMP_DIR:tk=tcl)
+COFFBASE = $(_TCLDIR)\win\coffbase.txt
+TOOLSDIR = $(_TCLDIR)\tools
+!endif
-TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
-TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
+WISH = $(OUT_DIR)\$(WISHNAMEPREFIX)$(VERSION)$(SUFX).exe
+WISHC = $(OUT_DIR)\$(WISHNAMEPREFIX)c$(VERSION)$(SUFX).exe
-TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
+TKTEST = $(OUT_DIR)\$(PROJECT)test.exe
CAT32 = $(OUT_DIR)\cat32.exe
+RMDIR = .\rmd.bat
+RM = del
-### Make sure we use backslash only.
-_INSTALLDIR = $(INSTALLDIR:/=\)
LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
-SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(DOTVERSION)
INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
-TCLSHOBJS = \
- $(TMP_DIR)\tclAppInit.obj \
-!if $(TCL_LINKWITHEXTENSIONS)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!endif
- $(TMP_DIR)\tclsh.res
-
-TCLTESTOBJS = \
- $(TMP_DIR)\tclTest.obj \
- $(TMP_DIR)\tclTestObj.obj \
- $(TMP_DIR)\tclTestProcBodyObj.obj \
- $(TMP_DIR)\tclThreadTest.obj \
- $(TMP_DIR)\tclWinTest.obj \
+WISHOBJS = \
+ $(TMP_DIR)\winMain.obj \
!if $(TCL_LINKWITHEXTENSIONS)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!endif
- $(TMP_DIR)\testMain.obj
-
-TCLOBJS = \
- $(TMP_DIR)\regcomp.obj \
- $(TMP_DIR)\regexec.obj \
- $(TMP_DIR)\regfree.obj \
- $(TMP_DIR)\regerror.obj \
- $(TMP_DIR)\strftime.obj \
- $(TMP_DIR)\strtoll.obj \
- $(TMP_DIR)\strtoull.obj \
- $(TMP_DIR)\tclAlloc.obj \
- $(TMP_DIR)\tclAsync.obj \
- $(TMP_DIR)\tclBasic.obj \
- $(TMP_DIR)\tclBinary.obj \
- $(TMP_DIR)\tclCkalloc.obj \
- $(TMP_DIR)\tclClock.obj \
- $(TMP_DIR)\tclCmdAH.obj \
- $(TMP_DIR)\tclCmdIL.obj \
- $(TMP_DIR)\tclCmdMZ.obj \
- $(TMP_DIR)\tclCompCmds.obj \
- $(TMP_DIR)\tclCompExpr.obj \
- $(TMP_DIR)\tclCompile.obj \
- $(TMP_DIR)\tclDate.obj \
- $(TMP_DIR)\tclEncoding.obj \
- $(TMP_DIR)\tclEnv.obj \
- $(TMP_DIR)\tclEvent.obj \
- $(TMP_DIR)\tclExecute.obj \
- $(TMP_DIR)\tclFCmd.obj \
- $(TMP_DIR)\tclFileName.obj \
- $(TMP_DIR)\tclGet.obj \
- $(TMP_DIR)\tclHash.obj \
- $(TMP_DIR)\tclHistory.obj \
- $(TMP_DIR)\tclIndexObj.obj \
- $(TMP_DIR)\tclInterp.obj \
- $(TMP_DIR)\tclIO.obj \
- $(TMP_DIR)\tclIOCmd.obj \
- $(TMP_DIR)\tclIOGT.obj \
- $(TMP_DIR)\tclIOSock.obj \
- $(TMP_DIR)\tclIOUtil.obj \
- $(TMP_DIR)\tclLink.obj \
- $(TMP_DIR)\tclLiteral.obj \
- $(TMP_DIR)\tclListObj.obj \
- $(TMP_DIR)\tclLoad.obj \
- $(TMP_DIR)\tclMain.obj \
- $(TMP_DIR)\tclNamesp.obj \
- $(TMP_DIR)\tclNotify.obj \
- $(TMP_DIR)\tclObj.obj \
- $(TMP_DIR)\tclPanic.obj \
- $(TMP_DIR)\tclParse.obj \
- $(TMP_DIR)\tclParseExpr.obj \
- $(TMP_DIR)\tclPipe.obj \
- $(TMP_DIR)\tclPkg.obj \
- $(TMP_DIR)\tclPosixStr.obj \
- $(TMP_DIR)\tclPreserve.obj \
- $(TMP_DIR)\tclProc.obj \
- $(TMP_DIR)\tclRegexp.obj \
- $(TMP_DIR)\tclResolve.obj \
- $(TMP_DIR)\tclResult.obj \
- $(TMP_DIR)\tclScan.obj \
- $(TMP_DIR)\tclStringObj.obj \
- $(TMP_DIR)\tclStubInit.obj \
- $(TMP_DIR)\tclStubLib.obj \
- $(TMP_DIR)\tclThread.obj \
- $(TMP_DIR)\tclThreadJoin.obj \
- $(TMP_DIR)\tclTimer.obj \
- $(TMP_DIR)\tclUtf.obj \
- $(TMP_DIR)\tclUtil.obj \
- $(TMP_DIR)\tclVar.obj \
- $(TMP_DIR)\tclWin32Dll.obj \
- $(TMP_DIR)\tclWinChan.obj \
- $(TMP_DIR)\tclWinConsole.obj \
- $(TMP_DIR)\tclWinSerial.obj \
- $(TMP_DIR)\tclWinError.obj \
- $(TMP_DIR)\tclWinFCmd.obj \
- $(TMP_DIR)\tclWinFile.obj \
- $(TMP_DIR)\tclWinInit.obj \
- $(TMP_DIR)\tclWinLoad.obj \
- $(TMP_DIR)\tclWinMtherr.obj \
- $(TMP_DIR)\tclWinNotify.obj \
- $(TMP_DIR)\tclWinPipe.obj \
- $(TMP_DIR)\tclWinSock.obj \
- $(TMP_DIR)\tclWinThrd.obj \
- $(TMP_DIR)\tclWinTime.obj \
+ $(TCLDDELIB) \
+ $(TCLREGLIB) \
+!endif
+ $(TMP_DIR)\wish.res
+
+TKTESTOBJS = \
+ $(TMP_DIR)\tkTest.obj \
+ $(TMP_DIR)\tkSquare.obj \
+ $(TMP_DIR)\testMain.obj \
+ $(TMP_DIR)\tkWinTest.obj \
+ $(TCLTMP_DIR)\tclThreadTest.obj
+
+XLIBOBJS = \
+ $(TMP_DIR)\xcolors.obj \
+ $(TMP_DIR)\xdraw.obj \
+ $(TMP_DIR)\xgc.obj \
+ $(TMP_DIR)\ximage.obj \
+ $(TMP_DIR)\xutil.obj
+
+TKOBJS = \
+ $(TMP_DIR)\tkConsole.obj \
+ $(TMP_DIR)\tkUnixMenubu.obj \
+ $(TMP_DIR)\tkUnixScale.obj \
+ $(XLIBOBJS) \
+ $(TMP_DIR)\tkWin3d.obj \
+ $(TMP_DIR)\tkWin32Dll.obj \
+ $(TMP_DIR)\tkWinButton.obj \
+ $(TMP_DIR)\tkWinClipboard.obj \
+ $(TMP_DIR)\tkWinColor.obj \
+ $(TMP_DIR)\tkWinConfig.obj \
+ $(TMP_DIR)\tkWinCursor.obj \
+ $(TMP_DIR)\tkWinDialog.obj \
+ $(TMP_DIR)\tkWinDraw.obj \
+ $(TMP_DIR)\tkWinEmbed.obj \
+ $(TMP_DIR)\tkWinFont.obj \
+ $(TMP_DIR)\tkWinImage.obj \
+ $(TMP_DIR)\tkWinInit.obj \
+ $(TMP_DIR)\tkWinKey.obj \
+ $(TMP_DIR)\tkWinMenu.obj \
+ $(TMP_DIR)\tkWinPixmap.obj \
+ $(TMP_DIR)\tkWinPointer.obj \
+ $(TMP_DIR)\tkWinRegion.obj \
+ $(TMP_DIR)\tkWinScrlbr.obj \
+ $(TMP_DIR)\tkWinSend.obj \
+ $(TMP_DIR)\tkWinWindow.obj \
+ $(TMP_DIR)\tkWinWm.obj \
+ $(TMP_DIR)\tkWinX.obj \
+ $(TMP_DIR)\stubs.obj \
+ $(TMP_DIR)\tk3d.obj \
+ $(TMP_DIR)\tkArgv.obj \
+ $(TMP_DIR)\tkAtom.obj \
+ $(TMP_DIR)\tkBind.obj \
+ $(TMP_DIR)\tkBitmap.obj \
+ $(TMP_DIR)\tkButton.obj \
+ $(TMP_DIR)\tkCanvArc.obj \
+ $(TMP_DIR)\tkCanvBmap.obj \
+ $(TMP_DIR)\tkCanvImg.obj \
+ $(TMP_DIR)\tkCanvLine.obj \
+ $(TMP_DIR)\tkCanvPoly.obj \
+ $(TMP_DIR)\tkCanvPs.obj \
+ $(TMP_DIR)\tkCanvText.obj \
+ $(TMP_DIR)\tkCanvUtil.obj \
+ $(TMP_DIR)\tkCanvWind.obj \
+ $(TMP_DIR)\tkCanvas.obj \
+ $(TMP_DIR)\tkClipboard.obj \
+ $(TMP_DIR)\tkCmds.obj \
+ $(TMP_DIR)\tkColor.obj \
+ $(TMP_DIR)\tkConfig.obj \
+ $(TMP_DIR)\tkCursor.obj \
+ $(TMP_DIR)\tkEntry.obj \
+ $(TMP_DIR)\tkError.obj \
+ $(TMP_DIR)\tkEvent.obj \
+ $(TMP_DIR)\tkFileFilter.obj \
+ $(TMP_DIR)\tkFocus.obj \
+ $(TMP_DIR)\tkFont.obj \
+ $(TMP_DIR)\tkFrame.obj \
+ $(TMP_DIR)\tkGC.obj \
+ $(TMP_DIR)\tkGeometry.obj \
+ $(TMP_DIR)\tkGet.obj \
+ $(TMP_DIR)\tkGrab.obj \
+ $(TMP_DIR)\tkGrid.obj \
+ $(TMP_DIR)\tkImage.obj \
+ $(TMP_DIR)\tkImgBmap.obj \
+ $(TMP_DIR)\tkImgGIF.obj \
+ $(TMP_DIR)\tkImgPPM.obj \
+ $(TMP_DIR)\tkImgPhoto.obj \
+ $(TMP_DIR)\tkImgUtil.obj \
+ $(TMP_DIR)\tkListbox.obj \
+ $(TMP_DIR)\tkMacWinMenu.obj \
+ $(TMP_DIR)\tkMain.obj \
+ $(TMP_DIR)\tkMenu.obj \
+ $(TMP_DIR)\tkMenubutton.obj \
+ $(TMP_DIR)\tkMenuDraw.obj \
+ $(TMP_DIR)\tkMessage.obj \
+ $(TMP_DIR)\tkPanedWindow.obj \
+ $(TMP_DIR)\tkObj.obj \
+ $(TMP_DIR)\tkOldConfig.obj \
+ $(TMP_DIR)\tkOption.obj \
+ $(TMP_DIR)\tkPack.obj \
+ $(TMP_DIR)\tkPlace.obj \
+ $(TMP_DIR)\tkPointer.obj \
+ $(TMP_DIR)\tkRectOval.obj \
+ $(TMP_DIR)\tkScale.obj \
+ $(TMP_DIR)\tkScrollbar.obj \
+ $(TMP_DIR)\tkSelect.obj \
+ $(TMP_DIR)\tkStyle.obj \
+ $(TMP_DIR)\tkText.obj \
+ $(TMP_DIR)\tkTextBTree.obj \
+ $(TMP_DIR)\tkTextDisp.obj \
+ $(TMP_DIR)\tkTextImage.obj \
+ $(TMP_DIR)\tkTextIndex.obj \
+ $(TMP_DIR)\tkTextMark.obj \
+ $(TMP_DIR)\tkTextTag.obj \
+ $(TMP_DIR)\tkTextWind.obj \
+ $(TMP_DIR)\tkTrig.obj \
+ $(TMP_DIR)\tkUndo.obj \
+ $(TMP_DIR)\tkUtil.obj \
+ $(TMP_DIR)\tkVisual.obj \
+ $(TMP_DIR)\tkStubInit.obj \
+ $(TMP_DIR)\tkStubLib.obj \
+ $(TMP_DIR)\tkWindow.obj \
!if !$(STATIC_BUILD)
- $(TMP_DIR)\tcl.res
+ $(TMP_DIR)\tk.res
!endif
-TCLSTUBOBJS = $(TMP_DIR)\tclStubLib.obj
+TKSTUBOBJS = \
+ $(TMP_DIR)\tkStubLib.obj \
+ $(TMP_DIR)\tkStubImg.obj
-### The following paths CANNOT have spaces in them.
-COMPATDIR = $(ROOT)\compat
-DOCDIR = $(ROOT)\doc
+
+WINDIR = $(ROOT)\win
GENERICDIR = $(ROOT)\generic
-TOOLSDIR = $(ROOT)\tools
-WINDIR = $(ROOT)\win
+XLIBDIR = $(ROOT)\xlib
+BITMAPDIR = $(ROOT)\bitmaps
+DOCDIR = $(ROOT)\doc
+RCDIR = $(WINDIR)\rc
+
+!if $(TCLINSTALL)
+TCL_INCLUDES = -I "$(_TCLDIR)\include"
+!else
+TCL_INCLUDES = -I "$(_TCLDIR)\win" -I "$(_TCLDIR)\generic"
+!endif
+TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(BITMAPDIR)" -I"$(XLIBDIR)" \
+ $(TCL_INCLUDES)
+
+TK_DEFINES = $(OPTDEFINES)
#---------------------------------------------------------------------
# Compile flags
#---------------------------------------------------------------------
-!if !$(DEBUG)
-!if $(OPTIMIZING)
-### This cranks the optimization level to maximize speed
-cdebug = -O2 -Op -Gs
+!if $(DEBUG)
+!if "$(MACHINE)" == "IA64"
+cdebug = -Od -Zi
!else
-cdebug =
+cdebug = -Z7 -Od -WX
!endif
-!else if "$(MACHINE)" == "IA64"
-### Warnings are too many, can't support warnings into errors.
-cdebug = -Z7 -Od
!else
-cdebug = -Z7 -WX -Od
+# This cranks the optimization level up. We can't use -02 because sometimes
+# it causes problems.
+cdebug = -Oti
!endif
-### Declarations common to all compiler options
+# declarations common to all compiler options
cflags = -nologo -c -W3 -YX -Fp$(TMP_DIR)^\
!if $(PENT_0F_ERRATA)
@@ -345,10 +427,10 @@ crt = -MD$(DBGX)
crt = -MT$(DBGX)
!endif
-TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-BASE_CLFAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES)
-CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
-TCL_CFLAGS = $(BASE_CLFAGS) $(OPTDEFINES)
+BASE_CLFAGS = $(cdebug) $(cflags) $(crt) $(TK_INCLUDES)
+TK_CFLAGS = $(BASE_CLFAGS) $(TK_DEFINES) -DUSE_TCL_STUBS
+CON_CFLAGS = $(cdebug) $(cflags) $(crt) -DCONSOLE
+WISH_CFLAGS = $(BASE_CLFAGS) $(TK_DEFINES)
#---------------------------------------------------------------------
@@ -361,7 +443,7 @@ ldebug = -debug:full -debugtype:cv
ldebug = -release -opt:ref -opt:icf,3
!endif
-### Declarations common to all linker options
+# declarations common to all linker options
lflags = -nologo -machine:$(MACHINE) $(ldebug)
!if $(PROFILE)
@@ -369,10 +451,10 @@ lflags = $(lflags) -profile
!endif
!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
-### Align sections for PE size savings.
+# align sections for PE size savings.
lflags = $(lflags) -opt:nowin98
!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
-### Align sections for speed in loading by choosing the virtual page size.
+# align sections for speed in loading by choosing the virtual page size.
lflags = $(lflags) -align:4096
!endif
@@ -385,116 +467,130 @@ conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
baselibs = kernel32.lib advapi32.lib user32.lib
+guilibs = $(baselibs) shell32.lib gdi32.lib comdlg32.lib winspool.lib imm32.lib comctl32.lib
#---------------------------------------------------------------------
-# TclTest flags
+# TkTest flags
#---------------------------------------------------------------------
-!IF "$(TESTPAT)" != ""
-TESTFLAGS = -file $(TESTPAT)
-!ENDIF
+!if "$(TESTPAT)" != ""
+TESTFLAGS = -file $(TESTPAT)
+!endif
#---------------------------------------------------------------------
# Project specific targets
#---------------------------------------------------------------------
-release: setup $(TCLSH) $(TCLSTUBLIB) dlls
-core: setup $(TCLLIB) $(TCLSTUBLIB)
-shell: setup $(TCLSH)
-dlls: setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB)
-all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32)
-tcltest: setup $(TCLTEST) dlls $(CAT32)
-install: install-binaries install-libraries install-docs
+release: setup $(TKSTUBLIB) $(WISH)
+all: release $(CAT32)
+core: setup $(TKSTUBLIB) $(TKLIB)
+console-wish : $(WISHC)
+install: install-binaries install-libraries install-docs
+tktest: setup $(TKTEST) $(CAT32)
-test: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
+test: setup $(TKTEST) $(TKLIB) $(CAT32)
+ set TCL_LIBRARY=$(TCL_LIBRARY)
+!if $(TCLINSTALL)
+ set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
- $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS)
+ $(TKTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) | $(CAT32)
+!else
+ $(TKTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) | $(CAT32)
+!endif
+
+runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
+ set TCL_LIBRARY=$(TCL_LIBRARY)
+!if $(TCLINSTALL)
+ set PATH=$(_TCLDIR)\bin;$(PATH)
!else
- $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) > tests.log
- type tests.log | more
+ set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
!endif
+ $(TKTEST)
-runtest: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
- $(TCLTEST)
+rundemo: setup $(TKTEST) $(TKLIB) $(CAT32)
+ set TCL_LIBRARY=$(TCL_LIBRARY)
+!if $(TCLINSTALL)
+ set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ $(TKTEST) $(ROOT)\library\demos\widget
setup:
@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
!if !$(STATIC_BUILD)
-$(TCLIMPLIB): $(TCLLIB)
+$(TKIMPLIB): $(TKLIB)
!endif
-$(TCLLIB): $(TCLOBJS)
+$(TKLIB): $(TKOBJS)
!if $(STATIC_BUILD)
$(lib32) -nologo -out:$@ @<<
$**
<<
!else
- $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
- $(baselibs) @<<
+ $(link32) $(dlllflags) -base:@$(COFFBASE),tk -out:$@ $(guilibs) \
+ $(TCLSTUBLIB) @<<
$**
<<
-@del $*.exp
!endif
-$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(lib32) -nologo -out:$@ $(TCLSTUBOBJS)
-$(TCLSH): $(TCLSHOBJS) $(TCLIMPLIB)
- $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
+$(TKSTUBLIB): $(TKSTUBOBJS)
+ $(lib32) -nologo -out:$@ $**
-$(TCLTEST): $(TCLTESTOBJS) $(TCLIMPLIB)
- $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
-$(TCLPIPEDLL): $(WINDIR)\stub16.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c
- $(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs)
+$(WISH): $(WISHOBJS) $(TKIMPLIB)
+ $(link32) $(guilflags) -out:$@ $(guilibs) $(TCLIMPLIB) $**
-!if $(STATIC_BUILD)
-$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
- $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinDde.obj
-!else
-$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
- $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
- $** $(baselibs)
- -@del $*.exp
- -@del $*.lib
-!endif
+$(WISHC): $(WISHOBJS) $(TKIMPLIB)
+ $(link32) $(conlflags) -out:$@ $(guilibs) $(TCLIMPLIB) $**
+
+$(TKTEST): $(TKTESTOBJS) $(TKIMPLIB)
+ $(link32) $(guilflags) -out:$@ $(guilibs) $(TCLIMPLIB) $**
-!if $(STATIC_BUILD)
-$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
- $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinReg.obj
-!else
-$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
- $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
- $** $(baselibs)
- -@del $*.exp
- -@del $*.lib
-!endif
-$(CAT32): $(WINDIR)\cat.c
+$(CAT32): $(_TCLDIR)\win\cat.c
$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
- $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
- $(baselibs)
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj $(baselibs)
+
+install-binaries:
+ @xcopy /i /y "$(WISH)" "$(BIN_INSTALL_DIR)\"
+!if "$(TKLIB)" != "$(TKIMPLIB)"
+ @xcopy /i /y "$(TKLIB)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @xcopy /i /y "$(TKIMPLIB)" "$(LIB_INSTALL_DIR)\"
+ @xcopy /i /y "$(TKSTUBLIB)" "$(LIB_INSTALL_DIR)\"
+
+install-libraries:
+ @xcopy /i /y "$(GENERICDIR)\tk.h" "$(INCLUDE_INSTALL_DIR)\"
+ @xcopy /i /y "$(GENERICDIR)\tkDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @xcopy /i /y "$(GENERICDIR)\tkPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @xcopy /i /y "$(GENERICDIR)\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @xcopy /i /y "$(XLIBDIR)\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11\"
+ @xcopy /i /y "$(ROOT)\library\*" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\*" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\demos\*" "$(SCRIPT_INSTALL_DIR)\demos\"
+ @xcopy /i /y "$(ROOT)\library\demos\images\*" "$(SCRIPT_INSTALL_DIR)\demos\images\"
+ @xcopy /i /y "$(ROOT)\library\images\*" "$(SCRIPT_INSTALL_DIR)\images\"
+ @xcopy /i /y "$(ROOT)\library\msgs\*" "$(SCRIPT_INSTALL_DIR)\msgs\"
#---------------------------------------------------------------------
-# Regenerate the stubs files. [Development use only]
+# Regenerate the stubs files.
#---------------------------------------------------------------------
genstubs:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
- $(TCLSH) $(TOOLSDIR:\=/)\genStubs.tcl $(GENERICDIR:\=/) \
- $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls
-!endif
+ $(TCLSH) $(_TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\$(PROJECT).decls $(GENERICDIR)\$(PROJECT)Int.decls
#---------------------------------------------------------------------
@@ -506,27 +602,27 @@ depend:
@echo Build tclsh first!
!else
$(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
- -passthru:"-DBUILD_tcl $(TCL_INCLUDES:"="")" $(GENERICDIR) \
+ -passthru:"-DBUILD_tcl $(TK_INCLUDES:"="")" $(GENERICDIR) \
$(COMPATDIR) $(WINDIR) @<<
-$(TCLOBJS)
+$(TKOBJS)
<<
!endif
#---------------------------------------------------------------------
-# Build the windows help file.
+# Regenerate the windows help files.
#---------------------------------------------------------------------
-TCLHLPBASE = $(PROJECT)$(VERSION)
-HELPFILE = $(OUT_DIR)\$(TCLHLPBASE).hlp
-HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt
+HLPBASE = $(PROJECT)$(VERSION)
+HELPFILE = $(OUT_DIR)\$(HLPBASE).hlp
+HELPCNT = $(OUT_DIR)\$(HLPBASE).cnt
DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
INDEX = $(DOCTMP_DIR)\index.tcl
-BMP = $(DOCTMP_DIR)\feather.bmp
-BMP_NOPATH = feather.bmp
+BMP = $(DOCTMP_DIR)\lamp.bmp
+BMP_NOPATH = lamp.bmp
MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
winhelp: docsetup $(HELPFILE)
@@ -534,16 +630,19 @@ winhelp: docsetup $(HELPFILE)
docsetup:
@if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
-$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
+$(MAN2HELP) $(MAN2HELP2) $(INDEX): $(TOOLSDIR)\$$(@F)
copy $(TOOLSDIR)\$(@F) $(@D)
+$(BMP):
+ copy $(WINDIR)\$(@F) $(@D)
+
$(HELPFILE): $(HELPRTF) $(BMP)
cd $(DOCTMP_DIR)
start /wait hcrtf.exe -x <<$(PROJECT).hpj
[OPTIONS]
COMPRESS=12 Hall Zeck
LCID=0x409 0x0 0x0 ; English (United States)
-TITLE=Tcl/Tk Reference Manual
+TITLE=Tk Reference Manual
BMROOT=.
CNT=$(@B).cnt
HLP=$(@B).hlp
@@ -552,7 +651,7 @@ HLP=$(@B).hlp
$(PROJECT).rtf
[WINDOWS]
-main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)
+main="Tcl/Tk Reference Manual",,27648,(r15263976),(r4227327)
[CONFIG]
BrowseButtons()
@@ -568,90 +667,114 @@ CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
$(cc32) -nologo -G4 -ML -O2 -Fo$(@D)\ $(TOOLSDIR)\$(@B).c -link -out:$@
-$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
+$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX)
$(TCLSH) $(MAN2HELP:\=/) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)
install-docs:
!if exist($(HELPFILE))
@xcopy /i /y "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
@xcopy /i /y "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
+ $(TCLSH) <<
+puts "Installing $(PROJECT)'s helpfile contents into Tcl's ..."
+set f [open "$(DOC_INSTALL_DIR:\=/)/tcl$(VERSION).cnt" r]
+while {![eof $$f]} {
+ if {[regexp {:Include $(PROJECT)([0-9]{2}).cnt} [gets $$f] dummy ver]} {
+ if {$$ver == $(VERSION)} {
+ puts "Already installed."
+ exit
+ } else {
+ # do something here logical to remove (or replace) it.
+ puts "$$ver != $(VERSION), unfinished code path, die, die!"
+ exit 1
+ }
+ }
+}
+close $$f
+set f [open $(DOC_INSTALL_DIR:\=/)/tcl$(VERSION).cnt a]
+puts $$f {:Include $(HLPBASE).cnt}
+close $$f
+<<
+ start /wait winhlp32 -g $(DOC_INSTALL_DIR)\tcl$(VERSION).hlp
!endif
-
#---------------------------------------------------------------------
# Special case object file targets
#---------------------------------------------------------------------
-$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+$(TMP_DIR)\testMain.obj: $(WINDIR)\winMain.c
!if $(TCL_LINKWITHEXTENSIONS)
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -DTCL_LINKWITHEXTENSIONS -Fo$@ $?
+ $(cc32) $(WISH_CFLAGS) -DTK_TEST -DTCL_LINKWITHEXTENSIONS -Fo$@ $?
!else
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$@ $?
+ $(cc32) $(WISH_CFLAGS) -DTK_TEST -Fo$@ $?
!endif
-$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+$(TMP_DIR)\tkTest.obj: $(GENERICDIR)\tkTest.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
-$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+$(TMP_DIR)\tkWinTest.obj: $(WINDIR)\tkWinTest.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
-$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+$(TMP_DIR)\tkSquare.obj: $(GENERICDIR)\tkSquare.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
-$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
+$(TMP_DIR)\winMain.obj: $(WINDIR)\winMain.c
!if $(TCL_LINKWITHEXTENSIONS)
- $(cc32) $(TCL_CFLAGS) -DTCL_LINKWITHEXTENSIONS -Fo$@ $?
-!else
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-!endif
-
-### The following objects should be built using the stub interfaces
-
-$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
-!if $(STATIC_BUILD)
- $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+ $(cc32) $(WISH_CFLAGS) -DTCL_LINKWITHEXTENSIONS -Fo$@ $?
!else
- $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
!endif
+# The following objects are part of the stub library and should not
+# be built as DLL objects but none of the symbols should be exported
+# and no reference made to a C runtime.
-$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
-!if $(STATIC_BUILD)
- $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
-!else
- $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
-!endif
+$(TMP_DIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c
+ $(cc32) $(cdebug) $(cflags) $(TK_INCLUDES) -Zl -DSTATIC_BUILD -Fo$@ $?
-
-### The following objects are part of the stub library and should not
-### be built as DLL objects but none of the symbols should be exported
-
-$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
- $(cc32) $(cdebug) $(cflags) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+$(TMP_DIR)\tkStubImg.obj : $(GENERICDIR)\tkStubImg.c
+ $(cc32) $(cdebug) $(cflags) $(TK_INCLUDES) -Zl -DSTATIC_BUILD -Fo$@ $?
#---------------------------------------------------------------------
# Dedependency rules
#---------------------------------------------------------------------
-$(GENERICDIR)\regcomp.c: \
- $(GENERICDIR)\regguts.h \
- $(GENERICDIR)\regc_lex.c \
- $(GENERICDIR)\regc_color.c \
- $(GENERICDIR)\regc_nfa.c \
- $(GENERICDIR)\regc_cvec.c \
- $(GENERICDIR)\regc_locale.c
-$(GENERICDIR)\regcustom.h: \
- $(GENERICDIR)\tclInt.h \
- $(GENERICDIR)\tclPort.h \
- $(GENERICDIR)\regex.h
-$(GENERICDIR)\regexec.c: \
- $(GENERICDIR)\rege_dfa.c \
- $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+$(TMP_DIR)\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)/tkPanedWindow.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)/tkUndo.c: $(GENERICDIR)/tkUndo.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
!if exist("$(OUT_DIR)\depend.mk")
!include "$(OUT_DIR)\depend.mk"
@@ -663,134 +786,54 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
### add a spacer in the output
!message
-
#---------------------------------------------------------------------
# Implicit rules
#---------------------------------------------------------------------
-{$(WINDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+{$(XLIBDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
$<
<<
{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
$<
<<
-{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+{$(ROOT)\unix}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
$<
<<
-{$(WINDIR)}.rc{$(TMP_DIR)}.res:
- $(rc32) -fo $@ -r -i "$(GENERICDIR)" -D__WIN32__ \
+{$(RCDIR)}.rc{$(TMP_DIR)}.res:
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" $(TCL_INCLUDES) \
!if $(DEBUG)
- -d DEBUG \
+ -d DEBUG \
!endif
!if $(TCL_THREADS)
- -d TCL_THREADS \
+ -d TCL_THREADS \
!endif
!if $(STATIC_BUILD)
- -d STATIC_BUILD \
+ -d STATIC_BUILD \
!endif
- $<
-
-.SUFFIXES:
-.SUFFIXES:.c .rc
-
-
-#---------------------------------------------------------------------
-# Installation.
-#---------------------------------------------------------------------
-
-install-binaries:
- @echo installing $(TCLLIBNAME)
-!if "$(TCLLIB)" != "$(TCLIMPLIB)"
- @xcopy /i /y "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
-!endif
- @xcopy /i /y "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
-!if exist($(TCLSH))
- @echo installing $(TCLSHNAME)
- @xcopy /i /y "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
-!endif
-!if exist($(TCLPIPEDLL))
- @echo installing $(TCLPIPEDLLNAME)
- @xcopy /i /y "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\"
-!endif
- @echo installing $(TCLSTUBLIBNAME)
- @xcopy /i /y "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
-
-install-libraries:
- @echo installing http1.0
- @xcopy /i /y "$(ROOT)\library\http1.0\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\http1.0\"
- @echo installing http2.4
- @xcopy /i /y "$(ROOT)\library\http\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\http2.4\"
- @echo installing opt0.4
- @xcopy /i /y "$(ROOT)\library\opt\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\opt0.4\"
- @echo installing msgcat1.3
- @xcopy /i /y "$(ROOT)\library\msgcat\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\msgcat1.3\"
- @echo installing tcltest2.2
- @xcopy /i /y "$(ROOT)\library\tcltest\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\tcltest2.2\"
- @echo installing $(TCLDDELIBNAME)
-!if $(STATIC_BUILD)
- @xcopy /i /y "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
-!else
- @xcopy /i /y "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
- @xcopy /i /y "$(ROOT)\library\dde\pkgIndex.tcl" \
- "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
-!endif
- @echo installing $(TCLREGLIBNAME)
-!if $(STATIC_BUILD)
- @xcopy /i /y "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
-!else
- @xcopy /i /y "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
- @xcopy /i /y "$(ROOT)\library\reg\pkgIndex.tcl" \
- "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
-!endif
- @echo installing encoding files
- @xcopy /i /y "$(ROOT)\library\encoding\*.enc" \
- "$(SCRIPT_INSTALL_DIR)\encoding\"
- @echo installing library files
- @xcopy /i /y "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
- @xcopy /i /y "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @xcopy /i /y "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @xcopy /i /y "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
-
+ $<
#---------------------------------------------------------------------
# Clean up
#---------------------------------------------------------------------
-!if "$(OS)" == "Windows_NT"
-RMDIR = rmdir /S /Q
-!else
-RMDIR = deltree /Y
-!endif
+clean:
+ -@$(RMDIR) $(TMP_DIR)
-tidy:
- if exist $(TCLLIB) del $(TCLLIB)
- if exist $(TCLSH) del $(TCLSH)
- if exist $(TCLTEST) del $(TCLTEST)
- if exist $(TCLDDELIB) del $(TCLDDELIB)
- if exist $(TCLREGLIB) del $(TCLREGLIB)
+hose: clean
+ -@$(RMDIR) $(OUT_DIR)
-clean:
- if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
-hose:
- if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
+.SUFFIXES:
+.SUFFIXES:.c .rc
diff --git a/tcl/win/mkd.bat b/tcl/win/mkd.bat
index c7598eb9fe6..ac35788ce2b 100644
--- a/tcl/win/mkd.bat
+++ b/tcl/win/mkd.bat
@@ -1,22 +1,14 @@
-@echo off
-rem RCS: @(#) $Id$
-
-if exist %1\. 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 created directory %1
-
-:end
-
-
+@echo off
+rem RCS: @(#) $Id$
+
+if exist %1\nul goto end
+
+md %1
+if errorlevel 1 goto end
+
+echo Created directory %1
+
+:end
+
+
+
diff --git a/tcl/win/rc/buttons.bmp b/tcl/win/rc/buttons.bmp
new file mode 100644
index 00000000000..f37a4c9d7c9
--- /dev/null
+++ b/tcl/win/rc/buttons.bmp
Binary files differ
diff --git a/tcl/win/rc/cursor00.cur b/tcl/win/rc/cursor00.cur
new file mode 100644
index 00000000000..337e6d4e901
--- /dev/null
+++ b/tcl/win/rc/cursor00.cur
Binary files differ
diff --git a/tcl/win/rc/cursor02.cur b/tcl/win/rc/cursor02.cur
new file mode 100644
index 00000000000..fbc47749fd4
--- /dev/null
+++ b/tcl/win/rc/cursor02.cur
Binary files differ
diff --git a/tcl/win/rc/cursor04.cur b/tcl/win/rc/cursor04.cur
new file mode 100644
index 00000000000..9634c42f3b5
--- /dev/null
+++ b/tcl/win/rc/cursor04.cur
Binary files differ
diff --git a/tcl/win/rc/cursor06.cur b/tcl/win/rc/cursor06.cur
new file mode 100644
index 00000000000..f7188b22c2f
--- /dev/null
+++ b/tcl/win/rc/cursor06.cur
Binary files differ
diff --git a/tcl/win/rc/cursor08.cur b/tcl/win/rc/cursor08.cur
new file mode 100644
index 00000000000..d9f15f77562
--- /dev/null
+++ b/tcl/win/rc/cursor08.cur
Binary files differ
diff --git a/tcl/win/rc/cursor0a.cur b/tcl/win/rc/cursor0a.cur
new file mode 100644
index 00000000000..3f8ef45620a
--- /dev/null
+++ b/tcl/win/rc/cursor0a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor0c.cur b/tcl/win/rc/cursor0c.cur
new file mode 100644
index 00000000000..1014eddca2e
--- /dev/null
+++ b/tcl/win/rc/cursor0c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor0e.cur b/tcl/win/rc/cursor0e.cur
new file mode 100644
index 00000000000..964058d9ade
--- /dev/null
+++ b/tcl/win/rc/cursor0e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor10.cur b/tcl/win/rc/cursor10.cur
new file mode 100644
index 00000000000..c4f78096f3b
--- /dev/null
+++ b/tcl/win/rc/cursor10.cur
Binary files differ
diff --git a/tcl/win/rc/cursor12.cur b/tcl/win/rc/cursor12.cur
new file mode 100644
index 00000000000..920c936ae04
--- /dev/null
+++ b/tcl/win/rc/cursor12.cur
Binary files differ
diff --git a/tcl/win/rc/cursor14.cur b/tcl/win/rc/cursor14.cur
new file mode 100644
index 00000000000..c7de122e01f
--- /dev/null
+++ b/tcl/win/rc/cursor14.cur
Binary files differ
diff --git a/tcl/win/rc/cursor16.cur b/tcl/win/rc/cursor16.cur
new file mode 100644
index 00000000000..cfc08f23f96
--- /dev/null
+++ b/tcl/win/rc/cursor16.cur
Binary files differ
diff --git a/tcl/win/rc/cursor18.cur b/tcl/win/rc/cursor18.cur
new file mode 100644
index 00000000000..95ed2ee9623
--- /dev/null
+++ b/tcl/win/rc/cursor18.cur
Binary files differ
diff --git a/tcl/win/rc/cursor1a.cur b/tcl/win/rc/cursor1a.cur
new file mode 100644
index 00000000000..ea51361200c
--- /dev/null
+++ b/tcl/win/rc/cursor1a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor1c.cur b/tcl/win/rc/cursor1c.cur
new file mode 100644
index 00000000000..6f10bfbee82
--- /dev/null
+++ b/tcl/win/rc/cursor1c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor1e.cur b/tcl/win/rc/cursor1e.cur
new file mode 100644
index 00000000000..49fa7f70ddb
--- /dev/null
+++ b/tcl/win/rc/cursor1e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor20.cur b/tcl/win/rc/cursor20.cur
new file mode 100644
index 00000000000..cf177a16c4f
--- /dev/null
+++ b/tcl/win/rc/cursor20.cur
Binary files differ
diff --git a/tcl/win/rc/cursor22.cur b/tcl/win/rc/cursor22.cur
new file mode 100644
index 00000000000..2f8e91247f8
--- /dev/null
+++ b/tcl/win/rc/cursor22.cur
Binary files differ
diff --git a/tcl/win/rc/cursor24.cur b/tcl/win/rc/cursor24.cur
new file mode 100644
index 00000000000..87ba5b4db19
--- /dev/null
+++ b/tcl/win/rc/cursor24.cur
Binary files differ
diff --git a/tcl/win/rc/cursor26.cur b/tcl/win/rc/cursor26.cur
new file mode 100644
index 00000000000..0b2dbd2578e
--- /dev/null
+++ b/tcl/win/rc/cursor26.cur
Binary files differ
diff --git a/tcl/win/rc/cursor28.cur b/tcl/win/rc/cursor28.cur
new file mode 100644
index 00000000000..30550f95613
--- /dev/null
+++ b/tcl/win/rc/cursor28.cur
Binary files differ
diff --git a/tcl/win/rc/cursor2a.cur b/tcl/win/rc/cursor2a.cur
new file mode 100644
index 00000000000..8dca4321fa3
--- /dev/null
+++ b/tcl/win/rc/cursor2a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor2c.cur b/tcl/win/rc/cursor2c.cur
new file mode 100644
index 00000000000..7be349469a3
--- /dev/null
+++ b/tcl/win/rc/cursor2c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor2e.cur b/tcl/win/rc/cursor2e.cur
new file mode 100644
index 00000000000..7a0bc694bd1
--- /dev/null
+++ b/tcl/win/rc/cursor2e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor30.cur b/tcl/win/rc/cursor30.cur
new file mode 100644
index 00000000000..70ef4fd23f8
--- /dev/null
+++ b/tcl/win/rc/cursor30.cur
Binary files differ
diff --git a/tcl/win/rc/cursor32.cur b/tcl/win/rc/cursor32.cur
new file mode 100644
index 00000000000..93b5c4759c2
--- /dev/null
+++ b/tcl/win/rc/cursor32.cur
Binary files differ
diff --git a/tcl/win/rc/cursor34.cur b/tcl/win/rc/cursor34.cur
new file mode 100644
index 00000000000..0fad3f1cfb3
--- /dev/null
+++ b/tcl/win/rc/cursor34.cur
Binary files differ
diff --git a/tcl/win/rc/cursor36.cur b/tcl/win/rc/cursor36.cur
new file mode 100644
index 00000000000..fc8d4f6d4e5
--- /dev/null
+++ b/tcl/win/rc/cursor36.cur
Binary files differ
diff --git a/tcl/win/rc/cursor38.cur b/tcl/win/rc/cursor38.cur
new file mode 100644
index 00000000000..4447d7d0bab
--- /dev/null
+++ b/tcl/win/rc/cursor38.cur
Binary files differ
diff --git a/tcl/win/rc/cursor3a.cur b/tcl/win/rc/cursor3a.cur
new file mode 100644
index 00000000000..8176d1da6ad
--- /dev/null
+++ b/tcl/win/rc/cursor3a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor3c.cur b/tcl/win/rc/cursor3c.cur
new file mode 100644
index 00000000000..6a3111d7fb6
--- /dev/null
+++ b/tcl/win/rc/cursor3c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor3e.cur b/tcl/win/rc/cursor3e.cur
new file mode 100644
index 00000000000..fa6fe5b694b
--- /dev/null
+++ b/tcl/win/rc/cursor3e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor40.cur b/tcl/win/rc/cursor40.cur
new file mode 100644
index 00000000000..f07bf4f5c47
--- /dev/null
+++ b/tcl/win/rc/cursor40.cur
Binary files differ
diff --git a/tcl/win/rc/cursor42.cur b/tcl/win/rc/cursor42.cur
new file mode 100644
index 00000000000..387d5f0bef9
--- /dev/null
+++ b/tcl/win/rc/cursor42.cur
Binary files differ
diff --git a/tcl/win/rc/cursor44.cur b/tcl/win/rc/cursor44.cur
new file mode 100644
index 00000000000..190320cbad6
--- /dev/null
+++ b/tcl/win/rc/cursor44.cur
Binary files differ
diff --git a/tcl/win/rc/cursor46.cur b/tcl/win/rc/cursor46.cur
new file mode 100644
index 00000000000..3e97094d931
--- /dev/null
+++ b/tcl/win/rc/cursor46.cur
Binary files differ
diff --git a/tcl/win/rc/cursor48.cur b/tcl/win/rc/cursor48.cur
new file mode 100644
index 00000000000..2a5689731ed
--- /dev/null
+++ b/tcl/win/rc/cursor48.cur
Binary files differ
diff --git a/tcl/win/rc/cursor4a.cur b/tcl/win/rc/cursor4a.cur
new file mode 100644
index 00000000000..30febfa2d45
--- /dev/null
+++ b/tcl/win/rc/cursor4a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor4c.cur b/tcl/win/rc/cursor4c.cur
new file mode 100644
index 00000000000..0407d77a21c
--- /dev/null
+++ b/tcl/win/rc/cursor4c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor4e.cur b/tcl/win/rc/cursor4e.cur
new file mode 100644
index 00000000000..a58e3dba5e2
--- /dev/null
+++ b/tcl/win/rc/cursor4e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor50.cur b/tcl/win/rc/cursor50.cur
new file mode 100644
index 00000000000..7352420db49
--- /dev/null
+++ b/tcl/win/rc/cursor50.cur
Binary files differ
diff --git a/tcl/win/rc/cursor52.cur b/tcl/win/rc/cursor52.cur
new file mode 100644
index 00000000000..435f99f46bb
--- /dev/null
+++ b/tcl/win/rc/cursor52.cur
Binary files differ
diff --git a/tcl/win/rc/cursor54.cur b/tcl/win/rc/cursor54.cur
new file mode 100644
index 00000000000..54eb4f2ce07
--- /dev/null
+++ b/tcl/win/rc/cursor54.cur
Binary files differ
diff --git a/tcl/win/rc/cursor56.cur b/tcl/win/rc/cursor56.cur
new file mode 100644
index 00000000000..c808bd4ea1d
--- /dev/null
+++ b/tcl/win/rc/cursor56.cur
Binary files differ
diff --git a/tcl/win/rc/cursor58.cur b/tcl/win/rc/cursor58.cur
new file mode 100644
index 00000000000..98b6a2fb592
--- /dev/null
+++ b/tcl/win/rc/cursor58.cur
Binary files differ
diff --git a/tcl/win/rc/cursor5a.cur b/tcl/win/rc/cursor5a.cur
new file mode 100644
index 00000000000..b00070e5c57
--- /dev/null
+++ b/tcl/win/rc/cursor5a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor5c.cur b/tcl/win/rc/cursor5c.cur
new file mode 100644
index 00000000000..a407b55fb2d
--- /dev/null
+++ b/tcl/win/rc/cursor5c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor5e.cur b/tcl/win/rc/cursor5e.cur
new file mode 100644
index 00000000000..ab3449f7a9d
--- /dev/null
+++ b/tcl/win/rc/cursor5e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor60.cur b/tcl/win/rc/cursor60.cur
new file mode 100644
index 00000000000..847969d261c
--- /dev/null
+++ b/tcl/win/rc/cursor60.cur
Binary files differ
diff --git a/tcl/win/rc/cursor62.cur b/tcl/win/rc/cursor62.cur
new file mode 100644
index 00000000000..36404a50b00
--- /dev/null
+++ b/tcl/win/rc/cursor62.cur
Binary files differ
diff --git a/tcl/win/rc/cursor64.cur b/tcl/win/rc/cursor64.cur
new file mode 100644
index 00000000000..a6bdd0efc93
--- /dev/null
+++ b/tcl/win/rc/cursor64.cur
Binary files differ
diff --git a/tcl/win/rc/cursor66.cur b/tcl/win/rc/cursor66.cur
new file mode 100644
index 00000000000..81d53b42696
--- /dev/null
+++ b/tcl/win/rc/cursor66.cur
Binary files differ
diff --git a/tcl/win/rc/cursor68.cur b/tcl/win/rc/cursor68.cur
new file mode 100644
index 00000000000..27cfaf07796
--- /dev/null
+++ b/tcl/win/rc/cursor68.cur
Binary files differ
diff --git a/tcl/win/rc/cursor6a.cur b/tcl/win/rc/cursor6a.cur
new file mode 100644
index 00000000000..20f138e45d8
--- /dev/null
+++ b/tcl/win/rc/cursor6a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor6c.cur b/tcl/win/rc/cursor6c.cur
new file mode 100644
index 00000000000..1e8d6d82e3f
--- /dev/null
+++ b/tcl/win/rc/cursor6c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor6e.cur b/tcl/win/rc/cursor6e.cur
new file mode 100644
index 00000000000..3a9b6b0ff1e
--- /dev/null
+++ b/tcl/win/rc/cursor6e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor70.cur b/tcl/win/rc/cursor70.cur
new file mode 100644
index 00000000000..e2d76732afc
--- /dev/null
+++ b/tcl/win/rc/cursor70.cur
Binary files differ
diff --git a/tcl/win/rc/cursor72.cur b/tcl/win/rc/cursor72.cur
new file mode 100644
index 00000000000..4994c6e7a26
--- /dev/null
+++ b/tcl/win/rc/cursor72.cur
Binary files differ
diff --git a/tcl/win/rc/cursor74.cur b/tcl/win/rc/cursor74.cur
new file mode 100644
index 00000000000..d5e43613d34
--- /dev/null
+++ b/tcl/win/rc/cursor74.cur
Binary files differ
diff --git a/tcl/win/rc/cursor76.cur b/tcl/win/rc/cursor76.cur
new file mode 100644
index 00000000000..34f402aaca5
--- /dev/null
+++ b/tcl/win/rc/cursor76.cur
Binary files differ
diff --git a/tcl/win/rc/cursor78.cur b/tcl/win/rc/cursor78.cur
new file mode 100644
index 00000000000..70e25dd1c67
--- /dev/null
+++ b/tcl/win/rc/cursor78.cur
Binary files differ
diff --git a/tcl/win/rc/cursor7a.cur b/tcl/win/rc/cursor7a.cur
new file mode 100644
index 00000000000..5ea95c4c674
--- /dev/null
+++ b/tcl/win/rc/cursor7a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor7c.cur b/tcl/win/rc/cursor7c.cur
new file mode 100644
index 00000000000..38036ab36c4
--- /dev/null
+++ b/tcl/win/rc/cursor7c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor7e.cur b/tcl/win/rc/cursor7e.cur
new file mode 100644
index 00000000000..4b24e50885a
--- /dev/null
+++ b/tcl/win/rc/cursor7e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor80.cur b/tcl/win/rc/cursor80.cur
new file mode 100644
index 00000000000..a3955a5f7e7
--- /dev/null
+++ b/tcl/win/rc/cursor80.cur
Binary files differ
diff --git a/tcl/win/rc/cursor82.cur b/tcl/win/rc/cursor82.cur
new file mode 100644
index 00000000000..984cfbaac8e
--- /dev/null
+++ b/tcl/win/rc/cursor82.cur
Binary files differ
diff --git a/tcl/win/rc/cursor84.cur b/tcl/win/rc/cursor84.cur
new file mode 100644
index 00000000000..cd6807ec40c
--- /dev/null
+++ b/tcl/win/rc/cursor84.cur
Binary files differ
diff --git a/tcl/win/rc/cursor86.cur b/tcl/win/rc/cursor86.cur
new file mode 100644
index 00000000000..2d38c0351f1
--- /dev/null
+++ b/tcl/win/rc/cursor86.cur
Binary files differ
diff --git a/tcl/win/rc/cursor88.cur b/tcl/win/rc/cursor88.cur
new file mode 100644
index 00000000000..62b80615f85
--- /dev/null
+++ b/tcl/win/rc/cursor88.cur
Binary files differ
diff --git a/tcl/win/rc/cursor8a.cur b/tcl/win/rc/cursor8a.cur
new file mode 100644
index 00000000000..6c5358d69a8
--- /dev/null
+++ b/tcl/win/rc/cursor8a.cur
Binary files differ
diff --git a/tcl/win/rc/cursor8c.cur b/tcl/win/rc/cursor8c.cur
new file mode 100644
index 00000000000..103010b645c
--- /dev/null
+++ b/tcl/win/rc/cursor8c.cur
Binary files differ
diff --git a/tcl/win/rc/cursor8e.cur b/tcl/win/rc/cursor8e.cur
new file mode 100644
index 00000000000..a500a38dffe
--- /dev/null
+++ b/tcl/win/rc/cursor8e.cur
Binary files differ
diff --git a/tcl/win/rc/cursor90.cur b/tcl/win/rc/cursor90.cur
new file mode 100644
index 00000000000..08731f8236a
--- /dev/null
+++ b/tcl/win/rc/cursor90.cur
Binary files differ
diff --git a/tcl/win/rc/cursor92.cur b/tcl/win/rc/cursor92.cur
new file mode 100644
index 00000000000..4364b5df1ce
--- /dev/null
+++ b/tcl/win/rc/cursor92.cur
Binary files differ
diff --git a/tcl/win/rc/cursor94.cur b/tcl/win/rc/cursor94.cur
new file mode 100644
index 00000000000..7777d5380a7
--- /dev/null
+++ b/tcl/win/rc/cursor94.cur
Binary files differ
diff --git a/tcl/win/rc/cursor96.cur b/tcl/win/rc/cursor96.cur
new file mode 100644
index 00000000000..cecaea39b5a
--- /dev/null
+++ b/tcl/win/rc/cursor96.cur
Binary files differ
diff --git a/tcl/win/rc/cursor98.cur b/tcl/win/rc/cursor98.cur
new file mode 100644
index 00000000000..5cab68ebace
--- /dev/null
+++ b/tcl/win/rc/cursor98.cur
Binary files differ
diff --git a/tcl/win/rc/tk.ico b/tcl/win/rc/tk.ico
new file mode 100644
index 00000000000..5fdb9a79d5f
--- /dev/null
+++ b/tcl/win/rc/tk.ico
Binary files differ
diff --git a/tcl/win/rc/tk.rc b/tcl/win/rc/tk.rc
new file mode 100644
index 00000000000..099c75c9400
--- /dev/null
+++ b/tcl/win/rc/tk.rc
@@ -0,0 +1,76 @@
+// RCS: @(#) $Id$
+//
+// Version Resource Script
+//
+
+#include <windows.h>
+#include <tk.h>
+
+//
+// build-up the name suffix that defines the type of build this is.
+//
+#ifdef TCL_THREADS
+#define SUFFIX_THREADS "t"
+#else
+#define SUFFIX_THREADS ""
+#endif
+
+#ifdef DEBUG
+#define SUFFIX_DEBUG "d"
+#else
+#define SUFFIX_DEBUG ""
+#endif
+
+#define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG
+
+
+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
+#ifdef DEBUG
+ FILEFLAGS VS_FF_DEBUG
+#else
+ FILEFLAGS 0x0L
+#endif
+ FILEOS VOS__WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Tk DLL\0"
+ VALUE "OriginalFilename", "tk" STRINGIFY(JOIN(TK_MAJOR_VERSION,TK_MINOR_VERSION)) SUFFIX ".dll\0"
+ VALUE "CompanyName", "ActiveState Corporation\0"
+ VALUE "FileVersion", TK_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 2001 by ActiveState Corporation, et al\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
+
+//
+// Include the base resources.
+//
+
+#include "tk_base.rc"
+
+//
+// This enables themed scrollbars in XP by trying to use comctl32 v6.
+//
+
+#ifndef RT_MANIFEST
+#define RT_MANIFEST 24
+#endif
+#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID
+#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
+#endif
+CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "wish.exe.manifest"
+
diff --git a/tcl/win/rc/tk_base.rc b/tcl/win/rc/tk_base.rc
new file mode 100644
index 00000000000..277f631363b
--- /dev/null
+++ b/tcl/win/rc/tk_base.rc
@@ -0,0 +1,131 @@
+// RCS: @(#) $Id$
+//
+// Base resources needed by Tk whether it's a DLL or a static library.
+//
+
+//
+// Tk Icon
+//
+
+tk ICON DISCARDABLE "tk.ico"
+
+#include <dlgs.h>
+
+FILEOPENORD DIALOG DISCARDABLE 36, 24, 218, 138
+STYLE DS_MODALFRAME | DS_3DLOOK | WS_POPUP | WS_CAPTION | WS_SYSMENU
+CAPTION "Choose Directory"
+FONT 8, "Helv"
+BEGIN
+ LTEXT "Directory &name:",-1,8,6,118,9
+ EDITTEXT edt10,8,26,144,12, WS_TABSTOP | ES_AUTOHSCROLL
+ LISTBOX lst2,8,40,144,64,LBS_SORT | LBS_OWNERDRAWFIXED |
+ LBS_HASSTRINGS | LBS_NOINTEGRALHEIGHT |
+ LBS_DISABLENOSCROLL | WS_VSCROLL | WS_TABSTOP
+ LTEXT "Dri&ves:",stc4,8,106,92,9
+ COMBOBOX cmb2,8,115,144,68,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED |
+ CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER |
+ WS_VSCROLL | WS_TABSTOP
+ DEFPUSHBUTTON "OK",1,160,6,50,14,WS_GROUP
+ PUSHBUTTON "Cancel",2,160,24,50,14,WS_GROUP
+ PUSHBUTTON "&Help",psh15,160,42,50,14,WS_GROUP
+ CHECKBOX "&Read only",chx1,160,66,50,12,WS_GROUP
+ PUSHBUTTON "Net&work...",psh14,160,115,50,14,WS_GROUP
+
+ LTEXT "a",stc3,9,143,114,15
+ EDITTEXT edt1,7,158,135,20,NOT WS_TABSTOP
+ LISTBOX lst1,8,205,134,42,LBS_NOINTEGRALHEIGHT
+ COMBOBOX cmb1,8,253,135,21,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED |
+ CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER |
+ WS_VSCROLL
+
+END
+
+
+//
+// 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/tcl/win/rc/wish.exe.manifest b/tcl/win/rc/wish.exe.manifest
new file mode 100644
index 00000000000..3fcc7c3b8f3
--- /dev/null
+++ b/tcl/win/rc/wish.exe.manifest
@@ -0,0 +1,23 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+<assemblyIdentity
+ version="8.4.0.4"
+ processorArchitecture="X86"
+ name="Tcl.Tk.wish"
+ type="win32"
+/>
+<description>Tcl/Tk windowing shell (wish)</description>
+<dependency>
+<dependentAssembly>
+<assemblyIdentity
+ type="win32"
+ name="Microsoft.Windows.Common-Controls"
+ version="6.0.0.0"
+ processorArchitecture="X86"
+ publicKeyToken="6595b64144ccf1df"
+ language="*"
+/>
+</dependentAssembly>
+</dependency>
+</assembly>
+
diff --git a/tcl/win/rc/wish.ico b/tcl/win/rc/wish.ico
new file mode 100644
index 00000000000..182575166f5
--- /dev/null
+++ b/tcl/win/rc/wish.ico
Binary files differ
diff --git a/tcl/win/rc/wish.rc b/tcl/win/rc/wish.rc
new file mode 100644
index 00000000000..1f5659db99c
--- /dev/null
+++ b/tcl/win/rc/wish.rc
@@ -0,0 +1,89 @@
+// RCS: @(#) $Id$
+//
+// Version Resource Script
+//
+
+#include <windows.h>
+#include <tk.h>
+
+//
+// build-up the name suffix that defines the type of build this is.
+//
+#ifdef TCL_THREADS
+#define SUFFIX_THREADS "t"
+#else
+#define SUFFIX_THREADS ""
+#endif
+
+#ifdef STATIC_BUILD
+#define SUFFIX_STATIC "s"
+#else
+#define SUFFIX_STATIC ""
+#endif
+
+#ifdef DEBUG
+#define SUFFIX_DEBUG "d"
+#else
+#define SUFFIX_DEBUG ""
+#endif
+
+#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG
+
+
+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
+#ifdef DEBUG
+ FILEFLAGS VS_FF_DEBUG
+#else
+ FILEFLAGS 0x0L
+#endif
+ FILEOS VOS__WINDOWS32
+ FILETYPE VFT_APP
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Wish Application\0"
+ VALUE "OriginalFilename", "wish" STRINGIFY(JOIN(TK_MAJOR_VERSION,TK_MINOR_VERSION)) SUFFIX ".exe\0"
+ VALUE "CompanyName", "ActiveState Corporation\0"
+ VALUE "FileVersion", TK_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\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
+//
+// The icon whose name or resource ID is lexigraphically first, is used
+// as the application's icon.
+//
+
+app ICON DISCARDABLE "wish.ico"
+
+#ifdef STATIC_BUILD
+#include "tk_base.rc"
+#endif
+
+//
+// This enables themed scrollbars in XP by trying to use comctl32 v6.
+//
+
+#ifndef RT_MANIFEST
+#define RT_MANIFEST 24
+#endif
+#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID
+#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
+#endif
+CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "wish.exe.manifest"
+
diff --git a/tcl/win/rmd.bat b/tcl/win/rmd.bat
index 721ba4f96fc..ee82bb12720 100644
--- a/tcl/win/rmd.bat
+++ b/tcl/win/rmd.bat
@@ -1,27 +1,22 @@
-@echo off
-rem RCS: @(#) $Id$
-
-if not exist %1\. 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
-
-
+@echo off
+rem RCS: @(#) $Id$
+
+if not exist %1\nul goto end
+
+echo Removing directory %1
+
+if "%OS%" == "Windows_NT" goto winnt
+
+deltree /y %1
+if errorlevel 1 goto end
+goto success
+
+:winnt
+rmdir /s /q %1
+if errorlevel 1 goto end
+
+:success
+echo Deleted directory %1
+
+:end
+
diff --git a/tcl/win/rules.vc b/tcl/win/rules.vc
index 84b6ad040cd..e77fb25edbe 100644
--- a/tcl/win/rules.vc
+++ b/tcl/win/rules.vc
@@ -46,7 +46,7 @@ MACHINE = IX86
#----------------------------------------------------------
### test for optimizations
-!if [nmakehlp -c -Otip ]
+!if [nmakehlp -c -Otip]
!message *** Compiler has 'Optimizations'
OPTIMIZING = 1
!else
diff --git a/tcl/win/stubs.c b/tcl/win/stubs.c
new file mode 100644
index 00000000000..5fbc8d1c3b5
--- /dev/null
+++ b/tcl/win/stubs.c
@@ -0,0 +1,393 @@
+#include "tk.h"
+
+/*
+ * Undocumented Xlib internal function
+ */
+
+int _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;
+ CONST 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/tcl/win/tcl.m4 b/tcl/win/tcl.m4
index 71ce0a98848..3a3b43f0e78 100644
--- a/tcl/win/tcl.m4
+++ b/tcl/win/tcl.m4
@@ -300,42 +300,6 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
])
-#------------------------------------------------------------------------
-# SC_ENABLE_MEMDEBUG --
-#
-# Specify if the memory debugging code should be used
-#
-# Arguments:
-# none
-#
-# Requires the following vars to be set in the Makefile:
-# None.
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --enable-memdebug
-#
-# Defines the following @vars@:
-# MEM_DEBUG_FLAGS Sets to -DTCL_MEM_DEBUG if true
-# Sets to "" if false
-#
-#------------------------------------------------------------------------
-
-AC_DEFUN(SC_ENABLE_MEMDEBUG, [
- AC_MSG_CHECKING([for build with memory debugging])
- AC_ARG_ENABLE(memdebug, [ --enable-memdebug build with memory debugging [--disable-memdebug]], [tcl_ok=$enableval], [tcl_ok=no])
- if test "$tcl_ok" = "yes"; then
- MEM_DEBUG_FLAGS=-DTCL_MEM_DEBUG
- AC_MSG_RESULT([yes])
- else
- MEM_DEBUG_FLAGS=""
- AC_MSG_RESULT([no])
- fi
- AC_SUBST(MEM_DEBUG_FLAGS)
-])
-
-
#--------------------------------------------------------------------
# SC_CONFIG_CFLAGS
#
@@ -412,7 +376,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
SHLIB_LD=""
SHLIB_LD_LIBS=""
LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32"
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
@@ -553,7 +517,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
SHLIB_LD="${LINKBIN} -dll -nologo -incremental:no"
SHLIB_LD_LIBS="user32.lib advapi32.lib"
LIBS="user32.lib advapi32.lib"
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib"
RC_OUT=-fo
RC_TYPE=-r
RC_INCLUDE=-i
diff --git a/tcl/win/tkConfig.sh.in b/tcl/win/tkConfig.sh.in
new file mode 100644
index 00000000000..34555334d36
--- /dev/null
+++ b/tcl/win/tkConfig.sh.in
@@ -0,0 +1,87 @@
+# 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@
+
+# This indicates if Tk was build with debugging symbols
+TK_DBGX=@TK_DBGX@
+
+# The name of the Tk library (may be either a .a file or a shared library):
+TK_LIB_FILE='@TK_LIB_FILE@'
+
+# Additional libraries to use when linking Tk.
+TK_LIBS='@LIBS@ @LIBS_GUI@'
+
+# 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@'
+
+# -l flag to pass to the linker to pick up the Tcl library
+TK_LIB_FLAG='@TK_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tk library from its
+# build directory.
+TK_BUILD_LIB_SPEC='@TK_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tk library from its
+# installed directory.
+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@'
+
+# The name of the Tk stub library (.a):
+TK_STUB_LIB_FILE='@TK_STUB_LIB_FILE@'
+
+# -l flag to pass to the linker to pick up the Tk stub library
+TK_STUB_LIB_FLAG='@TK_STUB_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tk stub library from its
+# build directory.
+TK_BUILD_STUB_LIB_SPEC='@TK_BUILD_STUB_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tk stub library from its
+# installed directory.
+TK_STUB_LIB_SPEC='@TK_STUB_LIB_SPEC@'
+
+# Path to the Tk stub library in the build directory.
+TK_BUILD_STUB_LIB_PATH='@TK_BUILD_STUB_LIB_PATH@'
+
+# Path to the Tk stub library in the install directory.
+TK_STUB_LIB_PATH='@TK_STUB_LIB_PATH@'
diff --git a/tcl/win/tkWin.h b/tcl/win/tkWin.h
new file mode 100644
index 00000000000..0e2cef4442c
--- /dev/null
+++ b/tcl/win/tkWin.h
@@ -0,0 +1,55 @@
+/*
+ * tkWin.h --
+ *
+ * Declarations of public types and interfaces that are only
+ * available under Windows.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKWIN
+#define _TKWIN
+
+#ifndef _TK
+#include <tk.h>
+#endif
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * The following messages are use to communicate between a Tk toplevel
+ * and its container window.
+ */
+
+#define TK_CLAIMFOCUS (WM_USER)
+#define TK_GEOMETRYREQ (WM_USER+1)
+#define TK_ATTACHWINDOW (WM_USER+2)
+#define TK_DETACHWINDOW (WM_USER+3)
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Exported procedures defined for the Windows platform only.
+ *
+ *--------------------------------------------------------------
+ */
+
+#include "tkPlatDecls.h"
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKWIN */
diff --git a/tcl/win/tkWin32Dll.c b/tcl/win/tkWin32Dll.c
new file mode 100644
index 00000000000..61b05c01806
--- /dev/null
+++ b/tcl/win/tkWin32Dll.c
@@ -0,0 +1,85 @@
+/*
+ * 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 "tkWinInt.h"
+
+/*
+ * The following declaration is for the VC++ DLL entry point.
+ */
+
+BOOL APIENTRY DllMain _ANSI_ARGS_((HINSTANCE hInst,
+ DWORD reason, LPVOID reserved));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ */
+
+ if (reason == DLL_PROCESS_ATTACH) {
+ TkWinXInit(hInstance);
+ } else if (reason == DLL_PROCESS_DETACH) {
+ TkWinXCleanup(hInstance);
+ }
+ return(TRUE);
+}
diff --git a/tcl/win/tkWin3d.c b/tcl/win/tkWin3d.c
new file mode 100644
index 00000000000..35d71c81f1d
--- /dev/null
+++ b/tcl/win/tkWin3d.c
@@ -0,0 +1,575 @@
+/*
+ * 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 "tkWinInt.h"
+#include "tk3d.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)
+ ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
+ : ((WinBorder *)borderPtr)->light2ColorPtr->pixel;
+ right = (leftBevel)
+ ? borderPtr->darkGC->foreground
+ : 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)
+ ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
+ : ((WinBorder *)borderPtr)->light2ColorPtr->pixel;
+ bottomColor = (topBevel)
+ ? borderPtr->darkGC->foreground
+ : 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;
+ int r, g, b;
+ 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.
+ * But if the background is already very dark, make the
+ * dark color a little lighter than the background by increasing
+ * each color component 1/4th of the way to MAX_INTENSITY.
+ *
+ * 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).
+ * But if the background is already very bright, instead choose a
+ * slightly darker color for the light shadow by reducing each
+ * color component by 10%.
+ *
+ * Compute the colors using integers, not using lightColor.red
+ * etc.: these are shorts and may have problems with integer
+ * overflow.
+ */
+
+ /*
+ * Compute the dark shadow color
+ */
+
+ r = (int) borderPtr->bgColorPtr->red;
+ g = (int) borderPtr->bgColorPtr->green;
+ b = (int) borderPtr->bgColorPtr->blue;
+
+ if (r*0.5*r + g*1.0*g + b*0.28*b < MAX_INTENSITY*0.05*MAX_INTENSITY) {
+ darkColor.red = (MAX_INTENSITY + 3*r)/4;
+ darkColor.green = (MAX_INTENSITY + 3*g)/4;
+ darkColor.blue = (MAX_INTENSITY + 3*b)/4;
+ } else {
+ darkColor.red = (60 * r)/100;
+ darkColor.green = (60 * g)/100;
+ darkColor.blue = (60 * b)/100;
+ }
+
+ /*
+ * Allocate the dark shadow color and its GC
+ */
+
+ borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor);
+ gcValues.foreground = borderPtr->darkColorPtr->pixel;
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+
+ /*
+ * Compute the light shadow color
+ */
+
+ if (g > MAX_INTENSITY*0.95) {
+ lightColor.red = (90 * r)/100;
+ lightColor.green = (90 * g)/100;
+ lightColor.blue = (90 * b)/100;
+ } else {
+ tmp1 = (14 * r)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + r)/2;
+ lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * g)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + g)/2;
+ lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * b)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + b)/2;
+ lightColor.blue = (tmp1 > tmp2) ? tmp1 : tmp2;
+ }
+
+ /*
+ * Allocate the light shadow color and its GC
+ */
+
+ 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/tcl/win/tkWinButton.c b/tcl/win/tkWinButton.c
new file mode 100644
index 00000000000..058ae39852f
--- /dev/null
+++ b/tcl/win/tkWinButton.c
@@ -0,0 +1,1215 @@
+/*
+ * tkWinButton.c --
+ *
+ * This file implements the Windows specific portion of the button
+ * widgets.
+ *
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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)
+
+/*
+ * 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. */
+ 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
+};
+
+/*
+ * Cached information about the boxes bitmap, and the default border
+ * width for a button in string form for use in Tk_OptionSpec for
+ * the various button widget classes.
+ */
+
+typedef struct ThreadSpecificData {
+ BITMAPINFOHEADER *boxesPtr; /* Information about the bitmap. */
+ DWORD *boxesPalette; /* Pointer to color palette. */
+ LPSTR boxesBits; /* Pointer to bitmap data. */
+ DWORD boxHeight; /* Height of each sub-image. */
+ DWORD boxWidth ; /* Width of each sub-image. */
+ char defWidth[TCL_INTEGER_SPACE];
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Declarations for functions defined in this file.
+ */
+static LRESULT CALLBACK ButtonProc _ANSI_ARGS_((HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam));
+static Window CreateProc _ANSI_ARGS_((Tk_Window tkwin,
+ Window parent, ClientData instanceData));
+static void InitBoxes _ANSI_ARGS_((void));
+
+/*
+ * The class procedure table for the button widgets.
+ */
+
+Tk_ClassProcs tkpButtonProcs = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkButtonWorldChanged, /* worldChangedProc */
+ CreateProc, /* createProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ hrsrc = FindResource(module, "buttons", RT_BITMAP);
+ if (hrsrc) {
+ hblk = LoadResource(module, hrsrc);
+ tsdPtr->boxesPtr = (LPBITMAPINFOHEADER)LockResource(hblk);
+ }
+
+ /*
+ * Copy the DIBitmap into writable memory.
+ */
+
+ if (tsdPtr->boxesPtr != NULL && !(tsdPtr->boxesPtr->biWidth % 4)
+ && !(tsdPtr->boxesPtr->biHeight % 2)) {
+ size = tsdPtr->boxesPtr->biSize + (1 << tsdPtr->boxesPtr->biBitCount)
+ * sizeof(RGBQUAD) + tsdPtr->boxesPtr->biSizeImage;
+ newBitmap = (LPBITMAPINFOHEADER) ckalloc(size);
+ memcpy(newBitmap, tsdPtr->boxesPtr, size);
+ tsdPtr->boxesPtr = newBitmap;
+ tsdPtr->boxWidth = tsdPtr->boxesPtr->biWidth / 4;
+ tsdPtr->boxHeight = tsdPtr->boxesPtr->biHeight / 2;
+ tsdPtr->boxesPalette = (DWORD*) (((LPSTR) tsdPtr->boxesPtr)
+ + tsdPtr->boxesPtr->biSize);
+ tsdPtr->boxesBits = ((LPSTR) tsdPtr->boxesPalette)
+ + ((1 << tsdPtr->boxesPtr->biBitCount) * sizeof(RGBQUAD));
+ } else {
+ tsdPtr->boxesPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpButtonSetDefaults --
+ *
+ * This procedure is invoked before option tables are created for
+ * buttons. It modifies some of the default values to match the
+ * current values defined for this platform.
+ *
+ * Results:
+ * Some of the default values in *specPtr are modified.
+ *
+ * Side effects:
+ * Updates some of.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpButtonSetDefaults(specPtr)
+ Tk_OptionSpec *specPtr; /* Points to an array of option specs,
+ * terminated by one with type
+ * TK_OPTION_END. */
+{
+ int width;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->defWidth[0] == 0) {
+ width = GetSystemMetrics(SM_CXEDGE);
+ if (width == 0) {
+ width = 1;
+ }
+ sprintf(tsdPtr->defWidth, "%d", width);
+ }
+ for ( ; specPtr->type != TK_OPTION_END; specPtr++) {
+ if (specPtr->internalOffset == Tk_Offset(TkButton, borderWidth)) {
+ specPtr->defValue = tsdPtr->defWidth;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ butPtr = (WinButton *)ckalloc(sizeof(WinButton));
+ butPtr->hwnd = NULL;
+ 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);
+#ifdef _WIN64
+ butPtr->oldProc = (WNDPROC)SetWindowLongPtr(butPtr->hwnd, GWLP_WNDPROC,
+ (LONG_PTR) ButtonProc);
+#else
+ butPtr->oldProc = (WNDPROC)SetWindowLong(butPtr->hwnd, GWL_WNDPROC,
+ (DWORD) ButtonProc);
+#endif
+
+ 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) {
+#ifdef _WIN64
+ SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) winButPtr->oldProc);
+#else
+ SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) winButPtr->oldProc);
+#endif
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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, haveImage = 0, haveText = 0, drawRing = 0;
+ RECT rect;
+ 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. */
+ int textXOffset = 0, textYOffset = 0; /* text offsets for use with
+ * compound buttons and focus ring */
+ DWORD *boxesPalette;
+
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ boxesPalette= tsdPtr->boxesPalette;
+ butPtr->flags &= ~REDRAW_PENDING;
+ if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ border = butPtr->normalBorder;
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
+ gc = butPtr->disabledGC;
+ } else if ((butPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(butPtr->tkwin)) {
+ gc = butPtr->activeTextGC;
+ border = butPtr->activeBorder;
+ } else {
+ gc = butPtr->normalTextGC;
+ }
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
+ && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
+ border = butPtr->selectBorder;
+ }
+
+ /*
+ * Override the relief specified for the button if this is a
+ * checkbutton or radiobutton and there's no indicator. The new
+ * relief is as follows:
+ * If the button is select --> "sunken"
+ * If relief==overrelief --> relief
+ * Otherwise --> overrelief
+ *
+ * The effect we are trying to achieve is as follows:
+ *
+ * value mouse-over? --> relief
+ * ------- ------------ --------
+ * off no flat
+ * off yes raised
+ * on no sunken
+ * on yes sunken
+ *
+ * This is accomplished by configuring the checkbutton or radiobutton
+ * like this:
+ *
+ * -indicatoron 0 -overrelief raised -offrelief flat
+ *
+ * Bindings (see library/button.tcl) will copy the -overrelief into
+ * -relief on mouseover. Hence, we can tell if we are in mouse-over by
+ * comparing relief against overRelief. This is an aweful kludge, but
+ * it gives use the desired behavior while keeping the code backwards
+ * compatible.
+ */
+
+ relief = butPtr->relief;
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
+ if (butPtr->flags & SELECTED) {
+ relief = TK_RELIEF_SUNKEN;
+ } else if (butPtr->overRelief != relief) {
+ relief = butPtr->offRelief;
+ }
+ }
+
+ /*
+ * Compute width of default ring and offset for pushed buttons.
+ */
+
+ if (butPtr->type == TYPE_BUTTON) {
+ defaultWidth = ((butPtr->defaultState == DEFAULT_ACTIVE)
+ ? butPtr->highlightWidth : 0);
+ offset = 1;
+ } else {
+ defaultWidth = 0;
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
+ offset = 1;
+ } else {
+ 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);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ haveImage = 1;
+ }
+
+ haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
+
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ int imageXOffset, imageYOffset, fullWidth,
+ fullHeight;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ fullWidth = 0;
+ fullHeight = 0;
+
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (butPtr->compound == COMPOUND_TOP) {
+ textYOffset = height + butPtr->padY;
+ } else {
+ imageYOffset = butPtr->textHeight + butPtr->padY;
+ }
+ fullHeight = height + butPtr->textHeight + butPtr->padY;
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ if (butPtr->compound == COMPOUND_LEFT) {
+ textXOffset = width + butPtr->padX;
+ } else {
+ imageXOffset = butPtr->textWidth + butPtr->padX;
+ }
+ fullWidth = butPtr->textWidth + butPtr->padX + width;
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ fullWidth = (width > butPtr->textWidth ? width :
+ butPtr->textWidth);
+ fullHeight = (height > butPtr->textHeight ? height :
+ butPtr->textHeight);
+ textXOffset = (fullWidth - butPtr->textWidth)/2;
+ imageXOffset = (fullWidth - width)/2;
+ textYOffset = (fullHeight - butPtr->textHeight)/2;
+ imageYOffset = (fullHeight - height)/2;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + fullWidth, fullHeight, &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 + imageXOffset,
+ y + imageYOffset);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width,
+ height, pixmap, x + imageXOffset, y + imageYOffset);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x + imageXOffset,
+ y + imageYOffset);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc,
+ 0, 0, (unsigned int) width,
+ (unsigned int) height, x + imageXOffset,
+ y + imageYOffset, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+
+ Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
+ x + textXOffset, y + textYOffset, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, gc,
+ butPtr->textLayout, x + textXOffset, y + textYOffset,
+ butPtr->underline);
+ height = fullHeight;
+ drawRing = 1;
+ } else {
+ if (haveImage) {
+ 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);
+ }
+
+ } else {
+ 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);
+
+ height = butPtr->textHeight;
+ drawRing = 1;
+ }
+ }
+
+ /*
+ * 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. The text offsets are only non-zero when this
+ * is a compound button.
+ */
+
+ if (drawRing && 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-1 + textYOffset;
+ rect.left = x-1 + textXOffset;
+ rect.right = x+butPtr->textWidth + 1 + textXOffset;
+ rect.bottom = y+butPtr->textHeight + 2 + textYOffset;
+ }
+ SetTextColor(dc, gc->foreground);
+ SetBkColor(dc, gc->background);
+ DrawFocusRect(dc, &rect);
+ TkWinReleaseDrawableDC(pixmap, dc, &state);
+ }
+
+ y += height/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
+ && tsdPtr->boxesPtr) {
+ int xSrc, ySrc;
+
+ x -= butPtr->indicatorSpace;
+ y -= butPtr->indicatorDiameter / 2;
+
+ xSrc = (butPtr->flags & SELECTED) ? tsdPtr->boxWidth : 0;
+ if (butPtr->state == STATE_ACTIVE) {
+ xSrc += tsdPtr->boxWidth*2;
+ }
+ ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : tsdPtr->boxHeight;
+
+ /*
+ * Update the palette in the boxes bitmap to reflect the current
+ * button colors. Note that this code relies on the layout of the
+ * bitmap's palette. Also, all of the colors used to draw the
+ * bitmap must be in the palette that is selected into the DC of
+ * the offscreen pixmap. This requires that the static colors
+ * be placed into the palette.
+ */
+
+ boxesPalette[PAL_CHECK] = FlipColor(gc->foreground);
+ boxesPalette[PAL_TOP_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
+ border, TK_3D_DARK_GC));
+ boxesPalette[PAL_TOP_INNER] = FlipColor(TkWinGetBorderPixels(tkwin,
+ border, TK_3D_DARK2));
+ boxesPalette[PAL_BOTTOM_INNER] = FlipColor(TkWinGetBorderPixels(tkwin,
+ border, TK_3D_LIGHT2));
+ boxesPalette[PAL_BOTTOM_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
+ border, TK_3D_LIGHT_GC));
+ if (butPtr->state == STATE_DISABLED) {
+ boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
+ border, TK_3D_LIGHT2));
+ } else if (butPtr->selectBorder != NULL) {
+ boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
+ butPtr->selectBorder, TK_3D_FLAT_GC));
+ } else {
+ boxesPalette[PAL_INTERIOR] = FlipColor(GetSysColor(COLOR_WINDOW));
+ }
+ boxesPalette[PAL_BACKGROUND] = FlipColor(TkWinGetBorderPixels(tkwin,
+ border, TK_3D_FLAT_GC));
+
+ dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state);
+ StretchDIBits(dc, x, y, tsdPtr->boxWidth, tsdPtr->boxHeight,
+ xSrc, ySrc, tsdPtr->boxWidth, tsdPtr->boxHeight,
+ tsdPtr->boxesBits, (LPBITMAPINFO) tsdPtr->boxesPtr,
+ DIB_RGB_COLORS, SRCCOPY);
+ TkWinReleaseDrawableDC(pixmap, dc, &state);
+ }
+
+ /*
+ * If the button is disabled with a stipple rather than a special
+ * foreground color, generate the stippled effect. If the widget
+ * is selected and we use a different background color when selected,
+ * must temporarily modify the GC.
+ */
+
+ if ((butPtr->state == STATE_DISABLED)
+ && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->selectBorder)->pixel);
+ }
+ XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
+ 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);
+ }
+
+ if (butPtr->flags & GOT_FOCUS) {
+ Tk_SetCaretPos(tkwin, x, y, 0 /* not used */);
+ }
+
+ /*
+ * 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 txtWidth, txtHeight; /* Width and height of text */
+ int imgWidth, imgHeight; /* Width and height of image */
+ int width = 0, height = 0; /* Width and height of button */
+ int haveImage, haveText;
+ int avgWidth;
+ int minWidth;
+ /* Vertical and horizontal dialog units size in pixels. */
+ double vDLU, hDLU;
+ Tk_FontMetrics fm;
+
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (butPtr->highlightWidth < 0) {
+ butPtr->highlightWidth = 0;
+ }
+ butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;
+ butPtr->indicatorSpace = 0;
+
+ if (!tsdPtr->boxesPtr) {
+ InitBoxes();
+ }
+
+ /* Figure out image metrics */
+ if (butPtr->image != NULL) {
+ Tk_SizeOfImage(butPtr->image, &imgWidth, &imgHeight);
+ haveImage = 1;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap,
+ &imgWidth, &imgHeight);
+ haveImage = 1;
+ } else {
+ imgWidth = 0;
+ imgHeight = 0;
+ haveImage = 0;
+ }
+
+ /*
+ * Figure out font metrics (even if we don't have text because we need
+ * DLUs (based on font, not text) for some spacing calculations below).
+ */
+ Tk_FreeTextLayout(butPtr->textLayout);
+ butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
+
+ txtWidth = butPtr->textWidth;
+ txtHeight = butPtr->textHeight;
+ haveText = (*(Tcl_GetString(butPtr->textPtr)) != '\0');
+ avgWidth = (Tk_TextWidth(butPtr->tkfont,
+ "abcdefghijklmnopqurstuvwzyABCDEFGHIJKLMNOPQURSTUVWZY",
+ 52) + 26) / 52;
+ Tk_GetFontMetrics(butPtr->tkfont, &fm);
+
+ /* Compute dialog units for layout calculations. */
+ hDLU = avgWidth / 4.0;
+ vDLU = fm.linespace / 8.0;
+
+ /*
+ * First, let's try to compute button size "by the book" (See "Microsoft
+ * Windows User Experience" (ISBN 0-7356-0566-1), Chapter 14 - Visual
+ * Design, Section 4 - Layout (page 448)).
+ *
+ * Note, that Tk "buttons" are Microsoft "Command buttons", Tk
+ * "checkbuttons" are Microsoft "check boxes", Tk "radiobuttons" are
+ * Microsoft "option buttons", and Tk "labels" are Microsoft "text
+ * labels".
+ */
+
+ /*
+ * Set width and height by button type; See User Experience table, p449.
+ * These are text-based measurements, even if the text is "".
+ * If there is an image, height will get set again later.
+ */
+ switch (butPtr->type) {
+ case TYPE_BUTTON: {
+ /*
+ * First compute the minimum width of the button in
+ * characters. MWUE says that the button should be
+ * 50 DLUs. We allow 6 DLUs padding left and right.
+ * (There is no rule but this is consistent with the
+ * fact that button text is 8 DLUs high and buttons
+ * are 14 DLUs high.)
+ *
+ * The width is specified in characters. A character
+ * is, by definition, 4 DLUs wide. 11 char * 4 DLU
+ * is 44 DLU + 6 DLU padding = 50 DLU. Therefore,
+ * width = -11 -> MWUE compliant buttons.
+ */
+ if (butPtr->width < 0) {
+ /* Min width in characters */
+ minWidth = -(butPtr->width);
+ /* Allow for characters */
+ width = avgWidth * minWidth;
+ /* Add for padding */
+ width += (int)(0.5 + (6 * hDLU));
+ }
+
+ /*
+ * If shrink-wrapping was requested (width = 0) or
+ * if the text is wider than the default button width,
+ * adjust the button width up to suit.
+ */
+ if (butPtr->width == 0
+ || (txtWidth + (int)(0.5 + (6 * hDLU)) > width)) {
+ width = txtWidth + (int)(0.5 + (6 * hDLU));
+ }
+
+ /*
+ * The User Experience says 14 DLUs. Since text is, by
+ * definition, 8 DLU/line, this allows for multi-line text
+ * while working perfectly for single-line text.
+ */
+ height = txtHeight + (int)(0.5 + (6 * vDLU));
+
+ /*
+ * The above includes 6 DLUs of padding which should include
+ * defaults of 1 pixel of highlightwidth, 2 pixels of
+ * borderwidth, 1 pixel of padding and 1 pixel of extra inset
+ * on each side. Those will be added later so reduce width
+ * and height now to compensate.
+ */
+ width -= 10;
+ height -= 10;
+
+ if (!haveImage) {
+ /*
+ * Extra inset for the focus ring.
+ */
+ butPtr->inset += 1;
+ }
+ break;
+ }
+
+ case TYPE_LABEL: {
+ /*
+ * The User Experience says, "as wide as needed".
+ */
+ width = txtWidth;
+
+ /*
+ * The User Experience says, "8 (DLUs) per line of text."
+ * Since text is, by definition, 8 DLU/line, this allows
+ * for multi-line text while working perfectly for single-line
+ * text.
+ */
+ if (txtHeight) {
+ height = txtHeight;
+ } else {
+ /*
+ * If there's no text, we want the height to be one linespace.
+ */
+ height = fm.linespace;
+ }
+ break;
+ }
+
+ case TYPE_RADIO_BUTTON:
+ case TYPE_CHECK_BUTTON: {
+ /* See note for TYPE_LABEL */
+ width = txtWidth;
+ /*
+ * The User Experience says 10 DLUs. (Is that one DLU above
+ * and below for the focus ring?) See note above about
+ * multi-line text and 8 DLU/line.
+ */
+ height = txtHeight + (int)(0.5 + (2.0 * vDLU));
+
+ /*
+ * The above includes 2 DLUs of padding which should include
+ * defaults of 1 pixel of highlightwidth, 0 pixels of
+ * borderwidth, and 1 pixel of padding on each side. Those
+ * will be added later so reduce height now to compensate.
+ */
+ height -= 4;
+
+ /*
+ * Extra inset for the focus ring.
+ */
+ butPtr->inset += 1;
+ break;
+ }
+ }/* switch */
+
+ /*
+ * At this point, the width and height are correct for a Tk text
+ * button, excluding padding and inset, but we have to allow for
+ * compound buttons. The image may be above, below, left, or right
+ * of the text.
+ */
+
+ /*
+ * If the button is compound (i.e., it shows both an image and text),
+ * the new geometry is a combination of the image and text geometry.
+ * We only honor the compound bit if the button has both text and an
+ * image, because otherwise it is not really a compound button.
+ */
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ switch ((enum compound) butPtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ /* Image is above or below text */
+ if (imgWidth > width) {
+ width = imgWidth;
+ }
+ height += imgHeight + butPtr->padY;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ /* Image is left or right of text */
+ /*
+ * Only increase width of button if image doesn't fit in
+ * slack space of default button width
+ */
+ if ((imgWidth + txtWidth + butPtr->padX) > width) {
+ width = imgWidth + txtWidth + butPtr->padX;
+ }
+
+ if (imgHeight > height) {
+ height = imgHeight;
+ }
+ break;
+ }
+ case COMPOUND_CENTER: {
+ /* Image and text are superimposed */
+ if (imgWidth > width) {
+ width = imgWidth;
+ }
+ if (imgHeight > height) {
+ height = imgHeight;
+ }
+ break;
+ }
+ } /* switch */
+
+ /* Fix up for minimum width */
+ if (butPtr->width < 0) {
+ /* minWidth in pixels (because there's an image */
+ minWidth = -(butPtr->width);
+ if (width < minWidth) {
+ width = minWidth;
+ }
+ } else if (butPtr->width > 0) {
+ width = butPtr->width;
+ }
+
+ if (butPtr->height > 0) {
+ height = butPtr->height;
+ }
+
+ width += 2*butPtr->padX;
+ height += 2*butPtr->padY;
+ } else if (haveImage) {
+ if (butPtr->width > 0) {
+ width = butPtr->width;
+ } else {
+ width = imgWidth;
+ }
+ if (butPtr->height > 0) {
+ height = butPtr->height;
+ } else {
+ height = imgHeight;
+ }
+ } else {
+ /* No image. May or may not be text. May or may not be compound. */
+
+ /*
+ * butPtr->width is in characters. We need to allow for that
+ * many characters on the face, not in the over-all button width
+ */
+ if (butPtr->width > 0) {
+ width = butPtr->width * avgWidth;
+ }
+
+ /*
+ * butPtr->height is in lines of text. We need to allow for
+ * that many lines on the face, not in the over-all button
+ * height.
+ */
+ if (butPtr->height > 0) {
+ height = butPtr->height * fm.linespace;
+
+ /*
+ * Make the same adjustments as above to get same height for
+ * e.g. a one line text with -height 0 or 1. [Bug #565485]
+ */
+
+ switch (butPtr->type) {
+ case TYPE_BUTTON: {
+ height += (int)(0.5 + (6 * vDLU)) - 10;
+ break;
+ }
+ case TYPE_RADIO_BUTTON:
+ case TYPE_CHECK_BUTTON: {
+ height += (int)(0.5 + (2.0 * vDLU)) - 4;
+ break;
+ }
+ }
+ }
+
+ width += 2 * butPtr->padX;
+ height += 2 * butPtr->padY;
+ }
+
+ /* Fix up width and height for indicator sizing and spacing */
+ if (butPtr->type == TYPE_RADIO_BUTTON
+ || butPtr->type == TYPE_CHECK_BUTTON) {
+ if (butPtr->indicatorOn) {
+ butPtr->indicatorDiameter = tsdPtr->boxHeight;
+
+ /*
+ * Make sure we can see the whole indicator, even if the text
+ * or image is very small.
+ */
+ if (height < butPtr->indicatorDiameter) {
+ height = butPtr->indicatorDiameter;
+ }
+
+ /*
+ * There is no rule for space between the indicator and
+ * the text (the two are atomic on 'Windows) but the User
+ * Experience page 451 says leave 3 hDLUs between "text
+ * labels and their associated controls".
+ */
+ butPtr->indicatorSpace = butPtr->indicatorDiameter +
+ (int)(0.5 + (3.0 * hDLU));
+ width += butPtr->indicatorSpace;
+ }
+ }
+
+ /*
+ * Inset is always added to the size.
+ */
+ width += 2 * butPtr->inset;
+ height += 2 * butPtr->inset;
+
+ Tk_GeometryRequest(butPtr->tkwin, width, height);
+ Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ 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);
+ return 0;
+ }
+ case BN_CLICKED: {
+ int code;
+ Tcl_Interp *interp = butPtr->info.interp;
+ if (butPtr->info.state != STATE_DISABLED) {
+ Tcl_Preserve((ClientData)interp);
+ code = TkInvokeButton((TkButton*)butPtr);
+ if (code != TCL_OK && code != TCL_CONTINUE
+ && code != TCL_BREAK) {
+ Tcl_AddErrorInfo(interp, "\n (button invoke)");
+ Tcl_BackgroundError(interp);
+ }
+ 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/tcl/win/tkWinClipboard.c b/tcl/win/tkWinClipboard.c
new file mode 100644
index 00000000000..7a5ff0b01eb
--- /dev/null
+++ b/tcl/win/tkWinClipboard.c
@@ -0,0 +1,454 @@
+/*
+ * tkWinClipboard.c --
+ *
+ * This file contains functions for managing the clipboard.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 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"
+#include "tkSelect.h"
+
+static void UpdateClipboard _ANSI_ARGS_((HWND hwnd));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelGetSelection --
+ *
+ * Retrieve the specified selection from another process. For
+ * now, only fetching XA_STRING from CLIPBOARD is supported.
+ * Eventually other types should be allowed.
+ *
+ * Results:
+ * The return value is a standard Tcl return value.
+ * If an error occurs (such as no selection exists)
+ * then an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, *destPtr;
+ Tcl_DString ds;
+ HGLOBAL handle;
+ Tcl_Encoding encoding;
+ int result, locale;
+
+ if ((selection != Tk_InternAtom(tkwin, "CLIPBOARD"))
+ || (target != XA_STRING)
+ || !OpenClipboard(NULL)) {
+ goto error;
+ }
+
+ /*
+ * Attempt to get the data in Unicode form if available as this is
+ * less work that CF_TEXT.
+ */
+
+ result = TCL_ERROR;
+ if (IsClipboardFormatAvailable(CF_UNICODETEXT)) {
+ handle = GetClipboardData(CF_UNICODETEXT);
+ if (!handle) {
+ CloseClipboard();
+ goto error;
+ }
+ data = GlobalLock(handle);
+ Tcl_DStringInit(&ds);
+ Tcl_UniCharToUtfDString((Tcl_UniChar *)data,
+ Tcl_UniCharLen((Tcl_UniChar *)data), &ds);
+ GlobalUnlock(handle);
+ } else if (IsClipboardFormatAvailable(CF_TEXT)) {
+ /*
+ * Determine the encoding to use to convert this text.
+ */
+
+ if (IsClipboardFormatAvailable(CF_LOCALE)) {
+ handle = GetClipboardData(CF_LOCALE);
+ if (!handle) {
+ CloseClipboard();
+ goto error;
+ }
+
+ /*
+ * Get the locale identifier, determine the proper code page
+ * to use, and find the corresponding encoding.
+ */
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "cp######", -1);
+ data = GlobalLock(handle);
+
+
+ /*
+ * Even though the documentation claims that GetLocaleInfo
+ * expects an LCID, on Windows 9x it really seems to expect
+ * a LanguageID.
+ */
+
+ locale = LANGIDFROMLCID(*((int*)data));
+ GetLocaleInfo(locale, LOCALE_IDEFAULTANSICODEPAGE,
+ Tcl_DStringValue(&ds)+2, Tcl_DStringLength(&ds)-2);
+ GlobalUnlock(handle);
+
+ encoding = Tcl_GetEncoding(NULL, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ } else {
+ encoding = NULL;
+ }
+
+ /*
+ * Fetch the text and convert it to UTF.
+ */
+
+ handle = GetClipboardData(CF_TEXT);
+ if (!handle) {
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+ CloseClipboard();
+ goto error;
+ }
+ data = GlobalLock(handle);
+ Tcl_ExternalToUtfDString(encoding, data, -1, &ds);
+ GlobalUnlock(handle);
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+
+ } else {
+ CloseClipboard();
+ goto error;
+ }
+
+ /*
+ * Translate CR/LF to LF.
+ */
+
+ data = destPtr = Tcl_DStringValue(&ds);
+ while (*data) {
+ if (data[0] == '\r' && data[1] == '\n') {
+ data++;
+ } else {
+ *destPtr++ = *data++;
+ }
+ }
+ *destPtr = '\0';
+
+ /*
+ * Pass the data off to the selection procedure.
+ */
+
+ result = (*proc)(clientData, interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ CloseClipboard();
+ return result;
+
+error:
+ 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) TkGetMainInfoList()->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) {
+ UpdateClipboard(hwnd);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, *rawText, *endPtr;
+ int length;
+ Tcl_DString ds;
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = targetPtr->nextPtr) {
+ if (targetPtr->type == XA_STRING)
+ break;
+ }
+
+ /*
+ * Count the number of newlines so we can add space for them in
+ * the resulting string.
+ */
+
+ 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++;
+ }
+ }
+ }
+ }
+
+ /*
+ * Copy the data and change EOL characters.
+ */
+
+ buffer = rawText = ckalloc(length + 1);
+ if (targetPtr != NULL) {
+ for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
+ cbPtr = cbPtr->nextPtr) {
+ for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
+ p < endPtr; p++) {
+ if (*p == '\n') {
+ *buffer++ = '\r';
+ }
+ *buffer++ = *p;
+ }
+ }
+ }
+ *buffer = '\0';
+
+ /*
+ * Depending on the platform, turn the data into Unicode or the
+ * system encoding before placing it on the clipboard.
+ */
+
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ Tcl_DStringInit(&ds);
+ Tcl_UtfToUniCharDString(rawText, -1, &ds);
+ ckfree(rawText);
+ handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE,
+ Tcl_DStringLength(&ds)+2);
+ if (!handle) {
+ Tcl_DStringFree(&ds);
+ return;
+ }
+ buffer = GlobalLock(handle);
+ memcpy(buffer, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds) + 2);
+ GlobalUnlock(handle);
+ Tcl_DStringFree(&ds);
+ SetClipboardData(CF_UNICODETEXT, handle);
+ } else {
+ Tcl_UtfToExternalDString(NULL, rawText, -1, &ds);
+ ckfree(rawText);
+ handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE,
+ Tcl_DStringLength(&ds)+1);
+ if (!handle) {
+ Tcl_DStringFree(&ds);
+ return;
+ }
+ buffer = GlobalLock(handle);
+ memcpy(buffer, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds) + 1);
+ GlobalUnlock(handle);
+ Tcl_DStringFree(&ds);
+ SetClipboardData(CF_TEXT, handle);
+ }
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ UpdateClipboard(hwnd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateClipboard --
+ *
+ * Take ownership of the clipboard, clear it, and indicate to the
+ * system the supported formats.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateClipboard(hwnd)
+ HWND hwnd;
+{
+ TkWinUpdatingClipboard(TRUE);
+ OpenClipboard(hwnd);
+ EmptyClipboard();
+
+ /*
+ * CF_UNICODETEXT is only supported on NT, but it it is prefered
+ * when possible.
+ */
+
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ SetClipboardData(CF_UNICODETEXT, NULL);
+ } else {
+ SetClipboardData(CF_TEXT, NULL);
+ }
+ CloseClipboard();
+ TkWinUpdatingClipboard(FALSE);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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/tcl/win/tkWinColor.c b/tcl/win/tkWinColor.c
new file mode 100644
index 00000000000..0381b1b54bb
--- /dev/null
+++ b/tcl/win/tkWinColor.c
@@ -0,0 +1,616 @@
+/*
+ * 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 "tkWinInt.h"
+#include "tkColor.h"
+
+/*
+ * The following structure is used to keep track of each color that is
+ * allocated by this module.
+ */
+
+typedef struct WinColor {
+ TkColor info; /* Generic color information. */
+ int index; /* Index for GetSysColor(), -1 if color
+ * is not a "live" system color. */
+} WinColor;
+
+/*
+ * The sysColors array contains the names and index values for the
+ * Windows indirect system color names. In use, all of the names
+ * will have the string "System" prepended, but we omit it in the table
+ * to save space.
+ */
+
+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
+};
+
+typedef struct ThreadSpecificData {
+ int ncolors;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for functions defined later in this file.
+ */
+
+static int FindSystemColor _ANSI_ARGS_((const char *name,
+ XColor *colorPtr, int *indexPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Count the number of elements in the color array if we haven't
+ * done so yet.
+ */
+
+ if (tsdPtr->ncolors == 0) {
+ SystemColorEntry *ePtr;
+ int version;
+
+ version = LOBYTE(LOWORD(GetVersion()));
+ for (ePtr = sysColors; ePtr->name != NULL; ePtr++) {
+ if (version < 4) {
+ if (ePtr->index == COLOR_3DDKSHADOW) {
+ ePtr->index = COLOR_BTNSHADOW;
+ } else if (ePtr->index == COLOR_3DLIGHT) {
+ ePtr->index = COLOR_BTNHIGHLIGHT;
+ }
+ }
+ tsdPtr->ncolors++;
+ }
+ }
+
+ /*
+ * Perform a binary search on the sorted array of colors.
+ */
+
+ l = 0;
+ u = tsdPtr->ncolors - 1;
+ while (l <= u) {
+ i = (l + u) / 2;
+ r = strcasecmp(name, sysColors[i].name);
+ if (r == 0) {
+ break;
+ } else if (r < 0) {
+ u = i-1;
+ } else {
+ l = i+1;
+ }
+ }
+ if (l > u) {
+ return 0;
+ }
+
+ *indexPtr = sysColors[i].index;
+ colorPtr->pixel = GetSysColor(sysColors[i].index);
+ /*
+ * x257 is (value<<8 + value) to get the properly bit shifted
+ * and padded value. [Bug: 4919]
+ */
+ colorPtr->red = GetRValue(colorPtr->pixel) * 257;
+ colorPtr->green = GetGValue(colorPtr->pixel) * 257;
+ colorPtr->blue = GetBValue(colorPtr->pixel) * 257;
+ 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 * 257;
+ color->green = closeEntry.peGreen * 257;
+ color->blue = closeEntry.peBlue * 257;
+ 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) * 257;
+ color->green = GetGValue(color->pixel) * 257;
+ color->blue = GetBValue(color->pixel) * 257;
+ }
+
+ 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;
+}
diff --git a/tcl/win/tkWinConfig.c b/tcl/win/tkWinConfig.c
new file mode 100644
index 00000000000..e9d6943225e
--- /dev/null
+++ b/tcl/win/tkWinConfig.c
@@ -0,0 +1,60 @@
+/*
+ * tkWinConfig.c --
+ *
+ * This module implements the Windows system defaults for
+ * the configuration package.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "tkInt.h"
+#include "tkWinInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetSystemDefault --
+ *
+ * Given a dbName and className for a configuration option,
+ * return a string representation of the option.
+ *
+ * Results:
+ * Returns a Tk_Uid that is the string identifier that identifies
+ * this option. Returns NULL if there are no system defaults
+ * that match this pair.
+ *
+ * Side effects:
+ * None, once the package is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkpGetSystemDefault(
+ Tk_Window tkwin, /* A window to use. */
+ CONST char *dbName, /* The option database name. */
+ CONST char *className) /* The name of the option class. */
+{
+ Tcl_Obj *valueObjPtr;
+ Tk_Uid classUid;
+
+ if (tkwin == NULL) {
+ return NULL;
+ }
+
+ valueObjPtr = NULL;
+ classUid = Tk_Class(tkwin);
+
+ if (strcmp(classUid, "Menu") == 0) {
+ valueObjPtr = TkWinGetMenuSystemDefault(tkwin, dbName, className);
+ }
+
+ return valueObjPtr;
+}
diff --git a/tcl/win/tkWinCursor.c b/tcl/win/tkWinCursor.c
new file mode 100644
index 00000000000..5c5ad1b8c98
--- /dev/null
+++ b/tcl/win/tkWinCursor.c
@@ -0,0 +1,251 @@
+/*
+ * 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;
+ int argc;
+ CONST char **argv = NULL;
+
+ /*
+ * All cursor names are valid lists of one element (for
+ * Unix-compatability), even unadorned system cursor names.
+ */
+
+ if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
+ return NULL;
+ }
+ if (argc != 1) {
+ goto badCursorSpec;
+ }
+
+ cursorPtr = (TkWinCursor *) ckalloc(sizeof(TkWinCursor));
+ cursorPtr->info.cursor = (Tk_Cursor) cursorPtr;
+ cursorPtr->winCursor = NULL;
+ cursorPtr->system = 0;
+
+ if (argv[0][0] == '@') {
+ /*
+ * Check for system cursor of type @<filename>, where only
+ * the name is allowed. This accepts any of:
+ * -cursor @/winnt/cursors/globe.ani
+ * -cursor @C:/Winnt/cursors/E_arrow.cur
+ * -cursor {@C:/Program\ Files/Cursors/bart.ani}
+ * -cursor {{@C:/Program Files/Cursors/bart.ani}}
+ * -cursor [list @[file join "C:/Program Files" Cursors bart.ani]]
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get cursor from a file in",
+ " a safe interpreter", (char *) NULL);
+ ckfree((char *) argv);
+ ckfree((char *) cursorPtr);
+ return NULL;
+ }
+ cursorPtr->winCursor = LoadCursorFromFile(&(argv[0][1]));
+ } else {
+ /*
+ * Check for the cursor in the system cursor set.
+ */
+ for (namePtr = cursorNames; namePtr->name != NULL; namePtr++) {
+ if (strcmp(namePtr->name, argv[0]) == 0) {
+ cursorPtr->winCursor = LoadCursor(NULL, namePtr->id);
+ break;
+ }
+ }
+
+ if (cursorPtr->winCursor == NULL) {
+ /*
+ * Hmm, it is not in the system cursor set. Check to see
+ * if it is one of our application resources.
+ */
+ cursorPtr->winCursor = LoadCursor(Tk_GetHINSTANCE(), argv[0]);
+ } else {
+ cursorPtr->system = 1;
+ }
+ }
+
+ if (cursorPtr->winCursor == NULL) {
+ ckfree((char *) cursorPtr);
+ badCursorSpec:
+ ckfree((char *) argv);
+ Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
+ (char *) NULL);
+ return NULL;
+ } else {
+ ckfree((char *) argv);
+ 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. */
+ CONST char *source; /* Bitmap data for cursor shape. */
+ CONST 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeCursor --
+ *
+ * This procedure is called to release a cursor allocated by
+ * TkGetCursorByName.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor data structure is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeCursor(cursorPtr)
+ TkCursor *cursorPtr;
+{
+ TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetCursor --
+ *
+ * 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/tcl/win/tkWinDefault.h b/tcl/win/tkWinDefault.h
new file mode 100644
index 00000000000..d1c5401ff3c
--- /dev/null
+++ b/tcl/win/tkWinDefault.h
@@ -0,0 +1,524 @@
+/*
+ * 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_COMPOUND "none"
+#define DEF_BUTTON_DEFAULT "disabled"
+#define DEF_BUTTON_DISABLED_FG_COLOR DISABLED
+#define DEF_BUTTON_DISABLED_FG_MONO ""
+#define DEF_BUTTON_FG NORMAL_FG
+#define DEF_CHKRAD_FG TEXT_FG
+#define DEF_BUTTON_FONT CTL_FONT
+#define DEF_BUTTON_HEIGHT "0"
+#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR
+#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO
+#define DEF_BUTTON_HIGHLIGHT HIGHLIGHT
+#define DEF_LABEL_HIGHLIGHT_WIDTH "0"
+#define DEF_BUTTON_HIGHLIGHT_WIDTH "1"
+#define DEF_BUTTON_IMAGE (char *) NULL
+#define DEF_BUTTON_INDICATOR "1"
+#define DEF_BUTTON_JUSTIFY "center"
+#define DEF_BUTTON_OFF_VALUE "0"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_OVER_RELIEF ""
+#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_REPEAT_DELAY "0"
+#define DEF_BUTTON_REPEAT_INTERVAL "0"
+#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_DISABLED_BG_COLOR "SystemButtonFace"
+#define DEF_ENTRY_DISABLED_BG_MONO WHITE
+#define DEF_ENTRY_DISABLED_FG DISABLED
+#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_READONLY_BG_COLOR "SystemButtonFace"
+#define DEF_ENTRY_READONLY_BG_MONO WHITE
+#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_PADX "0"
+#define DEF_FRAME_PADY "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for labelframes:
+ */
+
+#define DEF_LABELFRAME_BORDER_WIDTH "2"
+#define DEF_LABELFRAME_CLASS "Labelframe"
+#define DEF_LABELFRAME_RELIEF "groove"
+#define DEF_LABELFRAME_FG NORMAL_FG
+#define DEF_LABELFRAME_FONT CTL_FONT
+#define DEF_LABELFRAME_TEXT ""
+#define DEF_LABELFRAME_LABELANCHOR "nw"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_ACTIVE_STYLE "underline"
+#define DEF_LISTBOX_BG_COLOR "SystemWindow"
+#define DEF_LISTBOX_BG_MONO WHITE
+#define DEF_LISTBOX_BORDER_WIDTH "2"
+#define DEF_LISTBOX_CURSOR ""
+#define DEF_LISTBOX_DISABLED_FG DISABLED
+#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_LIST_VARIABLE ""
+#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_STATE "normal"
+#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_COMPOUND "none"
+#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_COLOR DEF_MENUBUTTON_BG_COLOR
+#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO
+#define DEF_MENUBUTTON_HIGHLIGHT HIGHLIGHT
+#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0"
+#define DEF_MENUBUTTON_IMAGE (char *) NULL
+#define DEF_MENUBUTTON_INDICATOR "0"
+#define DEF_MENUBUTTON_JUSTIFY "center"
+#define DEF_MENUBUTTON_MENU ""
+#define DEF_MENUBUTTON_PADX "4p"
+#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 panedwindows
+ */
+
+#define DEF_PANEDWINDOW_BG_COLOR NORMAL_BG
+#define DEF_PANEDWINDOW_BG_MONO WHITE
+#define DEF_PANEDWINDOW_BORDERWIDTH "2"
+#define DEF_PANEDWINDOW_CURSOR ""
+#define DEF_PANEDWINDOW_HANDLEPAD "8"
+#define DEF_PANEDWINDOW_HANDLESIZE "8"
+#define DEF_PANEDWINDOW_HEIGHT ""
+#define DEF_PANEDWINDOW_OPAQUERESIZE "0"
+#define DEF_PANEDWINDOW_ORIENT "horizontal"
+#define DEF_PANEDWINDOW_RELIEF "flat"
+#define DEF_PANEDWINDOW_SASHCURSOR ""
+#define DEF_PANEDWINDOW_SASHPAD "2"
+#define DEF_PANEDWINDOW_SASHRELIEF "raised"
+#define DEF_PANEDWINDOW_SASHWIDTH "2"
+#define DEF_PANEDWINDOW_SHOWHANDLE "0"
+#define DEF_PANEDWINDOW_WIDTH ""
+
+/*
+ * Defaults for panedwindow panes
+ */
+
+#define DEF_PANEDWINDOW_PANE_AFTER ""
+#define DEF_PANEDWINDOW_PANE_BEFORE ""
+#define DEF_PANEDWINDOW_PANE_HEIGHT ""
+#define DEF_PANEDWINDOW_PANE_MINSIZE "0"
+#define DEF_PANEDWINDOW_PANE_PADX "0"
+#define DEF_PANEDWINDOW_PANE_PADY "0"
+#define DEF_PANEDWINDOW_PANE_STICKY "nsew"
+#define DEF_PANEDWINDOW_PANE_WIDTH ""
+
+/*
+ * 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_COLOR DEF_SCALE_BG_COLOR
+#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO
+#define DEF_SCALE_HIGHLIGHT HIGHLIGHT
+#define DEF_SCALE_HIGHLIGHT_WIDTH "2"
+#define DEF_SCALE_LABEL ""
+#define DEF_SCALE_LENGTH "100"
+#define DEF_SCALE_ORIENT "vertical"
+#define DEF_SCALE_RELIEF "flat"
+#define DEF_SCALE_REPEAT_DELAY "300"
+#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_AUTO_SEPARATORS "1"
+#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_MAX_UNDO "0"
+#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_UNDO "0"
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+
+/*
+ * 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 ""
+#define DEF_TOPLEVEL_USE ""
+
+#endif /* _TKWINDEFAULT */
diff --git a/tcl/win/tkWinDialog.c b/tcl/win/tkWinDialog.c
new file mode 100644
index 00000000000..38b7370f56d
--- /dev/null
+++ b/tcl/win/tkWinDialog.c
@@ -0,0 +1,2596 @@
+/*
+ * 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 */
+
+/*
+ * This controls the use of the new style tk_chooseDirectory dialog.
+ */
+#define USE_NEW_CHOOSEDIR 1
+#ifdef USE_NEW_CHOOSEDIR
+#include <shlobj.h> /* includes SHBrowseForFolder */
+
+/* These needed for compilation with VC++ 5.2 */
+#ifndef BIF_EDITBOX
+#define BIF_EDITBOX 0x10
+#endif
+#ifndef BIF_VALIDATE
+#define BIF_VALIDATE 0x0020
+#endif
+#ifndef BFFM_VALIDATEFAILED
+#ifdef UNICODE
+#define BFFM_VALIDATEFAILED 4
+#else
+#define BFFM_VALIDATEFAILED 3
+#endif
+#endif
+
+/*
+ * The following structure is used by the new Tk_ChooseDirectoryObjCmd
+ * to pass data between it and its callback. Unqiue to Winodws platform.
+ */
+typedef struct ChooseDirData {
+ TCHAR utfInitDir[MAX_PATH]; /* Initial folder to use */
+ TCHAR utfRetDir[MAX_PATH]; /* Returned folder to use */
+ Tcl_Interp *interp;
+ int mustExist; /* true if file must exist to return from
+ * callback */
+} CHOOSEDIRDATA;
+#endif
+
+typedef struct ThreadSpecificData {
+ int debugFlag; /* Flags whether we should output debugging
+ * information while displaying a builtin
+ * dialog. */
+ Tcl_Interp *debugInterp; /* Interpreter to used for debugging. */
+ UINT WM_LBSELCHANGED; /* Holds a registered windows event used for
+ * communicating between the Directory
+ * Chooser dialog and its hook proc. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following structures are used by Tk_MessageBoxCmd() to parse
+ * arguments and return results.
+ */
+
+static const TkStateMap iconMap[] = {
+ {MB_ICONERROR, "error"},
+ {MB_ICONINFORMATION, "info"},
+ {MB_ICONQUESTION, "question"},
+ {MB_ICONWARNING, "warning"},
+ {-1, NULL}
+};
+
+static const TkStateMap typeMap[] = {
+ {MB_ABORTRETRYIGNORE, "abortretryignore"},
+ {MB_OK, "ok"},
+ {MB_OKCANCEL, "okcancel"},
+ {MB_RETRYCANCEL, "retrycancel"},
+ {MB_YESNO, "yesno"},
+ {MB_YESNOCANCEL, "yesnocancel"},
+ {-1, NULL}
+};
+
+static const TkStateMap buttonMap[] = {
+ {IDABORT, "abort"},
+ {IDRETRY, "retry"},
+ {IDIGNORE, "ignore"},
+ {IDOK, "ok"},
+ {IDCANCEL, "cancel"},
+ {IDNO, "no"},
+ {IDYES, "yes"},
+ {-1, NULL}
+};
+
+static const int buttonFlagMap[] = {
+ MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4
+};
+
+static const struct {int type; int btnIds[3];} allowedTypes[] = {
+ {MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}},
+ {MB_OK, {IDOK, -1, -1 }},
+ {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }},
+ {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }},
+ {MB_YESNO, {IDYES, IDNO, -1 }},
+ {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}}
+};
+
+#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))
+
+/*
+ * The value of TK_MULTI_MAX_PATH dictactes how many files can
+ * be retrieved with tk_get*File -multiple 1. It must be allocated
+ * on the stack, so make it large enough but not too large. -- hobbs
+ * The data is stored as <dir>\0<file1>\0<file2>\0...<fileN>\0\0.
+ * MAX_PATH == 260 on Win2K/NT.
+ */
+
+#define TK_MULTI_MAX_PATH (MAX_PATH*20)
+
+/*
+ * The following structure is used to pass information between the directory
+ * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
+ */
+
+typedef struct ChooseDir {
+ Tcl_Interp *interp; /* Interp, used only if debug is turned on,
+ * for setting the "tk_dialog" variable. */
+ int lastCtrl; /* Used by hook proc to keep track of last
+ * control that had input focus, so when OK
+ * is pressed we know whether to browse a
+ * new directory or return. */
+ int lastIdx; /* Last item that was selected in directory
+ * browser listbox. */
+ TCHAR path[MAX_PATH]; /* On return from choose directory dialog,
+ * holds the selected path. Cannot return
+ * selected path in ofnPtr->lpstrFile because
+ * the default dialog proc stores a '\0' in
+ * it, since, of course, no _file_ was
+ * selected. */
+ OPENFILENAME *ofnPtr; /* pointer to the OFN structure */
+} ChooseDir;
+
+/*
+ * Definitions of procedures used only in this file.
+ */
+
+#ifdef USE_NEW_CHOOSEDIR
+static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,
+ LPARAM wParam, LPARAM lParam);
+#else
+static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg,
+ WPARAM wParam, LPARAM lParam);
+#endif
+static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
+ LPARAM lParam);
+static int GetFileNameA(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], int isOpen);
+static int GetFileNameW(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], int isOpen);
+static int MakeFilter(Tcl_Interp *interp, char *string,
+ Tcl_DString *dsPtr);
+static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
+ LPARAM lParam);
+static UINT APIENTRY OFNHookProcW(HWND hdlg, UINT uMsg, WPARAM wParam,
+ LPARAM lParam);
+static void SetTkDialog(ClientData clientData);
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkWinDialogDebug --
+ *
+ * Function to turn on/off debugging support for common dialogs under
+ * windows. The variable "tk_debug" is set to the identifier of the
+ * dialog window when the modal dialog window pops up and it is safe to
+ * send messages to the dialog.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This variable only makes sense if just one dialog is up at a time.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkWinDialogDebug(
+ int debug)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->debugFlag = debug;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tk_ChooseColorObjCmd --
+ *
+ * This procedure implements the color dialog box for the Windows
+ * platform. See the user documentation for details on what it
+ * does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A dialog window is created the first time this procedure is called.
+ * This window is not destroyed and will be reused the next time the
+ * application invokes the "tk_chooseColor" command.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin, parent;
+ HWND hWnd;
+ int i, oldMode, winCode, result;
+ CHOOSECOLOR chooseColor;
+ static int inited = 0;
+ static COLORREF dwCustColors[16];
+ static long oldColor; /* the color selected last time */
+ static CONST char *optionStrings[] = {
+ "-initialcolor", "-parent", "-title", NULL
+ };
+ enum options {
+ COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
+ };
+
+ result = TCL_OK;
+ if (inited == 0) {
+ /*
+ * dwCustColors stores the custom color which the user can
+ * modify. We store these colors in a static array so that the next
+ * time the color dialog pops up, the same set of custom colors
+ * remain in the dialog.
+ */
+ for (i = 0; i < 16; i++) {
+ dwCustColors[i] = RGB(255-i * 10, i, i * 10);
+ }
+ oldColor = RGB(0xa0, 0xa0, 0xa0);
+ inited = 1;
+ }
+
+ tkwin = (Tk_Window) clientData;
+
+ parent = tkwin;
+ chooseColor.lStructSize = sizeof(CHOOSECOLOR);
+ chooseColor.hwndOwner = NULL;
+ chooseColor.hInstance = NULL;
+ chooseColor.rgbResult = oldColor;
+ chooseColor.lpCustColors = dwCustColors;
+ chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
+ chooseColor.lCustData = (LPARAM) NULL;
+ chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc;
+ chooseColor.lpTemplateName = (LPTSTR) interp;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case COLOR_INITIAL: {
+ XColor *colorPtr;
+
+ colorPtr = Tk_GetColor(interp, tkwin, string);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ chooseColor.rgbResult = RGB(colorPtr->red / 0x100,
+ colorPtr->green / 0x100, colorPtr->blue / 0x100);
+ break;
+ }
+ case COLOR_PARENT: {
+ parent = Tk_NameToWindow(interp, string, tkwin);
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case COLOR_TITLE: {
+ chooseColor.lCustData = (LPARAM) string;
+ break;
+ }
+ }
+ }
+
+ Tk_MakeWindowExist(parent);
+ chooseColor.hwndOwner = NULL;
+ hWnd = Tk_GetHWND(Tk_WindowId(parent));
+ chooseColor.hwndOwner = hWnd;
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ winCode = ChooseColor(&chooseColor);
+ (void) Tcl_SetServiceMode(oldMode);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we
+ * have updated the wrapper of the parent, which causes us to
+ * leave this child disabled (Windows loses sync).
+ */
+ EnableWindow(hWnd, 1);
+
+ /*
+ * 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 color[100];
+
+ sprintf(color, "#%02x%02x%02x",
+ GetRValue(chooseColor.rgbResult),
+ GetGValue(chooseColor.rgbResult),
+ GetBValue(chooseColor.rgbResult));
+ Tcl_AppendResult(interp, color, NULL);
+ oldColor = chooseColor.rgbResult;
+ result = TCL_OK;
+ }
+
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ColorDlgHookProc --
+ *
+ * Provides special handling of messages for the Color common dialog
+ * box. Used to set the title when the dialog first appears.
+ *
+ * Results:
+ * The return value is 0 if the default dialog box procedure should
+ * handle the message, non-zero otherwise.
+ *
+ * Side effects:
+ * Changes the title of the dialog window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static UINT CALLBACK
+ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
+ HWND hDlg; /* Handle to the color dialog. */
+ UINT uMsg; /* Type of message. */
+ WPARAM wParam; /* First message parameter. */
+ LPARAM lParam; /* Second message parameter. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ switch (uMsg) {
+ case WM_INITDIALOG: {
+ const char *title;
+ CHOOSECOLOR *ccPtr;
+ Tcl_DString ds;
+
+ /*
+ * Set the title string of the dialog.
+ */
+
+ ccPtr = (CHOOSECOLOR *) lParam;
+ title = (const char *) ccPtr->lCustData;
+ if ((title != NULL) && (title[0] != '\0')) {
+ (*tkWinProcs->setWindowText)(hDlg,
+ Tcl_WinUtfToTChar(title, -1, &ds));
+ Tcl_DStringFree(&ds);
+ }
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
+ }
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOpenFileCmd --
+ *
+ * This procedure implements the "open file" dialog box for the
+ * Windows platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A dialog window is created the first this procedure is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ return GetFileNameW(clientData, interp, objc, objv, 1);
+ } else {
+ return GetFileNameA(clientData, interp, objc, objv, 1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetSaveFileCmd --
+ *
+ * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
+ * instead
+ *
+ * Results:
+ * Same as Tk_GetOpenFileCmd.
+ *
+ * Side effects:
+ * Same as Tk_GetOpenFileCmd.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ return GetFileNameW(clientData, interp, objc, objv, 0);
+ } else {
+ return GetFileNameA(clientData, interp, objc, objv, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileNameW --
+ *
+ * Calls GetOpenFileName() or GetSaveFileName().
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * See user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFileNameW(clientData, interp, objc, objv, open)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int open; /* 1 to call GetOpenFileName(), 0 to
+ * call GetSaveFileName(). */
+{
+ OPENFILENAMEW ofn;
+ WCHAR file[TK_MULTI_MAX_PATH];
+ int result, winCode, oldMode, i, multi = 0;
+ char *extension, *filter, *title;
+ Tk_Window tkwin;
+ HWND hWnd;
+ Tcl_DString utfFilterString, utfDirString;
+ Tcl_DString extString, filterString, dirString, titleString;
+ Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ static CONST char *saveOptionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-parent", "-title", NULL
+ };
+ static CONST char *openOptionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-multiple", "-parent", "-title", NULL
+ };
+ CONST char **optionStrings;
+
+ enum options {
+ FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
+ FILE_MULTIPLE, FILE_PARENT, FILE_TITLE
+ };
+
+ result = TCL_ERROR;
+ file[0] = '\0';
+
+ /*
+ * Parse the arguments.
+ */
+
+ extension = NULL;
+ filter = NULL;
+ Tcl_DStringInit(&utfFilterString);
+ Tcl_DStringInit(&utfDirString);
+ tkwin = (Tk_Window) clientData;
+ title = NULL;
+
+ if (open) {
+ optionStrings = openOptionStrings;
+ } else {
+ optionStrings = saveOptionStrings;
+ }
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings,
+ "option", 0, &index) != TCL_OK) {
+ goto end;
+ }
+ /*
+ * We want to maximize code sharing between the open and save file
+ * dialog implementations; in particular, the switch statement below.
+ * We use different sets of option strings from the GetIndexFromObj
+ * call above, but a single enumeration for both. The save file
+ * dialog doesn't support -multiple, but it falls in the middle of
+ * the enumeration. Ultimately, this means that when the index found
+ * by GetIndexFromObj is >= FILE_MULTIPLE, when doing a save file
+ * dialog, we have to increment the index, so that it matches the
+ * open file dialog enumeration.
+ */
+ if (!open && index >= FILE_MULTIPLE) {
+ index++;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto end;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case FILE_DEFAULT: {
+ if (string[0] == '.') {
+ string++;
+ }
+ extension = string;
+ break;
+ }
+ case FILE_TYPES: {
+ Tcl_DStringFree(&utfFilterString);
+ if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ filter = Tcl_DStringValue(&utfFilterString);
+ break;
+ }
+ case FILE_INITDIR: {
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_INITFILE: {
+ Tcl_DString ds;
+
+ if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
+ goto end;
+ }
+ Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL, (char *) file,
+ sizeof(file), NULL, NULL, NULL);
+ break;
+ }
+ case FILE_MULTIPLE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr,
+ &multi) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case FILE_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_TITLE: {
+ title = string;
+ break;
+ }
+ }
+ }
+
+ if (filter == NULL) {
+ if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
+ ofn.lStructSize = sizeof(OPENFILENAMEW);
+ ofn.hwndOwner = hWnd;
+#ifdef _WIN64
+ ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner,
+ GWLP_HINSTANCE);
+#else
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+#endif
+ ofn.lpstrFile = (WCHAR *) file;
+ ofn.nMaxFile = TK_MULTI_MAX_PATH;
+ ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
+ | OFN_NOCHANGEDIR | OFN_EXPLORER;
+ ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProcW;
+ ofn.lCustData = (LPARAM) interp;
+
+ if (open != 0) {
+ ofn.Flags |= OFN_FILEMUSTEXIST;
+ } else {
+ ofn.Flags |= OFN_OVERWRITEPROMPT;
+ }
+
+ if (tsdPtr->debugFlag != 0) {
+ ofn.Flags |= OFN_ENABLEHOOK;
+ }
+
+ if (multi != 0) {
+ ofn.Flags |= OFN_ALLOWMULTISELECT;
+ }
+
+ if (extension != NULL) {
+ Tcl_UtfToExternalDString(unicodeEncoding, extension, -1, &extString);
+ ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);
+ }
+
+ Tcl_UtfToExternalDString(unicodeEncoding,
+ Tcl_DStringValue(&utfFilterString),
+ Tcl_DStringLength(&utfFilterString), &filterString);
+ ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
+
+ if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
+ Tcl_UtfToExternalDString(unicodeEncoding,
+ Tcl_DStringValue(&utfDirString),
+ Tcl_DStringLength(&utfDirString), &dirString);
+ } else {
+ /*
+ * NT 5.0 changed the meaning of lpstrInitialDir, so we have
+ * to ensure that we set the [pwd] if the user didn't specify
+ * anything else.
+ */
+ Tcl_DString cwd;
+
+ Tcl_DStringFree(&utfDirString);
+ if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) ||
+ (Tcl_TranslateFileName(interp,
+ Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&cwd),
+ Tcl_DStringLength(&cwd), &dirString);
+ }
+ Tcl_DStringFree(&cwd);
+ }
+ ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
+
+ if (title != NULL) {
+ Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
+ ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
+ }
+
+ /*
+ * Popup the dialog.
+ */
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ if (open != 0) {
+ winCode = GetOpenFileNameW(&ofn);
+ } else {
+ winCode = GetSaveFileNameW(&ofn);
+ }
+ Tcl_SetServiceMode(oldMode);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we
+ * have updated the wrapper of the parent, which causes us to
+ * leave this child disabled (Windows loses sync).
+ */
+ EnableWindow(hWnd, 1);
+
+ /*
+ * Clear the interp result since anything may have happened during the
+ * modal loop.
+ */
+
+ Tcl_ResetResult(interp);
+
+ /*
+ * Process the results.
+ */
+
+ if (winCode != 0) {
+ if (ofn.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;
+ char *p;
+ char *file;
+ WCHAR *files;
+ Tcl_DString ds;
+ Tcl_DString fullname, filename;
+ Tcl_Obj *returnList;
+ int count = 0;
+
+ returnList = Tcl_NewObj();
+ Tcl_IncrRefCount(returnList);
+
+ files = ofn.lpstrFile;
+ Tcl_ExternalToUtfDString(unicodeEncoding, (char *) files, -1, &ds);
+
+ /* Get directory */
+ dir = Tcl_DStringValue(&ds);
+ for (p = dir; p && *p; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+
+ while (*files != '\0') {
+ while (*files != '\0') {
+ files++;
+ }
+ files++;
+ if (*files != '\0') {
+ count++;
+ Tcl_ExternalToUtfDString(unicodeEncoding,
+ (char *)files, -1, &filename);
+ file = Tcl_DStringValue(&filename);
+ for (p = file; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_DStringInit(&fullname);
+ Tcl_DStringAppend(&fullname, dir, -1);
+ Tcl_DStringAppend(&fullname, "/", -1);
+ Tcl_DStringAppend(&fullname, file, -1);
+ Tcl_ListObjAppendElement(interp, returnList,
+ Tcl_NewStringObj(Tcl_DStringValue(&fullname), -1));
+ Tcl_DStringFree(&fullname);
+ Tcl_DStringFree(&filename);
+ }
+ }
+ if (count == 0) {
+ /*
+ * Only one file was returned.
+ */
+ Tcl_ListObjAppendElement(interp, returnList,
+ Tcl_NewStringObj(dir, -1));
+ }
+ Tcl_SetObjResult(interp, returnList);
+ Tcl_DecrRefCount(returnList);
+ Tcl_DStringFree(&ds);
+ } else {
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(unicodeEncoding,
+ (char *) ofn.lpstrFile, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ }
+ result = TCL_OK;
+ } else {
+ /*
+ * Use the CommDlgExtendedError() function to retrieve the error code.
+ * This function can return one of about two dozen codes; most of
+ * these indicate some sort of gross system failure (insufficient
+ * memory, bad window handles, etc.). Most of the error codes will be
+ * ignored; as we find we want more specific error messages for
+ * particular errors, we can extend the code as needed.
+ *
+ * We could also check for FNERR_BUFFERTOOSMALL, but we can't
+ * really do anything about it when it happens.
+ */
+
+ if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) {
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(unicodeEncoding,
+ (char *) ofn.lpstrFile, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname,
+ * where back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), "\"", NULL);
+ Tcl_DStringFree(&ds);
+ } else {
+ result = TCL_OK;
+ }
+ }
+
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
+ }
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
+ }
+ Tcl_DStringFree(&filterString);
+ if (ofn.lpstrDefExt != NULL) {
+ Tcl_DStringFree(&extString);
+ }
+
+ end:
+ Tcl_DStringFree(&utfDirString);
+ Tcl_DStringFree(&utfFilterString);
+
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * OFNHookProcW --
+ *
+ * Hook procedure called only if debugging is turned on. Sets
+ * the "tk_dialog" variable when the dialog is ready to receive
+ * messages.
+ *
+ * Results:
+ * Returns 0 to allow default processing of messages to occur.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static UINT APIENTRY
+OFNHookProcW(
+ HWND hdlg, // handle to child dialog window
+ UINT uMsg, // message identifier
+ WPARAM wParam, // message parameter
+ LPARAM lParam) // message parameter
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ OPENFILENAMEW *ofnPtr;
+
+ if (uMsg == WM_INITDIALOG) {
+#ifdef _WIN64
+ SetWindowLongPtr(hdlg, GWLP_USERDATA, lParam);
+#else
+ SetWindowLong(hdlg, GWL_USERDATA, lParam);
+#endif
+ } else if (uMsg == WM_WINDOWPOSCHANGED) {
+ /*
+ * This message is delivered at the right time to enable Tk
+ * to set the debug information. Unhooks itself so it
+ * won't set the debug information every time it gets a
+ * WM_WINDOWPOSCHANGED message.
+ */
+
+#ifdef _WIN64
+ ofnPtr = (OPENFILENAMEW *) GetWindowLongPtr(hdlg, GWLP_USERDATA);
+#else
+ ofnPtr = (OPENFILENAMEW *) GetWindowLong(hdlg, GWL_USERDATA);
+#endif
+ if (ofnPtr != NULL) {
+ hdlg = GetParent(hdlg);
+ tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
+#ifdef _WIN64
+ SetWindowLongPtr(hdlg, GWLP_USERDATA, (LPARAM) NULL);
+#else
+ SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
+#endif
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileNameA --
+ *
+ * Calls GetOpenFileName() or GetSaveFileName().
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * See user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFileNameA(clientData, interp, objc, objv, open)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int open; /* 1 to call GetOpenFileName(), 0 to
+ * call GetSaveFileName(). */
+{
+ OPENFILENAME ofn;
+ TCHAR file[TK_MULTI_MAX_PATH], savePath[MAX_PATH];
+ int result, winCode, oldMode, i, multi = 0;
+ char *extension, *filter, *title;
+ Tk_Window tkwin;
+ HWND hWnd;
+ Tcl_DString utfFilterString, utfDirString;
+ Tcl_DString extString, filterString, dirString, titleString;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ static CONST char *saveOptionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-parent", "-title", NULL
+ };
+ static CONST char *openOptionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-multiple", "-parent", "-title", NULL
+ };
+ CONST char **optionStrings;
+
+ enum options {
+ FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
+ FILE_MULTIPLE, FILE_PARENT, FILE_TITLE
+ };
+
+ result = TCL_ERROR;
+ file[0] = '\0';
+
+ /*
+ * Parse the arguments.
+ */
+
+ extension = NULL;
+ filter = NULL;
+ Tcl_DStringInit(&utfFilterString);
+ Tcl_DStringInit(&utfDirString);
+ tkwin = (Tk_Window) clientData;
+ title = NULL;
+
+ if (open) {
+ optionStrings = openOptionStrings;
+ } else {
+ optionStrings = saveOptionStrings;
+ }
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings,
+ "option", 0, &index) != TCL_OK) {
+ goto end;
+ }
+ /*
+ * We want to maximize code sharing between the open and save file
+ * dialog implementations; in particular, the switch statement below.
+ * We use different sets of option strings from the GetIndexFromObj
+ * call above, but a single enumeration for both. The save file
+ * dialog doesn't support -multiple, but it falls in the middle of
+ * the enumeration. Ultimately, this means that when the index found
+ * by GetIndexFromObj is >= FILE_MULTIPLE, when doing a save file
+ * dialog, we have to increment the index, so that it matches the
+ * open file dialog enumeration.
+ */
+ if (!open && index >= FILE_MULTIPLE) {
+ index++;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto end;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case FILE_DEFAULT: {
+ if (string[0] == '.') {
+ string++;
+ }
+ extension = string;
+ break;
+ }
+ case FILE_TYPES: {
+ Tcl_DStringFree(&utfFilterString);
+ if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ filter = Tcl_DStringValue(&utfFilterString);
+ break;
+ }
+ case FILE_INITDIR: {
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_INITFILE: {
+ Tcl_DString ds;
+
+ if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
+ goto end;
+ }
+ Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL, (char *) file,
+ sizeof(file), NULL, NULL, NULL);
+ break;
+ }
+ case FILE_MULTIPLE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr,
+ &multi) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case FILE_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_TITLE: {
+ title = string;
+ break;
+ }
+ }
+ }
+
+ if (filter == NULL) {
+ if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ ofn.lStructSize = sizeof(ofn);
+ ofn.hwndOwner = hWnd;
+#ifdef _WIN64
+ ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner,
+ GWLP_HINSTANCE);
+#else
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+#endif
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.nFilterIndex = 0;
+ ofn.lpstrFile = (LPTSTR) file;
+ ofn.nMaxFile = TK_MULTI_MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
+ | OFN_NOCHANGEDIR | OFN_EXPLORER;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc;
+ ofn.lCustData = (LPARAM) interp;
+ ofn.lpTemplateName = NULL;
+
+ if (open != 0) {
+ ofn.Flags |= OFN_FILEMUSTEXIST;
+ } else {
+ ofn.Flags |= OFN_OVERWRITEPROMPT;
+ }
+
+ if (tsdPtr->debugFlag != 0) {
+ ofn.Flags |= OFN_ENABLEHOOK;
+ }
+
+ if (multi != 0) {
+ ofn.Flags |= OFN_ALLOWMULTISELECT;
+ }
+
+ if (extension != NULL) {
+ Tcl_UtfToExternalDString(NULL, extension, -1, &extString);
+ ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString);
+ }
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString),
+ Tcl_DStringLength(&utfFilterString), &filterString);
+ ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString);
+
+ if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
+ Tcl_DStringLength(&utfDirString), &dirString);
+ } else {
+ /*
+ * NT 5.0 changed the meaning of lpstrInitialDir, so we have
+ * to ensure that we set the [pwd] if the user didn't specify
+ * anything else.
+ */
+ Tcl_DString cwd;
+
+ Tcl_DStringFree(&utfDirString);
+ if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) ||
+ (Tcl_TranslateFileName(interp,
+ Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
+ Tcl_DStringLength(&cwd), &dirString);
+ }
+ Tcl_DStringFree(&cwd);
+ }
+ ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
+
+ if (title != NULL) {
+ Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
+ ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
+ }
+
+ /*
+ * Popup the dialog.
+ */
+
+ GetCurrentDirectory(MAX_PATH, savePath);
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ if (open != 0) {
+ winCode = GetOpenFileName(&ofn);
+ } else {
+ winCode = GetSaveFileName(&ofn);
+ }
+ Tcl_SetServiceMode(oldMode);
+ SetCurrentDirectory(savePath);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we
+ * have updated the wrapper of the parent, which causes us to
+ * leave this child disabled (Windows loses sync).
+ */
+ EnableWindow(hWnd, 1);
+
+ /*
+ * Clear the interp result since anything may have happened during the
+ * modal loop.
+ */
+
+ Tcl_ResetResult(interp);
+
+ /*
+ * Process the results.
+ */
+
+ if (winCode != 0) {
+ if (ofn.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;
+ char *p;
+ char *file;
+ char *files;
+ Tcl_DString ds;
+ Tcl_DString fullname, filename;
+ Tcl_Obj *returnList;
+ int count = 0;
+
+ returnList = Tcl_NewObj();
+ Tcl_IncrRefCount(returnList);
+
+ files = ofn.lpstrFile;
+ Tcl_ExternalToUtfDString(NULL, (char *) files, -1, &ds);
+
+ /* Get directory */
+ dir = Tcl_DStringValue(&ds);
+ for (p = dir; p && *p; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+
+ while (*files != '\0') {
+ while (*files != '\0') {
+ files++;
+ }
+ files++;
+ if (*files != '\0') {
+ count++;
+ Tcl_ExternalToUtfDString(NULL,
+ (char *)files, -1, &filename);
+ file = Tcl_DStringValue(&filename);
+ for (p = file; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_DStringInit(&fullname);
+ Tcl_DStringAppend(&fullname, dir, -1);
+ Tcl_DStringAppend(&fullname, "/", -1);
+ Tcl_DStringAppend(&fullname, file, -1);
+ Tcl_ListObjAppendElement(interp, returnList,
+ Tcl_NewStringObj(Tcl_DStringValue(&fullname), -1));
+ Tcl_DStringFree(&fullname);
+ Tcl_DStringFree(&filename);
+ }
+ }
+ if (count == 0) {
+ /*
+ * Only one file was returned.
+ */
+ Tcl_ListObjAppendElement(interp, returnList,
+ Tcl_NewStringObj(dir, -1));
+ }
+ Tcl_SetObjResult(interp, returnList);
+ Tcl_DecrRefCount(returnList);
+ Tcl_DStringFree(&ds);
+ } else {
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ }
+ result = TCL_OK;
+ } else {
+ /*
+ * Use the CommDlgExtendedError() function to retrieve the error code.
+ * This function can return one of about two dozen codes; most of
+ * these indicate some sort of gross system failure (insufficient
+ * memory, bad window handles, etc.). Most of the error codes will be
+ * ignored;; as we find we want specific error messages for particular
+ * errors, we can extend the code as needed.
+ *
+ * We could also check for FNERR_BUFFERTOOSMALL, but we can't
+ * really do anything about it when it happens.
+ */
+ if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) {
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname,
+ * where back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), "\"", NULL);
+ Tcl_DStringFree(&ds);
+ } else {
+ result = TCL_OK;
+ }
+ }
+
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
+ }
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
+ }
+ Tcl_DStringFree(&filterString);
+ if (ofn.lpstrDefExt != NULL) {
+ Tcl_DStringFree(&extString);
+ }
+
+ end:
+ Tcl_DStringFree(&utfDirString);
+ Tcl_DStringFree(&utfFilterString);
+
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * OFNHookProc --
+ *
+ * Hook procedure called only if debugging is turned on. Sets
+ * the "tk_dialog" variable when the dialog is ready to receive
+ * messages.
+ *
+ * Results:
+ * Returns 0 to allow default processing of messages to occur.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static UINT APIENTRY
+OFNHookProc(
+ HWND hdlg, // handle to child dialog window
+ UINT uMsg, // message identifier
+ WPARAM wParam, // message parameter
+ LPARAM lParam) // message parameter
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ OPENFILENAME *ofnPtr;
+
+ if (uMsg == WM_INITDIALOG) {
+#ifdef _WIN64
+ SetWindowLongPtr(hdlg, GWLP_USERDATA, lParam);
+#else
+ SetWindowLong(hdlg, GWL_USERDATA, lParam);
+#endif
+ } else if (uMsg == WM_WINDOWPOSCHANGED) {
+ /*
+ * This message is delivered at the right time to both
+ * old-style and explorer-style hook procs to enable Tk
+ * to set the debug information. Unhooks itself so it
+ * won't set the debug information every time it gets a
+ * WM_WINDOWPOSCHANGED message.
+ */
+
+#ifdef _WIN64
+ ofnPtr = (OPENFILENAME *) GetWindowLongPtr(hdlg, GWLP_USERDATA);
+#else
+ ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA);
+#endif
+ if (ofnPtr != NULL) {
+ if (ofnPtr->Flags & OFN_EXPLORER) {
+ hdlg = GetParent(hdlg);
+ }
+ tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
+#ifdef _WIN64
+ SetWindowLongPtr(hdlg, GWLP_USERDATA, (LPARAM) NULL);
+#else
+ SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
+#endif
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeFilter --
+ *
+ * Allocate a buffer to store the filters in a format understood by
+ * Windows
+ *
+ * Results:
+ * A standard TCL return value.
+ *
+ * Side effects:
+ * ofnPtr->lpstrFilter is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+MakeFilter(interp, string, dsPtr)
+ Tcl_Interp *interp; /* Current interpreter. */
+ char *string; /* String value of the -filetypes option */
+ Tcl_DString *dsPtr; /* Filled with windows filter string. */
+{
+ char *filterStr;
+ char *p;
+ int pass;
+ FileFilterList flist;
+ FileFilter *filterPtr;
+
+ TkInitFileFilters(&flist);
+ if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (flist.filters == NULL) {
+ /*
+ * Use "All Files (*.*) as the default filter if none is specified
+ */
+ char *defaultFilter = "All Files (*.*)";
+
+ p = filterStr = (char*)ckalloc(30 * sizeof(char));
+
+ strcpy(p, defaultFilter);
+ p+= strlen(defaultFilter);
+
+ *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((unsigned int) 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';
+ }
+
+ Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr));
+ ckfree((char *) filterStr);
+
+ TkFreeFileFilters(&flist);
+ return TCL_OK;
+}
+
+#ifdef USE_NEW_CHOOSEDIR
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseDirectoryObjCmd --
+ *
+ * This procedure implements the "tk_chooseDirectory" dialog box
+ * for the Windows platform. See the user documentation for details
+ * on what it does. Uses the newer SHBrowseForFolder explorer type
+ * interface.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A modal dialog window is created. Tcl_SetServiceMode() is
+ * called to allow background events to be processed
+ *
+ *----------------------------------------------------------------------
+
+The procedure tk_chooseDirectory pops up a dialog box for the user to
+select a directory. The following option-value pairs are possible as
+command line arguments:
+
+-initialdir dirname
+
+Specifies that the directories in directory should be displayed when the
+dialog pops up. If this parameter is not specified, then the directories
+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 General Controls control panel on the Mac allows
+the end user to override the application default directory.
+
+-parent window
+
+Makes window the logical parent of the dialog. The dialog is displayed on
+top of its parent window.
+
+-title titleString
+
+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.
+
+-mustexist boolean
+
+Specifies whether the user may specify non-existant directories. If this
+parameter is true, then the user may only select directories that already
+exist. The default value is false.
+
+New Behaviour:
+
+- If mustexist = 0 and a user entered folder does not exist, a prompt will
+ pop-up asking if the user wants another chance to change it. The old
+ dialog just returned the bogus entry. On mustexist = 1, the entries MUST
+ exist before exiting the box with OK.
+
+ Bugs:
+
+- If valid abs directory name is entered into the entry box and Enter
+ pressed, the box will close returning the name. This is inconsistent when
+ entering relative names or names with forward slashes, which are
+ invalidated then corrected in the callback. After correction, the box is
+ held open to allow further modification by the user.
+
+- Not sure how to implement localization of message prompts.
+
+- -title is really -message.
+ToDo:
+- Fix bugs.
+- test to see what platforms this really works on. May require v4.71
+ of shell32.dll everywhere (what is standard?).
+ *
+ */
+int
+Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ char path[MAX_PATH];
+ int oldMode, result, i;
+ LPCITEMIDLIST pidl; /* Returned by browser */
+ BROWSEINFO bInfo; /* Used by browser */
+ CHOOSEDIRDATA cdCBData; /* Structure to pass back and forth */
+ LPMALLOC pMalloc; /* Used by shell */
+
+ Tk_Window tkwin;
+ HWND hWnd;
+ char *utfTitle; /* Title for window */
+ TCHAR saveDir[MAX_PATH];
+ Tcl_DString titleString; /* UTF Title */
+ Tcl_DString initDirString; /* Initial directory */
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ static CONST char *optionStrings[] = {
+ "-initialdir", "-mustexist", "-parent", "-title", (char *) NULL
+ };
+ enum options {
+ DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
+ };
+
+ /*
+ * Initialize
+ */
+ result = TCL_ERROR;
+ path[0] = '\0';
+ utfTitle = NULL;
+
+ ZeroMemory(&cdCBData, sizeof(CHOOSEDIRDATA));
+ cdCBData.interp = interp;
+
+ tkwin = (Tk_Window) clientData;
+ /*
+ * Process the command line options
+ */
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ goto cleanup;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto cleanup;
+ }
+
+ string = Tcl_GetString(valuePtr);
+ switch ((enum options) index) {
+ case DIR_INITIAL: {
+ if (Tcl_TranslateFileName(interp, string,
+ &initDirString) == NULL) {
+ goto cleanup;
+ }
+ string = Tcl_DStringValue(&initDirString);
+ /*
+ * Convert possible relative path to full path to keep
+ * dialog happy
+ */
+ GetFullPathName(string, MAX_PATH, saveDir, NULL);
+ lstrcpyn(cdCBData.utfInitDir, saveDir, MAX_PATH);
+ Tcl_DStringFree(&initDirString);
+ break;
+ }
+ case DIR_EXIST: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr,
+ &cdCBData.mustExist) != TCL_OK) {
+ goto cleanup;
+ }
+ break;
+ }
+ case DIR_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto cleanup;
+ }
+ break;
+ }
+ case FILE_TITLE: {
+ utfTitle = string;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Get ready to call the browser
+ */
+
+ Tk_MakeWindowExist(tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ /*
+ * Setup the parameters used by SHBrowseForFolder
+ */
+
+ bInfo.hwndOwner = hWnd;
+ bInfo.pszDisplayName = path;
+ bInfo.pidlRoot = NULL;
+ if (lstrlen(cdCBData.utfInitDir) == 0) {
+ GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir);
+ }
+ bInfo.lParam = (LPARAM) &cdCBData;
+
+ if (utfTitle != NULL) {
+ Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
+ bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
+ } else {
+ bInfo.lpszTitle = "Please choose a directory, then select OK.";
+ }
+
+ /*
+ * Set flags to add edit box (needs 4.71 Shell DLLs), status text line,
+ * validate edit box and
+ */
+ bInfo.ulFlags = BIF_EDITBOX | BIF_STATUSTEXT | BIF_RETURNFSANCESTORS
+ | BIF_VALIDATE;
+
+ /*
+ * Callback to handle events
+ */
+ bInfo.lpfn = (BFFCALLBACK) ChooseDirectoryValidateProc;
+
+ /*
+ * Display dialog in background and process result.
+ * We look to give the user a chance to change their mind
+ * on an invalid folder if mustexist is 0;
+ */
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ GetCurrentDirectory(MAX_PATH, saveDir);
+ if (SHGetMalloc(&pMalloc) == NOERROR) {
+ pidl = SHBrowseForFolder(&bInfo);
+ /* Null for cancel button or invalid dir, otherwise valid*/
+ if (pidl != NULL) {
+ if (!SHGetPathFromIDList(pidl, path)) {
+ Tcl_SetResult(interp, "Error: Not a file system folder\n",
+ TCL_VOLATILE);
+ };
+ pMalloc->lpVtbl->Free(pMalloc, (void *) pidl);
+ } else if (lstrlen(cdCBData.utfRetDir) > 0) {
+ lstrcpy(path, cdCBData.utfRetDir);
+ }
+ pMalloc->lpVtbl->Release(pMalloc);
+ }
+ SetCurrentDirectory(saveDir);
+ Tcl_SetServiceMode(oldMode);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we
+ * have updated the wrapper of the parent, which causes us to
+ * leave this child disabled (Windows loses sync).
+ */
+ EnableWindow(hWnd, 1);
+
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+ Tcl_ResetResult(interp);
+ if (*path) {
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, (char *) path, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ }
+
+ result = TCL_OK;
+
+ if (utfTitle != NULL) {
+ Tcl_DStringFree(&titleString);
+ }
+
+ cleanup:
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChooseDirectoryValidateProc --
+ *
+ * Hook procedure called by the explorer ChooseDirectory dialog when events
+ * occur. It is used to validate the text entry the user may have entered.
+ *
+ * Results:
+ * Returns 0 to allow default processing of message, or 1 to
+ * tell default dialog procedure not to close.
+ *
+ *----------------------------------------------------------------------
+ */
+static UINT APIENTRY
+ChooseDirectoryValidateProc (
+ HWND hwnd,
+ UINT message,
+ LPARAM lParam,
+ LPARAM lpData)
+{
+ TCHAR selDir[MAX_PATH];
+ CHOOSEDIRDATA *chooseDirSharedData;
+ Tcl_DString initDirString;
+ char string[MAX_PATH];
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ chooseDirSharedData = (CHOOSEDIRDATA *)lpData;
+
+#ifdef _WIN64
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, lpData);
+#else
+ SetWindowLong(hwnd, GWL_USERDATA, lpData);
+#endif
+
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ }
+ chooseDirSharedData->utfRetDir[0] = '\0';
+ switch (message) {
+ case BFFM_VALIDATEFAILED:
+ /*
+ * First save and check to see if it is a valid path name, if
+ * so then make that path the one shown in the
+ * window. Otherwise, it failed the check and should be treated
+ * as such. Use Set/GetCurrentDirectory which allows relative
+ * path names and names with forward slashes. Use
+ * Tcl_TranslateFileName to make sure names like ~ are
+ * converted correctly.
+ */
+ Tcl_TranslateFileName(chooseDirSharedData->interp,
+ (char *)lParam, &initDirString);
+ lstrcpyn (string, Tcl_DStringValue(&initDirString), MAX_PATH);
+ Tcl_DStringFree(&initDirString);
+
+ if (SetCurrentDirectory((char *)string) == 0) {
+ LPTSTR lpFilePart[MAX_PATH];
+ /*
+ * Get the full path name to the user entry,
+ * at this point it doesn't exist so see if
+ * it is supposed to. Otherwise just return it.
+ */
+ GetFullPathName(string, MAX_PATH,
+ chooseDirSharedData->utfRetDir, /*unused*/ lpFilePart);
+ if (chooseDirSharedData->mustExist) {
+ /*
+ * User HAS to select a valid directory.
+ */
+ wsprintf(selDir, _T("Directory '%.200s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->utfRetDir);
+ MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
+ return 1;
+ }
+ } else {
+ /*
+ * Changed to new folder OK, return immediatly with the
+ * current directory in utfRetDir.
+ */
+ GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir);
+ return 0;
+ }
+ return 0;
+
+ case BFFM_SELCHANGED:
+ /*
+ * Set the status window to the currently selected path.
+ * And enable the OK button if a file system folder, otherwise
+ * disable the OK button for things like server names.
+ * perhaps a new switch -enablenonfolders can be used to allow
+ * non folders to be selected.
+ *
+ * Not called when user changes edit box directly.
+ */
+
+ if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) {
+ SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir);
+ // enable the OK button
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ //EnableWindow(GetDlgItem(hwnd, IDOK), TRUE);
+ SetCurrentDirectory(selDir);
+ } else {
+ // disable the OK button
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
+ //EnableWindow(GetDlgItem(hwnd, IDOK), FALSE);
+ }
+ UpdateWindow(hwnd);
+ return 1;
+
+ case BFFM_INITIALIZED:
+ /*
+ * Directory browser intializing - tell it where to start from,
+ * user specified parameter.
+ */
+ SetCurrentDirectory((char *) lpData);
+ SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM)lpData);
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ break;
+
+ }
+ return 0;
+}
+#else
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseDirectoryObjCmd --
+ *
+ * This procedure implements the "tk_chooseDirectory" dialog box
+ * for the Windows platform. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * A modal dialog window is created. Tcl_SetServiceMode() is
+ * called to allow background events to be processed
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ OPENFILENAME ofn;
+ TCHAR path[MAX_PATH], savePath[MAX_PATH];
+ ChooseDir cd;
+ int result, mustExist, code, mode, i;
+ Tk_Window tkwin;
+ HWND hWnd;
+ char *utfTitle;
+ Tcl_DString utfDirString;
+ Tcl_DString titleString, dirString;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ static CONST char *optionStrings[] = {
+ "-initialdir", "-mustexist", "-parent", "-title",
+ NULL
+ };
+ enum options {
+ DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
+ };
+
+ if (tsdPtr->WM_LBSELCHANGED == 0) {
+ tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING);
+ }
+
+ result = TCL_ERROR;
+ path[0] = '\0';
+
+ Tcl_DStringInit(&utfDirString);
+ mustExist = 0;
+ tkwin = (Tk_Window) clientData;
+ utfTitle = NULL;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ goto cleanup;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto cleanup;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case DIR_INITIAL: {
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto cleanup;
+ }
+ break;
+ }
+ case DIR_EXIST: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) {
+ goto cleanup;
+ }
+ break;
+ }
+ case DIR_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto cleanup;
+ }
+ break;
+ }
+ case FILE_TITLE: {
+ utfTitle = string;
+ break;
+ }
+ }
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ cd.interp = interp;
+ cd.ofnPtr = &ofn;
+
+ ofn.lStructSize = sizeof(ofn);
+ ofn.hwndOwner = hWnd;
+#ifdef _WIN64
+ ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner,
+ GWLP_HINSTANCE);
+#else
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+#endif
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.nFilterIndex = 0;
+ ofn.lpstrFile = NULL; //(TCHAR *) path;
+ ofn.nMaxFile = MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY
+ | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lCustData = (LPARAM) &cd;
+ ofn.lpfnHook = (LPOFNHOOKPROC) ChooseDirectoryHookProc;
+ ofn.lpTemplateName = MAKEINTRESOURCE(FILEOPENORD);
+
+ if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
+ Tcl_DStringLength(&utfDirString), &dirString);
+ } else {
+ /*
+ * NT 5.0 changed the meaning of lpstrInitialDir, so we have
+ * to ensure that we set the [pwd] if the user didn't specify
+ * anything else.
+ */
+ Tcl_DString cwd;
+
+ Tcl_DStringFree(&utfDirString);
+ if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) ||
+ (Tcl_TranslateFileName(interp,
+ Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
+ Tcl_DStringLength(&cwd), &dirString);
+ }
+ Tcl_DStringFree(&cwd);
+ }
+ ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
+
+ if (mustExist) {
+ ofn.Flags |= OFN_PATHMUSTEXIST;
+ }
+ if (utfTitle != NULL) {
+ Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
+ ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
+ }
+
+ /*
+ * Display dialog. The choose directory dialog doesn't preserve the
+ * current directory, so it must be saved and restored here.
+ */
+
+ GetCurrentDirectory(MAX_PATH, savePath);
+ mode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ code = GetOpenFileName(&ofn);
+ Tcl_SetServiceMode(mode);
+ SetCurrentDirectory(savePath);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we
+ * have updated the wrapper of the parent, which causes us to
+ * leave this child disabled (Windows loses sync).
+ */
+ EnableWindow(hWnd, 1);
+
+ Tcl_ResetResult(interp);
+ if (code != 0) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ }
+
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
+ }
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
+ }
+ result = TCL_OK;
+
+ cleanup:
+ Tcl_DStringFree(&utfDirString);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChooseDirectoryHookProc --
+ *
+ * Hook procedure called by the ChooseDirectory dialog to modify
+ * its default behavior. The ChooseDirectory dialog is really an
+ * OpenFile dialog with certain controls rearranged and certain
+ * behaviors changed. For instance, typing a name in the
+ * ChooseDirectory dialog selects a directory, rather than
+ * selecting a file.
+ *
+ * Results:
+ * Returns 0 to allow default processing of message, or 1 to
+ * tell default dialog procedure not to process the message.
+ *
+ * Side effects:
+ * A dialog window is created the first this procedure is called.
+ * This window is not destroyed and will be reused the next time
+ * the application invokes the "tk_getOpenFile" or
+ * "tk_getSaveFile" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static UINT APIENTRY
+ChooseDirectoryHookProc(
+ HWND hwnd,
+ UINT message,
+ WPARAM wParam,
+ LPARAM lParam)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ OPENFILENAME *ofnPtr;
+ ChooseDir *cdPtr;
+
+ if (message == WM_INITDIALOG) {
+ ofnPtr = (OPENFILENAME *) lParam;
+ cdPtr = (ChooseDir *) ofnPtr->lCustData;
+ cdPtr->lastCtrl = 0;
+ cdPtr->lastIdx = 1000;
+ cdPtr->path[0] = '\0';
+#ifdef _WIN64
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) cdPtr);
+#else
+ SetWindowLong(hwnd, GWL_USERDATA, (LONG) cdPtr);
+#endif
+
+ if (ofnPtr->lpstrInitialDir == NULL) {
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ } else {
+ lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir);
+ }
+ SetDlgItemText(hwnd, edt10, cdPtr->path);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = cdPtr->interp;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ }
+ return 0;
+ }
+
+ /*
+ * GWL_USERDATA keeps track of cdPtr.
+ */
+
+#ifdef _WIN64
+ cdPtr = (ChooseDir *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
+#else
+ cdPtr = (ChooseDir *) GetWindowLong(hwnd, GWL_USERDATA);
+#endif
+ if (cdPtr == NULL) {
+ return 0;
+ }
+ ofnPtr = cdPtr->ofnPtr;
+
+ if (message == tsdPtr->WM_LBSELCHANGED) {
+ /*
+ * Called when double-clicking on directory.
+ * If directory wasn't already open, browse that directory.
+ * If directory was already open, return selected directory.
+ */
+
+ int idCtrl, thisItem;
+
+ idCtrl = (int) wParam;
+ thisItem = LOWORD(lParam);
+
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ if (idCtrl == lst2) {
+ if (cdPtr->lastIdx == thisItem) {
+ EndDialog(hwnd, IDOK);
+ return 1;
+ }
+ cdPtr->lastIdx = thisItem;
+ }
+ SetDlgItemText(hwnd, edt10, cdPtr->path);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ } else if (message == WM_COMMAND) {
+ int idCtrl, notifyCode;
+
+ idCtrl = LOWORD(wParam);
+ notifyCode = HIWORD(wParam);
+
+ if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) {
+ /*
+ * OK Button wasn't clicked. Do the default.
+ */
+
+ if ((idCtrl == lst2) || (idCtrl == edt10)) {
+ cdPtr->lastCtrl = idCtrl;
+ }
+ return 0;
+ }
+
+ /*
+ * Dialogs also get the message that OK was clicked when Enter
+ * is pressed in some other control. Find out what window
+ * we were really in when we got the supposed "OK", because the
+ * behavior is different.
+ */
+
+ if (cdPtr->lastCtrl == edt10) {
+ /*
+ * Hit Enter or clicked OK while typing a directory name in the
+ * edit control.
+ * If it's a new name, try to go to that directory.
+ * If the name hasn't changed since last time, return selected
+ * directory.
+ */
+
+ int changed;
+ TCHAR tmp[MAX_PATH];
+
+ if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) {
+ return 0;
+ }
+
+ changed = lstrcmp(cdPtr->path, tmp);
+ lstrcpy(cdPtr->path, tmp);
+
+ if (SetCurrentDirectory(cdPtr->path) == 0) {
+ /*
+ * Non-existent directory.
+ */
+
+ if (ofnPtr->Flags & OFN_PATHMUSTEXIST) {
+ /*
+ * Directory must exist. Complain, then rehighlight text.
+ */
+
+ wsprintf(tmp, _T("Cannot change directory to \"%.200s\"."),
+ cdPtr->path);
+ MessageBox(hwnd, tmp, NULL, MB_OK);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ return 0;
+ }
+ if (changed) {
+ /*
+ * Directory was invalid, but we want to keep displaying
+ * this name. Don't update the listbox that displays the
+ * current directory heirarchy, or it'll erase the name.
+ */
+
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ return 0;
+ }
+ }
+ if (changed == 0) {
+ /*
+ * Name hasn't changed since the last time we hit return
+ * or double-clicked on a directory, so return this.
+ */
+
+ EndDialog(hwnd, IDOK);
+ return 1;
+ }
+
+ cdPtr->lastCtrl = IDOK;
+
+ /*
+ * The following is the magic code, determined by running
+ * Spy++ on some other directory chooser, that it takes to
+ * get this dialog to update the listbox to display the
+ * current directory.
+ */
+
+ SetDlgItemText(hwnd, edt1, cdPtr->path);
+ SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003),
+ (LPARAM) GetDlgItem(hwnd, cmb2));
+ return 0;
+ } else if (idCtrl == lst2) {
+ /*
+ * Enter key was pressed while in listbox.
+ * If it's a new directory, allow default behavior to open dir.
+ * If the directory hasn't changed, return selected directory.
+ */
+
+ int thisItem;
+
+ thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0);
+ if (cdPtr->lastIdx == thisItem) {
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ EndDialog(hwnd, IDOK);
+ return 1;
+ }
+ } else if (idCtrl == IDOK) {
+ /*
+ * The OK button was clicked. Return the value currently selected
+ * in the entry.
+ */
+
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ EndDialog(hwnd, IDOK);
+ return 1;
+ }
+ }
+ return 0;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MessageBoxObjCmd --
+ *
+ * This procedure implements the MessageBox window for the
+ * Windows platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * None. The MessageBox window will be destroy before this procedure
+ * returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin, parent;
+ HWND hWnd;
+ char *message, *title;
+ int defaultBtn, icon, type;
+ int i, oldMode, flags, winCode;
+ Tcl_DString messageString, titleString;
+ Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
+ static CONST char *optionStrings[] = {
+ "-default", "-icon", "-message", "-parent",
+ "-title", "-type", NULL
+ };
+ enum options {
+ MSG_DEFAULT, MSG_ICON, MSG_MESSAGE, MSG_PARENT,
+ MSG_TITLE, MSG_TYPE
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ defaultBtn = -1;
+ icon = MB_ICONINFORMATION;
+ message = NULL;
+ parent = tkwin;
+ title = NULL;
+ type = MB_OK;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case MSG_DEFAULT:
+ defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,
+ valuePtr);
+ if (defaultBtn < 0) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case MSG_ICON:
+ icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);
+ if (icon < 0) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case MSG_MESSAGE:
+ message = string;
+ break;
+
+ case MSG_PARENT:
+ parent = Tk_NameToWindow(interp, string, tkwin);
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case MSG_TITLE:
+ title = string;
+ break;
+
+ case MSG_TYPE:
+ type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);
+ if (type < 0) {
+ return TCL_ERROR;
+ }
+ break;
+
+ }
+ }
+
+ Tk_MakeWindowExist(parent);
+ hWnd = Tk_GetHWND(Tk_WindowId(parent));
+
+ flags = 0;
+ if (defaultBtn >= 0) {
+ int defaultBtnIdx;
+
+ defaultBtnIdx = -1;
+ for (i = 0; i < NUM_TYPES; i++) {
+ if (type == allowedTypes[i].type) {
+ int j;
+
+ for (j = 0; j < 3; j++) {
+ if (allowedTypes[i].btnIds[j] == defaultBtn) {
+ defaultBtnIdx = j;
+ break;
+ }
+ }
+ if (defaultBtnIdx < 0) {
+ Tcl_AppendResult(interp, "invalid default button \"",
+ TkFindStateString(buttonMap, defaultBtn),
+ "\"", NULL);
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+ flags = buttonFlagMap[defaultBtnIdx];
+ }
+
+ flags |= icon | type | MB_SYSTEMMODAL;
+
+ Tcl_UtfToExternalDString(unicodeEncoding, message, -1, &messageString);
+ Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ /*
+ * MessageBoxW exists for all platforms. Use it to allow unicode
+ * error message to be displayed correctly where possible by the OS.
+ */
+ winCode = MessageBoxW(hWnd, (WCHAR *) Tcl_DStringValue(&messageString),
+ (WCHAR *) Tcl_DStringValue(&titleString), flags);
+ (void) Tcl_SetServiceMode(oldMode);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we
+ * have updated the wrapper of the parent, which causes us to
+ * leave this child disabled (Windows loses sync).
+ */
+ EnableWindow(hWnd, 1);
+
+ Tcl_DStringFree(&messageString);
+ Tcl_DStringFree(&titleString);
+
+ Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
+ return TCL_OK;
+}
+
+static void
+SetTkDialog(ClientData clientData)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ char buf[32];
+
+ sprintf(buf, "0x%p", (HWND) clientData);
+ Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
+}
diff --git a/tcl/win/tkWinDraw.c b/tcl/win/tkWinDraw.c
new file mode 100644
index 00000000000..a4dc49db73c
--- /dev/null
+++ b/tcl/win/tkWinDraw.c
@@ -0,0 +1,1339 @@
+/*
+ * 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));
+
+typedef struct ThreadSpecificData {
+ POINT *winPoints; /* Array of points that is reused. */
+ int nWinPoints; /* Current size of point array. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static POINT * ConvertPoints _ANSI_ARGS_((XPoint *points, int npoints,
+ int mode, RECT *bbox));
+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));
+static HPEN SetUpGraphicsPort _ANSI_ARGS_((GC gc));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ state->bkmode = GetBkMode(dc);
+ 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;
+ SetBkMode(dc, state->bkmode);
+ 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 in thread local storage that
+ * should not be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static POINT *
+ConvertPoints(points, npoints, mode, bbox)
+ XPoint *points;
+ int npoints;
+ int mode; /* CoordModeOrigin or CoordModePrevious. */
+ RECT *bbox; /* Bounding box of points. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int i;
+
+ /*
+ * To avoid paying the cost of a malloc on every drawing routine,
+ * we reuse the last array if it is large enough.
+ */
+
+ if (npoints > tsdPtr->nWinPoints) {
+ if (tsdPtr->winPoints != NULL) {
+ ckfree((char *) tsdPtr->winPoints);
+ }
+ tsdPtr->winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints);
+ if (tsdPtr->winPoints == NULL) {
+ tsdPtr->nWinPoints = -1;
+ return NULL;
+ }
+ tsdPtr->nWinPoints = npoints;
+ }
+
+ bbox->left = bbox->right = points[0].x;
+ bbox->top = bbox->bottom = points[0].y;
+
+ if (mode == CoordModeOrigin) {
+ for (i = 0; i < npoints; i++) {
+ tsdPtr->winPoints[i].x = points[i].x;
+ tsdPtr->winPoints[i].y = points[i].y;
+ bbox->left = MIN(bbox->left, tsdPtr->winPoints[i].x);
+ bbox->right = MAX(bbox->right, tsdPtr->winPoints[i].x);
+ bbox->top = MIN(bbox->top, tsdPtr->winPoints[i].y);
+ bbox->bottom = MAX(bbox->bottom, tsdPtr->winPoints[i].y);
+ }
+ } else {
+ tsdPtr->winPoints[0].x = points[0].x;
+ tsdPtr->winPoints[0].y = points[0].y;
+ for (i = 1; i < npoints; i++) {
+ tsdPtr->winPoints[i].x = tsdPtr->winPoints[i-1].x + points[i].x;
+ tsdPtr->winPoints[i].y = tsdPtr->winPoints[i-1].y + points[i].y;
+ bbox->left = MIN(bbox->left, tsdPtr->winPoints[i].x);
+ bbox->right = MAX(bbox->right, tsdPtr->winPoints[i].x);
+ bbox->top = MIN(bbox->top, tsdPtr->winPoints[i].y);
+ bbox->bottom = MAX(bbox->bottom, tsdPtr->winPoints[i].y);
+ }
+ }
+ return tsdPtr->winPoints;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XCopyArea --
+ *
+ * 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;
+ 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);
+ }
+ if(!bitmap) {
+ panic("Fail to allocate bitmap\n");
+ DeleteDC(dcMem);
+ TkWinReleaseDrawableDC(d, dc, &state);
+ return;
+ }
+ 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 line width.
+ */
+
+ 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);
+
+ pen = SetUpGraphicsPort(gc);
+ SetBkMode(dc, TRANSPARENT);
+ 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 = SetUpGraphicsPort(gc);
+ SetBkMode(dc, TRANSPARENT);
+ 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 = SetUpGraphicsPort(gc);
+ 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.
+ */
+
+ SetBkMode(dc, TRANSPARENT);
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetUpGraphicsPort --
+ *
+ * Set up the graphics port from the given GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current port is adjusted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static HPEN
+SetUpGraphicsPort(gc)
+ GC gc;
+{
+ DWORD style;
+
+ if (gc->line_style == LineOnOffDash) {
+ unsigned char *p = (unsigned char *) &(gc->dashes);
+ /* pointer to the dash-list */
+
+ /*
+ * Below is a simple translation of serveral dash patterns
+ * to valid windows pen types. Far from complete,
+ * but I don't know how to do it better.
+ * Any ideas: <mailto:j.nijtmans@chello.nl>
+ */
+
+ if (p[1] && p[2]) {
+ if (!p[3] || p[4]) {
+ style = PS_DASHDOTDOT; /* -.. */
+ } else {
+ style = PS_DASHDOT; /* -. */
+ }
+ } else {
+ if (p[0] > (4 * gc->line_width)) {
+ style = PS_DASH; /* - */
+ } else {
+ style = PS_DOT; /* . */
+ }
+ }
+ } else {
+ style = PS_SOLID;
+ }
+ if (gc->line_width < 2) {
+ return CreatePen(style, gc->line_width, gc->foreground);
+ } else {
+ LOGBRUSH lb;
+
+ lb.lbStyle = BS_SOLID;
+ lb.lbColor = gc->foreground;
+ lb.lbHatch = 0;
+
+ style |= PS_GEOMETRIC;
+ 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;
+ }
+ return ExtCreatePen(style, gc->line_width, &lb, 0, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawHighlightBorder --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus.
+ *
+ * On Windows, we just draw the simple inset ring. On other sytems,
+ * e.g. the Mac, the focus ring is a little more complicated, so we
+ * need this abstraction.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawHighlightBorder(tkwin, fgGC, bgGC, highlightWidth, drawable)
+ Tk_Window tkwin;
+ GC fgGC;
+ GC bgGC;
+ int highlightWidth;
+ Drawable drawable;
+{
+ TkDrawInsetFocusHighlight(tkwin, fgGC, highlightWidth, drawable, 0);
+}
diff --git a/tcl/win/tkWinEmbed.c b/tcl/win/tkWinEmbed.c
new file mode 100644
index 00000000000..249dae1cf36
--- /dev/null
+++ b/tcl/win/tkWinEmbed.c
@@ -0,0 +1,672 @@
+/*
+ * tkWinEmbed.c --
+ *
+ * This file contains platform specific procedures for Windows platforms
+ * to provide basic operations needed for application embedding (where
+ * one application can use as its main window an internal window from
+ * another application).
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+
+typedef struct ThreadSpecificData {
+ Container *firstContainerPtr; /* First in list of all containers
+ * managed by this process. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+static void CleanupContainerList _ANSI_ARGS_((
+ ClientData clientData));
+static void ContainerEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbeddedEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (;
+ tsdPtr->firstContainerPtr != (Container *) NULL;
+ tsdPtr->firstContainerPtr = nextPtr) {
+ nextPtr = tsdPtr->firstContainerPtr->nextPtr;
+ ckfree((char *) tsdPtr->firstContainerPtr);
+ }
+ tsdPtr->firstContainerPtr = (Container *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpTestembedCmd --
+ *
+ * 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;
+ CONST 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
+ * the interp's result if interp is not NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpUseWindow(interp, tkwin, string)
+ Tcl_Interp *interp; /* If not NULL, used for error reporting
+ * if string is bogus. */
+ Tk_Window tkwin; /* Tk window that does not yet have an
+ * associated X window. */
+ CONST char *string; /* String identifying an X window to use
+ * for tkwin; must be an integer value. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *usePtr;
+ int id;
+ HWND hwnd;
+ Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->window != None) {
+ panic("TkpUseWindow: Already assigned a window");
+ }
+
+ if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ hwnd = (HWND) id;
+
+ /*
+ * Check if the window is a valid handle. If it is invalid, return
+ * TCL_ERROR and potentially leave an error message in the interp's
+ * result.
+ */
+
+ if (!IsWindow(hwnd)) {
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "window \"", string,
+ "\" doesn't exist", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ usePtr = (TkWindow *) Tk_HWNDToWindow(hwnd);
+ if (usePtr != NULL) {
+ if (!(usePtr->flags & TK_CONTAINER)) {
+ Tcl_AppendResult(interp, "window \"", usePtr->pathName,
+ "\" doesn't have -container option set", (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 (tsdPtr->firstContainerPtr == (Container *) NULL) {
+ Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
+ }
+
+ /*
+ * Save information about the container and the embedded window
+ * in a Container structure. If there is already an existing
+ * Container structure, it means that both container and embedded
+ * app. are in the same process.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL; containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->parentHWnd == hwnd) {
+ winPtr->flags |= TK_BOTH_HALVES;
+ containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
+ break;
+ }
+ }
+ if (containerPtr == NULL) {
+ containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr->parentPtr = NULL;
+ containerPtr->parentHWnd = hwnd;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
+ }
+
+ /*
+ * embeddedHWnd is not created yet. It will be created by TkWmMapWindow(),
+ * which will send a TK_ATTACHWINDOW to the container window.
+ * TkWinEmbeddedEventProc will process this message and set the embeddedHWnd
+ * variable
+ */
+
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * If this is the first container, register an exit handler so that
+ * things will get cleaned up at finalization.
+ */
+
+ if (tsdPtr->firstContainerPtr == (Container *) NULL) {
+ Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
+ }
+
+ /*
+ * Register the window as a container so that, for example, we can
+ * find out later if the embedded app. is in the same process.
+ */
+
+ Tk_MakeWindowExist(tkwin);
+ containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr->parentPtr = winPtr;
+ containerPtr->parentHWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+ containerPtr->embeddedHWnd = NULL;
+ containerPtr->embeddedPtr = NULL;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
+ winPtr->flags |= TK_CONTAINER;
+
+ /*
+ * Unlike in tkUnixEmbed.c, we don't make any requests for events
+ * in the embedded window here. Now we just allow the embedding
+ * of another TK application into TK windows. When the embedded
+ * window makes a request, that will be done by sending to the
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the Container structure associated with the parent window.
+ */
+
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr->parentHWnd != hwnd;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr == NULL) {
+ panic("TkWinContainerProc couldn't find Container record");
+ }
+ }
+
+ 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, (int) 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ return containerPtr->parentPtr;
+ } else if (containerPtr->parentPtr == winPtr) {
+ return containerPtr->embeddedPtr;
+ }
+ }
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the Container structure for this window work. Delete the
+ * information about the embedded application and free the container's
+ * record.
+ * The main container may be null. [Bug #476176]
+ */
+
+ prevPtr = NULL;
+ containerPtr = tsdPtr->firstContainerPtr;
+ if (containerPtr == NULL) return;
+ while (1) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ containerPtr->embeddedHWnd = NULL;
+ containerPtr->embeddedPtr = NULL;
+ break;
+ }
+ if (containerPtr->parentPtr == winPtr) {
+ containerPtr->parentPtr = NULL;
+ break;
+ }
+ prevPtr = containerPtr;
+ containerPtr = containerPtr->nextPtr;
+ if (containerPtr == NULL) {
+ panic("EmbedWindowDeleted couldn't find window");
+ }
+ }
+ if ((containerPtr->embeddedPtr == NULL)
+ && (containerPtr->parentPtr == NULL)) {
+ if (prevPtr == NULL) {
+ tsdPtr->firstContainerPtr = containerPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = containerPtr->nextPtr;
+ }
+ ckfree((char *) containerPtr);
+ }
+}
diff --git a/tcl/win/tkWinFont.c b/tcl/win/tkWinFont.c
new file mode 100644
index 00000000000..dd314eb6468
--- /dev/null
+++ b/tcl/win/tkWinFont.c
@@ -0,0 +1,2383 @@
+/*
+ * tkWinFont.c --
+ *
+ * Contains the Windows implementation of the platform-independant
+ * font package interface.
+ *
+ * Copyright (c) 1994 Software Research Associates, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkWinInt.h"
+#include "tkFont.h"
+
+/*
+ * The following structure represents a font family. It is assumed that
+ * all screen fonts constructed from the same "font family" share certain
+ * properties; all screen fonts with the same "font family" point to a
+ * shared instance of this structure. The most important shared property
+ * is the character existence metrics, used to determine if a screen font
+ * can display a given Unicode character.
+ *
+ * Under Windows, a "font family" is uniquely identified by its face name.
+ */
+
+#define FONTMAP_SHIFT 10
+
+#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
+#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT)
+
+typedef struct FontFamily {
+ struct FontFamily *nextPtr; /* Next in list of all known font families. */
+ int refCount; /* How many SubFonts are referring to this
+ * FontFamily. When the refCount drops to
+ * zero, this FontFamily may be freed. */
+ /*
+ * Key.
+ */
+
+ Tk_Uid faceName; /* Face name key for this FontFamily. */
+
+ /*
+ * Derived properties.
+ */
+
+ Tcl_Encoding encoding; /* Encoding for this font family. */
+ int isSymbolFont; /* Non-zero if this is a symbol font. */
+ int isWideFont; /* 1 if this is a double-byte font, 0
+ * otherwise. */
+ BOOL (WINAPI *textOutProc)(HDC, int, int, TCHAR *, int);
+ /* The procedure to use to draw text after
+ * it has been converted from UTF-8 to the
+ * encoding of this font. */
+ BOOL (WINAPI *getTextExtentPoint32Proc)(HDC, TCHAR *, int, LPSIZE);
+ /* The procedure to use to measure text after
+ * it has been converted from UTF-8 to the
+ * encoding of this font. */
+
+ char *fontMap[FONTMAP_PAGES];
+ /* Two-level sparse table used to determine
+ * quickly if the specified character exists.
+ * As characters are encountered, more pages
+ * in this table are dynamically added. The
+ * contents of each page is a bitmask
+ * consisting of FONTMAP_BITSPERPAGE bits,
+ * representing whether this font can be used
+ * to display the given character at the
+ * corresponding bit position. The high bits
+ * of the character are used to pick which
+ * page of the table is used. */
+
+ /*
+ * Cached Truetype font info.
+ */
+
+ int segCount; /* The length of the following arrays. */
+ USHORT *startCount; /* Truetype information about the font, */
+ USHORT *endCount; /* indicating which characters this font
+ * can display (malloced). The format of
+ * this information is (relatively) compact,
+ * but would take longer to search than
+ * indexing into the fontMap[][] table. */
+} FontFamily;
+
+/*
+ * The following structure encapsulates an individual screen font. A font
+ * object is made up of however many SubFonts are necessary to display a
+ * stream of multilingual characters.
+ */
+
+typedef struct SubFont {
+ char **fontMap; /* Pointer to font map from the FontFamily,
+ * cached here to save a dereference. */
+ HFONT hFont; /* The specific screen font that will be
+ * used when displaying/measuring chars
+ * belonging to the FontFamily. */
+ FontFamily *familyPtr; /* The FontFamily for this SubFont. */
+} SubFont;
+
+/*
+ * The following structure represents Windows' implementation of a font
+ * object.
+ */
+
+#define SUBFONT_SPACE 3
+#define BASE_CHARS 128
+
+typedef struct WinFont {
+ TkFont font; /* Stuff used by generic font package. Must
+ * be first in structure. */
+ SubFont staticSubFonts[SUBFONT_SPACE];
+ /* Builtin space for a limited number of
+ * SubFonts. */
+ int numSubFonts; /* Length of following array. */
+ SubFont *subFontArray; /* Array of SubFonts that have been loaded
+ * in order to draw/measure all the characters
+ * encountered by this font so far. All fonts
+ * start off with one SubFont initialized by
+ * AllocFont() from the original set of font
+ * attributes. Usually points to
+ * staticSubFonts, but may point to malloced
+ * space if there are lots of SubFonts. */
+
+ HWND hwnd; /* Toplevel window of application that owns
+ * this font, used for getting HDC for
+ * offscreen measurements. */
+ int pixelSize; /* Original pixel size used when font was
+ * constructed. */
+ int widths[BASE_CHARS]; /* Widths of first 128 chars in the base
+ * font, for handling common case. The base
+ * font is always used to draw characters
+ * between 0x0000 and 0x007f. */
+} WinFont;
+
+/*
+ * The following structure is passed as the LPARAM when calling the font
+ * enumeration procedure to determine if a font can support the given
+ * character.
+ */
+
+typedef struct CanUse {
+ HDC hdc;
+ WinFont *fontPtr;
+ Tcl_DString *nameTriedPtr;
+ int ch;
+ SubFont *subFontPtr;
+} CanUse;
+
+/*
+ * The following structure is used to map between the Tcl strings that
+ * represent the system fonts and the numbers used by Windows.
+ */
+
+static TkStateMap systemMap[] = {
+ {ANSI_FIXED_FONT, "ansifixed"},
+ {ANSI_VAR_FONT, "ansi"},
+ {DEVICE_DEFAULT_FONT, "device"},
+ {OEM_FIXED_FONT, "oemfixed"},
+ {SYSTEM_FIXED_FONT, "systemfixed"},
+ {SYSTEM_FONT, "system"},
+ {-1, NULL}
+};
+
+typedef struct ThreadSpecificData {
+ FontFamily *fontFamilyList; /* The list of font families that are
+ * currently loaded. As screen fonts
+ * are loaded, this list grows to hold
+ * information about what characters
+ * exist in each font family. */
+ Tcl_HashTable uidTable;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Information cached about the system at startup time.
+ */
+
+static Tcl_Encoding systemEncoding;
+
+/*
+ * Procedures used only in this file.
+ */
+
+static FontFamily * AllocFontFamily(HDC hdc, HFONT hFont, int base);
+static SubFont * CanUseFallback(HDC hdc, WinFont *fontPtr,
+ char *fallbackName, int ch);
+static SubFont * CanUseFallbackWithAliases(HDC hdc, WinFont *fontPtr,
+ char *faceName, int ch, Tcl_DString *nameTriedPtr);
+static int FamilyExists(HDC hdc, CONST char *faceName);
+static char * FamilyOrAliasExists(HDC hdc, CONST char *faceName);
+static SubFont * FindSubFontForChar(WinFont *fontPtr, int ch);
+static void FontMapInsert(SubFont *subFontPtr, int ch);
+static void FontMapLoadPage(SubFont *subFontPtr, int row);
+static int FontMapLookup(SubFont *subFontPtr, int ch);
+static void FreeFontFamily(FontFamily *familyPtr);
+static HFONT GetScreenFont(CONST TkFontAttributes *faPtr,
+ CONST char *faceName, int pixelSize);
+static void InitFont(Tk_Window tkwin, HFONT hFont,
+ int overstrike, WinFont *tkFontPtr);
+static void InitSubFont(HDC hdc, HFONT hFont, int base,
+ SubFont *subFontPtr);
+static int LoadFontRanges(HDC hdc, HFONT hFont,
+ USHORT **startCount, USHORT **endCount,
+ int *symbolPtr);
+static void MultiFontTextOut(HDC hdc, WinFont *fontPtr,
+ CONST char *source, int numBytes, int x, int y);
+static void ReleaseFont(WinFont *fontPtr);
+static void ReleaseSubFont(SubFont *subFontPtr);
+static int SeenName(CONST char *name, Tcl_DString *dsPtr);
+static void SwapLong(PULONG p);
+static void SwapShort(USHORT *p);
+static int CALLBACK WinFontCanUseProc(ENUMLOGFONT *lfPtr,
+ NEWTEXTMETRIC *tmPtr, int fontType,
+ LPARAM lParam);
+static int CALLBACK WinFontExistProc(ENUMLOGFONT *lfPtr,
+ NEWTEXTMETRIC *tmPtr, int fontType,
+ LPARAM lParam);
+static int CALLBACK WinFontFamilyEnumProc(ENUMLOGFONT *lfPtr,
+ NEWTEXTMETRIC *tmPtr, int fontType,
+ LPARAM lParam);
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependent code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ *
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpFontPkgInit(
+ TkMainInfo *mainPtr) /* The application being created. */
+{
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ /*
+ * If running NT, then we will be calling some Unicode functions
+ * explictly. So, even if the Tcl system encoding isn't Unicode,
+ * make sure we convert to/from the Unicode char set.
+ */
+
+ systemEncoding = TkWinGetUnicodeEncoding();
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkFont *
+TkpGetNativeFont(
+ Tk_Window tkwin, /* For display where font will be used. */
+ CONST char *name) /* Platform-specific font name. */
+{
+ int object;
+ WinFont *fontPtr;
+
+ object = TkFindStateNum(NULL, NULL, systemMap, name);
+ if (object < 0) {
+ return NULL;
+ }
+
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
+ fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ InitFont(tkwin, GetStockObject(object), 0, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFromAttributes --
+ *
+ * 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:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkFont *
+TkpGetFontFromAttributes(
+ TkFont *tkFontPtr, /* If non-NULL, store the information in
+ * this existing TkFont structure, rather than
+ * allocating a new structure to hold the
+ * font; the existing contents of the font
+ * will be released. If NULL, a new TkFont
+ * structure is allocated. */
+ Tk_Window tkwin, /* For display where font will be used. */
+ CONST TkFontAttributes *faPtr)
+ /* Set of attributes to match. */
+{
+ int i, j;
+ HDC hdc;
+ HWND hwnd;
+ HFONT hFont;
+ Window window;
+ WinFont *fontPtr;
+ char ***fontFallbacks;
+ Tk_Uid faceName, fallback, actualName;
+
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
+ window = Tk_WindowId(tkwin);
+ hwnd = (window == None) ? NULL : TkWinGetHWND(window);
+ hdc = GetDC(hwnd);
+
+ /*
+ * Algorithm to get the closest font name to the one requested.
+ *
+ * try fontname
+ * try all aliases for fontname
+ * foreach fallback for fontname
+ * try the fallback
+ * try all aliases for the fallback
+ */
+
+ faceName = faPtr->family;
+ if (faceName != NULL) {
+ actualName = FamilyOrAliasExists(hdc, faceName);
+ if (actualName != NULL) {
+ faceName = actualName;
+ goto found;
+ }
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(faceName, fallback) == 0) {
+ break;
+ }
+ }
+ if (fallback != NULL) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ actualName = FamilyOrAliasExists(hdc, fallback);
+ if (actualName != NULL) {
+ faceName = actualName;
+ goto found;
+ }
+ }
+ }
+ }
+ }
+
+ found:
+ ReleaseDC(hwnd, hdc);
+
+ hFont = GetScreenFont(faPtr, faceName, TkFontGetPixels(tkwin, faPtr->size));
+ if (tkFontPtr == NULL) {
+ fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ } else {
+ fontPtr = (WinFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+ }
+ InitFont(tkwin, hFont, faPtr->overstrike, fontPtr);
+
+ return (TkFont *) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpDeleteFont --
+ *
+ * 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. */
+{
+ WinFont *fontPtr;
+
+ fontPtr = (WinFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetFontFamilies, WinFontFamilyEnumProc --
+ *
+ * Return information about the font families that are available
+ * on the display of the given window.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list of all the available
+ * font families.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkpGetFontFamilies(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ Tk_Window tkwin) /* For display to query. */
+{
+ HDC hdc;
+ HWND hwnd;
+ Window window;
+
+ window = Tk_WindowId(tkwin);
+ hwnd = (window == None) ? NULL : TkWinGetHWND(window);
+ hdc = GetDC(hwnd);
+
+ /*
+ * On any version NT, there may fonts with international names.
+ * Use the NT-only Unicode version of EnumFontFamilies to get the
+ * font names. If we used the ANSI version on a non-internationalized
+ * version of NT, we would get font names with '?' replacing all
+ * the international characters.
+ *
+ * On a non-internationalized verson of 95, fonts with international
+ * names are not allowed, so the ANSI version of EnumFontFamilies will
+ * work. On an internationalized version of 95, there may be fonts with
+ * international names; the ANSI version will work, fetching the
+ * name in the system code page. Can't use the Unicode version of
+ * EnumFontFamilies because it only exists under NT.
+ */
+
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc,
+ (LPARAM) interp);
+ } else {
+ EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontFamilyEnumProc,
+ (LPARAM) interp);
+ }
+ ReleaseDC(hwnd, hdc);
+}
+
+static int CALLBACK
+WinFontFamilyEnumProc(
+ ENUMLOGFONT *lfPtr, /* Logical-font data. */
+ NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */
+ int fontType, /* Type of font (not used). */
+ LPARAM lParam) /* Result object to hold result. */
+{
+ char *faceName;
+ Tcl_DString faceString;
+ Tcl_Obj *strPtr;
+ Tcl_Interp *interp;
+
+ interp = (Tcl_Interp *) lParam;
+ faceName = lfPtr->elfLogFont.lfFaceName;
+ Tcl_ExternalToUtfDString(systemEncoding, faceName, -1, &faceString);
+ strPtr = Tcl_NewStringObj(Tcl_DStringValue(&faceString),
+ Tcl_DStringLength(&faceString));
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr);
+ Tcl_DStringFree(&faceString);
+ return 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpGetSubFonts --
+ *
+ * A function used by the testing package for querying the actual
+ * screen fonts that make up a font object.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list containing the
+ * names of the screen fonts that make up the given font object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpGetSubFonts(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ Tk_Font tkfont) /* Font object to query. */
+{
+ int i;
+ WinFont *fontPtr;
+ FontFamily *familyPtr;
+ Tcl_Obj *resultPtr, *strPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ fontPtr = (WinFont *) tkfont;
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ familyPtr = fontPtr->subFontArray[i].familyPtr;
+ strPtr = Tcl_NewStringObj(familyPtr->faceName, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_MeasureChars --
+ *
+ * Determine the number of bytes from the string that will fit
+ * in the given horizontal span. The measurement is done under the
+ * assumption that Tk_DrawChars() will be used to actually display
+ * the characters.
+ *
+ * Results:
+ * The return value is the number of bytes from source that
+ * fit into the span that extends from 0 to maxLength. *lengthPtr is
+ * filled with the x-coordinate of the right edge of the last
+ * character that did fit.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_MeasureChars(
+ Tk_Font tkfont, /* Font in which characters will be drawn. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes, /* Maximum number of bytes to consider
+ * from source string. */
+ int maxLength, /* If >= 0, maxLength specifies the longest
+ * permissible line length in pixels; don't
+ * consider any character that would cross
+ * this x-position. If < 0, then line length
+ * is unbounded and the flags argument is
+ * ignored. */
+ int flags, /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ int *lengthPtr) /* Filled with x-location just after the
+ * terminating character. */
+{
+ HDC hdc;
+ HFONT oldFont;
+ WinFont *fontPtr;
+ int curX, curByte;
+ SubFont *lastSubFontPtr;
+
+ /*
+ * According to Microsoft tech support, Windows does not use kerning
+ * or fractional character widths when displaying text on the screen.
+ * So that means we can safely measure individual characters or spans
+ * of characters and add up the widths w/o any "off-by-one-pixel"
+ * errors.
+ */
+
+ fontPtr = (WinFont *) tkfont;
+
+ hdc = GetDC(fontPtr->hwnd);
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+ oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
+
+ if (numBytes == 0) {
+ curX = 0;
+ curByte = 0;
+ } else if (maxLength < 0) {
+ Tcl_UniChar ch;
+ SIZE size;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+ SubFont *thisSubFontPtr;
+ CONST char *p, *end, *next;
+
+ /*
+ * A three step process:
+ * 1. Find a contiguous range of characters that can all be
+ * represented by a single screen font.
+ * 2. Convert those chars to the encoding of that font.
+ * 3. Measure converted chars.
+ */
+
+ curX = 0;
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ (int) (p - source), &runString);
+ (*familyPtr->getTextExtentPoint32Proc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ curX += size.cx;
+ Tcl_DStringFree(&runString);
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+
+ SelectObject(hdc, lastSubFontPtr->hFont);
+ }
+ p = next;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ (int) (p - source), &runString);
+ (*familyPtr->getTextExtentPoint32Proc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ curX += size.cx;
+ Tcl_DStringFree(&runString);
+ curByte = numBytes;
+ } else {
+ Tcl_UniChar ch;
+ SIZE size;
+ char buf[16];
+ FontFamily *familyPtr;
+ SubFont *thisSubFontPtr;
+ CONST char *term, *end, *p, *next;
+ int newX, termX, sawNonSpace, dstWrote;
+
+ /*
+ * How many chars will fit in the space allotted?
+ * This first version may be inefficient because it measures
+ * every character individually. There is a function call that
+ * can measure multiple characters at once and return the
+ * offset of each of them, but it only works on NT, even though
+ * the documentation claims it works for 95.
+ * TODO: verify that GetTextExtentExPoint is still broken in '95, and
+ * possibly use it for NT anyway since it should be much faster and
+ * more accurate.
+ */
+
+ next = source + Tcl_UtfToUniChar(source, &ch);
+ newX = curX = termX = 0;
+
+ term = source;
+ end = source + numBytes;
+
+ sawNonSpace = (ch > 255) || !isspace(ch);
+ for (p = source; ; ) {
+ if (ch < BASE_CHARS) {
+ newX += fontPtr->widths[ch];
+ } else {
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ SelectObject(hdc, thisSubFontPtr->hFont);
+ lastSubFontPtr = thisSubFontPtr;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternal(NULL, familyPtr->encoding, p,
+ (int) (next - p), 0, NULL, buf, sizeof(buf), NULL,
+ &dstWrote, NULL);
+ (*familyPtr->getTextExtentPoint32Proc)(hdc, buf,
+ dstWrote >> familyPtr->isWideFont, &size);
+ newX += size.cx;
+ }
+ if (newX > maxLength) {
+ break;
+ }
+ curX = newX;
+ p = next;
+ if (p >= end) {
+ term = end;
+ termX = curX;
+ break;
+ }
+
+ next += Tcl_UtfToUniChar(next, &ch);
+ if ((ch < 256) && isspace(ch)) {
+ if (sawNonSpace) {
+ term = p;
+ termX = curX;
+ sawNonSpace = 0;
+ }
+ } else {
+ sawNonSpace = 1;
+ }
+ }
+
+ /*
+ * P points to the first character that doesn't fit in the desired
+ * span. Use the flags to figure out what to return.
+ */
+
+ if ((flags & TK_PARTIAL_OK) && (p < end) && (curX < maxLength)) {
+ /*
+ * Include the first character that didn't quite fit in the desired
+ * span. The width returned will include the width of that extra
+ * character.
+ */
+
+ curX = newX;
+ p += Tcl_UtfToUniChar(p, &ch);
+ }
+ if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
+ term = p;
+ termX = curX;
+ if (term == source) {
+ term += Tcl_UtfToUniChar(term, &ch);
+ termX = newX;
+ }
+ } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
+ term = p;
+ termX = curX;
+ }
+
+ curX = termX;
+ curByte = (int) (term - source);
+ }
+
+ SelectObject(hdc, oldFont);
+ ReleaseDC(fontPtr->hwnd, hdc);
+
+ *lengthPtr = curX;
+ return curByte;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawChars --
+ *
+ * Draw a string of characters on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawChars(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for drawing characters. */
+ Tk_Font tkfont, /* Font in which characters will be drawn;
+ * must be the same as font used in GC. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. All Tk meta-characters
+ * (tabs, control characters, and newlines)
+ * should be stripped out of the string that
+ * is passed to this function. If they are
+ * not stripped out, they will be displayed as
+ * regular printing characters. */
+ int numBytes, /* Number of bytes in string. */
+ int x, int y) /* Coordinates at which to place origin of
+ * string when drawing. */
+{
+ HDC dc;
+ WinFont *fontPtr;
+ TkWinDCState state;
+
+ fontPtr = (WinFont *) gc->font;
+ display->request++;
+
+ if (drawable == None) {
+ return;
+ }
+
+ dc = TkWinGetDrawableDC(display, drawable, &state);
+
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+
+ if ((gc->clip_mask != None) &&
+ ((TkpClipMask*)gc->clip_mask)->type == TKP_CLIP_REGION) {
+ SelectClipRgn(dc, (HRGN)((TkpClipMask*)gc->clip_mask)->value.region);
+ }
+
+ 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_BASELINE);
+ SetTextColor(dcMem, gc->foreground);
+ SetBkMode(dcMem, TRANSPARENT);
+ SetBkColor(dcMem, RGB(0, 0, 0));
+
+ /*
+ * Compute the bounding box and create a compatible bitmap.
+ */
+
+ GetTextExtentPoint(dcMem, source, numBytes, &size);
+ GetTextMetrics(dcMem, &tm);
+ size.cx -= tm.tmOverhang;
+ bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
+ oldBitmap = SelectObject(dcMem, bitmap);
+
+ /*
+ * The following code is tricky because fonts are rendered in multiple
+ * colors. First we draw onto a black background and copy the white
+ * bits. Then we draw onto a white background and copy the black bits.
+ * Both the foreground and background bits of the font are ANDed with
+ * the stipple pattern as they are copied.
+ */
+
+ PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
+ BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
+ 0, 0, 0xEA02E9);
+ PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
+ BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
+ 0, 0, 0x8A0E06);
+
+ /*
+ * Destroy the temporary bitmap and restore the device context.
+ */
+
+ SelectObject(dcMem, oldBitmap);
+ DeleteObject(bitmap);
+ DeleteDC(dcMem);
+ SelectObject(dc, oldBrush);
+ DeleteObject(stipple);
+ } else {
+ SetTextAlign(dc, TA_LEFT | TA_BASELINE);
+ SetTextColor(dc, gc->foreground);
+ SetBkMode(dc, TRANSPARENT);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
+ }
+ TkWinReleaseDrawableDC(drawable, dc, &state);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * MultiFontTextOut --
+ *
+ * Helper function for Tk_DrawChars. Draws characters, using the
+ * various screen fonts in fontPtr to draw multilingual characters.
+ * Note: No bidirectional support.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ * Contents of fontPtr may be modified if more subfonts were loaded
+ * in order to draw all the multilingual characters in the given
+ * string.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+MultiFontTextOut(
+ HDC hdc, /* HDC to draw into. */
+ WinFont *fontPtr, /* Contains set of fonts to use when drawing
+ * following string. */
+ CONST char *source, /* Potentially multilingual UTF-8 string. */
+ int numBytes, /* Length of string in bytes. */
+ int x, int y) /* Coordinates at which to place origin *
+ * of string when drawing. */
+{
+ Tcl_UniChar ch;
+ SIZE size;
+ HFONT oldFont;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ SubFont *lastSubFontPtr, *thisSubFontPtr;
+
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+ oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
+
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ (int) (p - source), &runString);
+ (*familyPtr->textOutProc)(hdc, x, y,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
+ (*familyPtr->getTextExtentPoint32Proc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ x += size.cx;
+ Tcl_DStringFree(&runString);
+ }
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ SelectObject(hdc, lastSubFontPtr->hFont);
+ }
+ p = next;
+ }
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ (int) (p - source), &runString);
+ (*familyPtr->textOutProc)(hdc, x, y, Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
+ Tcl_DStringFree(&runString);
+ }
+ SelectObject(hdc, oldFont);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Initializes the memory for a new WinFont that wraps the
+ * platform-specific data.
+ *
+ * The caller is responsible for initializing the fields of the
+ * WinFont that are used exclusively by the generic TkFont code, and
+ * for releasing those fields before calling TkpDeleteFont().
+ *
+ * Results:
+ * Fills the WinFont structure.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitFont(
+ Tk_Window tkwin, /* Main window of interp in which font will
+ * be used, for getting HDC. */
+ HFONT hFont, /* Windows token for font. */
+ int overstrike, /* The overstrike attribute of logfont used
+ * to allocate this font. For some reason,
+ * the TEXTMETRICs may contain incorrect info
+ * in the tmStruckOut field. */
+ WinFont *fontPtr) /* Filled with information constructed from
+ * the above arguments. */
+{
+ HDC hdc;
+ HWND hwnd;
+ HFONT oldFont;
+ TEXTMETRIC tm;
+ Window window;
+ TkFontMetrics *fmPtr;
+ Tcl_Encoding encoding;
+ Tcl_DString faceString;
+ TkFontAttributes *faPtr;
+ char buf[LF_FACESIZE * sizeof(WCHAR)];
+
+ window = Tk_WindowId(tkwin);
+ hwnd = (window == None) ? NULL : TkWinGetHWND(window);
+ hdc = GetDC(hwnd);
+ oldFont = SelectObject(hdc, hFont);
+
+ GetTextMetrics(hdc, &tm);
+
+ /*
+ * On any version NT, there may fonts with international names.
+ * Use the NT-only Unicode version of GetTextFace to get the font's
+ * name. If we used the ANSI version on a non-internationalized
+ * version of NT, we would get a font name with '?' replacing all
+ * the international characters.
+ *
+ * On a non-internationalized verson of 95, fonts with international
+ * names are not allowed, so the ANSI version of GetTextFace will work.
+ * On an internationalized version of 95, there may be fonts with
+ * international names; the ANSI version will work, fetching the
+ * name in the international system code page. Can't use the Unicode
+ * version of GetTextFace because it only exists under NT.
+ */
+
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
+ } else {
+ GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
+ }
+ Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
+
+ fontPtr->font.fid = (Font) fontPtr;
+
+ faPtr = &fontPtr->font.fa;
+ faPtr->family = Tk_GetUid(Tcl_DStringValue(&faceString));
+ faPtr->size = TkFontGetPoints(tkwin, -(tm.tmHeight - tm.tmInternalLeading));
+ faPtr->weight = (tm.tmWeight > FW_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL;
+ faPtr->slant = (tm.tmItalic != 0) ? TK_FS_ITALIC : TK_FS_ROMAN;
+ faPtr->underline = (tm.tmUnderlined != 0) ? 1 : 0;
+ faPtr->overstrike = overstrike;
+
+ fmPtr = &fontPtr->font.fm;
+ fmPtr->ascent = tm.tmAscent;
+ fmPtr->descent = tm.tmDescent;
+ fmPtr->maxWidth = tm.tmMaxCharWidth;
+ fmPtr->fixed = !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH);
+
+ fontPtr->hwnd = hwnd;
+ fontPtr->pixelSize = tm.tmHeight - tm.tmInternalLeading;
+
+ fontPtr->numSubFonts = 1;
+ fontPtr->subFontArray = fontPtr->staticSubFonts;
+ InitSubFont(hdc, hFont, 1, &fontPtr->subFontArray[0]);
+
+ encoding = fontPtr->subFontArray[0].familyPtr->encoding;
+ if (encoding == TkWinGetUnicodeEncoding()) {
+ GetCharWidthW(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
+ } else {
+ GetCharWidthA(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
+ }
+ Tcl_DStringFree(&faceString);
+
+ SelectObject(hdc, oldFont);
+ ReleaseDC(hwnd, hdc);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseFont --
+ *
+ * Called to release the windows-specific contents of a TkFont.
+ * The caller is responsible for freeing the memory used by the
+ * font itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseFont(
+ WinFont *fontPtr) /* The font to delete. */
+{
+ int i;
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ ReleaseSubFont(&fontPtr->subFontArray[i]);
+ }
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * InitSubFont --
+ *
+ * Wrap a screen font and load the FontFamily that represents
+ * it. Used to prepare a SubFont so that characters can be mapped
+ * from UTF-8 to the charset of the font.
+ *
+ * Results:
+ * The subFontPtr is filled with information about the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+InitSubFont(
+ HDC hdc, /* HDC in which font can be selected. */
+ HFONT hFont, /* The screen font. */
+ int base, /* Non-zero if this SubFont is being used
+ * as the base font for a font object. */
+ SubFont *subFontPtr) /* Filled with SubFont constructed from
+ * above attributes. */
+{
+ subFontPtr->hFont = hFont;
+ subFontPtr->familyPtr = AllocFontFamily(hdc, hFont, base);
+ subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseSubFont --
+ *
+ * Called to release the contents of a SubFont. The caller is
+ * responsible for freeing the memory used by the SubFont itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseSubFont(
+ SubFont *subFontPtr) /* The SubFont to delete. */
+{
+ DeleteObject(subFontPtr->hFont);
+ FreeFontFamily(subFontPtr->familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * AllocFontFamily --
+ *
+ * Find the FontFamily structure associated with the given font
+ * name. The information should be stored by the caller in a
+ * SubFont and used when determining if that SubFont supports a
+ * character.
+ *
+ * Cannot use the string name used to construct the font as the
+ * key, because the capitalization may not be canonical. Therefore
+ * use the face name actually retrieved from the font metrics as
+ * the key.
+ *
+ * Results:
+ * A pointer to a FontFamily. The reference count in the FontFamily
+ * is automatically incremented. When the SubFont is released, the
+ * reference count is decremented. When no SubFont is using this
+ * FontFamily, it may be deleted.
+ *
+ * Side effects:
+ * A new FontFamily structure will be allocated if this font family
+ * has not been seen. TrueType character existence metrics are
+ * loaded into the FontFamily structure.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static FontFamily *
+AllocFontFamily(
+ HDC hdc, /* HDC in which font can be selected. */
+ HFONT hFont, /* Screen font whose FontFamily is to be
+ * returned. */
+ int base) /* Non-zero if this font family is to be
+ * used in the base font of a font object. */
+{
+ Tk_Uid faceName;
+ FontFamily *familyPtr;
+ Tcl_DString faceString;
+ Tcl_Encoding encoding;
+ char buf[LF_FACESIZE * sizeof(WCHAR)];
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ hFont = SelectObject(hdc, hFont);
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
+ } else {
+ GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
+ }
+ Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
+ faceName = Tk_GetUid(Tcl_DStringValue(&faceString));
+ Tcl_DStringFree(&faceString);
+ hFont = SelectObject(hdc, hFont);
+
+ familyPtr = tsdPtr->fontFamilyList;
+ for ( ; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if (familyPtr->faceName == faceName) {
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
+
+ familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ memset(familyPtr, 0, sizeof(FontFamily));
+ familyPtr->nextPtr = tsdPtr->fontFamilyList;
+ tsdPtr->fontFamilyList = familyPtr;
+
+ /*
+ * Set key for this FontFamily.
+ */
+
+ familyPtr->faceName = faceName;
+
+ /*
+ * An initial refCount of 2 means that FontFamily information will
+ * persist even when the SubFont that loaded the FontFamily is released.
+ * Change it to 1 to cause FontFamilies to be unloaded when not in use.
+ */
+
+ familyPtr->refCount = 2;
+
+ familyPtr->segCount = LoadFontRanges(hdc, hFont, &familyPtr->startCount,
+ &familyPtr->endCount, &familyPtr->isSymbolFont);
+
+ encoding = NULL;
+ if (familyPtr->isSymbolFont != 0) {
+ /*
+ * Symbol fonts are handled specially. For instance, Unicode 0393
+ * (GREEK CAPITAL GAMMA) must be mapped to Symbol character 0047
+ * (GREEK CAPITAL GAMMA), because the Symbol font doesn't have a
+ * GREEK CAPITAL GAMMA at location 0393. If Tk interpreted the
+ * Symbol font using the Unicode encoding, it would decide that
+ * the Symbol font has no GREEK CAPITAL GAMMA, because the Symbol
+ * encoding (of course) reports that character 0393 doesn't exist.
+ *
+ * With non-symbol Windows fonts, such as Times New Roman, if the
+ * font has a GREEK CAPITAL GAMMA, it will be found in the correct
+ * Unicode location (0393); the GREEK CAPITAL GAMMA will not be off
+ * hiding at some other location.
+ */
+
+ encoding = Tcl_GetEncoding(NULL, faceName);
+ }
+
+ if (encoding == NULL) {
+ encoding = Tcl_GetEncoding(NULL, "unicode");
+ familyPtr->textOutProc =
+ (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutW;
+ familyPtr->getTextExtentPoint32Proc =
+ (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPoint32W;
+ familyPtr->isWideFont = 1;
+ } else {
+ familyPtr->textOutProc =
+ (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutA;
+ familyPtr->getTextExtentPoint32Proc =
+ (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPoint32A;
+ familyPtr->isWideFont = 0;
+ }
+
+ familyPtr->encoding = encoding;
+
+ return familyPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FreeFontFamily --
+ *
+ * Called to free a FontFamily when the SubFont is finished using it.
+ * Frees the contents of the FontFamily and the memory used by the
+ * FontFamily itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FreeFontFamily(
+ FontFamily *familyPtr) /* The FontFamily to delete. */
+{
+ int i;
+ FontFamily **familyPtrPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+ if (familyPtr->startCount != NULL) {
+ ckfree((char *) familyPtr->startCount);
+ }
+ if (familyPtr->endCount != NULL) {
+ ckfree((char *) familyPtr->endCount);
+ }
+ if (familyPtr->encoding != TkWinGetUnicodeEncoding()) {
+ Tcl_FreeEncoding(familyPtr->encoding);
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which screen font is necessary to use to display the
+ * given character. If the font object does not have a screen font
+ * that can display the character, another screen font may be loaded
+ * into the font object, following a set of preferred fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+FindSubFontForChar(
+ WinFont *fontPtr, /* The font object with which the character
+ * will be displayed. */
+ int ch) /* The Unicode character to be displayed. */
+{
+ HDC hdc;
+ int i, j, k;
+ CanUse canUse;
+ char **aliases, **anyFallbacks;
+ char ***fontFallbacks;
+ char *fallbackName;
+ SubFont *subFontPtr;
+ Tcl_DString ds;
+
+ if (ch < BASE_CHARS) {
+ return &fontPtr->subFontArray[0];
+ }
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
+ return &fontPtr->subFontArray[i];
+ }
+ }
+
+ /*
+ * Keep track of all face names that we check, so we don't check some
+ * name multiple times if it can be reached by multiple paths.
+ */
+
+ Tcl_DStringInit(&ds);
+ hdc = GetDC(fontPtr->hwnd);
+
+ aliases = TkFontGetAliasList(fontPtr->font.fa.family);
+
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) {
+ /*
+ * If the base font has a fallback...
+ */
+
+ goto tryfallbacks;
+ } else if (aliases != NULL) {
+ /*
+ * Or if an alias for the base font has a fallback...
+ */
+
+ for (k = 0; aliases[k] != NULL; k++) {
+ if (strcasecmp(aliases[k], fallbackName) == 0) {
+ goto tryfallbacks;
+ }
+ }
+ }
+ }
+ continue;
+
+ /*
+ * ...then see if we can use one of the fallbacks, or an
+ * alias for one of the fallbacks.
+ */
+
+ tryfallbacks:
+ for (j = 0; fontFallbacks[i][j] != NULL; j++) {
+ fallbackName = fontFallbacks[i][j];
+ subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName,
+ ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ /*
+ * See if we can use something from the global fallback list.
+ */
+
+ anyFallbacks = TkFontGetGlobalClass();
+ for (i = 0; anyFallbacks[i] != NULL; i++) {
+ fallbackName = anyFallbacks[i];
+ subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName,
+ ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * Try all face names available in the whole system until we
+ * find one that can be used.
+ */
+
+ canUse.hdc = hdc;
+ canUse.fontPtr = fontPtr;
+ canUse.nameTriedPtr = &ds;
+ canUse.ch = ch;
+ canUse.subFontPtr = NULL;
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontCanUseProc,
+ (LPARAM) &canUse);
+ } else {
+ EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontCanUseProc,
+ (LPARAM) &canUse);
+ }
+ subFontPtr = canUse.subFontPtr;
+
+ end:
+ Tcl_DStringFree(&ds);
+
+ if (subFontPtr == NULL) {
+ /*
+ * No font can display this character. We will use the base font
+ * and have it display the "unknown" character.
+ */
+
+ subFontPtr = &fontPtr->subFontArray[0];
+ FontMapInsert(subFontPtr, ch);
+ }
+ ReleaseDC(fontPtr->hwnd, hdc);
+ return subFontPtr;
+}
+
+static int CALLBACK
+WinFontCanUseProc(
+ ENUMLOGFONT *lfPtr, /* Logical-font data. */
+ NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */
+ int fontType, /* Type of font (not used). */
+ LPARAM lParam) /* Result object to hold result. */
+{
+ int ch;
+ HDC hdc;
+ WinFont *fontPtr;
+ CanUse *canUsePtr;
+ char *fallbackName;
+ SubFont *subFontPtr;
+ Tcl_DString faceString;
+ Tcl_DString *nameTriedPtr;
+
+ canUsePtr = (CanUse *) lParam;
+ ch = canUsePtr->ch;
+ hdc = canUsePtr->hdc;
+ fontPtr = canUsePtr->fontPtr;
+ nameTriedPtr = canUsePtr->nameTriedPtr;
+
+ fallbackName = lfPtr->elfLogFont.lfFaceName;
+ Tcl_ExternalToUtfDString(systemEncoding, fallbackName, -1, &faceString);
+ fallbackName = Tcl_DStringValue(&faceString);
+
+ if (SeenName(fallbackName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, fallbackName, ch);
+ if (subFontPtr != NULL) {
+ canUsePtr->subFontPtr = subFontPtr;
+ Tcl_DStringFree(&faceString);
+ return 0;
+ }
+ }
+ Tcl_DStringFree(&faceString);
+ return 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLookup --
+ *
+ * See if the screen font can display the given character.
+ *
+ * Results:
+ * The return value is 0 if the screen font cannot display the
+ * character, non-zero otherwise.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FontMapLookup(
+ SubFont *subFontPtr, /* Contains font mapping cache to be queried
+ * and possibly updated. */
+ int ch) /* Character to be tested. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapInsert --
+ *
+ * Tell the font mapping cache that the given screen font should be
+ * used to display the specified character. This is called when no
+ * font on the system can be be found that can display that
+ * character; we lie to the font and tell it that it can display
+ * the character, otherwise we would end up re-searching the entire
+ * fallback hierarchy every time that character was seen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontMapInsert(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int ch) /* Character to be added to cache. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated HFONT can (1) or cannot (0) display the
+ * characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int row) /* Index of the page to be loaded into
+ * the cache. */
+{
+ FontFamily *familyPtr;
+ Tcl_Encoding encoding;
+ char src[TCL_UTF_MAX], buf[16];
+ USHORT *startCount, *endCount;
+ int i, j, bitOffset, end, segCount;
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ familyPtr = subFontPtr->familyPtr;
+ encoding = familyPtr->encoding;
+
+ if (familyPtr->encoding == TkWinGetUnicodeEncoding()) {
+ /*
+ * Font is Unicode. Few fonts are going to have all characters, so
+ * examine the TrueType character existence metrics to determine
+ * what characters actually exist in this font.
+ */
+
+ segCount = familyPtr->segCount;
+ startCount = familyPtr->startCount;
+ endCount = familyPtr->endCount;
+
+ j = 0;
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ for ( ; j < segCount; j++) {
+ if (endCount[j] >= i) {
+ if (startCount[j] <= i) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ break;
+ }
+ }
+ }
+ } else if (familyPtr->isSymbolFont) {
+ /*
+ * Assume that a symbol font with a known encoding has all the
+ * characters that its encoding claims it supports.
+ *
+ * The test for "encoding == unicodeEncoding"
+ * must occur before this case, to catch all symbol fonts (such
+ * as {Comic Sans MS} or Wingdings) for which we don't have
+ * encoding information; those symbol fonts are treated as if
+ * they were in the Unicode encoding and their symbolic
+ * character existence metrics are treated as if they were Unicode
+ * character existence metrics. This way, although we don't know
+ * the proper Unicode -> symbol font mapping, we can install the
+ * symbol font as the base font and access its glyphs.
+ */
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ if (Tcl_UtfToExternal(NULL, encoding, src,
+ Tcl_UniCharToUtf(i, src), TCL_ENCODING_STOPONERROR, NULL,
+ buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK) {
+ continue;
+ }
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(
+ HDC hdc, /* HDC in which font can be selected. */
+ WinFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ char *faceName, /* Desired face name for new screen font. */
+ int ch, /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr) /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ int i;
+ char **aliases;
+ SubFont *subFontPtr;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SeenName(
+ CONST char *name, /* The name to check. */
+ Tcl_DString *dsPtr) /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified screen font has not already been loaded into
+ * the font object, determine if it can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont, owned
+ * by the font object. This SubFont can be used to display the given
+ * character. The SubFont represents the screen font with the base set
+ * of font attributes from the font object, but using the specified
+ * font name. NULL is returned if the font object already holds
+ * a reference to the specified physical font or if the specified
+ * physical font cannot display the given character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(
+ HDC hdc, /* HDC in which font can be selected. */
+ WinFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ char *faceName, /* Desired face name for new screen font. */
+ int ch) /* The Unicode character that the new
+ * screen font must be able to display. */
+{
+ int i;
+ HFONT hFont;
+ SubFont subFont;
+
+ if (FamilyExists(hdc, faceName) == 0) {
+ return NULL;
+ }
+
+ /*
+ * Skip all fonts we've already used.
+ */
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ if (faceName == fontPtr->subFontArray[i].familyPtr->faceName) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Load this font and see if it has the desired character.
+ */
+
+ hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize);
+ InitSubFont(hdc, hFont, 0, &subFont);
+ if (((ch < 256) && (subFont.familyPtr->isSymbolFont))
+ || (FontMapLookup(&subFont, ch) == 0)) {
+ /*
+ * Don't use a symbol font as a fallback font for characters below
+ * 256.
+ */
+
+ ReleaseSubFont(&subFont);
+ return NULL;
+ }
+
+ if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
+ SubFont *newPtr;
+
+ newPtr = (SubFont *) ckalloc(sizeof(SubFont)
+ * (fontPtr->numSubFonts + 1));
+ memcpy((char *) newPtr, fontPtr->subFontArray,
+ fontPtr->numSubFonts * sizeof(SubFont));
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+ fontPtr->subFontArray = newPtr;
+ }
+ fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
+ fontPtr->numSubFonts++;
+ return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetScreenFont --
+ *
+ * Given the name and other attributes, construct an HFONT.
+ * This is where all the alias and fallback substitution bottoms
+ * out.
+ *
+ * Results:
+ * The screen font that corresponds to the attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static HFONT
+GetScreenFont(
+ CONST TkFontAttributes *faPtr,
+ /* Desired font attributes for new HFONT. */
+ CONST char *faceName, /* Overrides font family specified in font
+ * attributes. */
+ int pixelSize) /* Overrides size specified in font
+ * attributes. */
+{
+ Tcl_DString ds;
+ HFONT hFont;
+ LOGFONTW lf;
+
+ memset(&lf, 0, sizeof(lf));
+ lf.lfHeight = -pixelSize;
+ lf.lfWidth = 0;
+ lf.lfEscapement = 0;
+ lf.lfOrientation = 0;
+ lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
+ lf.lfItalic = faPtr->slant;
+ lf.lfUnderline = faPtr->underline;
+ lf.lfStrikeOut = faPtr->overstrike;
+ lf.lfCharSet = DEFAULT_CHARSET;
+ lf.lfOutPrecision = OUT_TT_PRECIS;
+ lf.lfClipPrecision = CLIP_DEFAULT_PRECIS;
+ lf.lfQuality = DEFAULT_QUALITY;
+ lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
+
+ Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds);
+
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ Tcl_UniChar *src, *dst;
+
+ /*
+ * We can only store up to LF_FACESIZE wide characters
+ */
+ if (Tcl_DStringLength(&ds) >= (LF_FACESIZE * sizeof(WCHAR))) {
+ Tcl_DStringSetLength(&ds, LF_FACESIZE);
+ }
+ src = (Tcl_UniChar *) Tcl_DStringValue(&ds);
+ dst = (Tcl_UniChar *) lf.lfFaceName;
+ while (*src != '\0') {
+ *dst++ = *src++;
+ }
+ *dst = '\0';
+ hFont = CreateFontIndirectW(&lf);
+ } else {
+ /*
+ * We can only store up to LF_FACESIZE characters
+ */
+ if (Tcl_DStringLength(&ds) >= LF_FACESIZE) {
+ Tcl_DStringSetLength(&ds, LF_FACESIZE);
+ }
+ strcpy((char *) lf.lfFaceName, Tcl_DStringValue(&ds));
+ hFont = CreateFontIndirectA((LOGFONTA *) &lf);
+ }
+ Tcl_DStringFree(&ds);
+ return hFont;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FamilyExists, FamilyOrAliasExists, WinFontExistsProc --
+ *
+ * Determines if any physical screen font exists on the system with
+ * the given family name. If the family exists, then it should be
+ * possible to construct some physical screen font with that family
+ * name.
+ *
+ * Results:
+ * The return value is 0 if the specified font family does not exist,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FamilyExists(
+ HDC hdc, /* HDC in which font family will be used. */
+ CONST char *faceName) /* Font family to query. */
+{
+ int result;
+ Tcl_DString faceString;
+
+ /*
+ * Just immediately rule out the following fonts, because they look so
+ * ugly on windows. The caller's fallback mechanism will cause the
+ * corresponding appropriate TrueType fonts to be selected.
+ */
+
+ if (strcasecmp(faceName, "Courier") == 0) {
+ return 0;
+ }
+ if (strcasecmp(faceName, "Times") == 0) {
+ return 0;
+ }
+ if (strcasecmp(faceName, "Helvetica") == 0) {
+ return 0;
+ }
+
+ Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &faceString);
+
+ /*
+ * If the family exists, WinFontExistProc() will be called and
+ * EnumFontFamilies() will return whatever WinFontExistProc() returns.
+ * If the family doesn't exist, EnumFontFamilies() will just return a
+ * non-zero value.
+ */
+
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ result = EnumFontFamiliesW(hdc, (WCHAR *) Tcl_DStringValue(&faceString),
+ (FONTENUMPROCW) WinFontExistProc, 0);
+ } else {
+ result = EnumFontFamiliesA(hdc, (char *) Tcl_DStringValue(&faceString),
+ (FONTENUMPROCA) WinFontExistProc, 0);
+ }
+ Tcl_DStringFree(&faceString);
+ return (result == 0);
+}
+
+static char *
+FamilyOrAliasExists(
+ HDC hdc,
+ CONST char *faceName)
+{
+ char **aliases;
+ int i;
+
+ if (FamilyExists(hdc, faceName) != 0) {
+ return (char *) faceName;
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (FamilyExists(hdc, aliases[i]) != 0) {
+ return aliases[i];
+ }
+ }
+ }
+ return NULL;
+}
+
+static int CALLBACK
+WinFontExistProc(
+ ENUMLOGFONT *lfPtr, /* Logical-font data. */
+ NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */
+ int fontType, /* Type of font (not used). */
+ LPARAM lParam) /* EnumFontData to hold result. */
+{
+ return 0;
+}
+
+/*
+ * The following data structures are used when querying a TrueType font file
+ * to determine which characters the font supports.
+ */
+
+#pragma pack(1) /* Structures are byte aligned in file. */
+
+#define CMAPHEX 0x636d6170 /* Key for character map resource. */
+
+typedef struct CMAPTABLE {
+ USHORT version; /* Table version number (0). */
+ USHORT numTables; /* Number of encoding tables following. */
+} CMAPTABLE;
+
+typedef struct ENCODINGTABLE {
+ USHORT platform; /* Platform for which data is targeted.
+ * 3 means data is for Windows. */
+ USHORT encoding; /* How characters in font are encoded.
+ * 1 means that the following subtable is
+ * keyed based on Unicode. */
+ ULONG offset; /* Byte offset from beginning of CMAPTABLE
+ * to the subtable for this encoding. */
+} ENCODINGTABLE;
+
+typedef struct ANYTABLE {
+ USHORT format; /* Format number. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+} ANYTABLE;
+
+typedef struct BYTETABLE {
+ USHORT format; /* Format number is set to 0. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ BYTE glyphIdArray[256]; /* Array that maps up to 256 single-byte char
+ * codes to glyph indices. */
+} BYTETABLE;
+
+typedef struct SUBHEADER {
+ USHORT firstCode; /* First valid low byte for subHeader. */
+ USHORT entryCount; /* Number valid low bytes for subHeader. */
+ SHORT idDelta; /* Constant adder to get base glyph index. */
+ USHORT idRangeOffset; /* Byte offset from here to appropriate
+ * glyphIndexArray. */
+} SUBHEADER;
+
+typedef struct HIBYTETABLE {
+ USHORT format; /* Format number is set to 2. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ USHORT subHeaderKeys[256]; /* Maps high bytes to subHeaders: value is
+ * subHeader index * 8. */
+#if 0
+ SUBHEADER subHeaders[]; /* Variable-length array of SUBHEADERs. */
+ USHORT glyphIndexArray[]; /* Variable-length array containing subarrays
+ * used for mapping the low byte of 2-byte
+ * characters. */
+#endif
+} HIBYTETABLE;
+
+typedef struct SEGMENTTABLE {
+ USHORT format; /* Format number is set to 4. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ USHORT segCountX2; /* 2 x segCount. */
+ USHORT searchRange; /* 2 x (2**floor(log2(segCount))). */
+ USHORT entrySelector; /* log2(searchRange/2). */
+ USHORT rangeShift; /* 2 x segCount - searchRange. */
+#if 0
+ USHORT endCount[segCount] /* End characterCode for each segment. */
+ USHORT reservedPad; /* Set to 0. */
+ USHORT startCount[segCount];/* Start character code for each segment. */
+ USHORT idDelta[segCount]; /* Delta for all character in segment. */
+ USHORT idRangeOffset[segCount]; /* Offsets into glyphIdArray or 0. */
+ USHORT glyphIdArray[] /* Glyph index array. */
+#endif
+} SEGMENTTABLE;
+
+typedef struct TRIMMEDTABLE {
+ USHORT format; /* Format number is set to 6. */
+ USHORT length; /* The actual length in bytes of this
+ * subtable. */
+ USHORT version; /* Version number (starts at 0). */
+ USHORT firstCode; /* First character code of subrange. */
+ USHORT entryCount; /* Number of character codes in subrange. */
+#if 0
+ USHORT glyphIdArray[]; /* Array of glyph index values for
+ character codes in the range. */
+#endif
+} TRIMMEDTABLE;
+
+typedef union SUBTABLE {
+ ANYTABLE any;
+ BYTETABLE byte;
+ HIBYTETABLE hiByte;
+ SEGMENTTABLE segment;
+ TRIMMEDTABLE trimmed;
+} SUBTABLE;
+
+#pragma pack()
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * LoadFontRanges --
+ *
+ * Given an HFONT, get the information about the characters that
+ * this font can display.
+ *
+ * Results:
+ * If the font has no Unicode character information, the return value
+ * is 0 and *startCountPtr and *endCountPtr are filled with NULL.
+ * Otherwise, *startCountPtr and *endCountPtr are set to pointers to
+ * arrays of TrueType character existence information and the return
+ * value is the length of the arrays (the two arrays are always the
+ * same length as each other).
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+LoadFontRanges(
+ HDC hdc, /* HDC into which font can be selected. */
+ HFONT hFont, /* HFONT to query. */
+ USHORT **startCountPtr, /* Filled with malloced pointer to
+ * character range information. */
+ USHORT **endCountPtr, /* Filled with malloced pointer to
+ * character range information. */
+ int *symbolPtr)
+ {
+ int n, i, swapped, offset, cbData, segCount;
+ DWORD cmapKey;
+ USHORT *startCount, *endCount;
+ CMAPTABLE cmapTable;
+ ENCODINGTABLE encTable;
+ SUBTABLE subTable;
+ char *s;
+
+ segCount = 0;
+ startCount = NULL;
+ endCount = NULL;
+ *symbolPtr = 0;
+
+ hFont = SelectObject(hdc, hFont);
+
+ i = 0;
+ s = (char *) &i;
+ *s = '\1';
+ swapped = 0;
+
+ if (i == 1) {
+ swapped = 1;
+ }
+
+ cmapKey = CMAPHEX;
+ if (swapped) {
+ SwapLong(&cmapKey);
+ }
+
+ n = GetFontData(hdc, cmapKey, 0, &cmapTable, sizeof(cmapTable));
+ if (n != GDI_ERROR) {
+ if (swapped) {
+ SwapShort(&cmapTable.numTables);
+ }
+ for (i = 0; i < cmapTable.numTables; i++) {
+ offset = sizeof(cmapTable) + i * sizeof(encTable);
+ GetFontData(hdc, cmapKey, offset, &encTable, sizeof(encTable));
+ if (swapped) {
+ SwapShort(&encTable.platform);
+ SwapShort(&encTable.encoding);
+ SwapLong(&encTable.offset);
+ }
+ if (encTable.platform != 3) {
+ /*
+ * Not Microsoft encoding.
+ */
+
+ continue;
+ }
+ if (encTable.encoding == 0) {
+ *symbolPtr = 1;
+ } else if (encTable.encoding != 1) {
+ continue;
+ }
+
+ GetFontData(hdc, cmapKey, encTable.offset, &subTable,
+ sizeof(subTable));
+ if (swapped) {
+ SwapShort(&subTable.any.format);
+ }
+ if (subTable.any.format == 4) {
+ if (swapped) {
+ SwapShort(&subTable.segment.segCountX2);
+ }
+ segCount = subTable.segment.segCountX2 / 2;
+ cbData = segCount * sizeof(USHORT);
+
+ startCount = (USHORT *) ckalloc(cbData);
+ endCount = (USHORT *) ckalloc(cbData);
+
+ offset = encTable.offset + sizeof(subTable.segment);
+ GetFontData(hdc, cmapKey, offset, endCount, cbData);
+ offset += cbData + sizeof(USHORT);
+ GetFontData(hdc, cmapKey, offset, startCount, cbData);
+ if (swapped) {
+ for (i = 0; i < segCount; i++) {
+ SwapShort(&endCount[i]);
+ SwapShort(&startCount[i]);
+ }
+ }
+ if (*symbolPtr != 0) {
+ /*
+ * Empirically determined: When a symbol font is
+ * loaded, the character existence metrics obtained
+ * from the system are mildly wrong. If the real range
+ * of the symbol font is from 0020 to 00FE, then the
+ * metrics are reported as F020 to F0FE. When we load
+ * a symbol font, we must fix the character existence
+ * metrics.
+ *
+ * Symbol fonts should only use the symbol encoding
+ * for 8-bit characters [note Bug: 2406]
+ */
+
+ for (i = 0; i < segCount; i++) {
+ if (((startCount[i] & 0xff00) == 0xf000)
+ && ((endCount[i] & 0xff00) == 0xf000)) {
+ startCount[i] &= 0xff;
+ endCount[i] &= 0xff;
+ }
+ }
+ }
+ }
+ }
+ } else if (GetTextCharset(hdc) == ANSI_CHARSET) {
+ /*
+ * Bitmap font. We should also support ranges for the other
+ * *_CHARSET values.
+ */
+ segCount = 1;
+ cbData = segCount * sizeof(USHORT);
+ startCount = (USHORT *) ckalloc(cbData);
+ endCount = (USHORT *) ckalloc(cbData);
+ startCount[0] = 0x0000;
+ endCount[0] = 0x00ff;
+ }
+ SelectObject(hdc, hFont);
+
+ *startCountPtr = startCount;
+ *endCountPtr = endCount;
+ return segCount;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * SwapShort, SwapLong --
+ *
+ * Helper functions to convert the data loaded from TrueType font
+ * files to Intel byte ordering.
+ *
+ * Results:
+ * Bytes of input value are swapped and stored back in argument.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+SwapShort(PUSHORT p)
+{
+ *p = (SHORT)(HIBYTE(*p) + (LOBYTE(*p) << 8));
+}
+
+static void
+SwapLong(PULONG p)
+{
+ ULONG temp;
+
+ temp = (LONG) ((BYTE) *p);
+ temp <<= 8;
+ *p >>=8;
+
+ temp += (LONG) ((BYTE) *p);
+ temp <<= 8;
+ *p >>=8;
+
+ temp += (LONG) ((BYTE) *p);
+ temp <<= 8;
+ *p >>=8;
+
+ temp += (LONG) ((BYTE) *p);
+ *p = temp;
+}
diff --git a/tcl/win/tkWinImage.c b/tcl/win/tkWinImage.c
new file mode 100644
index 00000000000..00a5439bf35
--- /dev/null
+++ b/tcl/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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static 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 = LSBFirst;
+ 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/tcl/win/tkWinInit.c b/tcl/win/tkWinInit.c
new file mode 100644
index 00000000000..471590b15f8
--- /dev/null
+++ b/tcl/win/tkWinInit.c
@@ -0,0 +1,138 @@
+/*
+ * 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 the interp's result.
+ *
+ * Side effects:
+ * Sets "tk_library" Tcl variable, runs "tk.tcl" script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(interp)
+ Tcl_Interp *interp;
+{
+ /*
+ * This is necessary for static initialization, and is ok
+ * otherwise because TkWinXInit flips a static bit to do
+ * its work just once.
+ */
+ TkWinXInit(GetModuleHandle(NULL));
+ 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, namelength;
+ CONST char **argv = NULL, *name, *p;
+
+ name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
+ namelength = -1;
+ if (name != NULL) {
+ Tcl_SplitPath(name, &argc, &argv);
+ if (argc > 0) {
+ name = argv[argc-1];
+ p = strrchr(name, '.');
+ if (p != NULL) {
+ namelength = p - name;
+ }
+ } else {
+ name = NULL;
+ }
+ }
+ if ((name == NULL) || (*name == 0)) {
+ name = "tk";
+ namelength = -1;
+ }
+ Tcl_DStringAppend(namePtr, name, namelength);
+ 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)
+ CONST char *msg; /* Message to be displayed. */
+ CONST char *title; /* Title of warning. */
+{
+ Tcl_DString msgString, titleString;
+ Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
+
+ Tcl_UtfToExternalDString(unicodeEncoding, msg, -1, &msgString);
+ Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
+ MessageBoxW(NULL, (WCHAR *) Tcl_DStringValue(&msgString),
+ (WCHAR *) Tcl_DStringValue(&titleString),
+ MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
+ | MB_SETFOREGROUND | MB_TOPMOST);
+ Tcl_DStringFree(&msgString);
+ Tcl_DStringFree(&titleString);
+}
diff --git a/tcl/win/tkWinInt.h b/tcl/win/tkWinInt.h
new file mode 100644
index 00000000000..bf58e18d424
--- /dev/null
+++ b/tcl/win/tkWinInt.h
@@ -0,0 +1,205 @@
+/*
+ * tkWinInt.h --
+ *
+ * This file contains declarations that are shared among the
+ * Windows-specific parts of Tk, but aren't used by the rest of
+ * Tk.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 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 _TKWININT
+#define _TKWININT
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Include platform specific public interfaces.
+ */
+
+#ifndef _TKWIN
+#include "tkWin.h"
+#endif
+
+#ifndef _TKPORT
+#include "tkPort.h"
+#endif
+
+
+/*
+ * Define constants missing from older Win32 SDK header files.
+ */
+
+#ifndef WS_EX_TOOLWINDOW
+#define WS_EX_TOOLWINDOW 0x00000080L
+#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;
+ int bkmode;
+} 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 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.
+ */
+
+#include "tkIntPlatDecls.h"
+
+/*
+ * We need to specially add the TkWinChildProc because of the special
+ * prototype it has (doesn't fit into stubs schema)
+ */
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+EXTERN LRESULT CALLBACK TkWinChildProc _ANSI_ARGS_((HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam));
+
+/*
+ * Special proc needed as tsd accessor function between
+ * tkWinX.c:GenerateXEvent and tkWinClipboard.c:UpdateClipboard
+ */
+EXTERN void TkWinUpdatingClipboard(int mode);
+
+/*
+ * The following structure keeps track of whether we are using the
+ * multi-byte or the wide-character interfaces to the operating system.
+ * System calls should be made through the following function table.
+ *
+ * While some system calls need to use this A/W jump-table, it is not
+ * necessary for all calls to do it, which is why you won't see this
+ * used throughout the Tk code, but only in key areas. -- hobbs
+ */
+
+typedef struct TkWinProcs {
+ int useWide;
+ LRESULT (WINAPI *callWindowProc)(WNDPROC lpPrevWndFunc, HWND hWnd,
+ UINT Msg, WPARAM wParam, LPARAM lParam);
+ LRESULT (WINAPI *defWindowProc)(HWND hWnd, UINT Msg, WPARAM wParam,
+ LPARAM lParam);
+ ATOM (WINAPI *registerClass)(CONST WNDCLASS *lpWndClass);
+ BOOL (WINAPI *setWindowText)(HWND hWnd, LPCTSTR lpString);
+ HWND (WINAPI *createWindowEx)(DWORD dwExStyle, LPCTSTR lpClassName,
+ LPCTSTR lpWindowName, DWORD dwStyle, int x, int y,
+ int nWidth, int nHeight, HWND hWndParent, HMENU hMenu,
+ HINSTANCE hInstance, LPVOID lpParam);
+} TkWinProcs;
+
+EXTERN TkWinProcs *tkWinProcs;
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+/*
+ * The following allows us to cache these encoding for multiple functions.
+ */
+
+
+extern Tcl_Encoding TkWinGetKeyInputEncoding _ANSI_ARGS_((void));
+extern Tcl_Encoding TkWinGetUnicodeEncoding _ANSI_ARGS_((void));
+
+#endif /* _TKWININT */
+
diff --git a/tcl/win/tkWinKey.c b/tcl/win/tkWinKey.c
new file mode 100644
index 00000000000..33d84ab1935
--- /dev/null
+++ b/tcl/win/tkWinKey.c
@@ -0,0 +1,742 @@
+/*
+ * 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"
+/*
+ * The keymap table holds mappings of Windows keycodes to X keysyms.
+ * If Windows ever comes along and changes the value of their keycodes,
+ * this will break all kinds of things. However, this table lookup is much
+ * faster than the alternative, in which we walked a list of keycodes looking
+ * for a match. Since this lookup is performed for every Windows keypress
+ * event, it seems like a worthwhile improvement to use the table.
+ */
+#define MAX_KEYCODE 145 /* VK_SCROLL is the last entry in our table below */
+static KeySym keymap[] = {
+ NoSymbol, NoSymbol, NoSymbol, XK_Cancel, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, XK_BackSpace, XK_Tab,
+ NoSymbol, NoSymbol, XK_Clear, XK_Return, NoSymbol,
+ NoSymbol, XK_Shift_L, XK_Control_L, XK_Alt_L, XK_Pause,
+ XK_Caps_Lock, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, XK_Escape, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, XK_space, XK_Prior, XK_Next,
+ XK_End, XK_Home, XK_Left, XK_Up, XK_Right,
+ XK_Down, XK_Select, XK_Print, XK_Execute, NoSymbol,
+ XK_Insert, XK_Delete, XK_Help, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, XK_Win_L, XK_Win_R, XK_App, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, XK_F1, XK_F2, XK_F3,
+ XK_F4, XK_F5, XK_F6, XK_F7, XK_F8,
+ XK_F9, XK_F10, XK_F11, XK_F12, XK_F13,
+ XK_F14, XK_F15, XK_F16, XK_F17, XK_F18,
+ XK_F19, XK_F20, XK_F21, XK_F22, XK_F23,
+ XK_F24, NoSymbol, NoSymbol, NoSymbol, NoSymbol,
+ NoSymbol, NoSymbol, NoSymbol, NoSymbol, XK_Num_Lock,
+ XK_Scroll_Lock
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static KeySym KeycodeToKeysym _ANSI_ARGS_((unsigned int keycode,
+ int state, int noascii));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetString --
+ *
+ * Retrieve the UTF string equivalent for the given keyboard event.
+ *
+ * Results:
+ * Returns the UTF string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkpGetString(winPtr, eventPtr, dsPtr)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ XEvent *eventPtr; /* X keyboard event. */
+ Tcl_DString *dsPtr; /* Uninitialized or empty string to hold
+ * result. */
+{
+ KeySym keysym;
+ XKeyEvent* keyEv = &eventPtr->xkey;
+
+ Tcl_DStringInit(dsPtr);
+ if (eventPtr->xkey.send_event == -1) {
+ if (eventPtr->xkey.nbytes > 0) {
+ Tcl_ExternalToUtfDString(TkWinGetKeyInputEncoding(),
+ eventPtr->xkey.trans_chars, eventPtr->xkey.nbytes, dsPtr);
+ }
+ } else if (eventPtr->xkey.send_event == -2) {
+ /*
+ * Special case for win2000 multi-lingal IME input.
+ * xkey.trans_chars[] already contains a UNICODE char.
+ */
+
+ int unichar;
+ char buf[TCL_UTF_MAX];
+ int len;
+
+ unichar = (eventPtr->xkey.trans_chars[1] & 0xff);
+ unichar <<= 8;
+ unichar |= (eventPtr->xkey.trans_chars[0] & 0xff);
+
+ len = Tcl_UniCharToUtf((Tcl_UniChar) unichar, buf);
+
+ Tcl_DStringAppend(dsPtr, buf, len);
+ } else {
+ /*
+ * This is an event generated from generic code. It has no
+ * nchars or trans_chars members.
+ */
+
+ keysym = KeycodeToKeysym(eventPtr->xkey.keycode,
+ eventPtr->xkey.state, 0);
+ if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
+ || (keysym == XK_Return)
+ || (keysym == XK_Tab)) {
+ char buf[TCL_UTF_MAX];
+ int len = Tcl_UniCharToUtf((Tcl_UniChar) (keysym & 255), buf);
+ Tcl_DStringAppend(dsPtr, buf, len);
+ }
+ }
+ return Tcl_DStringValue(dsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ int state = 0;
+
+ if (index & 0x01) {
+ state |= ShiftMask;
+ }
+ return KeycodeToKeysym(keycode, state, 0);
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * KeycodeToKeysym --
+ *
+ * Translate from a system-dependent keycode to a
+ * system-independent keysym.
+ *
+ * Results:
+ * Returns the translated keysym, or NoSymbol on failure.
+ *
+ * Side effects:
+ * It may affect the internal state of the keyboard, such as
+ * remembered dead key or lock indicator lamps.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static KeySym
+KeycodeToKeysym(keycode, state, noascii)
+ unsigned int keycode;
+ int state;
+ int noascii;
+{
+ BYTE keys[256];
+ int result, deadkey, shift;
+ char buf[4];
+ unsigned int scancode = MapVirtualKey(keycode, 0);
+
+ /*
+ * Do not run keycodes of lock keys through ToAscii().
+ * One of ToAscii()'s side effects is to handle the lights
+ * on the keyboard, and we don't want to mess that up.
+ */
+
+ if (noascii || keycode == VK_CAPITAL || keycode == VK_SCROLL ||
+ keycode == VK_NUMLOCK)
+ goto skipToAscii;
+
+ /*
+ * Use MapVirtualKey() to detect some dead keys.
+ */
+
+ if (MapVirtualKey(keycode, 2) > 0x7fffUL)
+ return XK_Multi_key;
+
+ /*
+ * Set up a keyboard with correct modifiers
+ */
+
+ memset(keys, 0, 256);
+ if (state & ShiftMask)
+ keys[VK_SHIFT] = 0x80;
+ if (state & ControlMask)
+ keys[VK_CONTROL] = 0x80;
+ if (state & Mod2Mask)
+ keys[VK_MENU] = 0x80;
+
+ /*
+ * Make sure all lock button info is correct so we don't mess up the
+ * lights
+ */
+
+ if (state & LockMask)
+ keys[VK_CAPITAL] = 1;
+ if (state & Mod3Mask)
+ keys[VK_SCROLL] = 1;
+ if (state & Mod1Mask)
+ keys[VK_NUMLOCK] = 1;
+
+ result = ToAscii(keycode, scancode, keys, (LPWORD) buf, 0);
+
+ if (result < 0) {
+ /*
+ * Win95/98:
+ * This was a dead char, which is now remembered by the keyboard.
+ * Call ToAscii() again to forget it.
+ * WinNT:
+ * This was a dead char, overwriting any previously remembered
+ * key. Calling ToAscii() again does not affect anything.
+ */
+
+ ToAscii(keycode, scancode, keys, (LPWORD) buf, 0);
+ return XK_Multi_key;
+ }
+ if (result == 2) {
+ /*
+ * This was a dead char, and there were one previously remembered
+ * by the keyboard.
+ * Call ToAscii() again with proper parameters to restore it.
+ */
+
+ /*
+ * Get information about the old char
+ */
+
+ deadkey = VkKeyScan(buf[0]);
+ shift = deadkey >> 8;
+ deadkey &= 255;
+ scancode = MapVirtualKey(deadkey, 0);
+
+ /*
+ * Set up a keyboard with proper modifier keys
+ */
+
+ memset(keys, 0, 256);
+ if (shift & 1)
+ keys[VK_SHIFT] = 0x80;
+ if (shift & 2)
+ keys[VK_CONTROL] = 0x80;
+ if (shift & 4)
+ keys[VK_MENU] = 0x80;
+ ToAscii(deadkey, scancode, keys, (LPWORD) buf, 0);
+ return XK_Multi_key;
+ }
+
+ /*
+ * Keycode mapped to a valid Latin-1 character. Since the keysyms
+ * for alphanumeric characters map onto Latin-1, we just return it.
+ *
+ * We treat 0x7F as a special case mostly for backwards compatibility.
+ * In versions of Tk<=8.2, Control-Backspace returned "XK_BackSpace"
+ * as the X Keysym. This was due to the fact that we did not
+ * initialize the keys array properly when we passed it to ToAscii, above.
+ * We had previously not been setting the state bit for the Control key.
+ * When we fixed that, we found that Control-Backspace on Windows is
+ * interpreted as ASCII-127 (0x7F), which corresponds to the Delete key.
+ *
+ * Upon discovering this, we realized we had two choices: return XK_Delete
+ * or return XK_BackSpace. If we returned XK_Delete, that could be
+ * considered "more correct" (although the correctness would be dependant
+ * on whether you believe that ToAscii is doing the right thing in that
+ * case); however, this would break backwards compatibility, and worse,
+ * it would limit application programmers -- they would effectively be
+ * unable to bind to <Control-Backspace> on Windows. We therefore chose
+ * instead to return XK_BackSpace (handled here by letting the code
+ * "fall-through" to the return statement below, which works because the
+ * keycode for this event is VK_BACKSPACE, and the keymap table maps that
+ * keycode to XK_BackSpace).
+ */
+
+ if (result == 1 && UCHAR(buf[0]) >= 0x20 && UCHAR(buf[0]) != 0x7F) {
+ return (KeySym) UCHAR(buf[0]);
+ }
+
+ /*
+ * Keycode is a non-alphanumeric key, so we have to do the lookup.
+ */
+
+ skipToAscii:
+ if (keycode < 0 || keycode > MAX_KEYCODE) {
+ return NoSymbol;
+ }
+ switch (keycode) {
+ /*
+ * Windows only gives us an undifferentiated VK_CONTROL
+ * code (for example) when either Control key is pressed.
+ * To distinguish between left and right, we have to query the
+ * state of one of the two to determine which was actually
+ * pressed. So if the keycode indicates Control, Shift, or Menu
+ * (the key that everybody else calls Alt), do this extra test.
+ * If the right-side key was pressed, return the appropriate
+ * keycode. Otherwise, we fall through and rely on the
+ * keymap table to hold the correct keysym value.
+ */
+ case VK_CONTROL: {
+ if (GetKeyState(VK_RCONTROL) & 0x80) {
+ return XK_Control_R;
+ }
+ break;
+ }
+ case VK_SHIFT: {
+ if (GetKeyState(VK_RSHIFT) & 0x80) {
+ return XK_Shift_R;
+ }
+ break;
+ }
+ case VK_MENU: {
+ if (GetKeyState(VK_RMENU) & 0x80) {
+ return XK_Alt_R;
+ }
+ break;
+ }
+ }
+ return keymap[keycode];
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetKeySym --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkpGetKeySym(dispPtr, eventPtr)
+ TkDisplay *dispPtr; /* Display in which to map keycode. */
+ XEvent *eventPtr; /* Description of X event. */
+{
+ KeySym sym;
+ int state = eventPtr->xkey.state;
+
+ /*
+ * Refresh the mapping information if it's stale
+ */
+
+ if (dispPtr->bindInfoStale) {
+ TkpInitKeymapInfo(dispPtr);
+ }
+
+ sym = KeycodeToKeysym(eventPtr->xkey.keycode, state, 0);
+
+ /*
+ * Special handling: if this is a ctrl-alt or shifted key, and there
+ * is no keysym defined, try without the modifiers.
+ */
+
+ if ((sym == NoSymbol) && ((state & ControlMask) || (state & Mod2Mask))) {
+ state &= ~(ControlMask | Mod2Mask);
+ sym = KeycodeToKeysym(eventPtr->xkey.keycode, state, 0);
+ }
+ if ((sym == NoSymbol) && (state & ShiftMask)) {
+ state &= ~ShiftMask;
+ sym = KeycodeToKeysym(eventPtr->xkey.keycode, state, 0);
+ }
+ return sym;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitKeymapInfo --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitKeymapInfo(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 = KeycodeToKeysym(*codePtr, 0, 1);
+ 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 = KeycodeToKeysym(*codePtr, 0, 1);
+ 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);
+}
+
+/*
+ * 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.
+ */
+
+void
+TkpSetKeycodeAndState(tkwin, keySym, eventPtr)
+ Tk_Window tkwin;
+ KeySym keySym;
+ XEvent *eventPtr;
+{
+ int i;
+ SHORT result;
+ int shift;
+
+ eventPtr->xkey.keycode = 0;
+ if (keySym == NoSymbol) {
+ return;
+ }
+
+ /*
+ * We check our private map first for a virtual keycode,
+ * as VkKeyScan will return values that don't map to X
+ * for the "extended" Syms. This may be due to just casting
+ * problems below, but this works.
+ */
+ for (i = 0; i <= MAX_KEYCODE; i++) {
+ if (keymap[i] == keySym) {
+ eventPtr->xkey.keycode = i;
+ return;
+ }
+ }
+ if (keySym >= 0x20) {
+ result = VkKeyScan((char) keySym);
+ if (result != -1) {
+ shift = result >> 8;
+ if (shift & 1)
+ eventPtr->xkey.state |= ShiftMask;
+ if (shift & 2)
+ eventPtr->xkey.state |= ControlMask;
+ if (shift & 4)
+ eventPtr->xkey.state |= Mod2Mask;
+ eventPtr->xkey.keycode = (KeyCode) (result & 0xff);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ int i;
+ SHORT result;
+
+ /*
+ * We check our private map first for a virtual keycode,
+ * as VkKeyScan will return values that don't map to X
+ * for the "extended" Syms. This may be due to just casting
+ * problems below, but this works.
+ */
+ if (keysym == NoSymbol) {
+ return 0;
+ }
+ for (i = 0; i <= MAX_KEYCODE; i++) {
+ if (keymap[i] == keysym) {
+ return ((KeyCode) i);
+ }
+ }
+ if (keysym >= 0x20) {
+ result = VkKeyScan((char) keysym);
+ if (result != -1) {
+ return (KeyCode) (result & 0xff);
+ }
+ }
+
+ 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/tcl/win/tkWinMenu.c b/tcl/win/tkWinMenu.c
new file mode 100644
index 00000000000..cd58053eac4
--- /dev/null
+++ b/tcl/win/tkWinMenu.c
@@ -0,0 +1,2937 @@
+/*
+ * tkWinMenu.c --
+ *
+ * This module implements the Windows platform-specific features of menus.
+ *
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define OEMRESOURCE
+#include "tkWinInt.h"
+#include "tkMenu.h"
+
+#include <string.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. */
+
+typedef struct ThreadSpecificData {
+ Tcl_HashTable commandTable;
+ /* A map of command ids to menu entries */
+ int inPostMenu; /* We cannot be re-entrant like X Windows. */
+ WORD lastCommandID; /* The last command ID we allocated. */
+ HWND menuHWND; /* A window to service popup-menu messages
+ * in. */
+ int oldServiceMode; /* Used while processing a menu; we need
+ * to set the event mode specially when we
+ * enter the menu processing modal loop
+ * and reset it when menus go away. */
+ TkMenu *modalMenuPtr; /* The menu we are processing inside the modal
+ * loop. We need this to reset all of the
+ * active items when menus go away since
+ * Windows does not see fit to give this
+ * to us when it sends its WM_MENUSELECT. */
+ Tcl_HashTable winMenuTable;
+ /* Need this to map HMENUs back to menuPtrs */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following are default menu value strings.
+ */
+
+static int defaultBorderWidth; /* The windows default border width. */
+static Tcl_DString menuFontDString;
+ /* A buffer to store the default menu font
+ * string. */
+/*
+ * 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 TCHAR * GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr));
+static void GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *widthPtr,
+ int *heightPtr));
+static void GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+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 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 void SetDefaults _ANSI_ARGS_((int firstTime));
+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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ WORD curID = tsdPtr->lastCommandID + 1;
+
+ /*
+ * The following code relies on WORD wrapping when the highest value is
+ * incremented.
+ */
+
+ while (curID != tsdPtr->lastCommandID) {
+ commandEntryPtr = Tcl_CreateHashEntry(&tsdPtr->commandTable,
+ (char *) curID, &newEntry);
+ if (newEntry == 1) {
+ found = 1;
+ returnID = curID;
+ break;
+ }
+ curID++;
+ }
+
+ if (found) {
+ Tcl_SetHashValue(commandEntryPtr, (char *) mePtr);
+ *menuIDPtr = (int) returnID;
+ tsdPtr->lastCommandID = returnID;
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ winMenuHdl = CreatePopupMenu();
+
+ if (winMenuHdl == NULL) {
+ Tcl_AppendResult(menuPtr->interp, "No more menus can be allocated.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * We hash all of the HMENU's so that we can get their menu ptrs
+ * back when dispatch messages.
+ */
+
+ hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl,
+ &newEntry);
+ Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
+
+ menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ char *searchName;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
+ Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
+ }
+
+ if (winMenuHdl == NULL) {
+ return;
+ }
+
+ if (menuPtr->menuFlags & MENU_SYSTEM_MENU) {
+ TkMenuEntry *searchEntryPtr;
+ Tcl_HashTable *tablePtr = TkGetMenuHashTable(menuPtr->interp);
+ char *menuName = Tcl_GetHashKey(tablePtr,
+ menuPtr->menuRefPtr->hashEntryPtr);
+
+ /*
+ * Search for the menu in the menubar, if it is present, get the
+ * wrapper window associated with the toplevel and reset its
+ * system menu to the default menu.
+ */
+
+ for (searchEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ searchEntryPtr != NULL;
+ searchEntryPtr = searchEntryPtr->nextCascadePtr) {
+ searchName = Tcl_GetStringFromObj(searchEntryPtr->namePtr, NULL);
+ if (strcmp(searchName, menuName) == 0) {
+ Tk_Window parentTopLevelPtr = searchEntryPtr
+ ->menuPtr->parentTopLevelPtr;
+
+ if (parentTopLevelPtr != NULL) {
+ GetSystemMenu(TkWinGetWrapperWindow(parentTopLevelPtr),
+ TRUE);
+ }
+ break;
+ }
+ }
+ } else {
+ Tcl_HashEntry *hashEntryPtr;
+
+ /*
+ * Remove the menu from the menu hash table, then destroy the handle.
+ */
+
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) winMenuHdl);
+ if (hashEntryPtr != NULL) {
+ Tcl_DeleteHashEntry(hashEntryPtr);
+ }
+ DestroyMenu(winMenuHdl);
+ }
+ menuPtr->platformData = NULL;
+
+ if (menuPtr == tsdPtr->modalMenuPtr) {
+ tsdPtr->modalMenuPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuEntry --
+ *
+ * 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->imagePtr != NULL) {
+ itemText = ckalloc(sizeof("(Image)"));
+ strcpy(itemText, "(Image)");
+ } else if (mePtr->bitmapPtr != NULL) {
+ itemText = ckalloc(sizeof("(Pixmap)"));
+ strcpy(itemText, "(Pixmap)");
+ } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) {
+ itemText = ckalloc(sizeof("( )"));
+ strcpy(itemText, "( )");
+ } else {
+ int i;
+ char *label = (mePtr->labelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ char *accel = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ CONST char *p, *next;
+ Tcl_DString itemString;
+
+ /*
+ * We have to construct the string with an ampersand
+ * preceeding the underline character, and a tab seperating
+ * the text and the accel text. We have to be careful with
+ * ampersands in the string.
+ */
+
+ Tcl_DStringInit(&itemString);
+
+ for (p = label, i = 0; *p != '\0'; i++, p = next) {
+ if (i == mePtr->underline) {
+ Tcl_DStringAppend(&itemString, "&", 1);
+ }
+ if (*p == '&') {
+ Tcl_DStringAppend(&itemString, "&", 1);
+ }
+ next = Tcl_UtfNext(p);
+ Tcl_DStringAppend(&itemString, p, (int) (next - p));
+ }
+ if (mePtr->accelLength > 0) {
+ Tcl_DStringAppend(&itemString, "\t", 1);
+ for (p = accel, i = 0; *p != '\0'; i++, p = next) {
+ if (*p == '&') {
+ Tcl_DStringAppend(&itemString, "&", 1);
+ }
+ next = Tcl_UtfNext(p);
+ Tcl_DStringAppend(&itemString, p, (int) (next - p));
+ }
+ }
+
+ itemText = ckalloc(Tcl_DStringLength(&itemString) + 1);
+ strcpy(itemText, Tcl_DStringValue(&itemString));
+ Tcl_DStringFree(&itemString);
+ }
+ 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;
+ TCHAR *itemText = NULL;
+ const TCHAR *lpNewItem;
+ UINT flags;
+ UINT itemID;
+ int i, count, systemMenu = 0, base;
+ int width, height;
+ Tcl_DString translatedText;
+
+ if (NULL == winMenuHdl) {
+ return;
+ }
+
+ /*
+ * Reconstruct the entire menu. Takes care of nasty system menu and index
+ * problem.
+ *
+ */
+
+ if ((menuPtr->menuType == MENUBAR)
+ && (menuPtr->parentTopLevelPtr != NULL)) {
+ width = Tk_Width(menuPtr->parentTopLevelPtr);
+ height = Tk_Height(menuPtr->parentTopLevelPtr);
+ }
+
+ base = (menuPtr->menuFlags & MENU_SYSTEM_MENU) ? 7 : 0;
+ count = GetMenuItemCount(winMenuHdl);
+ for (i = base; i < count; i++) {
+ RemoveMenu(winMenuHdl, base, MF_BYPOSITION);
+ }
+
+ count = menuPtr->numEntries;
+ for (i = 0; i < count; i++) {
+ mePtr = menuPtr->entries[i];
+ lpNewItem = NULL;
+ flags = MF_BYPOSITION;
+ itemID = 0;
+ Tcl_DStringInit(&translatedText);
+
+ if ((menuPtr->menuType == MENUBAR) && (mePtr->type == TEAROFF_ENTRY)) {
+ continue;
+ }
+
+ itemText = GetEntryText(mePtr);
+ if ((menuPtr->menuType == MENUBAR)
+ || (menuPtr->menuFlags & MENU_SYSTEM_MENU)) {
+ Tcl_UtfToExternalDString(NULL, itemText, -1, &translatedText);
+ lpNewItem = Tcl_DStringValue(&translatedText);
+ } else {
+ lpNewItem = (LPCTSTR) mePtr;
+ flags |= MF_OWNERDRAW;
+ }
+
+ /*
+ * Set enabling and disabling correctly.
+ */
+
+ if (mePtr->state == ENTRY_DISABLED) {
+ flags |= MF_DISABLED | MF_GRAYED;
+ }
+
+ /*
+ * 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;
+ }
+
+ /*
+ * Set the SEPARATOR bit for separator entries. This bit is not
+ * used by our internal drawing functions, but it is used by the
+ * system when drawing the system menu (we do not draw the system menu
+ * ourselves). If this bit is not set, separator entries on the system
+ * menu will not be drawn correctly.
+ */
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ flags |= MF_SEPARATOR;
+ }
+
+ if (mePtr->columnBreak) {
+ flags |= MF_MENUBREAK;
+ }
+
+ itemID = (int) mePtr->platformEntryData;
+ if ((mePtr->type == CASCADE_ENTRY)
+ && (mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ HMENU childMenuHdl = (HMENU) mePtr->childMenuRefPtr->menuPtr
+ ->platformData;
+ if (childMenuHdl != NULL) {
+ itemID = (UINT) childMenuHdl;
+ flags |= MF_POPUP;
+ }
+ if ((menuPtr->menuType == MENUBAR)
+ && !(mePtr->childMenuRefPtr->menuPtr->menuFlags
+ & MENU_SYSTEM_MENU)) {
+ Tcl_DString ds;
+ TkMenuReferences *menuRefPtr;
+ TkMenu *systemMenuPtr = mePtr->childMenuRefPtr->menuPtr;
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds,
+ Tk_PathName(menuPtr->masterMenuPtr->tkwin), -1);
+ Tcl_DStringAppend(&ds, ".system", 7);
+
+ menuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ Tcl_DStringValue(&ds));
+
+ Tcl_DStringFree(&ds);
+
+ if ((menuRefPtr != NULL)
+ && (menuRefPtr->menuPtr != NULL)
+ && (menuPtr->parentTopLevelPtr != NULL)
+ && (systemMenuPtr->masterMenuPtr
+ == menuRefPtr->menuPtr)) {
+ HMENU systemMenuHdl =
+ (HMENU) systemMenuPtr->platformData;
+ HWND wrapper = TkWinGetWrapperWindow(menuPtr
+ ->parentTopLevelPtr);
+ if (wrapper != NULL) {
+ DestroyMenu(systemMenuHdl);
+ systemMenuHdl = GetSystemMenu(wrapper, FALSE);
+ systemMenuPtr->menuFlags |= MENU_SYSTEM_MENU;
+ systemMenuPtr->platformData =
+ (TkMenuPlatformData) systemMenuHdl;
+ if (!(systemMenuPtr->menuFlags
+ & MENU_RECONFIGURE_PENDING)) {
+ systemMenuPtr->menuFlags
+ |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureWindowsMenu,
+ (ClientData) systemMenuPtr);
+ }
+ }
+ }
+ }
+ if (mePtr->childMenuRefPtr->menuPtr->menuFlags
+ & MENU_SYSTEM_MENU) {
+ systemMenu++;
+ }
+ }
+ if (!systemMenu) {
+ InsertMenu(winMenuHdl, 0xFFFFFFFF, flags, itemID, lpNewItem);
+ }
+ Tcl_DStringFree(&translatedText);
+ if (itemText != NULL) {
+ ckfree(itemText);
+ itemText = NULL;
+ }
+ }
+
+
+ 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();
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->inPostMenu++;
+
+ if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
+ Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
+ ReconfigureWindowsMenu((ClientData) menuPtr);
+ }
+
+ result = TkPreprocessMenu(menuPtr);
+ if (result != TCL_OK) {
+ tsdPtr->inPostMenu--;
+ return result;
+ }
+
+ /*
+ * The post commands could have deleted the menu, which means
+ * we are dead and should go away.
+ */
+
+ if (menuPtr->tkwin == NULL) {
+ tsdPtr->inPostMenu--;
+ return TCL_OK;
+ }
+
+ if (NULL == parentWindow) {
+ noGoawayRect.top = y - 50;
+ noGoawayRect.bottom = y + 50;
+ noGoawayRect.left = x - 50;
+ 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,
+ tsdPtr->menuHWND, &noGoawayRect);
+ Tcl_SetServiceMode(oldServiceMode);
+
+ GetCursorPos(&point);
+ Tk_PointerEvent(NULL, point.x, point.y);
+
+ if (tsdPtr->inPostMenu) {
+ tsdPtr->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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ switch (*pMessage) {
+ case WM_INITMENU:
+ TkMenuInit();
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) *pwParam);
+ if (hashEntryPtr != NULL) {
+ tsdPtr->oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ tsdPtr->modalMenuPtr = menuPtr;
+ if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
+ Tcl_CancelIdleCall(ReconfigureWindowsMenu,
+ (ClientData) menuPtr);
+ ReconfigureWindowsMenu((ClientData) menuPtr);
+ }
+ RecursivelyClearActiveMenu(menuPtr);
+ if (!tsdPtr->inPostMenu) {
+ Tcl_Interp *interp;
+ int code;
+
+ interp = menuPtr->interp;
+ Tcl_Preserve((ClientData)interp);
+ code = TkPreprocessMenu(menuPtr);
+ if ((code != TCL_OK) && (code != TCL_CONTINUE)
+ && (code != TCL_BREAK)) {
+ Tcl_AddErrorInfo(interp, "\n (menu preprocess)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData)interp);
+ }
+ TkActivateMenuEntry(menuPtr, -1);
+ *plResult = 0;
+ returnResult = 1;
+ } else {
+ tsdPtr->modalMenuPtr = NULL;
+ }
+ break;
+
+ case WM_SYSCOMMAND:
+ case WM_COMMAND: {
+ TkMenuInit();
+ if (HIWORD(*pwParam) != 0) {
+ break;
+ }
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
+ (char *)LOWORD(*pwParam));
+ if (hashEntryPtr == NULL) {
+ break;
+ }
+ mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr);
+ if (mePtr != NULL) {
+ TkMenuReferences *menuRefPtr;
+ TkMenuEntry *parentEntryPtr;
+ Tcl_Interp *interp;
+ int code;
+
+ /*
+ * We have to set the parent of this menu to be active
+ * if this is a submenu so that tearoffs will get the
+ * correct title.
+ */
+
+ menuPtr = mePtr->menuPtr;
+ menuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ Tk_PathName(menuPtr->tkwin));
+ if ((menuRefPtr != NULL)
+ && (menuRefPtr->parentEntryPtr != NULL)) {
+ char *name;
+
+ for (parentEntryPtr = menuRefPtr->parentEntryPtr;
+ ;
+ parentEntryPtr =
+ parentEntryPtr->nextCascadePtr) {
+ name = Tcl_GetStringFromObj(
+ parentEntryPtr->namePtr, NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin))
+ == 0) {
+ break;
+ }
+ }
+ if (parentEntryPtr->menuPtr->entries[parentEntryPtr->index]
+ ->state != ENTRY_DISABLED) {
+ TkActivateMenuEntry(parentEntryPtr->menuPtr,
+ parentEntryPtr->index);
+ }
+ }
+
+ interp = menuPtr->interp;
+ Tcl_Preserve((ClientData)interp);
+ code = TkInvokeMenu(interp, menuPtr, mePtr->index);
+ if (code != TCL_OK && code != TCL_CONTINUE
+ && code != TCL_BREAK) {
+ Tcl_AddErrorInfo(interp, "\n (menu invoke)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData)interp);
+ }
+ *plResult = 0;
+ returnResult = 1;
+ break;
+ }
+
+
+ case WM_MENUCHAR: {
+ unsigned char menuChar = (unsigned char) LOWORD(*pwParam);
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) *plParam);
+ if (hashEntryPtr != NULL) {
+ int i;
+
+ *plResult = 0;
+ menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ int underline;
+ char *label;
+
+ underline = menuPtr->entries[i]->underline;
+ if (menuPtr->entries[i]->labelPtr != NULL) {
+ label = Tcl_GetStringFromObj(
+ menuPtr->entries[i]->labelPtr, NULL);
+ }
+ if ((-1 != underline)
+ && (NULL != menuPtr->entries[i]->labelPtr)
+ && (CharUpper((LPTSTR) menuChar)
+ == CharUpper((LPTSTR) (unsigned char)
+ label[underline]))) {
+ *plResult = (2 << 16) | i;
+ returnResult = 1;
+ break;
+ }
+ }
+ }
+ break;
+ }
+
+ case WM_MEASUREITEM: {
+ LPMEASUREITEMSTRUCT itemPtr = (LPMEASUREITEMSTRUCT) *plParam;
+
+ if (itemPtr != NULL) {
+ mePtr = (TkMenuEntry *) itemPtr->itemData;
+ menuPtr = mePtr->menuPtr;
+
+ TkRecomputeMenu(menuPtr);
+ itemPtr->itemHeight = mePtr->height;
+ itemPtr->itemWidth = mePtr->width;
+ if (mePtr->hideMargin) {
+ itemPtr->itemWidth += 2 - indicatorDimensions[1];
+ } else {
+ int activeBorderWidth;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ itemPtr->itemWidth += 2 * activeBorderWidth;
+ }
+ *plResult = 1;
+ returnResult = 1;
+ }
+ break;
+ }
+
+ case WM_DRAWITEM: {
+ TkWinDrawable *twdPtr;
+ LPDRAWITEMSTRUCT itemPtr = (LPDRAWITEMSTRUCT) *plParam;
+ Tk_FontMetrics fontMetrics;
+
+ if (itemPtr != NULL) {
+ Tk_Font tkfont;
+
+ mePtr = (TkMenuEntry *) itemPtr->itemData;
+ menuPtr = mePtr->menuPtr;
+ twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
+ twdPtr->type = TWD_WINDC;
+ twdPtr->winDC.hdc = itemPtr->hDC;
+
+ if (mePtr->state != ENTRY_DISABLED) {
+ if (itemPtr->itemState & ODS_SELECTED) {
+ TkActivateMenuEntry(menuPtr, mePtr->index);
+ } else {
+ TkActivateMenuEntry(menuPtr, -1);
+ }
+ } else {
+ /* On windows, menu entries should highlight even if they
+ ** are disabled. (I know this seems dumb, but it is the way
+ ** native windows menus works so we ought to mimic it.)
+ ** The ENTRY_PLATFORM_FLAG1 flag will indicate that the
+ ** entry should be highlighted even though it is disabled.
+ */
+ if (itemPtr->itemState & ODS_SELECTED) {
+ mePtr->entryFlags |= ENTRY_PLATFORM_FLAG1;
+ } else {
+ mePtr->entryFlags &= ~ENTRY_PLATFORM_FLAG1;
+ }
+ }
+
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &fontMetrics);
+ TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, tkfont,
+ &fontMetrics, itemPtr->rcItem.left,
+ itemPtr->rcItem.top, itemPtr->rcItem.right
+ - itemPtr->rcItem.left, itemPtr->rcItem.bottom
+ - itemPtr->rcItem.top, 0, 0);
+
+ ckfree((char *) twdPtr);
+ *plResult = 1;
+ returnResult = 1;
+ }
+ break;
+ }
+
+ case WM_MENUSELECT: {
+ UINT flags = HIWORD(*pwParam);
+
+ TkMenuInit();
+
+ if ((flags == 0xFFFF) && (*plParam == 0)) {
+ if (tsdPtr->modalMenuPtr != NULL) {
+ Tcl_SetServiceMode(tsdPtr->oldServiceMode);
+ RecursivelyClearActiveMenu(tsdPtr->modalMenuPtr);
+ }
+ } else {
+ menuPtr = NULL;
+ if (*plParam != 0) {
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) *plParam);
+ if (hashEntryPtr != NULL) {
+ menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ }
+ }
+
+ if (menuPtr != NULL) {
+ mePtr = NULL;
+ if (flags != 0xFFFF) {
+ if (flags & MF_POPUP) {
+ mePtr = menuPtr->entries[LOWORD(*pwParam)];
+ } else {
+ hashEntryPtr = Tcl_FindHashEntry(
+ &tsdPtr->commandTable,
+ (char *) LOWORD(*pwParam));
+ if (hashEntryPtr != NULL) {
+ mePtr = (TkMenuEntry *)
+ Tcl_GetHashValue(hashEntryPtr);
+ }
+ }
+ }
+
+ if ((mePtr == NULL) || (mePtr->state == ENTRY_DISABLED)) {
+ TkActivateMenuEntry(menuPtr, -1);
+ } else {
+ TkActivateMenuEntry(menuPtr, mePtr->index);
+ }
+ MenuSelectEvent(menuPtr);
+ Tcl_ServiceAll();
+ }
+ }
+ break;
+ }
+ }
+ 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->state == ENTRY_ACTIVE) {
+ mePtr->state = ENTRY_NORMAL;
+ }
+ mePtr->entryFlags &= ~ENTRY_PLATFORM_FLAG1;
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (menuPtr != NULL) {
+ Tcl_HashEntry *hashEntryPtr;
+ int newEntry;
+
+ winMenuHdl = (HMENU) menuPtr->platformData;
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) winMenuHdl);
+ Tcl_DeleteHashEntry(hashEntryPtr);
+ DestroyMenu(winMenuHdl);
+ winMenuHdl = CreateMenu();
+ hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable,
+ (char *) winMenuHdl, &newEntry);
+ Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
+ menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
+ TkWinSetMenu(tkwin, winMenuHdl);
+ if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
+ }
+ } 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 {
+ int borderWidth;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ *widthPtr = indicatorDimensions[1] - 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->accelPtr == NULL) {
+ *widthPtr = 0;
+ } else {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ *widthPtr = Tk_TextWidth(tkfont, 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 - (2 * fmPtr->descent);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(scratchDC, &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)) {
+ if (mePtr->indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ RECT rect;
+ GC whichGC;
+ int borderWidth, activeBorderWidth;
+ if (mePtr->state != ENTRY_NORMAL) {
+ whichGC = gc;
+ } else {
+ whichGC = indicatorGC;
+ }
+
+ rect.top = y;
+ rect.bottom = y + mePtr->height;
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ rect.left = borderWidth + activeBorderWidth + x;
+ rect.right = mePtr->indicatorSpace + x;
+
+ if ((mePtr->state == ENTRY_DISABLED)
+ && (menuPtr->disabledFgPtr != NULL)) {
+ 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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ char *accel;
+
+ if (mePtr->accelPtr != NULL) {
+ accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ }
+
+ baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+
+ if ((mePtr->state == ENTRY_DISABLED) && (menuPtr->disabledFgPtr != NULL)
+ && ((mePtr->accelPtr != NULL)
+ || ((mePtr->type == CASCADE_ENTRY) && drawArrow))) {
+ COLORREF oldFgColor = gc->foreground;
+
+ gc->foreground = GetSysColor(COLOR_3DHILIGHT);
+ if (mePtr->accelPtr != NULL) {
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
+ mePtr->accelLength, leftEdge + 1, baseline + 1);
+ }
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ RECT rect;
+
+ rect.top = y + GetSystemMetrics(SM_CYBORDER) + 1;
+ rect.bottom = y + height - GetSystemMetrics(SM_CYBORDER) + 1;
+ rect.left = x + mePtr->indicatorSpace + mePtr->labelWidth + 1;
+ rect.right = x + width;
+ DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect,
+ OBM_MNARROW, ALIGN_BITMAP_RIGHT);
+ }
+ gc->foreground = oldFgColor;
+ }
+
+ if (mePtr->accelPtr != NULL) {
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
+ mePtr->accelLength, leftEdge, baseline);
+ }
+
+ if ((mePtr->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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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];
+ Tk_3DBorder border;
+
+ points[0].x = x;
+ points[0].y = y + height / 2;
+ points[1].x = x + width - 1;
+ points[1].y = points[0].y;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuUnderline --
+ *
+ * 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) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ CONST char *start = Tcl_UtfAtIndex(label, mePtr->underline);
+ CONST char *end = Tcl_UtfNext(start);
+
+ Tk_UnderlineChars(menuPtr->display, d,
+ gc, tkfont, label, x + mePtr->indicatorSpace,
+ y + (height + fmPtr->ascent - fmPtr->descent) / 2,
+ (int) (start - label), (int) (end - label));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.nbytes > 0) {
+ for (i = 0; i < eventPtr->xkey.nbytes; i++) {
+ CallWindowProc(DefWindowProc,
+ Tk_GetHWND(Tk_WindowId(tkwin)),
+ WM_SYSCHAR,
+ eventPtr->xkey.trans_chars[i],
+ ((scanCode << 16) | (1 << 29)));
+ }
+ }
+ }
+ }
+ } else if (eventPtr->type == KeyRelease) {
+ switch (keySym) {
+ case XK_Alt_L:
+ scanCode = MapVirtualKey(VK_LMENU, 0);
+ CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ 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 indicatorSpace = mePtr->indicatorSpace;
+ int activeBorderWidth;
+ int leftEdge;
+ int imageHeight, imageWidth;
+ int textHeight, textWidth;
+ int haveImage = 0, haveText = 0;
+ int imageXOffset = 0, imageYOffset = 0;
+ int textXOffset = 0, textYOffset = 0;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
+
+ /*
+ * Work out what we will need to draw first.
+ */
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight);
+ haveImage = 1;
+ }
+ if (!haveImage || (mePtr->compound != COMPOUND_NONE)) {
+ if (mePtr->labelLength > 0) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
+ textHeight = fmPtr->linespace;
+ haveText = 1;
+ }
+ }
+
+ /*
+ * Now work out what the relative positions are.
+ */
+
+ if (haveImage && haveText) {
+ int fullWidth = (imageWidth > textWidth ? imageWidth : textWidth);
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = imageHeight/2 + 2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = -textHeight/2;
+ break;
+ }
+ case COMPOUND_BOTTOM: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = -imageHeight/2;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = textHeight/2 + 2;
+ break;
+ }
+ case COMPOUND_LEFT: {
+ textXOffset = imageWidth + 2;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_RIGHT: {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = textWidth + 2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ textXOffset = (fullWidth - textWidth)/2;
+ textYOffset = 0;
+ imageXOffset = (fullWidth - imageWidth)/2;
+ imageYOffset = 0;
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ textXOffset = 0;
+ textYOffset = 0;
+ imageXOffset = 0;
+ imageYOffset = 0;
+ }
+
+ /*
+ * Draw label and/or bitmap or image for entry.
+ */
+
+ if (mePtr->image != NULL) {
+ if ((mePtr->selectImage != NULL)
+ && (mePtr->entryFlags & ENTRY_SELECTED)) {
+ Tk_RedrawImage(mePtr->selectImage, 0, 0,
+ imageWidth, imageHeight, d, leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ } else {
+ Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
+ imageHeight, d, leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset));
+ }
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0,
+ (unsigned) imageWidth, (unsigned) imageHeight,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset), 1);
+ }
+ if ((mePtr->compound != COMPOUND_NONE) || !haveImage) {
+ if (mePtr->labelLength > 0) {
+ int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,
+ mePtr->labelLength, leftEdge + textXOffset,
+ baseline + textYOffset);
+ DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr,
+ x + textXOffset, y + textYOffset,
+ width, height);
+ }
+ }
+
+ if (mePtr->state == ENTRY_DISABLED) {
+ if (menuPtr->disabledFgPtr == NULL) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
+ (unsigned) width, (unsigned) height);
+ } else if ((mePtr->image != NULL)
+ && (menuPtr->disabledImageGC != None)) {
+ XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
+ leftEdge + imageXOffset,
+ (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
+ (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;
+ Tk_3DBorder border;
+
+ if (menuPtr->menuType != MASTER_MENU) {
+ return;
+ }
+
+ points[0].x = x;
+ points[0].y = y + height/2;
+ points[1].y = points[0].y;
+ segmentWidth = 6;
+ maxX = width - 1;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+
+ while (points[0].x < maxX) {
+ points[1].x = points[0].x + segmentWidth;
+ if (points[1].x > maxX) {
+ points[1].x = maxX;
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
+ points[0].x += 2*segmentWidth;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpConfigureMenuEntry --
+ *
+ * Processes configurations for menu entries.
+ *
+ * Results:
+ * Returns standard TCL result. If TCL_ERROR is returned, then
+ * the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information get set for mePtr; old resources
+ * get freed, if any need it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 == ENTRY_ACTIVE) && !strictMotif) {
+ gc = mePtr->activeGC;
+ if (gc == NULL) {
+ gc = menuPtr->activeGC;
+ }
+ } else {
+ TkMenuEntry *cascadeEntryPtr;
+ int parentDisabled = 0;
+ char *name;
+
+ for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
+ if (mePtr->state == ENTRY_DISABLED) {
+ parentDisabled = 1;
+ }
+ break;
+ }
+ }
+
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
+ gc = mePtr->disabledGC;
+ if (gc == NULL) {
+ gc = menuPtr->disabledGC;
+ }
+ } else {
+ gc = mePtr->textGC;
+ if (gc == NULL) {
+ gc = menuPtr->textGC;
+ }
+ }
+ }
+ indicatorGC = mePtr->indicatorGC;
+ if (indicatorGC == NULL) {
+ indicatorGC = menuPtr->indicatorGC;
+ }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL) ? menuPtr->borderPtr
+ : mePtr->borderPtr);
+ if (strictMotif) {
+ activeBorder = bgBorder;
+ } else {
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL) ? menuPtr->activeBorderPtr
+ : mePtr->activeBorderPtr);
+ }
+
+ if (mePtr->fontPtr == NULL) {
+ fmPtr = menuMetricsPtr;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+
+ /*
+ * Need to draw the entire background, including padding. On Unix,
+ * for menubars, we have to draw the rest of the entry taking
+ * 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;
+ int haveImage = 0, haveText = 0;
+
+ if (mePtr->image != NULL) {
+ Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
+ haveImage = 1;
+ } else if (mePtr->bitmapPtr != NULL) {
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+ Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
+ haveImage = 1;
+ } else {
+ *heightPtr = 0;
+ *widthPtr = 0;
+ }
+
+ if (haveImage && (mePtr->compound == COMPOUND_NONE)) {
+ /* We don't care about the text in this case */
+ } else {
+ /* Either it is compound or we don't have an image */
+ if (mePtr->labelPtr != NULL) {
+ int textWidth;
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
+
+ if ((mePtr->compound != COMPOUND_NONE) && haveImage) {
+ switch ((enum compound) mePtr->compound) {
+ case COMPOUND_TOP:
+ case COMPOUND_BOTTOM: {
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ /* Add text and padding */
+ *heightPtr += fmPtr->linespace + 2;
+ break;
+ }
+ case COMPOUND_LEFT:
+ case COMPOUND_RIGHT: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ /* Add text and padding */
+ *widthPtr += textWidth + 2;
+ break;
+ }
+ case COMPOUND_CENTER: {
+ if (fmPtr->linespace > *heightPtr) {
+ *heightPtr = fmPtr->linespace;
+ }
+ if (textWidth > *widthPtr) {
+ *widthPtr = textWidth;
+ }
+ break;
+ }
+ case COMPOUND_NONE: {break;}
+ }
+ } else {
+ /* We don't have an image or we're not compound */
+ *heightPtr = fmPtr->linespace;
+ *widthPtr = textWidth;
+ }
+ } else {
+ /* An empty entry still has this height */
+ *heightPtr = fmPtr->linespace;
+ }
+ }
+ *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 == ENTRY_ACTIVE
+ || (mePtr->entryFlags & ENTRY_PLATFORM_FLAG1)!=0 ) {
+ 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 menuFont, tkfont;
+ Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
+ int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
+ int windowWidth, windowHeight, accelSpace;
+ int i, j, lastColumnBreak = 0;
+ int activeBorderWidth, borderWidth;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ x = y = borderWidth;
+ indicatorSpace = labelWidth = accelWidth = 0;
+ windowHeight = 0;
+
+ /*
+ * On the Mac especially, getting font metrics can be quite slow,
+ * so we want to do it intelligently. We are going to precalculate
+ * them and pass them down to all of the measuring and drawing
+ * routines. We will measure the font metrics of the menu once.
+ * If an entry does not have its own font set, then we give
+ * the geometry/drawing routines the menu's font and metrics.
+ * If an entry has its own font, we will measure that font and
+ * give all of the geometry/drawing the entry's font and metrics.
+ */
+
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
+ accelSpace = Tk_TextWidth(menuFont, "M", 1);
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ if (menuPtr->entries[i]->fontPtr == NULL) {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
+ } else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ menuPtr->entries[i]->fontPtr);
+ Tk_GetFontMetrics(tkfont, &entryMetrics);
+ fmPtr = &entryMetrics;
+ }
+ if ((i > 0) && menuPtr->entries[i]->columnBreak) {
+ if (accelWidth != 0) {
+ labelWidth += accelSpace;
+ }
+ for (j = lastColumnBreak; j < i; j++) {
+ menuPtr->entries[j]->indicatorSpace = indicatorSpace;
+ menuPtr->entries[j]->labelWidth = labelWidth;
+ menuPtr->entries[j]->width = indicatorSpace + labelWidth
+ + accelWidth + 2 * activeBorderWidth;
+ menuPtr->entries[j]->x = x;
+ menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
+ }
+ x += indicatorSpace + labelWidth + accelWidth
+ + 2 * borderWidth;
+ indicatorSpace = labelWidth = accelWidth = 0;
+ lastColumnBreak = i;
+ y = borderWidth;
+ }
+
+ if (menuPtr->entries[i]->type == SEPARATOR_ENTRY) {
+ GetMenuSeparatorGeometry(menuPtr, menuPtr->entries[i], tkfont,
+ fmPtr, &width, &height);
+ menuPtr->entries[i]->height = height;
+ } else if (menuPtr->entries[i]->type == TEAROFF_ENTRY) {
+ 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 * activeBorderWidth + 1;
+ }
+ menuPtr->entries[i]->y = y;
+ y += menuPtr->entries[i]->height;
+ if (y > windowHeight) {
+ windowHeight = y;
+ }
+ }
+
+ if (accelWidth != 0) {
+ labelWidth += accelSpace;
+ }
+ for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
+ menuPtr->entries[j]->indicatorSpace = indicatorSpace;
+ menuPtr->entries[j]->labelWidth = labelWidth;
+ menuPtr->entries[j]->width = indicatorSpace + labelWidth
+ + accelWidth + 2 * activeBorderWidth;
+ menuPtr->entries[j]->x = x;
+ menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
+ }
+ windowWidth = x + indicatorSpace + labelWidth + accelWidth + accelSpace
+ + 2 * activeBorderWidth + 2 * borderWidth;
+
+
+ windowHeight += borderWidth;
+
+ /*
+ * The X server doesn't like zero dimensions, so round up to at least
+ * 1 (a zero-sized menu should never really occur, anyway).
+ */
+
+ if (windowWidth <= 0) {
+ 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 */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ DestroyWindow(tsdPtr->menuHWND);
+ UnregisterClass(MENU_CLASS_NAME, Tk_GetHINSTANCE());
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetMenuSystemDefault --
+ *
+ * Gets the Windows specific default value for a given X resource
+ * database name.
+ *
+ * Results:
+ * Returns a Tcl_Obj * with the default value. If there is no
+ * Windows-specific default for this attribute, returns NULL.
+ * This object has a ref count of 0.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkWinGetMenuSystemDefault(
+ Tk_Window tkwin, /* A window to use. */
+ CONST char *dbName, /* The option database name. */
+ CONST char *className) /* The name of the option class. */
+{
+ Tcl_Obj *valuePtr = NULL;
+
+ if ((strcmp(dbName, "activeBorderWidth") == 0) ||
+ (strcmp(dbName, "borderWidth") == 0)) {
+ valuePtr = Tcl_NewIntObj(defaultBorderWidth);
+ } else if (strcmp(dbName, "font") == 0) {
+ valuePtr = Tcl_NewStringObj(Tcl_DStringValue(&menuFontDString),
+ -1);
+ }
+
+ return valuePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinMenuSetDefaults --
+ *
+ * Sets up the hash tables and the variables used by the menu package.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * lastMenuID gets initialized, and the parent hash and the command hash
+ * are allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+SetDefaults(
+ int firstTime) /* Is this the first time this
+ * has been called? */
+{
+ char sizeString[TCL_INTEGER_SPACE];
+ char faceName[LF_FACESIZE];
+ HDC scratchDC;
+ Tcl_DString boldItalicDString;
+ int bold = 0;
+ int italic = 0;
+ TEXTMETRIC tm;
+ int pointSize;
+ HFONT menuFont;
+ NONCLIENTMETRICS ncMetrics;
+
+ /*
+ * Set all of the default options. The loop will terminate when we run
+ * out of options via a break statement.
+ */
+
+ defaultBorderWidth = GetSystemMetrics(SM_CXBORDER);
+ if (GetSystemMetrics(SM_CYBORDER) > defaultBorderWidth) {
+ defaultBorderWidth = GetSystemMetrics(SM_CYBORDER);
+ }
+
+ scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL);
+ if (!firstTime) {
+ Tcl_DStringFree(&menuFontDString);
+ }
+ Tcl_DStringInit(&menuFontDString);
+
+ ncMetrics.cbSize = sizeof(ncMetrics);
+ SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics),
+ &ncMetrics, 0);
+ menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont);
+ SelectObject(scratchDC, menuFont);
+ GetTextMetrics(scratchDC, &tm);
+ GetTextFace(scratchDC, LF_FACESIZE, faceName);
+ pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
+ 72, GetDeviceCaps(scratchDC, LOGPIXELSY));
+ if (tm.tmWeight >= 700) {
+ bold = 1;
+ }
+ if (tm.tmItalic) {
+ italic = 1;
+ }
+
+ SelectObject(scratchDC, GetStockObject(SYSTEM_FONT));
+ DeleteDC(scratchDC);
+
+ DeleteObject(menuFont);
+
+ Tcl_DStringAppendElement(&menuFontDString, faceName);
+ sprintf(sizeString, "%d", pointSize);
+ Tcl_DStringAppendElement(&menuFontDString, sizeString);
+
+ if (bold == 1 || italic == 1) {
+ Tcl_DStringInit(&boldItalicDString);
+ if (bold == 1) {
+ Tcl_DStringAppendElement(&boldItalicDString, "bold");
+ }
+ if (italic == 1) {
+ Tcl_DStringAppendElement(&boldItalicDString, "italic");
+ }
+ Tcl_DStringAppendElement(&menuFontDString,
+ Tcl_DStringValue(&boldItalicDString));
+ }
+
+ /*
+ * Now we go ahead and get the dimensions of the check mark and the
+ * appropriate margins. Since this is fairly hairy, we do it here
+ * to save time when traversing large sets of menu items.
+ *
+ * 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 (TkWinGetPlatformId() >= 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuInit --
+ *
+ * Sets up the process-wide variables used by the menu package.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * lastMenuID gets initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuInit()
+{
+ WNDCLASS wndClass;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ wndClass.style = CS_OWNDC;
+ wndClass.lpfnWndProc = TkWinMenuProc;
+ wndClass.cbClsExtra = 0;
+ wndClass.cbWndExtra = 0;
+ wndClass.hInstance = Tk_GetHINSTANCE();
+ wndClass.hIcon = NULL;
+ wndClass.hCursor = NULL;
+ wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1);
+ wndClass.lpszMenuName = NULL;
+ wndClass.lpszClassName = MENU_CLASS_NAME;
+ RegisterClass(&wndClass);
+
+ tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP,
+ 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);
+
+ Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL);
+ SetDefaults(1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuThreadInit --
+ *
+ * Sets up the thread-local hash tables used by the menu module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Hash tables winMenuTable and commandTable are initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuThreadInit()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_InitHashTable(&tsdPtr->winMenuTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&tsdPtr->commandTable, TCL_ONE_WORD_KEYS);
+}
diff --git a/tcl/win/tkWinPixmap.c b/tcl/win/tkWinPixmap.c
new file mode 100644
index 00000000000..f62f59c4751
--- /dev/null
+++ b/tcl/win/tkWinPixmap.c
@@ -0,0 +1,198 @@
+/*
+ * 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 or window.
+ *
+ * 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;
+
+ if (twdPtr->type == TWD_BITMAP) {
+ HDC dc;
+ BITMAPINFO info;
+
+ if (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;
+ } else if (twdPtr->type == TWD_WINDOW) {
+ RECT rect;
+
+ if (twdPtr->window.handle == NULL) {
+ panic("XGetGeometry: invalid window");
+ }
+ GetClientRect(twdPtr->window.handle, &rect);
+ *width_return = rect.right - rect.left;
+ *height_return = rect.bottom - rect.top;
+ } else {
+ panic("XGetGeometry: invalid window");
+ }
+ return 1;
+}
diff --git a/tcl/win/tkWinPointer.c b/tcl/win/tkWinPointer.c
new file mode 100644
index 00000000000..3ed9aa97f42
--- /dev/null
+++ b/tcl/win/tkWinPointer.c
@@ -0,0 +1,528 @@
+/*
+ * tkWinPointer.c --
+ *
+ * Windows specific mouse tracking code.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 |= ALT_MASK;
+ }
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinCancelMouseTimer --
+ *
+ * If the mouse timer is set, cancel it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May cancel the mouse timer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinCancelMouseTimer()
+{
+ if (mouseTimerSet) {
+ Tcl_DeleteTimerHandler(mouseTimer);
+ mouseTimerSet = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetPointerCoords --
+ *
+ * Fetch the position of the mouse pointer.
+ *
+ * Results:
+ * *xPtr and *yPtr are filled in with the root coordinates
+ * of the mouse pointer for the display.
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XWarpPointer --
+ *
+ * Move pointer to new location. This is not a complete
+ * implementation of this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mouse pointer changes position on screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XWarpPointer(display, src_w, dest_w, src_x, src_y, src_width,
+ src_height, dest_x, dest_y)
+ 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;
+{
+ RECT r;
+
+ GetWindowRect(Tk_GetHWND(dest_w), &r);
+ SetCursorPos(r.left+dest_x, r.top+dest_y);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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) {
+ TkWinSetForegroundWindow(winPtr);
+ }
+ XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent,
+ CurrentTime);
+
+ /*
+ * Remember the current serial number for the X server and issue
+ * a dummy server request. This marks the position at which we
+ * changed the focus, so we can distinguish FocusIn and FocusOut
+ * 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/tcl/win/tkWinPort.h b/tcl/win/tkWinPort.h
new file mode 100644
index 00000000000..3f652e35b24
--- /dev/null
+++ b/tcl/win/tkWinPort.h
@@ -0,0 +1,129 @@
+/*
+ * tkWinPort.h --
+ *
+ * This header file handles porting issues that occur because of
+ * differences between Windows and Unix. It should be the only
+ * file that contains #ifdefs to handle different flavors of OS.
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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>
+
+/*
+ * Need to block out this include for building extensions with MetroWerks
+ * compiler for Win32.
+ */
+
+#ifndef __MWERKS__
+#include <sys/stat.h>
+#endif
+
+#include <time.h>
+#include <tchar.h>
+
+#ifdef _MSC_VER
+# define hypot _hypot
+#endif /* _MSC_VER */
+
+#ifndef __GNUC__
+# 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.
+ */
+
+#ifdef _MSC_VER
+# define TK_READ_DATA_PENDING(f) ((f)->_cnt > 0)
+#else /* _MSC_VER */
+# define TK_READ_DATA_PENDING(f) ((f)->level > 0)
+#endif /* _MSC_VER */
+
+/*
+ * 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
+
+/*
+ * Define timezone for gettimeofday.
+ */
+
+struct timezone {
+ int tz_minuteswest;
+ int tz_dsttime;
+};
+
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
+
+#endif /* _WINPORT */
diff --git a/tcl/win/tkWinRegion.c b/tcl/win/tkWinRegion.c
new file mode 100644
index 00000000000..ea48a5f592a
--- /dev/null
+++ b/tcl/win/tkWinRegion.c
@@ -0,0 +1,204 @@
+/*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSubtractRegion --
+ *
+ * Compute the set-difference of two regions.
+ *
+ * Results:
+ * Returns the result in the dr_return region.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSubtractRegion(sra, srb, dr_return)
+ TkRegion sra;
+ TkRegion srb;
+ TkRegion dr_return;
+{
+ CombineRgn((HRGN) dr_return, (HRGN) sra, (HRGN) srb, RGN_DIFF);
+}
diff --git a/tcl/win/tkWinScrlbr.c b/tcl/win/tkWinScrlbr.c
new file mode 100644
index 00000000000..9b547d97d9b
--- /dev/null
+++ b/tcl/win/tkWinScrlbr.c
@@ -0,0 +1,761 @@
+/*
+ * 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. */
+
+TCL_DECLARE_MUTEX(winScrlbrMutex)
+
+/*
+ * This variable holds the default width for a scrollbar in string
+ * form for use in a Tk_ConfigSpec.
+ */
+
+static char defWidth[TCL_INTEGER_SPACE];
+
+/*
+ * Declarations for functions defined in this file.
+ */
+
+static Window CreateProc _ANSI_ARGS_((Tk_Window tkwin,
+ Window parent, ClientData instanceData));
+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.
+ */
+
+Tk_ClassProcs tkpScrollbarProcs = {
+ sizeof(Tk_ClassProcs), /* size */
+ NULL, /* worldChangedProc */
+ CreateProc, /* createProc */
+ 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) {
+ Tcl_MutexLock(&winScrlbrMutex);
+ UpdateScrollbarMetrics();
+ initialized = 1;
+ Tcl_MutexUnlock(&winScrlbrMutex);
+ }
+
+ 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);
+ 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_HIERARCHY)) {
+ TkWinSetWindowPos(scrollPtr->hwnd, Tk_GetHWND(winPtr->window),
+ Below);
+ break;
+ }
+ }
+
+ scrollPtr->lastVertical = scrollPtr->info.vertical;
+#ifdef _WIN64
+ scrollPtr->oldProc = (WNDPROC)SetWindowLongPtr(scrollPtr->hwnd,
+ GWLP_WNDPROC, (LONG_PTR) ScrollbarProc);
+#else
+ scrollPtr->oldProc = (WNDPROC)SetWindowLong(scrollPtr->hwnd, GWL_WNDPROC,
+ (DWORD) ScrollbarProc);
+#endif
+ 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));
+
+#ifdef _WIN64
+ SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) scrollPtr->oldProc);
+#else
+ SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) scrollPtr->oldProc);
+#endif
+ 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) {
+#ifdef _WIN64
+ SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) winScrollPtr->oldProc);
+#else
+ SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) winScrollPtr->oldProc);
+#endif
+ 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;
+
+ if (scrollPtr->hwnd) {
+ 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/tcl/win/tkWinSend.c b/tcl/win/tkWinSend.c
new file mode 100644
index 00000000000..3bf42b46b96
--- /dev/null
+++ b/tcl/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.
+ *
+ *--------------------------------------------------------------
+ */
+
+CONST 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. */
+ CONST 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/tcl/win/tkWinTest.c b/tcl/win/tkWinTest.c
new file mode 100644
index 00000000000..03d8984e129
--- /dev/null
+++ b/tcl/win/tkWinTest.c
@@ -0,0 +1,346 @@
+/*
+ * tkWinTest.c --
+ *
+ * Contains commands for platform specific tests for
+ * the Windows platform.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 by Scriptics Corporation.
+ * Copyright (c) 2001 by ActiveState 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"
+
+HWND tkWinCurrentDialog;
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+
+int TkplatformtestInit(Tcl_Interp *interp);
+static int TestclipboardObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]);
+static int TestwineventCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc, CONST 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_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendSystemError --
+ *
+ * This routine formats a Windows system error message and places
+ * it into the interpreter result. Originally from tclWinReg.c.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendSystemError(
+ Tcl_Interp *interp, /* Current interpreter. */
+ DWORD error) /* Result code from error. */
+{
+ int length;
+ WCHAR *wMsgPtr;
+ char *msg;
+ char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
+ Tcl_DString ds;
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+
+ length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr,
+ 0, NULL);
+ if (length == 0) {
+ char *msgPtr;
+
+ length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
+ 0, NULL);
+ if (length > 0) {
+ wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
+ MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
+ length + 1);
+ LocalFree(msgPtr);
+ }
+ }
+ if (length == 0) {
+ if (error == ERROR_CALL_NOT_IMPLEMENTED) {
+ msg = "function not supported under Win32s";
+ } else {
+ sprintf(msgBuf, "unknown error: %ld", error);
+ msg = msgBuf;
+ }
+ } else {
+ Tcl_Encoding encoding;
+
+ encoding = Tcl_GetEncoding(NULL, "unicode");
+ msg = Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
+ Tcl_FreeEncoding(encoding);
+ LocalFree(wMsgPtr);
+
+ length = Tcl_DStringLength(&ds);
+
+ /*
+ * Trim the trailing CR/LF from the system message.
+ */
+ if (msg[length-1] == '\n') {
+ msg[--length] = 0;
+ }
+ if (msg[length-1] == '\r') {
+ msg[--length] = 0;
+ }
+ }
+
+ sprintf(id, "%ld", error);
+ Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL);
+ Tcl_AppendToObj(resultPtr, msg, length);
+
+ if (length != 0) {
+ Tcl_DStringFree(&ds);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestclipboardObjCmd --
+ *
+ * This procedure implements the testclipboard command. It provides
+ * a way to determine the actual contents of the Windows clipboard.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestclipboardObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ HGLOBAL handle;
+ char *data;
+ int code = TCL_OK;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (OpenClipboard(NULL)) {
+ /*
+ * We could consider using CF_UNICODETEXT on NT, but then we
+ * would have to convert it from External. Instead we'll just
+ * take this and do "bytestring" at the Tcl level for Unicode
+ * inclusive text
+ */
+ handle = GetClipboardData(CF_TEXT);
+ if (handle != NULL) {
+ data = GlobalLock(handle);
+ Tcl_AppendResult(interp, data, (char *) NULL);
+ GlobalUnlock(handle);
+ } else {
+ Tcl_AppendResult(interp, "null clipboard handle", (char *) NULL);
+ code = TCL_ERROR;
+ }
+ CloseClipboard();
+ return code;
+ } else {
+ Tcl_AppendResult(interp, "couldn't open clipboard: ", (char *) NULL);
+ AppendSystemError(interp, GetLastError());
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwineventCmd --
+ *
+ * This procedure implements the testwinevent command. It provides
+ * a way to send messages to windows dialogs.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwineventCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ HWND hwnd = 0;
+ int id;
+ char *rest;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+ static TkStateMap messageMap[] = {
+ {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"},
+ {WM_LBUTTONUP, "WM_LBUTTONUP"},
+ {WM_CHAR, "WM_CHAR"},
+ {WM_GETTEXT, "WM_GETTEXT"},
+ {WM_SETTEXT, "WM_SETTEXT"},
+ {-1, NULL}
+ };
+
+ if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) {
+ int b;
+
+ if (Tcl_GetBoolean(interp, argv[2], &b) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkWinDialogDebug(b);
+ return TCL_OK;
+ }
+
+ if (argc < 4) {
+ return TCL_ERROR;
+ }
+
+#if 0
+ TkpScanWindowId(interp, argv[1], &id);
+ if (
+#ifdef _WIN64
+ (sscanf(string, "0x%p", &number) != 1) &&
+#endif
+ Tcl_GetInt(interp, string, (int *)&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+#endif
+ hwnd = (HWND) strtol(argv[1], &rest, 0);
+ if (rest == argv[1]) {
+ hwnd = FindWindow(NULL, argv[1]);
+ if (hwnd == NULL) {
+ Tcl_SetResult(interp, "no such window", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+ UpdateWindow(hwnd);
+
+ id = strtol(argv[2], &rest, 0);
+ if (rest == argv[2]) {
+ HWND child;
+ char buf[256];
+
+ child = GetWindow(hwnd, GW_CHILD);
+ while (child != NULL) {
+ SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
+ if (strcasecmp(buf, argv[2]) == 0) {
+ id = GetDlgCtrlID(child);
+ break;
+ }
+ child = GetWindow(child, GW_HWNDNEXT);
+ }
+ if (child == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
+ if (message < 0) {
+ message = strtol(argv[3], NULL, 0);
+ }
+ wParam = 0;
+ lParam = 0;
+
+ if (argc > 4) {
+ wParam = strtol(argv[4], NULL, 0);
+ }
+ if (argc > 5) {
+ lParam = strtol(argv[5], NULL, 0);
+ }
+
+ switch (message) {
+ case WM_GETTEXT: {
+ Tcl_DString ds;
+ char buf[256];
+
+ GetDlgItemText(hwnd, id, buf, 256);
+ Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ case WM_SETTEXT: {
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
+ SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ default: {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d",
+ SendDlgItemMessage(hwnd, id, message, wParam, lParam));
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+
+
diff --git a/tcl/win/tkWinWindow.c b/tcl/win/tkWinWindow.c
new file mode 100644
index 00000000000..580531f9aa0
--- /dev/null
+++ b/tcl/win/tkWinWindow.c
@@ -0,0 +1,813 @@
+/*
+ * tkWinWindow.c --
+ *
+ * Xlib emulation routines for Windows related to creating,
+ * displaying and destroying windows.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkWinInt.h"
+
+typedef struct ThreadSpecificData {
+ int initialized; /* 0 means table below needs initializing. */
+ Tcl_HashTable windowTable; /* The windowTable maps from HWND to
+ * Tk_Window handles. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void NotifyVisibility _ANSI_ARGS_((XEvent *eventPtr,
+ TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(&tsdPtr->windowTable, TCL_ONE_WORD_KEYS);
+ tsdPtr->initialized = 1;
+ }
+
+ /*
+ * Allocate a new drawable if necessary. Otherwise, remove the
+ * previous HWND from from the window table.
+ */
+
+ if (twdPtr == NULL) {
+ twdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable));
+ twdPtr->type = TWD_WINDOW;
+ twdPtr->window.winPtr = (TkWindow *) tkwin;
+ } else if (twdPtr->window.handle != NULL) {
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable,
+ (char *)twdPtr->window.handle);
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+
+ /*
+ * Insert the new HWND into the window table.
+ */
+
+ twdPtr->window.handle = hwnd;
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->windowTable, (char *)hwnd, &new);
+ Tcl_SetHashValue(entryPtr, (ClientData)tkwin);
+
+ return (Window)twdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(&tsdPtr->windowTable, TCL_ONE_WORD_KEYS);
+ tsdPtr->initialized = 1;
+ }
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd);
+ if (entryPtr != NULL) {
+ return (Tk_Window) Tcl_GetHashValue(entryPtr);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ return ((TkWinDrawable *) window)->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;
+ /*
+ * Use pointer representation, because Win64 is P64 (*not* LP64).
+ * Windows doesn't print the 0x for %p, so we do it.
+ */
+ sprintf(buf, "0x%p", 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 the interp's 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. */
+ CONST char *string; /* String containing a (possibly signed)
+ * integer in a form acceptable to strtol. */
+ Window *idPtr; /* Place to store converted result. */
+{
+ Tk_Window tkwin;
+ Window number;
+
+ /*
+ * We want sscanf for the 64-bit check, but if that doesn't work,
+ * then Tcl_GetInt manages the error correctly.
+ */
+ if (
+#ifdef _WIN64
+ (sscanf(string, "0x%p", &number) != 1) &&
+#endif
+ Tcl_GetInt(interp, string, (int *)&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);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ display->request++;
+
+ /*
+ * Remove references to the window in the pointer module then
+ * release the drawable.
+ */
+
+ TkPointerDeadWindow(winPtr);
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+
+ ckfree((char *)twdPtr);
+
+ /*
+ * 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(Tk_GetHWND(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_HIERARCHY)) {
+ for (parentPtr = winPtr->parentPtr; ;
+ parentPtr = parentPtr->parentPtr) {
+ if ((parentPtr == NULL) || !(parentPtr->flags & TK_MAPPED)) {
+ return;
+ }
+ if (parentPtr->flags & TK_TOP_HIERARCHY) {
+ 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(Tk_GetHWND(w), SW_HIDE);
+ winPtr->flags &= ~TK_MAPPED;
+
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ 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(Tk_GetHWND(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(Tk_GetHWND(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(Tk_GetHWND(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 = Tk_GetHWND(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 = Tk_GetHWND(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 = Tk_GetHWND(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/tcl/win/tkWinWm.c b/tcl/win/tkWinWm.c
new file mode 100644
index 00000000000..db1e540693c
--- /dev/null
+++ b/tcl/win/tkWinWm.c
@@ -0,0 +1,7111 @@
+/*
+ * 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-2000 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"
+#include <shellapi.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))
+
+/*
+ * Helper type passed via lParam to TkWmStackorderToplevelEnumProc
+ */
+typedef struct TkWmStackorderToplevelPair {
+ Tcl_HashTable *table;
+ TkWindow **window_ptr;
+} TkWmStackorderToplevelPair;
+
+/*
+ * This structure represents the contents of a icon, in terms of its
+ * image. The HICON is an internal Windows format. Most of these
+ * icon-specific-structures originated with the Winico extension.
+ * We stripped out unused parts of that code, and integrated the
+ * code more naturally with Tcl.
+ */
+typedef struct {
+ UINT Width, Height, Colors; /* Width, Height and bpp */
+ LPBYTE lpBits; /* ptr to DIB bits */
+ DWORD dwNumBytes; /* how many bytes? */
+ LPBITMAPINFO lpbi; /* ptr to header */
+ LPBYTE lpXOR; /* ptr to XOR image bits */
+ LPBYTE lpAND; /* ptr to AND image bits */
+ HICON hIcon; /* DAS ICON */
+} ICONIMAGE, *LPICONIMAGE;
+/*
+ * This structure is how we represent a block of the above
+ * items. We will reallocate these structures according to
+ * how many images they need to contain.
+ */
+typedef struct {
+ int nNumImages; /* How many images? */
+ ICONIMAGE IconImages[1]; /* Image entries */
+} BlockOfIconImages, *BlockOfIconImagesPtr;
+/*
+ * These two structures are used to read in icons from an
+ * 'icon directory' (i.e. the contents of a .icr file, say).
+ * We only use these structures temporarily, since we copy
+ * the information we want into a BlockOfIconImages.
+ */
+typedef struct {
+ BYTE bWidth; /* Width of the image */
+ BYTE bHeight; /* Height of the image (times 2) */
+ BYTE bColorCount; /* Number of colors in image (0 if >=8bpp) */
+ BYTE bReserved; /* Reserved */
+ WORD wPlanes; /* Color Planes */
+ WORD wBitCount; /* Bits per pixel */
+ DWORD dwBytesInRes; /* how many bytes in this resource? */
+ DWORD dwImageOffset; /* where in the file is this image */
+} ICONDIRENTRY, *LPICONDIRENTRY;
+typedef struct {
+ WORD idReserved; /* Reserved */
+ WORD idType; /* resource type (1 for icons) */
+ WORD idCount; /* how many images? */
+ ICONDIRENTRY idEntries[1]; /* the entries for each image */
+} ICONDIR, *LPICONDIR;
+
+/*
+ * A pointer to one of these strucutures is associated with each
+ * toplevel. This allows us to free up all memory associated with icon
+ * resources when a window is deleted or if the window's icon is
+ * changed. They are simply reference counted according to:
+ *
+ * (i) how many WmInfo structures point to this object
+ * (ii) whether the ThreadSpecificData defined in this file contains
+ * a pointer to this object.
+ *
+ * The former count is for windows whose icons are individually
+ * set, and the latter is for the global default icon choice.
+ *
+ * Icons loaded from .icr/.icr use the iconBlock field, icons
+ * loaded from .exe/.dll use the hIcon field.
+ */
+typedef struct WinIconInstance {
+ int refCount; /* Number of instances that share this
+ * data structure. */
+ BlockOfIconImagesPtr iconBlock;
+ /* Pointer to icon resource data for
+ * image. */
+} WinIconInstance;
+
+typedef struct WinIconInstance *WinIconPtr;
+
+/*
+ * 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. */
+ char *title; /* Title to display in window caption. If
+ * NULL, use name of widget. Malloced. */
+ char *iconName; /* Name to display in icon. Malloced. */
+ 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. */
+ TkWindow *masterPtr; /* Master window for TRANSIENT_FOR property,
+ * or NULL. */
+ 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. */
+ LONG styleConfig; /* Extra user requested style bits */
+ LONG exStyleConfig; /* Extra user requested extended style bits */
+
+ /*
+ * 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. */
+ CONST 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. */
+ int numTransients; /* number of transients on this window */
+ WinIconPtr iconPtr; /* pointer to titlebar icon structure for
+ * this window, or NULL. */
+ 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. Not used on Win.
+ * 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_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).
+ * WM_TRANSIENT_WITHDRAWN - non-zero means that this is a transient window
+ * that has explicitly been withdrawn. It should
+ * not mirror state changes in the master.
+ */
+
+#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)
+#define WM_TRANSIENT_WITHDRAWN (1<<12)
+
+/*
+ * 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)
+#define EX_TRANSIENT_STYLE (WS_EX_DLGMODALFRAME)
+
+/*
+ * The following structure is the official type record for geometry
+ * management of top-level windows.
+ */
+
+static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin);
+
+static Tk_GeomMgr wmMgrType = {
+ "wm", /* name */
+ TopLevelReqProc, /* requestProc */
+ (Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */
+};
+
+typedef struct ThreadSpecificData {
+ HPALETTE systemPalette; /* System palette; refers to the
+ * currently installed foreground logical
+ * palette. */
+ TkWindow *createWindow; /* Window that is being constructed. This
+ * value is set immediately before a
+ * call to CreateWindowEx, and is used
+ * by SetLimits. This is a gross hack
+ * needed to work around Windows brain
+ * damage where it sends the
+ * WM_GETMINMAXINFO message before the
+ * WM_CREATE window. */
+ int initialized; /* Flag indicating whether thread-
+ * specific elements of module have
+ * been initialized. */
+ int firstWindow; /* Flag, cleared when the first window
+ * is mapped in a non-iconic state. */
+ WinIconPtr iconPtr; /* IconPtr being used as default for all
+ * toplevels, or NULL. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following variables cannot be placed in thread local storage
+ * because they must be shared across threads.
+ */
+
+static int initialized; /* Flag indicating whether module has
+ * been initialized. */
+
+/*
+ * A pointer to a shell proc which allows us to extract icons from
+ * any file. We just initialize this when we start up (if we can)
+ * and then it never changes
+ */
+DWORD* (WINAPI *shgetfileinfoProc) (LPCTSTR pszPath, DWORD dwFileAttributes,
+ SHFILEINFO* psfi, UINT cbFileInfo, UINT uFlags) = NULL;
+
+TCL_DECLARE_MUTEX(winWmMutex)
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static int ActivateWindow _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static void ConfigureTopLevel _ANSI_ARGS_((WINDOWPOS *pos));
+static void GenerateConfigureNotify _ANSI_ARGS_((
+ TkWindow *winPtr));
+static void GetMaxSize _ANSI_ARGS_((WmInfo *wmPtr,
+ int *maxWidthPtr, int *maxHeightPtr));
+static void GetMinSize _ANSI_ARGS_((WmInfo *wmPtr,
+ int *minWidthPtr, int *minHeightPtr));
+static TkWindow * GetTopLevel _ANSI_ARGS_((HWND hwnd));
+static void InitWm _ANSI_ARGS_((void));
+static int InstallColormaps _ANSI_ARGS_((HWND hwnd, int message,
+ int isForemost));
+static void InvalidateSubTree _ANSI_ARGS_((TkWindow *winPtr,
+ Colormap colormap));
+static int ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, TkWindow *winPtr));
+static void RefreshColormap _ANSI_ARGS_((Colormap colormap,
+ TkDisplay *dispPtr));
+static void SetLimits _ANSI_ARGS_((HWND hwnd, MINMAXINFO *info));
+static void TkWmStackorderToplevelWrapperMap _ANSI_ARGS_((
+ TkWindow *winPtr,
+ Tcl_HashTable *table));
+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));
+static void WmWaitVisibilityOrMapProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static BlockOfIconImagesPtr ReadIconOrCursorFromFile _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_Obj* fileName, BOOL isIcon));
+static WinIconPtr ReadIconFromFile _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_Obj *fileName));
+static WinIconPtr GetIconFromPixmap _ANSI_ARGS_((Display *dsPtr,
+ Pixmap pixmap));
+static int ReadICOHeader _ANSI_ARGS_((Tcl_Channel channel));
+static BOOL AdjustIconImagePointers _ANSI_ARGS_((LPICONIMAGE lpImage));
+static HICON MakeIconOrCursorFromResource
+ _ANSI_ARGS_((LPICONIMAGE lpIcon, BOOL isIcon));
+static HICON GetIcon _ANSI_ARGS_((WinIconPtr titlebaricon,
+ int icon_size));
+static int WinSetIcon _ANSI_ARGS_((Tcl_Interp *interp,
+ WinIconPtr titlebaricon, Tk_Window tkw));
+static void FreeIconBlock _ANSI_ARGS_((BlockOfIconImagesPtr lpIR));
+static void DecrIconRefCount _ANSI_ARGS_((WinIconPtr titlebaricon));
+
+static int WmAspectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmAttributesCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmClientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmColormapwindowsCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmCommandCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmDeiconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFocusmodelCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmFrameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGeometryCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGridCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmGroupCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconbitmapCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconifyCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmIconwindowCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMaxsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmMinsizeCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmOverrideredirectCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmPositionfromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmProtocolCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmResizableCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmSizefromCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStackorderCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmStateCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTitleCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmTransientCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr,
+ TkWindow *winPtr));
+
+/* Used in BytesPerLine */
+#define WIDTHBYTES(bits) ((((bits) + 31)>>5)<<2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DIBNumColors --
+ *
+ * Calculates the number of entries in the color table, given by
+ * LPSTR lpbi - pointer to the CF_DIB memory block. Used by
+ * titlebar icon code.
+ *
+ * Results:
+ *
+ * WORD - Number of entries in the color table.
+ *
+ * Side effects: None.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static WORD
+DIBNumColors( LPSTR lpbi )
+{
+ WORD wBitCount;
+ DWORD dwClrUsed;
+
+ dwClrUsed = ((LPBITMAPINFOHEADER) lpbi)->biClrUsed;
+
+ if (dwClrUsed)
+ return (WORD) dwClrUsed;
+
+ wBitCount = ((LPBITMAPINFOHEADER) lpbi)->biBitCount;
+
+ switch (wBitCount)
+ {
+ case 1: return 2;
+ case 4: return 16;
+ case 8: return 256;
+ default:return 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PaletteSize --
+ *
+ * Calculates the number of bytes in the color table, as given by
+ * LPSTR lpbi - pointer to the CF_DIB memory block. Used by
+ * titlebar icon code.
+ *
+ * Results:
+ * number of bytes in the color table
+ *
+ * Side effects: None.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static WORD
+PaletteSize( LPSTR lpbi )
+{
+ return ((WORD)( DIBNumColors( lpbi ) * sizeof( RGBQUAD )) );
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDIBits --
+ *
+ * Locate the image bits in a CF_DIB format DIB, as given by
+ * LPSTR lpbi - pointer to the CF_DIB memory block. Used by
+ * titlebar icon code.
+ *
+ * Results:
+ * pointer to the image bits
+ *
+ * Side effects: None
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static LPSTR
+FindDIBBits( LPSTR lpbi )
+{
+ return ( lpbi + *(LPDWORD)lpbi + PaletteSize( lpbi ) );
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BytesPerLine --
+ *
+ * Calculates the number of bytes in one scan line, as given by
+ * LPBITMAPINFOHEADER lpBMIH - pointer to the BITMAPINFOHEADER
+ * that begins the CF_DIB block. Used by titlebar icon code.
+ *
+ * Results:
+ * number of bytes in one scan line (DWORD aligned)
+ *
+ * Side effects: None
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static DWORD
+BytesPerLine( LPBITMAPINFOHEADER lpBMIH )
+{
+ return WIDTHBYTES(lpBMIH->biWidth * lpBMIH->biPlanes * lpBMIH->biBitCount);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustIconImagePointers --
+ *
+ * Adjusts internal pointers in icon resource struct, as given
+ * by LPICONIMAGE lpImage - the resource to handle. Used by
+ * titlebar icon code.
+ *
+ * Results:
+ * BOOL - TRUE for success, FALSE for failure
+ *
+ * Side effects:
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static BOOL
+AdjustIconImagePointers( LPICONIMAGE lpImage )
+{
+ /* Sanity check */
+ if (lpImage==NULL)
+ return FALSE;
+ /* BITMAPINFO is at beginning of bits */
+ lpImage->lpbi = (LPBITMAPINFO)lpImage->lpBits;
+ /* Width - simple enough */
+ lpImage->Width = lpImage->lpbi->bmiHeader.biWidth;
+ /*
+ * Icons are stored in funky format where height is doubled
+ * so account for that
+ */
+ lpImage->Height = (lpImage->lpbi->bmiHeader.biHeight)/2;
+ /* How many colors? */
+ lpImage->Colors = lpImage->lpbi->bmiHeader.biPlanes *
+ lpImage->lpbi->bmiHeader.biBitCount;
+ /* XOR bits follow the header and color table */
+ lpImage->lpXOR = (LPBYTE)FindDIBBits(((LPSTR)lpImage->lpbi));
+ /* AND bits follow the XOR bits */
+ lpImage->lpAND = lpImage->lpXOR + (lpImage->Height*
+ BytesPerLine((LPBITMAPINFOHEADER)(lpImage->lpbi)));
+ return TRUE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeIconOrCursorFromResource --
+ *
+ * Construct an actual HICON structure from the information
+ * in a resource.
+ *
+ * Results:
+ *
+ *
+ * Side effects:
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static HICON
+MakeIconOrCursorFromResource(LPICONIMAGE lpIcon, BOOL isIcon) {
+ HICON hIcon ;
+ static FARPROC pfnCreateIconFromResourceEx=NULL;
+ static int initinfo=0;
+ /* Sanity Check */
+ if (lpIcon == NULL)
+ return NULL;
+ if (lpIcon->lpBits == NULL)
+ return NULL;
+ if (!initinfo) {
+ HMODULE hMod = GetModuleHandleA("USER32.DLL");
+ initinfo=1;
+ if (hMod){
+ pfnCreateIconFromResourceEx =
+ GetProcAddress(hMod, "CreateIconFromResourceEx");
+ }
+ }
+ /* Let the OS do the real work :) */
+ if (pfnCreateIconFromResourceEx!=NULL) {
+ hIcon = (HICON) (pfnCreateIconFromResourceEx)
+ (lpIcon->lpBits, lpIcon->dwNumBytes, isIcon, 0x00030000,
+ (*(LPBITMAPINFOHEADER)(lpIcon->lpBits)).biWidth,
+ (*(LPBITMAPINFOHEADER)(lpIcon->lpBits)).biHeight/2, 0);
+ } else {
+ hIcon = NULL;
+ }
+ /* It failed, odds are good we're on NT so try the non-Ex way */
+ if (hIcon == NULL) {
+ /* We would break on NT if we try with a 16bpp image */
+ if (lpIcon->lpbi->bmiHeader.biBitCount != 16) {
+ hIcon = CreateIconFromResource(lpIcon->lpBits, lpIcon->dwNumBytes,
+ isIcon, 0x00030000);
+ }
+ }
+ return hIcon;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadICOHeader --
+ *
+ * Reads the header from an ICO file, as specfied by channel.
+ *
+ * Results:
+ * UINT - Number of images in file, -1 for failure.
+ * If this succeeds, there is a decent chance this is a
+ * valid icon file.
+ *
+ * Side effects:
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ReadICOHeader( Tcl_Channel channel )
+{
+ WORD Input;
+ DWORD dwBytesRead;
+
+ /* Read the 'reserved' WORD */
+ dwBytesRead = Tcl_Read( channel, (char*)&Input, sizeof( WORD ));
+ /* Did we get a WORD? */
+ if (dwBytesRead != sizeof( WORD ))
+ return -1;
+ /* Was it 'reserved' ? (ie 0) */
+ if (Input != 0)
+ return -1;
+ /* Read the type WORD */
+ dwBytesRead = Tcl_Read( channel, (char*)&Input, sizeof( WORD ));
+ /* Did we get a WORD? */
+ if (dwBytesRead != sizeof( WORD ))
+ return -1;
+ /* Was it type 1? */
+ if (Input != 1)
+ return -1;
+ /* Get the count of images */
+ dwBytesRead = Tcl_Read( channel, (char*)&Input, sizeof( WORD ));
+ /* Did we get a WORD? */
+ if (dwBytesRead != sizeof( WORD ))
+ return -1;
+ /* Return the count */
+ return (int)Input;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitWindowClass --
+ *
+ * This routine creates the Wm toplevel decorative frame class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Registers a new window class.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+InitWindowClass(WinIconPtr titlebaricon) {
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (! tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ tsdPtr->firstWindow = 1;
+ tsdPtr->iconPtr = NULL;
+ }
+ if (! initialized) {
+ Tcl_MutexLock(&winWmMutex);
+ if (! initialized) {
+ Tcl_DString classString;
+ WNDCLASS class;
+ initialized = 1;
+
+ if (shgetfileinfoProc == NULL) {
+ HINSTANCE hInstance = LoadLibraryA("shell32");
+ if (hInstance != NULL) {
+ shgetfileinfoProc =
+ (DWORD* (WINAPI *) (LPCTSTR pszPath, DWORD dwFileAttributes,
+ SHFILEINFO* psfi, UINT cbFileInfo, UINT uFlags)) GetProcAddress(hInstance,
+ "SHGetFileInfo");
+ FreeLibrary(hInstance);
+ }
+ }
+ /*
+ * The only difference between WNDCLASSW and WNDCLASSA are
+ * in pointers, so we can use the generic structure WNDCLASS.
+ */
+ ZeroMemory(&class, sizeof(WNDCLASS));
+
+ /*
+ * When threads are enabled, we cannot use CLASSDC because
+ * threads will then write into the same device context.
+ *
+ * This is a hack; we should add a subsystem that manages
+ * device context on a per-thread basis. See also tkWinX.c,
+ * which also initializes a WNDCLASS structure.
+ */
+
+#ifdef TCL_THREADS
+ class.style = CS_HREDRAW | CS_VREDRAW;
+#else
+ class.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;
+#endif
+ class.hInstance = Tk_GetHINSTANCE();
+ Tcl_WinUtfToTChar(TK_WIN_TOPLEVEL_CLASS_NAME, -1, &classString);
+ class.lpszClassName = (LPCTSTR) Tcl_DStringValue(&classString);
+ class.lpfnWndProc = WmProc;
+ if (titlebaricon == NULL) {
+ class.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
+ } else {
+ class.hIcon = GetIcon(titlebaricon, ICON_BIG);
+ if (class.hIcon == NULL) {
+ return TCL_ERROR;
+ }
+ /*
+ * Store pointer to default icon so we know when
+ * we need to free that information
+ */
+ tsdPtr->iconPtr = titlebaricon;
+ }
+ class.hCursor = LoadCursor(NULL, IDC_ARROW);
+
+ if (!(*tkWinProcs->registerClass)(&class)) {
+ panic("Unable to register TkTopLevel class");
+ }
+ Tcl_DStringFree(&classString);
+ }
+ Tcl_MutexUnlock(&winWmMutex);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitWm --
+ *
+ * This initialises the window manager
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Registers a new window class.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+InitWm(void)
+{
+ /* Ignore return result */
+ (void) InitWindowClass(NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WinSetIcon --
+ *
+ * Sets either the default toplevel titlebar icon, or the icon
+ * for a specific toplevel (if tkw is given, then only that
+ * window is used).
+ *
+ * The ref-count of the titlebaricon is NOT changed. If this
+ * function returns successfully, the caller should assume
+ * the icon was used (and therefore the ref-count should
+ * be adjusted to reflect that fact). If the function returned
+ * an error, the caller should assume the icon was not used
+ * (and may wish to free the memory associated with it).
+ *
+ * Results:
+ * A standard Tcl return code.
+ *
+ * Side effects:
+ * One or all windows may have their icon changed.
+ * The Tcl result may be modified.
+ * The window-manager will be initialised if it wasn't already.
+ * The given window will be forced into existence.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+WinSetIcon(interp, titlebaricon, tkw)
+ Tcl_Interp *interp;
+ WinIconPtr titlebaricon;
+ Tk_Window tkw;
+{
+ WmInfo *wmPtr;
+ HWND hwnd;
+ int application = 0;
+
+ if (tkw == NULL) {
+ tkw = Tk_MainWindow(interp);
+ application = 1;
+ }
+
+ if (!(Tk_IsTopLevel(tkw))) {
+ Tcl_AppendResult(interp, "window \"", Tk_PathName(tkw),
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_WindowId(tkw) == None) {
+ Tk_MakeWindowExist(tkw);
+ }
+ /* We must get the window's wrapper, not the window itself */
+ wmPtr = ((TkWindow*)tkw)->wmInfoPtr;
+ hwnd = wmPtr->wrapper;
+
+ if (application) {
+ if (hwnd == NULL) {
+ /*
+ * I don't actually think this is ever the correct thing, unless
+ * perhaps the window doesn't have a wrapper. But I believe all
+ * windows have wrappers.
+ */
+ hwnd = Tk_GetHWND(Tk_WindowId(tkw));
+ }
+ /*
+ * If we aren't initialised, then just initialise with the user's
+ * icon. Otherwise our icon choice will be ignored moments later
+ * when Tk finishes initialising.
+ */
+ if (!initialized) {
+ if (InitWindowClass(titlebaricon) != TCL_OK) {
+ Tcl_AppendResult(interp,"Unable to set icon", (char*)NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ ThreadSpecificData *tsdPtr;
+ if (
+#ifdef _WIN64
+ !SetClassLongPtr(hwnd, GCLP_HICONSM,
+ (LPARAM)GetIcon(titlebaricon, ICON_SMALL))
+#else
+ !SetClassLong(hwnd, GCL_HICONSM,
+ (LPARAM)GetIcon(titlebaricon, ICON_SMALL))
+#endif
+ ) {
+ /*
+ * For some reason this triggers, even though it seems
+ * to be successful This is probably related to the
+ * WNDCLASS vs WNDCLASSEX difference. Anyway it seems
+ * we have to ignore errors returned here.
+ */
+
+ /*
+ * Tcl_AppendResult(interp,"Unable to set new small icon", (char*)NULL);
+ * return TCL_ERROR;
+ */
+ }
+ if (
+#ifdef _WIN64
+ !SetClassLongPtr(hwnd, GCLP_HICON,
+ (LPARAM)GetIcon(titlebaricon, ICON_BIG))
+#else
+ !SetClassLong(hwnd, GCL_HICON,
+ (LPARAM)GetIcon(titlebaricon, ICON_BIG))
+#endif
+ ) {
+ Tcl_AppendResult(interp,"Unable to set new icon", (char*)NULL);
+ return TCL_ERROR;
+ }
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ if (tsdPtr->iconPtr != NULL) {
+ DecrIconRefCount(tsdPtr->iconPtr);
+ }
+ tsdPtr->iconPtr = titlebaricon;
+ }
+ } else {
+ if (!initialized) {
+ /*
+ * Need to initialise the wm otherwise we will fail on
+ * code which tries to set a toplevel's icon before that
+ * happens. Ignore return result.
+ */
+ (void)InitWindowClass(NULL);
+ }
+ /*
+ * The following code is exercised if you do
+ *
+ * toplevel .t ; wm titlebaricon .t foo.icr
+ *
+ * i.e. the wm hasn't had time to properly create
+ * the '.t' window before you set the icon.
+ */
+ if (hwnd == NULL) {
+ /*
+ * This little snippet is copied from the 'Map' function,
+ * and should probably be placed in one proper location
+ */
+ UpdateWrapper(wmPtr->winPtr);
+ wmPtr = ((TkWindow*)tkw)->wmInfoPtr;
+ hwnd = wmPtr->wrapper;
+ if (hwnd == NULL) {
+ Tcl_AppendResult(interp,
+ "Can't set icon; window has no wrapper.", (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+ SendMessage(hwnd, WM_SETICON, ICON_SMALL,
+ (LPARAM) GetIcon(titlebaricon, ICON_SMALL));
+ SendMessage(hwnd, WM_SETICON, ICON_BIG,
+ (LPARAM) GetIcon(titlebaricon, ICON_BIG));
+
+ /* Update the iconPtr we keep for each WmInfo structure. */
+ if (wmPtr->iconPtr != NULL) {
+ /* Free any old icon ptr which is associated with this window. */
+ DecrIconRefCount(wmPtr->iconPtr);
+ }
+ /*
+ * We do not need to increment the ref count for the
+ * titlebaricon, because it was already incremented when we
+ * retrieved it.
+ */
+ wmPtr->iconPtr = titlebaricon;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadIconFromFile --
+ *
+ * Read the contents of a file (usually .ico, .icr) and extract an
+ * icon resource, if possible, otherwise check if the shell has an
+ * icon assigned to the given file and use that. If both of those
+ * fail, then NULL is returned, and an error message will already be
+ * in the interpreter.
+ *
+ * Results:
+ * A WinIconPtr structure containing the icons in the file, with
+ * its ref count already incremented. The calling procedure should
+ * either place this structure inside a WmInfo structure, or it should
+ * pass it on to DecrIconRefCount() to ensure no memory leaks occur.
+ *
+ * If the given fileName did not contain a valid icon structure,
+ * return NULL.
+ *
+ * Side effects:
+ * Memory is allocated for the returned structure and the icons
+ * it contains. If the structure is not wanted, it should be
+ * passed to DecrIconRefCount, and in any case a valid ref count
+ * should be ensured to avoid memory leaks.
+ *
+ * Currently icon resources are not shared, so the ref count of
+ * one of these structures will always be 0 or 1. However all we
+ * need do is implement some sort of lookup function between
+ * filenames and WinIconPtr structures and no other code will need
+ * to be changed. The pseudo-code for this is implemented below
+ * in the 'if (0)' branch. It did not seem necessary to implement
+ * this optimisation here, since moving to icon<->image
+ * conversions will probably make it obsolete.
+ *
+ *----------------------------------------------------------------------
+ */
+static WinIconPtr
+ReadIconFromFile(interp, fileName)
+ Tcl_Interp *interp;
+ Tcl_Obj *fileName;
+{
+ WinIconPtr titlebaricon = NULL;
+
+ if (0 /* If we already have an icon for this filename */) {
+ titlebaricon = NULL; /* Get the real value from a lookup */
+ titlebaricon->refCount++;
+ return titlebaricon;
+ } else {
+ /* First check if it is a .ico file */
+ BlockOfIconImagesPtr lpIR;
+ lpIR = ReadIconOrCursorFromFile(interp, fileName, TRUE);
+
+ /* Then see if we can ask the shell for the icon for this file */
+ if (lpIR == NULL && shgetfileinfoProc != NULL) {
+ SHFILEINFO sfi;
+ Tcl_DString ds, ds2;
+ DWORD *res;
+ CONST char *file;
+
+ file = Tcl_TranslateFileName(interp, Tcl_GetString(fileName), &ds);
+ if (file == NULL) { return NULL; }
+ Tcl_UtfToExternalDString(NULL, file, -1, &ds2);
+ Tcl_DStringFree(&ds);
+
+ res = (*shgetfileinfoProc)(Tcl_DStringValue(&ds2), 0, &sfi,
+ sizeof(SHFILEINFO), SHGFI_SMALLICON|SHGFI_ICON);
+
+ Tcl_DStringFree(&ds2);
+
+ if (res != 0) {
+ Tcl_ResetResult(interp);
+
+ lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages));
+ if (lpIR == NULL) {
+ DestroyIcon(sfi.hIcon);
+ return NULL;
+ }
+
+ lpIR->nNumImages = 1;
+ lpIR->IconImages[0].Width = 16;
+ lpIR->IconImages[0].Height = 16;
+ lpIR->IconImages[0].Colors = 4;
+ lpIR->IconImages[0].hIcon = sfi.hIcon;
+ /* These fields are ignored */
+ lpIR->IconImages[0].lpBits = 0;
+ lpIR->IconImages[0].dwNumBytes = 0;
+ lpIR->IconImages[0].lpXOR = 0;
+ lpIR->IconImages[0].lpAND = 0;
+ }
+ }
+ if (lpIR != NULL) {
+ titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance));
+ titlebaricon->iconBlock = lpIR;
+ titlebaricon->refCount = 1;
+ }
+ return titlebaricon;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIconFromPixmap --
+ *
+ * Turn a Tk Pixmap (i.e. a bitmap) into an icon resource, if
+ * possible, otherwise NULL is returned.
+ *
+ * Results:
+ * A WinIconPtr structure containing a conversion of the given
+ * bitmap into an icon, with its ref count already incremented. The
+ * calling procedure should either place this structure inside a
+ * WmInfo structure, or it should pass it on to DecrIconRefCount()
+ * to ensure no memory leaks occur.
+ *
+ * If the given pixmap did not contain a valid icon structure,
+ * return NULL.
+ *
+ * Side effects:
+ * Memory is allocated for the returned structure and the icons
+ * it contains. If the structure is not wanted, it should be
+ * passed to DecrIconRefCount, and in any case a valid ref count
+ * should be ensured to avoid memory leaks.
+ *
+ * Currently icon resources are not shared, so the ref count of
+ * one of these structures will always be 0 or 1. However all we
+ * need do is implement some sort of lookup function between
+ * pixmaps and WinIconPtr structures and no other code will need
+ * to be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+static WinIconPtr
+GetIconFromPixmap(dsPtr, pixmap)
+ Display *dsPtr;
+ Pixmap pixmap;
+{
+ WinIconPtr titlebaricon = NULL;
+ TkWinDrawable* twdPtr = (TkWinDrawable*) pixmap;
+
+ if (twdPtr == NULL) {
+ return NULL;
+ }
+
+ if (0 /* If we already have an icon for this pixmap */) {
+ titlebaricon = NULL; /* Get the real value from a lookup */
+ titlebaricon->refCount++;
+ return titlebaricon;
+ } else {
+ BlockOfIconImagesPtr lpIR;
+ ICONINFO icon;
+ HICON hIcon;
+ int width, height;
+
+ Tk_SizeOfBitmap(dsPtr, pixmap, &width, &height);
+
+ icon.fIcon = TRUE;
+ icon.xHotspot = 0;
+ icon.yHotspot = 0;
+ icon.hbmMask = twdPtr->bitmap.handle;
+ icon.hbmColor = twdPtr->bitmap.handle;
+
+ hIcon = CreateIconIndirect(&icon);
+ if (hIcon == NULL) {
+ return NULL;
+ }
+
+ lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages));
+ if (lpIR == NULL) {
+ DestroyIcon(hIcon);
+ return NULL;
+ }
+
+ lpIR->nNumImages = 1;
+ lpIR->IconImages[0].Width = width;
+ lpIR->IconImages[0].Height = height;
+ lpIR->IconImages[0].Colors = 1 << twdPtr->bitmap.depth;
+ lpIR->IconImages[0].hIcon = hIcon;
+ /* These fields are ignored */
+ lpIR->IconImages[0].lpBits = 0;
+ lpIR->IconImages[0].dwNumBytes = 0;
+ lpIR->IconImages[0].lpXOR = 0;
+ lpIR->IconImages[0].lpAND = 0;
+
+ titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance));
+ titlebaricon->iconBlock = lpIR;
+ titlebaricon->refCount = 1;
+ return titlebaricon;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DecrIconRefCount --
+ *
+ * Reduces the reference count.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the ref count falls to zero, free the memory associated
+ * with the icon resource structures. In this case the pointer
+ * passed into this function is no longer valid.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DecrIconRefCount(WinIconPtr titlebaricon) {
+ titlebaricon->refCount--;
+
+ if (titlebaricon->refCount <= 0) {
+ if (titlebaricon->iconBlock != NULL) {
+ FreeIconBlock(titlebaricon->iconBlock);
+ }
+ titlebaricon->iconBlock = NULL;
+
+ ckfree((char*)titlebaricon);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeIconBlock --
+ *
+ * Frees all memory associated with a previously loaded
+ * titlebaricon. The icon block pointer is no longer
+ * valid once this function returns.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FreeIconBlock(BlockOfIconImagesPtr lpIR) {
+ int i;
+
+ /* Free all the bits */
+ for (i=0; i< lpIR->nNumImages; i++) {
+ if (lpIR->IconImages[i].lpBits != NULL) {
+ ckfree((char*)lpIR->IconImages[i].lpBits);
+ }
+ if (lpIR->IconImages[i].hIcon != NULL) {
+ DestroyIcon(lpIR->IconImages[i].hIcon);
+ }
+ }
+ ckfree ((char*)lpIR);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIcon --
+ *
+ * Extracts an icon of a given size from an icon resource
+ *
+ * Results:
+ * Returns the icon, if found, else NULL.
+ *
+ * Side effects:
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static HICON
+GetIcon(WinIconPtr titlebaricon, int icon_size) {
+ BlockOfIconImagesPtr lpIR;
+
+ if (titlebaricon == NULL) {
+ return NULL;
+ }
+
+ lpIR = titlebaricon->iconBlock;
+ if (lpIR == NULL) {
+ return NULL;
+ } else {
+ unsigned int size = (icon_size == 0 ? 16 : 32);
+ int i;
+
+ for (i = 0; i < lpIR->nNumImages; i++) {
+ /* Take the first or a 32x32 16 color icon*/
+ if ((lpIR->IconImages[i].Height == size)
+ && (lpIR->IconImages[i].Width == size)
+ && (lpIR->IconImages[i].Colors >= 4)) {
+ return lpIR->IconImages[i].hIcon;
+ }
+ }
+
+ /*
+ * If we get here, then just return the first one,
+ * it will have to do!
+ */
+ if (lpIR->nNumImages >= 1) {
+ return lpIR->IconImages[0].hIcon;
+ }
+ }
+ return NULL;
+}
+
+static HCURSOR
+TclWinReadCursorFromFile(Tcl_Interp* interp, Tcl_Obj* fileName) {
+ BlockOfIconImagesPtr lpIR;
+ HICON res = NULL;
+
+ lpIR = ReadIconOrCursorFromFile(interp, fileName, FALSE);
+ if (lpIR == NULL) {
+ return NULL;
+ }
+ if (lpIR->nNumImages >= 1) {
+ res = CopyImage(lpIR->IconImages[0].hIcon, IMAGE_CURSOR,0,0,0);
+ }
+ FreeIconBlock(lpIR);
+ return res;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadIconOrCursorFromFile --
+ *
+ * Reads an Icon Resource from an ICO file, as given by
+ * char* fileName - Name of the ICO file. This name should
+ * be in Utf format.
+ *
+ * Results:
+ * Returns an icon resource, if found, else NULL.
+ *
+ * Side effects:
+ * May leave error messages in the Tcl interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static BlockOfIconImagesPtr
+ReadIconOrCursorFromFile(Tcl_Interp* interp, Tcl_Obj* fileName, BOOL isIcon) {
+ BlockOfIconImagesPtr lpIR, lpNew;
+ Tcl_Channel channel;
+ int i;
+ DWORD dwBytesRead;
+ LPICONDIRENTRY lpIDE;
+
+ /* Open the file */
+ channel = Tcl_FSOpenFileChannel(interp, fileName, "r", 0);
+ if (channel == NULL) {
+ Tcl_AppendResult(interp,"Error opening file \"",
+ Tcl_GetString(fileName),
+ "\" for reading",(char*)NULL);
+ return NULL;
+ }
+ if (Tcl_SetChannelOption(interp, channel, "-translation", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, channel);
+ return NULL;
+ }
+ if (Tcl_SetChannelOption(interp, channel, "-encoding", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, channel);
+ return NULL;
+ }
+ /* Allocate memory for the resource structure */
+ lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages));
+ if (lpIR == NULL) {
+ Tcl_AppendResult(interp,"Error allocating memory",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ return NULL;
+ }
+ /* Read in the header */
+ if ((lpIR->nNumImages = ReadICOHeader( channel )) == -1) {
+ Tcl_AppendResult(interp,"Invalid file header",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree((char*) lpIR );
+ return NULL;
+ }
+ /* Adjust the size of the struct to account for the images */
+ lpNew = (BlockOfIconImagesPtr) ckrealloc((char*)lpIR,
+ sizeof(BlockOfIconImages) + ((lpIR->nNumImages-1) * sizeof(ICONIMAGE)));
+ if (lpNew == NULL) {
+ Tcl_AppendResult(interp,"Error allocating memory",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree( (char*)lpIR );
+ return NULL;
+ }
+ lpIR = lpNew;
+ /* Allocate enough memory for the icon directory entries */
+ lpIDE = (LPICONDIRENTRY) ckalloc(lpIR->nNumImages * sizeof(ICONDIRENTRY));
+ if (lpIDE == NULL) {
+ Tcl_AppendResult(interp,"Error allocating memory",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree( (char*)lpIR );
+ return NULL;
+ }
+ /* Read in the icon directory entries */
+ dwBytesRead = Tcl_Read(channel, (char*)lpIDE,
+ lpIR->nNumImages * sizeof( ICONDIRENTRY ));
+ if (dwBytesRead != lpIR->nNumImages * sizeof( ICONDIRENTRY )) {
+ Tcl_AppendResult(interp,"Error reading file",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree( (char*)lpIR );
+ return NULL;
+ }
+ /* Loop through and read in each image */
+ for( i = 0; i < lpIR->nNumImages; i++ ) {
+ /* Allocate memory for the resource */
+ lpIR->IconImages[i].lpBits = (LPBYTE) ckalloc(lpIDE[i].dwBytesInRes);
+ if (lpIR->IconImages[i].lpBits == NULL) {
+ Tcl_AppendResult(interp,"Error allocating memory",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree( (char*)lpIR );
+ ckfree( (char*)lpIDE );
+ return NULL;
+ }
+ lpIR->IconImages[i].dwNumBytes = lpIDE[i].dwBytesInRes;
+ /* Seek to beginning of this image */
+ if (Tcl_Seek(channel, lpIDE[i].dwImageOffset, FILE_BEGIN) == -1) {
+ Tcl_AppendResult(interp,"Error seeking in file",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree( (char*)lpIR );
+ ckfree( (char*)lpIDE );
+ return NULL;
+ }
+ /* Read it in */
+ dwBytesRead = Tcl_Read( channel, lpIR->IconImages[i].lpBits,
+ lpIDE[i].dwBytesInRes);
+ if (dwBytesRead != lpIDE[i].dwBytesInRes) {
+ Tcl_AppendResult(interp,"Error reading file",(char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree( (char*)lpIDE );
+ ckfree( (char*)lpIR );
+ return NULL;
+ }
+ /* Set the internal pointers appropriately */
+ if (!AdjustIconImagePointers( &(lpIR->IconImages[i]))) {
+ Tcl_AppendResult(interp,"Error converting to internal format",
+ (char*)NULL);
+ Tcl_Close(NULL, channel);
+ ckfree( (char*)lpIDE );
+ ckfree( (char*)lpIR );
+ return NULL;
+ }
+ lpIR->IconImages[i].hIcon =
+ MakeIconOrCursorFromResource(&(lpIR->IconImages[i]), isIcon);
+ }
+ /* Clean up */
+ ckfree((char*)lpIDE);
+ Tcl_Close(NULL, channel);
+ if (lpIR == NULL){
+ Tcl_AppendResult(interp,"Reading of ", Tcl_GetString(fileName),
+ " failed!",(char*)NULL);
+ return NULL;
+ }
+ return lpIR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * If this function is called before the CreateWindowEx call
+ * has completed, then the user data slot will not have been
+ * set yet, so we use the global createWindow variable.
+ */
+
+ if (tsdPtr->createWindow) {
+ return tsdPtr->createWindow;
+ }
+#ifdef _WIN64
+ return (TkWindow *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
+#else
+ return (TkWindow *) GetWindowLong(hwnd, GWL_USERDATA);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * If we're using stubs to access the Tcl library, and they
+ * haven't been initialized, we can't call Tcl_GetThreadData.
+ */
+
+#ifdef USE_TCL_STUBS
+ if (tclStubsPtr == NULL) {
+ return;
+ }
+#endif
+
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ return;
+ }
+ tsdPtr->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));
+
+ /*
+ * Initialize full structure, then set what isn't NULL
+ */
+ ZeroMemory(wmPtr, sizeof(WmInfo));
+ winPtr->wmInfoPtr = wmPtr;
+ wmPtr->winPtr = winPtr;
+ 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;
+
+ /*
+ * 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->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->configWidth = -1;
+ wmPtr->configHeight = -1;
+ wmPtr->flags = WM_NEVER_MAPPED;
+ wmPtr->nextPtr = winPtr->dispPtr->firstWmPtr;
+ winPtr->dispPtr->firstWmPtr = wmPtr;
+
+ /*
+ * Tk must monitor structure events for top-level windows, in order
+ * to detect size and position changes caused by window managers.
+ */
+
+ Tk_CreateEventHandler((Tk_Window) winPtr, StructureNotifyMask,
+ 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, oldWrapper;
+ HWND child;
+ int x, y, width, height, state;
+ WINDOWPLACEMENT place;
+ HICON hSmallIcon = NULL;
+ HICON hBigIcon = NULL;
+ Tcl_DString titleString, classString;
+ int *childStateInfo = NULL;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->window == None) {
+ /*
+ * Ensure existence of the window to update the wrapper for.
+ */
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ }
+
+ child = TkWinGetHWND(winPtr->window);
+ parentHWND = NULL;
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ wmPtr->wrapper = (HWND) winPtr->privatePtr;
+ if (wmPtr->wrapper == NULL) {
+ panic("UpdateWrapper: Cannot find container window");
+ }
+ if (!IsWindow(wmPtr->wrapper)) {
+ panic("UpdateWrapper: 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 Windows 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;
+ }
+
+ wmPtr->style |= wmPtr->styleConfig;
+ wmPtr->exStyle |= wmPtr->exStyleConfig;
+
+ 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.
+ */
+
+ tsdPtr->createWindow = winPtr;
+ Tcl_WinUtfToTChar(((wmPtr->title != NULL) ?
+ wmPtr->title : winPtr->nameUid), -1, &titleString);
+ Tcl_WinUtfToTChar(TK_WIN_TOPLEVEL_CLASS_NAME, -1, &classString);
+ wmPtr->wrapper = (*tkWinProcs->createWindowEx)(wmPtr->exStyle,
+ (LPCTSTR) Tcl_DStringValue(&classString),
+ (LPCTSTR) Tcl_DStringValue(&titleString),
+ wmPtr->style, x, y, width, height,
+ parentHWND, NULL, Tk_GetHINSTANCE(), NULL);
+ Tcl_DStringFree(&classString);
+ Tcl_DStringFree(&titleString);
+#ifdef _WIN64
+ SetWindowLongPtr(wmPtr->wrapper, GWLP_USERDATA, (LONG_PTR) winPtr);
+#else
+ SetWindowLong(wmPtr->wrapper, GWL_USERDATA, (LONG) winPtr);
+#endif
+ tsdPtr->createWindow = NULL;
+
+ place.length = sizeof(WINDOWPLACEMENT);
+ GetWindowPlacement(wmPtr->wrapper, &place);
+ wmPtr->x = place.rcNormalPosition.left;
+ wmPtr->y = place.rcNormalPosition.top;
+
+ TkInstallFrameMenu((Tk_Window) winPtr);
+ }
+
+ /*
+ * 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.
+ */
+
+#ifdef _WIN64
+ SetWindowLongPtr(child, GWL_STYLE,
+ WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS);
+#else
+ SetWindowLong(child, GWL_STYLE,
+ WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS);
+#endif
+ if (winPtr->flags & TK_EMBEDDED) {
+#ifdef _WIN64
+ SetWindowLongPtr(child, GWLP_WNDPROC, (LONG_PTR) TopLevelProc);
+#else
+ SetWindowLong(child, GWL_WNDPROC, (LONG) TopLevelProc);
+#endif
+ }
+ oldWrapper = SetParent(child, wmPtr->wrapper);
+ if (oldWrapper) {
+ hSmallIcon = (HICON) SendMessage(oldWrapper, WM_GETICON, ICON_SMALL,
+ (LPARAM) NULL);
+ hBigIcon = (HICON) SendMessage(oldWrapper, WM_GETICON, ICON_BIG,
+ (LPARAM) NULL);
+ }
+
+ if (oldWrapper && (oldWrapper != wmPtr->wrapper)
+ && (oldWrapper != GetDesktopWindow())) {
+#ifdef _WIN64
+ SetWindowLongPtr(oldWrapper, GWLP_USERDATA, (LONG) NULL);
+#else
+ SetWindowLong(oldWrapper, GWL_USERDATA, (LONG) NULL);
+#endif
+
+ if (wmPtr->numTransients > 0) {
+ /*
+ * Unset the current wrapper as the parent for all transient
+ * children for whom this is the master
+ */
+ WmInfo *wmPtr2;
+
+ childStateInfo = (int *)ckalloc((unsigned) wmPtr->numTransients
+ * sizeof(int));
+ state = 0;
+ for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL;
+ wmPtr2 = wmPtr2->nextPtr) {
+ if (wmPtr2->masterPtr == winPtr) {
+ if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
+ childStateInfo[state++] = wmPtr2->hints.initial_state;
+ SetParent(TkWinGetHWND(wmPtr2->winPtr->window), 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 (hSmallIcon != NULL) {
+ SendMessage(wmPtr->wrapper,WM_SETICON,ICON_SMALL,(LPARAM)hSmallIcon);
+ }
+ if (hBigIcon != NULL) {
+ SendMessage(wmPtr->wrapper,WM_SETICON,ICON_BIG,(LPARAM)hBigIcon);
+ }
+
+ /*
+ * 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 (childStateInfo) {
+ if (wmPtr->numTransients > 0) {
+ /*
+ * Reset all transient children for whom this is the master
+ */
+ WmInfo *wmPtr2;
+
+ state = 0;
+ for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL;
+ wmPtr2 = wmPtr2->nextPtr) {
+ if (wmPtr2->masterPtr == winPtr) {
+ if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
+ UpdateWrapper(wmPtr2->winPtr);
+ TkpWmSetState(wmPtr2->winPtr, childStateInfo[state++]);
+ }
+ }
+ }
+ }
+
+ ckfree((char *) childStateInfo);
+ }
+
+ /*
+ * If this is the first window created by the application, then
+ * we should activate the initial window.
+ */
+
+ if (tsdPtr->firstWindow) {
+ tsdPtr->firstWindow = 0;
+ SetActiveWindow(wmPtr->wrapper);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ InitWm();
+ }
+
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ /*
+ * Don't map a transient if the master is not mapped.
+ */
+
+ if (wmPtr->masterPtr != NULL &&
+ !Tk_IsMapped(wmPtr->masterPtr)) {
+ wmPtr->hints.initial_state = WithdrawnState;
+ return;
+ }
+ } else {
+ 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.
+ */
+
+ 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 (winPtr->dispPtr->firstWmPtr == wmPtr) {
+ winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
+ } else {
+ register WmInfo *prevPtr;
+ for (prevPtr = winPtr->dispPtr->firstWmPtr; ;
+ prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ panic("couldn't unlink window in TkWmDeadWindow");
+ }
+ if (prevPtr->nextPtr == wmPtr) {
+ prevPtr->nextPtr = wmPtr->nextPtr;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Reset all transient windows whose master is the dead window.
+ */
+
+ for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL;
+ wmPtr2 = wmPtr2->nextPtr) {
+ if (wmPtr2->masterPtr == winPtr) {
+ wmPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) wmPtr2->masterPtr,
+ VisibilityChangeMask|StructureNotifyMask,
+ WmWaitVisibilityOrMapProc, (ClientData) wmPtr2->winPtr);
+ wmPtr2->masterPtr = NULL;
+ if ((wmPtr2->wrapper != None)
+ && !(wmPtr2->flags & (WM_NEVER_MAPPED))) {
+ UpdateWrapper(wmPtr2->winPtr);
+ }
+ }
+ }
+ if (wmPtr->numTransients != 0)
+ panic("numTransients should be 0");
+
+ 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->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);
+ }
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr2 = wmPtr->masterPtr->wmInfoPtr;
+ /*
+ * If we had a master, tell them that we aren't tied
+ * to them anymore
+ */
+ if (wmPtr2 != NULL) {
+ wmPtr2->numTransients--;
+ }
+ Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
+ VisibilityChangeMask|StructureNotifyMask,
+ WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+ wmPtr->masterPtr = NULL;
+ }
+
+ /*
+ * Destroy the decorative frame window.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (wmPtr->wrapper != NULL) {
+ DestroyWindow(wmPtr->wrapper);
+ } else {
+ DestroyWindow(Tk_GetHWND(winPtr->window));
+ }
+ }
+ if (wmPtr->iconPtr != NULL) {
+ /*
+ * This may delete the icon resource data. I believe we
+ * should do this after destroying the decorative frame,
+ * because the decorative frame is using this icon.
+ */
+ DecrIconRefCount(wmPtr->iconPtr);
+ }
+
+ 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_WmObjCmd --
+ *
+ * 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_WmObjCmd(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;
+ static CONST char *optionStrings[] = {
+ "aspect", "attributes", "client", "colormapwindows",
+ "command", "deiconify", "focusmodel", "frame",
+ "geometry", "grid", "group", "iconbitmap",
+ "iconify", "iconmask", "iconname", "iconposition",
+ "iconwindow", "maxsize", "minsize", "overrideredirect",
+ "positionfrom", "protocol", "resizable", "sizefrom",
+ "stackorder", "state", "title", "transient",
+ "withdraw", (char *) NULL };
+ enum options {
+ WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
+ WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
+ WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
+ WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
+ WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
+ WMOPT_WITHDRAW };
+ int index, length;
+ char *argv1;
+ TkWindow *winPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objc < 2) {
+ wrongNumArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ argv1 = Tcl_GetStringFromObj(objv[1], &length);
+ if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0)
+ && (length >= 3)) {
+ int wmTracing;
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetResult(interp,
+ ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmTracing) {
+ dispPtr->flags |= TK_DISPLAY_WM_TRACING;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
+ }
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc < 3) {
+ goto wrongNumArgs;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case WMOPT_ASPECT:
+ return WmAspectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ATTRIBUTES:
+ return WmAttributesCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_CLIENT:
+ return WmClientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COLORMAPWINDOWS:
+ return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_COMMAND:
+ return WmCommandCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_DEICONIFY:
+ return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FOCUSMODEL:
+ return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_FRAME:
+ return WmFrameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GEOMETRY:
+ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GRID:
+ return WmGridCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_GROUP:
+ return WmGroupCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONBITMAP:
+ return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONIFY:
+ return WmIconifyCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONMASK:
+ return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONNAME:
+ return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPOSITION:
+ return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONWINDOW:
+ return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MAXSIZE:
+ return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_MINSIZE:
+ return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_OVERRIDEREDIRECT:
+ return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_POSITIONFROM:
+ return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_PROTOCOL:
+ return WmProtocolCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_RESIZABLE:
+ return WmResizableCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_SIZEFROM:
+ return WmSizefromCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STACKORDER:
+ return WmStackorderCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_STATE:
+ return WmStateCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TITLE:
+ return WmTitleCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_TRANSIENT:
+ return WmTransientCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_WITHDRAW:
+ return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAspectCmd --
+ *
+ * This procedure is invoked to process the "wm aspect" 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
+WmAspectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int numer1, denom1, numer2, denom2;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?minNumer minDenom maxNumer maxDenom?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PAspect) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
+ wmPtr->minAspect.y, wmPtr->maxAspect.x,
+ wmPtr->maxAspect.y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~PAspect;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
+ (denom2 <= 0)) {
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ wmPtr->minAspect.x = numer1;
+ wmPtr->minAspect.y = denom1;
+ wmPtr->maxAspect.x = numer2;
+ wmPtr->maxAspect.y = denom2;
+ wmPtr->sizeHintsFlags |= PAspect;
+ }
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmAttributesCmd --
+ *
+ * This procedure is invoked to process the "wm attributes" 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
+WmAttributesCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ LONG style, exStyle, styleBit, *stylePtr;
+ char buf[TCL_INTEGER_SPACE], *string;
+ int i, boolean, length;
+
+ if (objc < 3) {
+ configArgs:
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window"
+ " ?-disabled ?bool??"
+ " ?-toolwindow ?bool??"
+ " ?-topmost ?bool??");
+ return TCL_ERROR;
+ }
+ exStyle = wmPtr->exStyleConfig;
+ style = wmPtr->styleConfig;
+ if (objc == 3) {
+ sprintf(buf, "%d", ((style & WS_DISABLED) != 0));
+ Tcl_AppendResult(interp, "-disabled ", buf, (char *) NULL);
+ sprintf(buf, "%d", ((exStyle & WS_EX_TOOLWINDOW) != 0));
+ Tcl_AppendResult(interp, " -toolwindow ", buf, (char *) NULL);
+ sprintf(buf, "%d", ((exStyle & WS_EX_TOPMOST) != 0));
+ Tcl_AppendResult(interp, " -topmost ", buf, (char *) NULL);
+ return TCL_OK;
+ }
+ for (i = 3; i < objc; i += 2) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ if ((length < 2) || (string[0] != '-')) {
+ goto configArgs;
+ }
+ if ((i < objc-1) &&
+ (Tcl_GetBooleanFromObj(interp, objv[i+1], &boolean) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (strncmp(string, "-disabled", length) == 0) {
+ stylePtr = &style;
+ styleBit = WS_DISABLED;
+ } else if ((strncmp(string, "-toolwindow", length) == 0)
+ && (length >= 3)) {
+ stylePtr = &exStyle;
+ styleBit = WS_EX_TOOLWINDOW;
+ } else if ((strncmp(string, "-topmost", length) == 0)
+ && (length >= 3)) {
+ stylePtr = &exStyle;
+ styleBit = WS_EX_TOPMOST;
+ if ((i < objc-1) && (winPtr->flags & TK_EMBEDDED)) {
+ Tcl_AppendResult(interp, "can't set topmost flag on ",
+ winPtr->pathName, ": it is an embedded window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ goto configArgs;
+ }
+ if (i == objc-1) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ ((*stylePtr & styleBit) != 0));
+ } else if (boolean) {
+ *stylePtr |= styleBit;
+ } else {
+ *stylePtr &= ~styleBit;
+ }
+ }
+ if ((wmPtr->styleConfig != style) ||
+ (wmPtr->exStyleConfig != exStyle)) {
+ wmPtr->styleConfig = style;
+ wmPtr->exStyleConfig = exStyle;
+ UpdateWrapper(winPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmClientCmd --
+ *
+ * This procedure is invoked to process the "wm client" 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
+WmClientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->clientMachine != NULL) {
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (argv3[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) (length + 1));
+ strcpy(wmPtr->clientMachine, argv3);
+ 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);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmColormapwindowsCmd --
+ *
+ * This procedure is invoked to process the "wm colormapwindows"
+ * 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
+WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ TkWindow **cmapList;
+ TkWindow *winPtr2;
+ int i, windowObjc, gotToplevel;
+ Tcl_Obj **windowObjv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?");
+ return TCL_ERROR;
+ }
+ if (objc == 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_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (TkWindow **) ckalloc((unsigned)
+ ((windowObjc+1)*sizeof(TkWindow*)));
+ gotToplevel = 0;
+ for (i = 0; i < windowObjc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, windowObjv[i],
+ (Tk_Window *) &winPtr2) != TCL_OK)
+ {
+ ckfree((char *) cmapList);
+ 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[windowObjc] = winPtr;
+ windowObjc++;
+ } 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 = windowObjc;
+
+ /*
+ * Now we need to force the updated colormaps to be installed.
+ */
+
+ if (wmPtr == winPtr->dispPtr->foregroundWmPtr) {
+ InstallColormaps(wmPtr->wrapper, WM_QUERYNEWPALETTE, 1);
+ } else {
+ InstallColormaps(wmPtr->wrapper, WM_PALETTECHANGED, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmCommandCmd --
+ *
+ * This procedure is invoked to process the "wm command" 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
+WmCommandCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int cmdArgc;
+ CONST char **cmdArgv;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?value?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->cmdArgv != NULL) {
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (argv3[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, argv3, &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);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmDeiconifyCmd --
+ *
+ * This procedure is invoked to process the "wm deiconify" 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
+WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[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 deiconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) {
+ wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN;
+ }
+
+ /*
+ * If WM_UPDATE_PENDING is true, a pending UpdateGeometryInfo may
+ * need to be called first to update a withdrawn toplevel's geometry
+ * before it is deiconified by TkpWmSetState.
+ * Don't bother if we've never been mapped.
+ */
+ if ((wmPtr->flags & WM_UPDATE_PENDING) &&
+ !(wmPtr->flags & WM_NEVER_MAPPED)) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ UpdateGeometryInfo((ClientData) winPtr);
+ }
+
+ /*
+ * If we were in the ZoomState (maximized), 'wm deiconify'
+ * should not cause the window to shrink
+ */
+ if (wmPtr->hints.initial_state == ZoomState) {
+ TkpWmSetState(winPtr, ZoomState);
+ } else {
+ TkpWmSetState(winPtr, NormalState);
+ }
+
+ /*
+ * An unmapped window will be mapped at idle time
+ * by a call to MapFrame. That calls CreateWrapper
+ * which sets the focus and raises the window.
+ */
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return TCL_OK;
+ }
+
+ /*
+ * Follow Windows-like style here, raising the window to the top.
+ */
+ TkWmRestackToplevel(winPtr, Above, NULL);
+ if (!(Tk_Attributes((Tk_Window) winPtr)->override_redirect)) {
+ TkSetFocusWin(winPtr, 1);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFocusmodelCmd --
+ *
+ * This procedure is invoked to process the "wm focusmodel" 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
+WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "active", "passive", (char *) NULL };
+ enum options {
+ OPT_ACTIVE, OPT_PASSIVE };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ACTIVE) {
+ wmPtr->hints.input = False;
+ } else { /* OPT_PASSIVE */
+ wmPtr->hints.input = True;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmFrameCmd --
+ *
+ * This procedure is invoked to process the "wm frame" 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
+WmFrameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ HWND hwnd;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (Tk_WindowId((Tk_Window) winPtr) == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ }
+ hwnd = wmPtr->wrapper;
+ if (hwnd == NULL) {
+ hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr));
+ }
+ sprintf(buf, "0x%x", (unsigned int) hwnd);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGeometryCmd --
+ *
+ * This procedure is invoked to process the "wm geometry" 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
+WmGeometryCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char xSign, ySign;
+ int width, height;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
+ xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
+ ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
+ if (wmPtr->gridWin != NULL) {
+ width = wmPtr->reqGridWidth + (winPtr->changes.width
+ - winPtr->reqWidth)/wmPtr->widthInc;
+ height = wmPtr->reqGridHeight + (winPtr->changes.height
+ - winPtr->reqHeight)/wmPtr->heightInc;
+ } else {
+ width = winPtr->changes.width;
+ height = winPtr->changes.height;
+ }
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\0') {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+ }
+ return ParseGeometry(interp, argv3, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGridCmd --
+ *
+ * This procedure is invoked to process the "wm grid" 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
+WmGridCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int reqWidth, reqHeight, widthInc, heightInc;
+
+ if ((objc != 3) && (objc != 7)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?baseWidth baseHeight widthInc heightInc?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & PBaseSize) {
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
+ wmPtr->reqGridHeight, wmPtr->widthInc,
+ wmPtr->heightInc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (reqWidth < 0) {
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (reqHeight < 0) {
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (widthInc < 0) {
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (heightInc < 0) {
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
+ heightInc);
+ }
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmGroupCmd --
+ *
+ * This procedure is invoked to process the "wm group" 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
+WmGroupCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ char *argv3;
+ int length;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & WindowGroupHint) {
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ if (*argv3 == '\0') {
+ wmPtr->hints.flags &= ~WindowGroupHint;
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(tkwin2);
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ wmPtr->hints.window_group = Tk_WindowId(tkwin2);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->leaderName, argv3);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconbitmapCmd --
+ *
+ * This procedure is invoked to process the "wm iconbitmap" 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
+WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ /* If true, then set for all windows. */
+ int isDefault = 0;
+ char *string;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? ?image?");
+ return TCL_ERROR;
+ } else if (objc == 5) {
+ /* If we have 5 arguments, we must have a '-default' flag */
+ char *argv3 = Tcl_GetString(objv[3]);
+ if (strcmp(argv3, "-default")) {
+ Tcl_AppendResult(interp, "illegal option \"",
+ argv3, "\" must be \"-default\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ isDefault = 1;
+ } else if (objc == 3) {
+ /* No arguments were given */
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tcl_SetResult(interp, (char *)
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ string = Tcl_GetString(objv[objc-1]);
+ if (*string == '\0') {
+ if (wmPtr->hints.icon_pixmap != None) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
+ wmPtr->hints.icon_pixmap = None;
+ }
+ wmPtr->hints.flags &= ~IconPixmapHint;
+ if (WinSetIcon(interp, NULL,
+ (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * In the future this block of code will use Tk's 'image'
+ * functionality to allow all supported image formats.
+ * However, this will require a change to the way icons are
+ * handled. We will need to add icon<->image conversions
+ * routines.
+ *
+ * Until that happens we simply try to find an icon in the
+ * given argument, and if that fails, we use the older
+ * bitmap code. We do things this way round (icon then
+ * bitmap), because the bitmap code actually seems to have
+ * no visible effect, so we want to give the icon code the
+ * first try at doing something.
+ */
+
+ /*
+ * Either return NULL, or return a valid titlebaricon with its
+ * ref count already incremented.
+ */
+ WinIconPtr titlebaricon = ReadIconFromFile(interp, objv[objc-1]);
+ if (titlebaricon != NULL) {
+ /*
+ * Try to set the icon for the window. If it is a '-default'
+ * icon, we must pass in NULL
+ */
+ if (WinSetIcon(interp, titlebaricon,
+ (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) {
+ /* We didn't use the titlebaricon after all */
+ DecrIconRefCount(titlebaricon);
+ titlebaricon = NULL;
+ }
+ }
+ if (titlebaricon == NULL) {
+ /*
+ * We didn't manage to handle the argument as a valid
+ * icon. Try as a bitmap. First we must clear the
+ * error message which was placed in the interpreter
+ */
+ Pixmap pixmap;
+ Tcl_ResetResult(interp);
+ pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, string);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ titlebaricon = GetIconFromPixmap(Tk_Display(winPtr), pixmap);
+ if (titlebaricon != NULL) {
+ if (WinSetIcon(interp, titlebaricon,
+ (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) {
+ /* We didn't use the titlebaricon after all */
+ DecrIconRefCount(titlebaricon);
+ titlebaricon = NULL;
+ }
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconifyCmd --
+ *
+ * This procedure is invoked to process the "wm iconify" 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
+WmIconifyCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ 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 ", winPtr->pathName,
+ ": 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);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconmaskCmd --
+ *
+ * This procedure is invoked to process the "wm iconmask" 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
+WmIconmaskCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Pixmap pixmap;
+ char *argv3;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tcl_SetResult(interp, (char *)
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (*argv3 == '\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, argv3);
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconnameCmd --
+ *
+ * This procedure is invoked to process the "wm iconname" 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
+WmIconnameCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->iconName != NULL) {
+ ckfree((char *) wmPtr->iconName);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->iconName = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->iconName, argv3);
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconpositionCmd --
+ *
+ * This procedure is invoked to process the "wm iconposition"
+ * 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
+WmIconpositionCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->hints.flags & IconPositionHint) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->hints.icon_x,
+ wmPtr->hints.icon_y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->hints.flags &= ~IconPositionHint;
+ } else {
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmIconwindowCmd --
+ *
+ * This procedure is invoked to process the "wm iconwindow" 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
+WmIconwindowCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->icon != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[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 {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]),
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, Tcl_GetString(objv[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) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMaxsizeCmd --
+ *
+ * This procedure is invoked to process the "wm maxsize" 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
+WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ GetMaxSize(wmPtr, &width, &height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->maxWidth = width;
+ wmPtr->maxHeight = height;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmMinsizeCmd --
+ *
+ * This procedure is invoked to process the "wm minsize" 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
+WmMinsizeCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ GetMinSize(wmPtr, &width, &height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ wmPtr->minWidth = width;
+ wmPtr->minHeight = height;
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmOverrideredirectCmd --
+ *
+ * This procedure is invoked to process the "wm overrideredirect"
+ * 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
+WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int boolean, curValue;
+ XSetWindowAttributes atts;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+ curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
+ if (objc == 3) {
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue);
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (curValue != boolean) {
+ /*
+ * Only do this if we are really changing value, because it
+ * causes some funky stuff to occur
+ */
+ 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);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmPositionfromCmd --
+ *
+ * This procedure is invoked to process the "wm positionfrom"
+ * 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
+WmPositionfromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USPosition) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PPosition) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ }
+ }
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmProtocolCmd --
+ *
+ * This procedure is invoked to process the "wm protocol" 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
+WmProtocolCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ char *cmd;
+ int cmdLength;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?");
+ return TCL_ERROR;
+ }
+ if (objc == 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, Tcl_GetString(objv[3]));
+ if (objc == 4) {
+ /*
+ * Return the command to handle a given protocol.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * 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;
+ }
+ }
+ cmd = Tcl_GetStringFromObj(objv[4], &cmdLength);
+ 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, cmd);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmResizableCmd --
+ *
+ * This procedure is invoked to process the "wm resizable" 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
+WmResizableCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int width, height;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
+ (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[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;
+ }
+ if (!((wmPtr->flags & WM_NEVER_MAPPED)
+ && !(winPtr->flags & TK_EMBEDDED))) {
+ UpdateWrapper(winPtr);
+ }
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmSizefromCmd --
+ *
+ * This procedure is invoked to process the "wm sizefrom" 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
+WmSizefromCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "program", "user", (char *) NULL };
+ enum options {
+ OPT_PROGRAM, OPT_USER };
+ int index;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (wmPtr->sizeHintsFlags & USSize) {
+ Tcl_SetResult(interp, "user", TCL_STATIC);
+ } else if (wmPtr->sizeHintsFlags & PSize) {
+ Tcl_SetResult(interp, "program", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ if (*Tcl_GetString(objv[3]) == '\0') {
+ wmPtr->sizeHintsFlags &= ~(USSize|PSize);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_USER) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else { /* OPT_PROGRAM */
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ }
+ }
+ WmUpdateGeom(wmPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStackorderCmd --
+ *
+ * This procedure is invoked to process the "wm stackorder" 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
+WmStackorderCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ TkWindow **windows, **window_ptr;
+ static CONST char *optionStrings[] = {
+ "isabove", "isbelow", (char *) NULL };
+ enum options {
+ OPT_ISABOVE, OPT_ISBELOW };
+ int index;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ windows = TkWmStackorderToplevel(winPtr);
+ if (windows == NULL) {
+ panic("TkWmStackorderToplevel failed");
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ Tcl_AppendElement(interp, (*window_ptr)->pathName);
+ }
+ ckfree((char *) windows);
+ return TCL_OK;
+ }
+ } else {
+ TkWindow *winPtr2;
+ int index1=-1, index2=-1, result;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsTopLevel(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(winPtr2)) {
+ Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
+ "\" isn't mapped", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Lookup stacking order of all toplevels that are children
+ * of "." and find the position of winPtr and winPtr2
+ * in the stacking order.
+ */
+
+ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
+
+ if (windows == NULL) {
+ Tcl_AppendResult(interp, "TkWmStackorderToplevel failed",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ for (window_ptr = windows; *window_ptr ; window_ptr++) {
+ if (*window_ptr == winPtr)
+ index1 = (window_ptr - windows);
+ if (*window_ptr == winPtr2)
+ index2 = (window_ptr - windows);
+ }
+ if (index1 == -1)
+ panic("winPtr window not found");
+ if (index2 == -1)
+ panic("winPtr2 window not found");
+
+ ckfree((char *) windows);
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_ISABOVE) {
+ result = index1 > index2;
+ } else { /* OPT_ISBELOW */
+ result = index1 < index2;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+ return TCL_OK;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmStateCmd --
+ *
+ * This procedure is invoked to process the "wm state" 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
+WmStateCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ static CONST char *optionStrings[] = {
+ "normal", "iconic", "withdrawn", "zoomed", (char *) NULL };
+ enum options {
+ OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN, OPT_ZOOMED };
+ int index;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?state?");
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ",
+ Tcl_GetString(objv[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 change state of ",
+ winPtr->pathName, ": it is an embedded window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == OPT_NORMAL) {
+ if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) {
+ wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN;
+ }
+ TkpWmSetState(winPtr, NormalState);
+ /*
+ * This varies from 'wm deiconify' because it does not
+ * force the window to be raised and receive focus
+ */
+ } else if (index == OPT_ICONIC) {
+ 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;
+ }
+ TkpWmSetState(winPtr, IconicState);
+ } else if (index == OPT_WITHDRAWN) {
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->flags |= WM_TRANSIENT_WITHDRAWN;
+ }
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else { /* OPT_ZOOMED */
+ TkpWmSetState(winPtr, ZoomState);
+ }
+ } else {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else {
+ switch (wmPtr->hints.initial_state) {
+ case NormalState:
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ break;
+ case IconicState:
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ break;
+ case WithdrawnState:
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ break;
+ case ZoomState:
+ Tcl_SetResult(interp, "zoomed", TCL_STATIC);
+ break;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTitleCmd --
+ *
+ * This procedure is invoked to process the "wm title" 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
+WmTitleCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ char *argv3;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_SetResult(interp, (char *)
+ ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),
+ TCL_STATIC);
+ return TCL_OK;
+ } else {
+ if (wmPtr->title != NULL) {
+ ckfree((char *) wmPtr->title);
+ }
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ wmPtr->title = ckalloc((unsigned) (length + 1));
+ strcpy(wmPtr->title, argv3);
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) {
+ Tcl_DString titleString;
+ Tcl_WinUtfToTChar(wmPtr->title, -1, &titleString);
+ (*tkWinProcs->setWindowText)(wmPtr->wrapper,
+ (LPCTSTR) Tcl_DStringValue(&titleString));
+ Tcl_DStringFree(&titleString);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmTransientCmd --
+ *
+ * This procedure is invoked to process the "wm transient" 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
+WmTransientCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ TkWindow *masterPtr = wmPtr->masterPtr;
+ WmInfo *wmPtr2;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?master?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ if (masterPtr != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ if (masterPtr != NULL) {
+ /*
+ * If we had a master, tell them that we aren't tied
+ * to them anymore
+ */
+
+ masterPtr->wmInfoPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) masterPtr,
+ VisibilityChangeMask|StructureNotifyMask,
+ WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+ }
+
+ wmPtr->masterPtr = NULL;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, objv[3],
+ (Tk_Window *) &masterPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ while (!Tk_TopWinHierarchy(masterPtr)) {
+ /*
+ * Ensure that the master window is actually a Tk toplevel.
+ */
+
+ masterPtr = masterPtr->parentPtr;
+ }
+ Tk_MakeWindowExist((Tk_Window) masterPtr);
+
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[2]),
+ "\" a transient: it is an icon for ",
+ Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ wmPtr2 = masterPtr->wmInfoPtr;
+
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't make \"",
+ Tcl_GetString(objv[3]),
+ "\" a master: it is an icon for ",
+ Tk_PathName(wmPtr2->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (masterPtr == winPtr) {
+ Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr),
+ "\" its own master",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (masterPtr != wmPtr->masterPtr) {
+ /*
+ * Remove old master map/unmap binding before setting
+ * the new master. The event handler will ensure that
+ * transient states reflect the state of the master.
+ */
+
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->masterPtr->wmInfoPtr->numTransients--;
+ Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
+ VisibilityChangeMask|StructureNotifyMask,
+ WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+ }
+
+ masterPtr->wmInfoPtr->numTransients++;
+ Tk_CreateEventHandler((Tk_Window) masterPtr,
+ VisibilityChangeMask|StructureNotifyMask,
+ WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+
+ wmPtr->masterPtr = masterPtr;
+ }
+ }
+ if (!((wmPtr->flags & WM_NEVER_MAPPED)
+ && !(winPtr->flags & TK_EMBEDDED))) {
+ if (wmPtr->masterPtr != NULL &&
+ !Tk_IsMapped(wmPtr->masterPtr)) {
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else {
+ UpdateWrapper(winPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmWithdrawCmd --
+ *
+ * This procedure is invoked to process the "wm withdraw" 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
+WmWithdrawCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]),
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->masterPtr != NULL) {
+ wmPtr->flags |= WM_TRANSIENT_WITHDRAWN;
+ }
+ TkpWmSetState(winPtr, WithdrawnState);
+ return TCL_OK;
+}
+
+/*
+ * Invoked by those wm subcommands that affect geometry.
+ * Schedules a geometry update.
+ */
+static void
+WmUpdateGeom(wmPtr, winPtr)
+ WmInfo *wmPtr;
+ TkWindow *winPtr;
+{
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+ /*ARGSUSED*/
+static void
+WmWaitVisibilityOrMapProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr;
+
+ if (masterPtr == NULL)
+ return;
+
+ if (eventPtr->type == MapNotify) {
+ if (!(winPtr->wmInfoPtr->flags & WM_TRANSIENT_WITHDRAWN))
+ TkpWmSetState(winPtr, NormalState);
+ } else if (eventPtr->type == UnmapNotify) {
+ TkpWmSetState(winPtr, WithdrawnState);
+ }
+
+ if (eventPtr->type == VisibilityNotify) {
+ int state = masterPtr->wmInfoPtr->hints.initial_state;
+
+ if ((state == NormalState) || (state == ZoomState)) {
+ state = winPtr->wmInfoPtr->hints.initial_state;
+ if ((state == NormalState) || (state == ZoomState)) {
+ UpdateWrapper(winPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ 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_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+
+ 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) && (wmPtr->wrapper != NULL)) {
+ 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
+ * the interp's 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) {
+ /*
+ * Cache atom name, as we might destroy the window as a
+ * result of the eval.
+ */
+ CONST char *name = Tk_GetAtomName((Tk_Window) winPtr, 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, name);
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevelEnumProc --
+ *
+ * This procedure is invoked once for each HWND Window on the
+ * display as a result of calling EnumWindows from
+ * TkWmStackorderToplevel.
+ *
+ * Results:
+ * TRUE to request further iteration.
+ *
+ * Side effects:
+ * Adds entries to the passed array of TkWindows.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL CALLBACK TkWmStackorderToplevelEnumProc(hwnd, lParam)
+ HWND hwnd; /* handle to parent window */
+ LPARAM lParam; /* application-defined value */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *childWinPtr;
+
+ TkWmStackorderToplevelPair *pair =
+ (TkWmStackorderToplevelPair *) lParam;
+
+ /*fprintf(stderr, "Looking up HWND %d\n", hwnd);*/
+
+ hPtr = Tcl_FindHashEntry(pair->table, (char *) hwnd);
+ if (hPtr != NULL) {
+ childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr);
+ /* Double check that same HWND does not get passed twice */
+ if (childWinPtr == NULL) {
+ panic("duplicate HWND in TkWmStackorderToplevelEnumProc");
+ } else {
+ Tcl_SetHashValue(hPtr, NULL);
+ }
+ /*fprintf(stderr, "Found mapped HWND %d -> %x (%s)\n", hwnd,
+ childWinPtr, childWinPtr->pathName);*/
+ *(pair->window_ptr)-- = childWinPtr;
+ }
+ return TRUE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevelWrapperMap --
+ *
+ * This procedure will create a table that maps the wrapper
+ * HWND id for a toplevel to the TkWindow structure that is wraps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds entries to the passed hashtable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TkWmStackorderToplevelWrapperMap(winPtr, table)
+ TkWindow *winPtr; /* TkWindow to recurse on */
+ Tcl_HashTable *table; /* Table to maps HWND to TkWindow */
+{
+ TkWindow *childPtr;
+ Tcl_HashEntry *hPtr;
+ HWND wrapper;
+ int newEntry;
+
+ if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) &&
+ !Tk_IsEmbedded(winPtr)) {
+ wrapper = TkWinGetWrapperWindow((Tk_Window) winPtr);
+
+ /*fprintf(stderr, "Mapped HWND %d to %x (%s)\n", wrapper,
+ winPtr, winPtr->pathName);*/
+
+ hPtr = Tcl_CreateHashEntry(table,
+ (char *) wrapper, &newEntry);
+ Tcl_SetHashValue(hPtr, winPtr);
+ }
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ TkWmStackorderToplevelWrapperMap(childPtr, table);
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmStackorderToplevel --
+ *
+ * This procedure returns the stack order of toplevel windows.
+ *
+ * Results:
+ * An array of pointers to tk window objects in stacking order
+ * or else NULL if there was an error.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow **
+TkWmStackorderToplevel(parentPtr)
+ TkWindow *parentPtr; /* Parent toplevel window. */
+{
+ TkWmStackorderToplevelPair pair;
+ TkWindow **windows;
+ Tcl_HashTable table;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Map HWND ids to a TkWindow of the wrapped toplevel.
+ */
+
+ Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS);
+ TkWmStackorderToplevelWrapperMap(parentPtr, &table);
+
+ windows = (TkWindow **) ckalloc((table.numEntries+1)
+ * sizeof(TkWindow *));
+
+ /*
+ * Special cases: If zero or one toplevels were mapped
+ * there is no need to call EnumWindows.
+ */
+
+ switch (table.numEntries) {
+ case 0:
+ windows[0] = NULL;
+ goto done;
+ case 1:
+ hPtr = Tcl_FirstHashEntry(&table, &search);
+ windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr);
+ windows[1] = NULL;
+ goto done;
+ }
+
+ /*
+ * We will be inserting into the array starting at the end
+ * and working our way to the beginning since EnumWindows
+ * returns windows in highest to lowest order.
+ */
+
+ pair.table = &table;
+ pair.window_ptr = windows + table.numEntries;
+ *pair.window_ptr-- = NULL;
+
+ if (EnumWindows((WNDENUMPROC) TkWmStackorderToplevelEnumProc,
+ (LPARAM) &pair) == 0) {
+ ckfree((char *) windows);
+ windows = NULL;
+ } else {
+ if (pair.window_ptr != (windows-1))
+ panic("num matched toplevel windows does not equal num children");
+ }
+
+ done:
+ Tcl_DeleteHashTable(&table);
+ return windows;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_HIERARCHY) {
+ break;
+ }
+ }
+ if (topPtr->wmInfoPtr == NULL) {
+ return;
+ }
+
+ 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 == winPtr->dispPtr->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;
+ }
+
+ if (topPtr->wmInfoPtr == NULL) {
+ 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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr == NULL) {
+ return 0;
+ }
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ if (message == WM_QUERYNEWPALETTE) {
+ /*
+ * Case 1: This window is about to become the foreground window, so we
+ * need to install the primary palette. If the system palette was
+ * updated, then Windows will generate a WM_PALETTECHANGED message.
+ * Otherwise, we have to synthesize one in order to ensure that the
+ * secondary palettes are installed properly.
+ */
+
+ winPtr->dispPtr->foregroundWmPtr = wmPtr;
+
+ if (wmPtr->cmapCount > 0) {
+ winPtr = wmPtr->cmapList[0];
+ }
+
+ tsdPtr->systemPalette = TkWinGetPalette(winPtr->atts.colormap);
+ dc = GetDC(hwnd);
+ oldPalette = SelectPalette(dc, tsdPtr->systemPalette, FALSE);
+ if (RealizePalette(dc)) {
+ RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr);
+ } else if (wmPtr->cmapCount > 1) {
+ SelectPalette(dc, oldPalette, TRUE);
+ RealizePalette(dc);
+ ReleaseDC(hwnd, dc);
+ SendMessage(hwnd, WM_PALETTECHANGED, (WPARAM)hwnd,
+ (LPARAM)NULL);
+ return TRUE;
+ }
+
+ } 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, winPtr->dispPtr);
+ }
+ for (; i < wmPtr->cmapCount; i++) {
+ winPtr = wmPtr->cmapList[i];
+ SelectPalette(dc, TkWinGetPalette(winPtr->atts.colormap), TRUE);
+ if (RealizePalette(dc)) {
+ RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr);
+ }
+ }
+ }
+
+ SelectPalette(dc, oldPalette, TRUE);
+ RealizePalette(dc);
+ ReleaseDC(hwnd, dc);
+ 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, dispPtr)
+ Colormap colormap;
+ TkDisplay *dispPtr;
+{
+ WmInfo *wmPtr;
+ int i;
+
+ for (wmPtr = dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
+ if (wmPtr->cmapCount > 0) {
+ for (i = 0; i < wmPtr->cmapCount; i++) {
+ if ((wmPtr->cmapList[i]->atts.colormap == colormap)
+ && Tk_IsMapped(wmPtr->cmapList[i])) {
+ InvalidateSubTree(wmPtr->cmapList[i], colormap);
+ }
+ }
+ } 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_TopWinHierarchy(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()
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->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 int oldMode; /* This static is set upon entering move/size mode
+ * and is used to reset the service mode after
+ * leaving move/size mode. Note that this mechanism
+ * assumes move/size is only one level deep. */
+ LRESULT result;
+ TkWindow *winPtr = NULL;
+
+ if (TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &result)) {
+ goto done;
+ }
+
+ switch (message) {
+ case WM_KILLFOCUS:
+ case WM_ERASEBKGND:
+ result = 0;
+ goto done;
+
+ case WM_ENTERSIZEMOVE:
+ inMoveSize = 1;
+
+ /*
+ * Cancel any current mouse timer. If the mouse timer
+ * fires during the size/move mouse capture, it will
+ * release the capture, which is wrong.
+ */
+
+ TkWinCancelMouseTimer();
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ break;
+
+ case WM_ACTIVATE:
+ case WM_EXITSIZEMOVE:
+ if (inMoveSize) {
+ inMoveSize = 0;
+ 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);
+
+ if (winPtr && (TkGrabState(winPtr) != TK_GRAB_EXCLUDED)) {
+ /*
+ * This allows us to pass the message onto the
+ * native menus [Bug: 2272]
+ */
+ result = (*tkWinProcs->defWindowProc)(hwnd, message,
+ wParam, lParam);
+ goto done;
+ }
+
+ /*
+ * Don't activate the window yet since there is a grab
+ * that takes precedence. Instead we need to queue
+ * an event so we can check the grab state right before we
+ * handle the mouse event.
+ */
+
+ if (winPtr) {
+ eventPtr = (ActivateEvent *)ckalloc(sizeof(ActivateEvent));
+ eventPtr->ev.proc = ActivateWindow;
+ eventPtr->winPtr = winPtr;
+ Tcl_QueueEvent((Tcl_Event*)eventPtr, TCL_QUEUE_TAIL);
+ }
+ result = MA_NOACTIVATE;
+ goto done;
+ }
+
+ default:
+ break;
+ }
+
+ winPtr = GetTopLevel(hwnd);
+ if (winPtr && winPtr->window) {
+ HWND child = Tk_GetHWND(winPtr->window);
+ if (message == WM_SETFOCUS) {
+ SetFocus(child);
+ result = 0;
+ } else if (!Tk_TranslateWinEvent(child, message, wParam, lParam,
+ &result)) {
+ result = (*tkWinProcs->defWindowProc)(hwnd, message,
+ wParam, lParam);
+ }
+ } else {
+ result = (*tkWinProcs->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 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_HIERARCHY)) {
+ 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_HIERARCHY)) {
+ return NULL;
+ }
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ActivateWindow --
+ *
+ * This function is called when an ActivateEvent is processed.
+ *
+ * Results:
+ * Returns 1 to indicate that the event was handled, else 0.
+ *
+ * Side effects:
+ * May activate the toplevel window associated with the event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ActivateWindow(
+ Tcl_Event *evPtr, /* Pointer to ActivateEvent. */
+ int flags) /* Notifier event mask. */
+{
+ TkWindow *winPtr;
+
+ if (! (flags & TCL_WINDOW_EVENTS)) {
+ return 0;
+ }
+
+ winPtr = ((ActivateEvent *) evPtr)->winPtr;
+
+ /*
+ * Ensure that the window is not excluded by a grab.
+ */
+
+ if (winPtr && (TkGrabState(winPtr) != TK_GRAB_EXCLUDED)) {
+ SetFocus(Tk_GetHWND(winPtr->window));
+ }
+
+ return 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinSetForegroundWindow --
+ *
+ * This function is a wrapper for SetForegroundWindow, calling
+ * it on the wrapper window because it has no affect on child
+ * windows.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * May activate the toplevel window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinSetForegroundWindow(winPtr)
+ TkWindow *winPtr;
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (wmPtr->wrapper != NULL) {
+ SetForegroundWindow(wmPtr->wrapper);
+ } else {
+ SetForegroundWindow(Tk_GetHWND(winPtr->window));
+ }
+}
diff --git a/tcl/win/tkWinX.c b/tcl/win/tkWinX.c
new file mode 100644
index 00000000000..93c305dc78e
--- /dev/null
+++ b/tcl/win/tkWinX.c
@@ -0,0 +1,1649 @@
+/*
+ * 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-2000 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"
+
+/*
+ * The w32api 1.1 package (included in Mingw 1.1) does not define _WIN32_IE
+ * by default. Define it here to gain access to the InitCommonControlsEx API
+ * in commctrl.h.
+ */
+
+#ifndef _WIN32_IE
+#define _WIN32_IE 0x0300
+#endif
+
+#include <commctrl.h>
+
+/*
+ * The zmouse.h file includes the definition for WM_MOUSEWHEEL.
+ */
+
+#include <zmouse.h>
+
+/*
+ * imm.h is needed by HandleIMEComposition
+ */
+
+#include <imm.h>
+
+static TkWinProcs asciiProcs = {
+ 0,
+
+ (LRESULT (WINAPI *)(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg,
+ WPARAM wParam, LPARAM lParam)) CallWindowProcA,
+ (LRESULT (WINAPI *)(HWND hWnd, UINT Msg, WPARAM wParam,
+ LPARAM lParam)) DefWindowProcA,
+ (ATOM (WINAPI *)(CONST WNDCLASS *lpWndClass)) RegisterClassA,
+ (BOOL (WINAPI *)(HWND hWnd, LPCTSTR lpString)) SetWindowTextA,
+ (HWND (WINAPI *)(DWORD dwExStyle, LPCTSTR lpClassName,
+ LPCTSTR lpWindowName, DWORD dwStyle, int x, int y,
+ int nWidth, int nHeight, HWND hWndParent, HMENU hMenu,
+ HINSTANCE hInstance, LPVOID lpParam)) CreateWindowExA,
+};
+
+static TkWinProcs unicodeProcs = {
+ 1,
+
+ (LRESULT (WINAPI *)(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg,
+ WPARAM wParam, LPARAM lParam)) CallWindowProcW,
+ (LRESULT (WINAPI *)(HWND hWnd, UINT Msg, WPARAM wParam,
+ LPARAM lParam)) DefWindowProcW,
+ (ATOM (WINAPI *)(CONST WNDCLASS *lpWndClass)) RegisterClassW,
+ (BOOL (WINAPI *)(HWND hWnd, LPCTSTR lpString)) SetWindowTextW,
+ (HWND (WINAPI *)(DWORD dwExStyle, LPCTSTR lpClassName,
+ LPCTSTR lpWindowName, DWORD dwStyle, int x, int y,
+ int nWidth, int nHeight, HWND hWndParent, HMENU hMenu,
+ HINSTANCE hInstance, LPVOID lpParam)) CreateWindowExW,
+};
+
+TkWinProcs *tkWinProcs;
+
+/*
+ * Declarations of static variables used in this file.
+ */
+
+static char winScreenName[] = ":0"; /* Default name of windows display. */
+static HINSTANCE tkInstance; /* Application instance handle. */
+static int childClassInitialized; /* Registered child class? */
+static WNDCLASS childClass; /* Window class for child windows. */
+static int tkPlatformId = 0; /* version of Windows platform */
+static Tcl_Encoding keyInputEncoding = NULL;/* The current character
+ * encoding for keyboard input */
+static int keyInputCharset = -1; /* The Win32 CHARSET for the keyboard
+ * encoding */
+static Tcl_Encoding unicodeEncoding = NULL; /* unicode encoding */
+
+/*
+ * Thread local storage. Notice that now each thread must have its
+ * own TkDisplay structure, since this structure contains most of
+ * the thread-specific date for threads.
+ */
+typedef struct ThreadSpecificData {
+ TkDisplay *winDisplay; /* TkDisplay structure that *
+ * represents Windows screen. */
+ int updatingClipboard; /* If 1, we are updating the clipboard */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations of procedures used in this file.
+ */
+
+static void GenerateXEvent _ANSI_ARGS_((HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam));
+static unsigned int GetState _ANSI_ARGS_((UINT message, WPARAM wParam,
+ LPARAM lParam));
+static void GetTranslatedKey _ANSI_ARGS_((XKeyEvent *xkey));
+static void UpdateInputLanguage _ANSI_ARGS_((int charset));
+static int HandleIMEComposition _ANSI_ARGS_((HWND hwnd,
+ LPARAM lParam));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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[60];
+ OSVERSIONINFO os;
+
+ os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&os);
+ sprintf(buffer, "Windows %d.%d %d %s", os.dwMajorVersion,
+ os.dwMinorVersion, os.dwBuildNumber,
+#ifdef _WIN64
+ "Win64"
+#else
+ "Win32"
+#endif
+ );
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ if (childClassInitialized != 0) {
+ return;
+ }
+ childClassInitialized = 1;
+
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ /*
+ * This is necessary to enable the use of themeable elements on XP,
+ * so we don't even try and call it for Win9*.
+ */
+
+ INITCOMMONCONTROLSEX comctl;
+ ZeroMemory(&comctl, sizeof(comctl));
+ (void) InitCommonControlsEx(&comctl);
+
+ tkWinProcs = &unicodeProcs;
+ } else {
+ tkWinProcs = &asciiProcs;
+ }
+
+ tkInstance = hInstance;
+
+ /*
+ * When threads are enabled, we cannot use CLASSDC because
+ * threads will then write into the same device context.
+ *
+ * This is a hack; we should add a subsystem that manages
+ * device context on a per-thread basis. See also tkWinWm.c,
+ * which also initializes a WNDCLASS structure.
+ */
+
+#ifdef TCL_THREADS
+ childClass.style = CS_HREDRAW | CS_VREDRAW;
+#else
+ childClass.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;
+#endif
+
+ childClass.cbClsExtra = 0;
+ childClass.cbWndExtra = 0;
+ childClass.hInstance = hInstance;
+ childClass.hbrBackground = NULL;
+ childClass.lpszMenuName = NULL;
+
+ /*
+ * 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);
+ }
+
+ if (unicodeEncoding != NULL) {
+ Tcl_FreeEncoding(unicodeEncoding);
+ unicodeEncoding = NULL;
+ }
+
+ /*
+ * And let the window manager clean up its own class(es).
+ */
+
+ TkWinWmCleanup(hInstance);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetPlatformId --
+ *
+ * Determines whether running under NT, 95, or Win32s, to allow
+ * runtime conditional code. Win32s is no longer supported.
+ *
+ * Results:
+ * The return value is one of:
+ * VER_PLATFORM_WIN32s Win32s on Windows 3.1.
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
+ * VER_PLATFORM_WIN32_NT Win32 on Windows NT
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkWinGetPlatformId()
+{
+ if (tkPlatformId == 0) {
+ OSVERSIONINFO os;
+
+ os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&os);
+ tkPlatformId = os.dwPlatformId;
+ }
+ return tkPlatformId;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDefaultScreenName --
+ *
+ * Returns the name of the screen that Tk should use during
+ * initialization.
+ *
+ * Results:
+ * Returns a statically allocated string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+TkGetDefaultScreenName(interp, screenName)
+ Tcl_Interp *interp; /* Not used. */
+ CONST 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 TkDisplay structure on success or NULL on failure.
+ *
+ * Side effects:
+ * Allocates a new TkDisplay structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkDisplay *
+TkpOpenDisplay(display_name)
+ CONST char *display_name;
+{
+ Screen *screen;
+ HDC dc;
+ TkWinDrawable *twdPtr;
+ Display *display;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->winDisplay != NULL) {
+ if (strcmp(tsdPtr->winDisplay->display->display_name, display_name)
+ == 0) {
+ return tsdPtr->winDisplay;
+ } else {
+ return NULL;
+ }
+ }
+
+ display = (Display *) ckalloc(sizeof(Display));
+ ZeroMemory(display, 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);
+ tsdPtr->winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay));
+ ZeroMemory(tsdPtr->winDisplay, sizeof(TkDisplay));
+ tsdPtr->winDisplay->display = display;
+ tsdPtr->updatingClipboard = FALSE;
+ return tsdPtr->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;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (dispPtr != tsdPtr->winDisplay) {
+ panic("TkpCloseDisplay: tried to call TkpCloseDisplay on another display");
+ return;
+ }
+
+ /*
+ * Force the clipboard to be rendered if we are the clipboard owner.
+ */
+
+ if (dispPtr->clipWindow) {
+ hwnd = Tk_GetHWND(Tk_WindowId(dispPtr->clipWindow));
+ if (GetClipboardOwner() == hwnd) {
+ OpenClipboard(hwnd);
+ EmptyClipboard();
+ TkWinClipboardRender(dispPtr, CF_TEXT);
+ CloseClipboard();
+ }
+ }
+
+ tsdPtr->winDisplay = NULL;
+
+ if (display->display_name != (char *) NULL) {
+ ckfree(display->display_name);
+ }
+ if (display->screens != (Screen *) NULL) {
+ if (display->screens->root_visual != NULL) {
+ ckfree((char *) display->screens->root_visual);
+ }
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_INPUTLANGCHANGE:
+ UpdateInputLanguage(wParam);
+ result = 1;
+ break;
+
+ case WM_IME_COMPOSITION:
+ result = 0;
+ if (HandleIMEComposition(hwnd, lParam) == 0) {
+ result = DefWindowProc(hwnd, message, wParam, lParam);
+ }
+ break;
+
+ case WM_SETCURSOR:
+ /*
+ * Short circuit the WM_SETCURSOR message since we set
+ * the cursor elsewhere.
+ */
+
+ result = TRUE;
+ break;
+
+ case WM_CREATE:
+ case WM_ERASEBKGND:
+ 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);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ 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;
+ }
+
+ /*
+ * Do a catch-all Tk_SetCaretPos here to make sure that the
+ * window receiving focus sets the caret at least once.
+ */
+ if (message == WM_SETFOCUS) {
+ Tk_SetCaretPos((Tk_Window) winPtr, 0, 0, 0);
+ }
+
+ if (otherWinPtr == winPtr) {
+ return;
+ }
+
+ event.xany.window = winPtr->window;
+ event.type = (message == WM_SETFOCUS) ? FocusIn : FocusOut;
+ event.xfocus.mode = NotifyNormal;
+ event.xfocus.detail = NotifyNonlinear;
+
+ /*
+ * Destroy the caret if we own it. If we are moving to another Tk
+ * window, it will reclaim and reposition it with Tk_SetCaretPos.
+ */
+ if (message == WM_KILLFOCUS) {
+ DestroyCaret();
+ }
+ break;
+ }
+
+ case WM_DESTROYCLIPBOARD:
+ if (tsdPtr->updatingClipboard == TRUE) {
+ /*
+ * We want to avoid this event if we are the ones that caused
+ * this event.
+ */
+ return;
+ }
+ event.type = SelectionClear;
+ event.xselectionclear.selection =
+ Tk_InternAtom((Tk_Window)winPtr, "CLIPBOARD");
+ event.xselectionclear.time = TkpGetMS();
+ break;
+
+ case WM_MOUSEWHEEL:
+ /*
+ * The mouse wheel event is closer to a key event than a
+ * mouse event in that the message is sent to the window
+ * that has focus.
+ */
+
+ case WM_CHAR:
+ case WM_SYSKEYDOWN:
+ case WM_SYSKEYUP:
+ case WM_KEYDOWN:
+ case WM_KEYUP: {
+ unsigned int state = GetState(message, wParam, lParam);
+ 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 TkpGetString() that this
+ * event was generated by windows and that the Windows
+ * extension xkey.trans_chars is filled with the
+ * MBCS characters that came from the TranslateMessage
+ * call.
+ */
+
+ 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.nbytes = 0;
+ break;
+
+ case WM_CHAR:
+ /*
+ * Synthesize both a KeyPress and a KeyRelease.
+ * Strings generated by Input Method Editor are handled
+ * in the following manner:
+ * 1. A series of WM_KEYDOWN & WM_KEYUP messages that
+ * cause GetTranslatedKey() to be called and return
+ * immediately because the WM_KEYDOWNs have no
+ * associated WM_CHAR messages -- the IME window is
+ * accumulating the characters and translating them
+ * itself. In the "bind" command, you get an event
+ * with a mystery keysym and %A == "" for each
+ * WM_KEYDOWN that actually was meant for the IME.
+ * 2. A WM_KEYDOWN corresponding to the "confirm typing"
+ * character. This causes GetTranslatedKey() to be
+ * called.
+ * 3. A WM_IME_NOTIFY message saying that the IME is
+ * done. A side effect of this message is that
+ * GetTranslatedKey() thinks this means that there
+ * are no WM_CHAR messages and returns immediately.
+ * In the "bind" command, you get an another event
+ * with a mystery keysym and %A == "".
+ * 4. A sequence of WM_CHAR messages that correspond to
+ * the characters in the IME window. A bunch of
+ * simulated KeyPress/KeyRelease events will be
+ * generated, one for each character. Adjacent
+ * WM_CHAR messages may actually specify the high
+ * and low bytes of a multi-byte character -- in that
+ * case the two WM_CHAR messages will be combined into
+ * one event. It is the event-consumer's
+ * responsibility to convert the string returned from
+ * XLookupString from system encoding to UTF-8.
+ * 5. And finally we get the WM_KEYUP for the "confirm
+ * typing" character.
+ */
+
+ event.type = KeyPress;
+ event.xany.send_event = -1;
+ event.xkey.keycode = 0;
+ event.xkey.nbytes = 1;
+ event.xkey.trans_chars[0] = (char) wParam;
+
+ if (IsDBCSLeadByte((BYTE) wParam)) {
+ MSG msg;
+
+ if ((PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE) != 0)
+ && (msg.message == WM_CHAR)) {
+ GetMessage(&msg, NULL, 0, 0);
+ event.xkey.nbytes = 2;
+ event.xkey.trans_chars[1] = (char) msg.wParam;
+ }
+ }
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ event.type = KeyRelease;
+ break;
+ }
+ break;
+ }
+
+ 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 = ALT_MASK;
+ 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 nbytes member of the key event.
+ *
+ * Side effects:
+ * Removes any WM_CHAR messages waiting on the top of the system
+ * event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetTranslatedKey(xkey)
+ XKeyEvent *xkey;
+{
+ MSG msg;
+
+ xkey->nbytes = 0;
+
+ while ((xkey->nbytes < XMaxTransChars)
+ && PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
+ if ((msg.message == WM_CHAR) || (msg.message == WM_SYSCHAR)) {
+ GetMessage(&msg, NULL, 0, 0);
+
+ /*
+ * If this is a normal character message, we may need to strip
+ * off the Alt modifier (e.g. Alt-digits). Note that we don't
+ * want to do this for system messages, because those were
+ * presumably generated as an Alt-char sequence (e.g. accelerator
+ * keys).
+ */
+
+ if ((msg.message == WM_CHAR) && (msg.lParam & 0x20000000)) {
+ xkey->state = 0;
+ }
+ xkey->trans_chars[xkey->nbytes] = (char) msg.wParam;
+ xkey->nbytes++;
+
+ if (((unsigned short) msg.wParam) > ((unsigned short) 0xff)) {
+ /*
+ * Some "addon" input devices, such as the popular
+ * PenPower Chinese writing pad, generate 16 bit
+ * values in WM_CHAR messages (instead of passing them
+ * in two separate WM_CHAR messages containing two
+ * 8-bit values.
+ */
+
+ xkey->trans_chars[xkey->nbytes] = (char) (msg.wParam >> 8);
+ xkey->nbytes ++;
+ }
+ } else {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateInputLanguage --
+ *
+ * Gets called when a WM_INPUTLANGCHANGE message is received
+ * by the TK child window procedure. This message is sent
+ * by the Input Method Editor system when the user chooses
+ * a different input method. All subsequent WM_CHAR
+ * messages will contain characters in the new encoding. We record
+ * the new encoding so that TkpGetString() knows how to
+ * correctly translate the WM_CHAR into unicode.
+ *
+ * Results:
+ * Records the new encoding in keyInputEncoding.
+ *
+ * Side effects:
+ * Old value of keyInputEncoding is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateInputLanguage(charset)
+ int charset;
+{
+ CHARSETINFO charsetInfo;
+ Tcl_Encoding encoding;
+ char codepage[4 + TCL_INTEGER_SPACE];
+
+ if (keyInputCharset == charset) {
+ return;
+ }
+ if (TranslateCharsetInfo((DWORD*)charset, &charsetInfo, TCI_SRCCHARSET)
+ == 0) {
+ /*
+ * Some mysterious failure.
+ */
+
+ return;
+ }
+
+ wsprintfA(codepage, "cp%d", charsetInfo.ciACP);
+
+ if ((encoding = Tcl_GetEncoding(NULL, codepage)) == NULL) {
+ /*
+ * The encoding is not supported by Tcl.
+ */
+
+ return;
+ }
+
+ if (keyInputEncoding != NULL) {
+ Tcl_FreeEncoding(keyInputEncoding);
+ }
+
+ keyInputEncoding = encoding;
+ keyInputCharset = charset;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetKeyInputEncoding --
+ *
+ * Returns the current keyboard input encoding selected by the
+ * user (with WM_INPUTLANGCHANGE events).
+ *
+ * Results:
+ * The current keyboard input encoding.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Encoding
+TkWinGetKeyInputEncoding()
+{
+ return keyInputEncoding;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetUnicodeEncoding --
+ *
+ * Returns the cached unicode encoding.
+ *
+ * Results:
+ * The unicode encoding.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Encoding
+TkWinGetUnicodeEncoding()
+{
+ if (unicodeEncoding == NULL) {
+ unicodeEncoding = Tcl_GetEncoding(NULL, "unicode");
+ }
+ return unicodeEncoding;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleIMEComposition --
+ *
+ * This function works around a definciency in some versions
+ * of Windows 2000 to make it possible to entry multi-lingual
+ * characters under all versions of Windows 2000.
+ *
+ * When an Input Method Editor (IME) is ready to send input
+ * characters to an application, it sends a WM_IME_COMPOSITION
+ * message with the GCS_RESULTSTR. However, The DefWindowProc()
+ * on English Windows 2000 arbitrarily converts all non-Latin-1
+ * characters in the composition to "?".
+ *
+ * This function correctly processes the composition data and
+ * sends the UNICODE values of the composed characters to
+ * TK's event queue.
+ *
+ * Results:
+ * If this function has processed the composition data, returns 1.
+ * Otherwise returns 0.
+ *
+ * Side effects:
+ * Key events are put into the TK event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HandleIMEComposition(hwnd, lParam)
+ HWND hwnd; /* Window receiving the message. */
+ LPARAM lParam; /* Flags for the WM_IME_COMPOSITION
+ * message */
+{
+ HIMC hIMC;
+ int i, n;
+ XEvent event;
+ char * buff;
+ TkWindow *winPtr;
+ Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
+ BOOL isWinNT = (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT);
+
+ if ((lParam & GCS_RESULTSTR) == 0) {
+ /*
+ * Composition is not finished yet.
+ */
+
+ return 0;
+ }
+
+ hIMC = ImmGetContext(hwnd);
+ if (hIMC) {
+ if (isWinNT) {
+ n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, NULL, 0);
+ } else {
+ n = ImmGetCompositionStringA(hIMC, GCS_RESULTSTR, NULL, 0);
+ }
+
+ if ((n > 0) && ((buff = (char *) ckalloc(n)) != NULL)) {
+ if (isWinNT) {
+ n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, buff, n);
+ } else {
+ Tcl_DString utfString, unicodeString;
+
+ n = ImmGetCompositionStringA(hIMC, GCS_RESULTSTR, buff, n);
+ Tcl_DStringInit(&utfString);
+ Tcl_ExternalToUtfDString(keyInputEncoding, buff, n,
+ &utfString);
+ Tcl_UtfToExternalDString(unicodeEncoding,
+ Tcl_DStringValue(&utfString), -1, &unicodeString);
+ i = Tcl_DStringLength(&unicodeString);
+ if (n < i) {
+ /*
+ * Only alloc more space if we need, otherwise just
+ * use what we've created. Don't realloc as that may
+ * copy data we no longer need.
+ */
+ ckfree((char *) buff);
+ buff = (char *) ckalloc(i);
+ }
+ n = i;
+ memcpy(buff, Tcl_DStringValue(&unicodeString), n);
+ Tcl_DStringFree(&utfString);
+ Tcl_DStringFree(&unicodeString);
+ }
+
+ /*
+ * Set up the fields pertinent to key event.
+ *
+ * We set send_event to the special value of -2, so that
+ * TkpGetString() in tkWinKey.c knows that trans_chars[]
+ * already contains a UNICODE char and there's no need to
+ * do encoding conversion.
+ */
+
+ winPtr = (TkWindow *)Tk_HWNDToWindow(hwnd);
+
+ event.xkey.serial = winPtr->display->request++;
+ event.xkey.send_event = -2;
+ event.xkey.display = winPtr->display;
+ event.xkey.window = winPtr->window;
+ event.xkey.root = RootWindow(winPtr->display, winPtr->screenNum);
+ event.xkey.subwindow = None;
+ event.xkey.state = TkWinGetModifierState();
+ event.xkey.time = TkpGetMS();
+ event.xkey.same_screen = True;
+ event.xkey.keycode = 0;
+ event.xkey.nbytes = 2;
+
+ for (i=0; i<n;) {
+ /*
+ * Simulate a pair of KeyPress and KeyRelease events
+ * for each UNICODE character in the composition.
+ */
+
+ event.xkey.trans_chars[0] = (char) buff[i++];
+ event.xkey.trans_chars[1] = (char) buff[i++];
+
+ event.type = KeyPress;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+
+ event.type = KeyRelease;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ ckfree(buff);
+ }
+ ImmReleaseContext(hwnd, hIMC);
+ return 1;
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeXId --
+ *
+ * This interface 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 GetTickCount();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinUpdatingClipboard --
+ *
+ *
+ * Results:
+ * Number of milliseconds.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinUpdatingClipboard(int mode)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->updatingClipboard = mode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetCaretPos --
+ *
+ * This enables correct movement of focus in the MS Magnifier, as well
+ * as allowing us to correctly position the IME Window. The following
+ * Win32 APIs are used to work with MS caret:
+ *
+ * CreateCaret DestroyCaret SetCaretPos GetCaretPos
+ *
+ * Only one instance of caret can be active at any time
+ * (e.g. DestroyCaret API does not take any argument such as handle).
+ * Since do-it-right approach requires to track the create/destroy
+ * caret status all the time in a global scope among windows (or
+ * widgets), we just implement this minimal setup to get the job done.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Sets the global Windows caret position.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetCaretPos(Tk_Window tkwin, int x, int y, int height)
+{
+ static HWND caretHWND = NULL;
+ TkCaret *caretPtr = &(((TkWindow *) tkwin)->dispPtr->caret);
+ Window win;
+
+ /*
+ * Prevent processing anything if the values haven't changed.
+ * Windows only has one display, so we can do this with statics.
+ */
+ if ((caretPtr->winPtr == ((TkWindow *) tkwin))
+ && (caretPtr->x == x) && (caretPtr->y == y)) {
+ return;
+ }
+
+ caretPtr->winPtr = ((TkWindow *) tkwin);
+ caretPtr->x = x;
+ caretPtr->y = y;
+ caretPtr->height = height;
+
+ /*
+ * We adjust to the toplevel to get the coords right, as setting
+ * the IME composition window is based on the toplevel hwnd, so
+ * ignore height.
+ */
+
+ while (!Tk_IsTopLevel(tkwin)) {
+ x += Tk_X(tkwin);
+ y += Tk_Y(tkwin);
+ tkwin = Tk_Parent(tkwin);
+ if (tkwin == NULL) {
+ return;
+ }
+ }
+
+ win = Tk_WindowId(tkwin);
+ if (win) {
+ HIMC hIMC;
+ HWND hwnd = Tk_GetHWND(win);
+
+ if (hwnd != caretHWND) {
+ DestroyCaret();
+ if (CreateCaret(hwnd, NULL, 0, 0)) {
+ caretHWND = hwnd;
+ }
+ }
+
+ if (!SetCaretPos(x, y) && CreateCaret(hwnd, NULL, 0, 0)) {
+ caretHWND = hwnd;
+ SetCaretPos(x, y);
+ }
+
+ /*
+ * The IME composition window should be updated whenever the caret
+ * position is changed because a clause of the composition string may
+ * be converted to the final characters and the other clauses still
+ * stay on the composition window. -- yamamoto
+ */
+ hIMC = ImmGetContext(hwnd);
+ if (hIMC) {
+ COMPOSITIONFORM cform;
+ cform.dwStyle = CFS_POINT;
+ cform.ptCurrentPos.x = x;
+ cform.ptCurrentPos.y = y;
+ ImmSetCompositionWindow(hIMC, &cform);
+ ImmReleaseContext(hwnd, hIMC);
+ }
+ }
+}
diff --git a/tcl/win/winMain.c b/tcl/win/winMain.c
new file mode 100644
index 00000000000..864f28a1286
--- /dev/null
+++ b/tcl/win/winMain.c
@@ -0,0 +1,407 @@
+/*
+ * winMain.c --
+ *
+ * Main entry point for wish and other Tk-based applications.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <tk.h>
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+#include <malloc.h>
+#include <locale.h>
+
+#include "tkInt.h"
+
+/*
+ * The following declarations refer to internal Tk routines. These
+ * interfaces are available for use, but are not supported.
+ */
+
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
+static void WishPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
+
+#ifdef TK_TEST
+extern int Tktest_Init(Tcl_Interp *interp);
+#endif /* TK_TEST */
+
+static BOOL consoleRequired = TRUE;
+
+/*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TK_LOCAL_APPINIT
+#define TK_LOCAL_APPINIT Tcl_AppInit
+#endif
+extern int TK_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tk_Main()
+ */
+
+#ifdef TK_LOCAL_MAIN_HOOK
+extern int TK_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+#endif
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ int argc;
+ char buffer[MAX_PATH+1];
+ char *p;
+
+ 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);
+
+ /*
+ * Create the console channels and install them as the standard
+ * channels. All I/O will be discarded until Tk_CreateConsoleWindow is
+ * called to attach the console to a text widget.
+ */
+
+ consoleRequired = TRUE;
+
+ /*
+ * 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 = '/';
+ }
+ }
+
+#ifdef TK_LOCAL_MAIN_HOOK
+ TK_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tk_Main(argc, argv, TK_LOCAL_APPINIT);
+ return 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ * This procedure performs application-specific initialization.
+ * Most applications, especially those that incorporate additional
+ * packages, will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error
+ * message in the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 (consoleRequired) {
+ if (Tk_CreateConsoleWindow(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:
+ MessageBeep(MB_ICONEXCLAMATION);
+ MessageBox(NULL, Tcl_GetStringResult(interp), "Error in Wish",
+ MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
+ ExitProcess(1);
+ /* we won't reach this, but we need the return */
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WishPanic --
+ *
+ * Display a message and exit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Exits the program.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+WishPanic TCL_VARARGS_DEF(CONST char *,arg1)
+{
+ va_list argList;
+ char buf[1024];
+ CONST char *format;
+
+ format = TCL_VARARGS_START(CONST 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(); /* INTL: BUG */
+
+ /*
+ * Precompute an overly pessimistic guess at the number of arguments
+ * in the command line by counting non-space spans.
+ */
+
+ size = 2;
+ for (p = cmdLine; *p != '\0'; p++) {
+ if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ size++;
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+ }
+ }
+ argSpace = (char *) Tcl_Alloc(
+ (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
+ argv = (char **) argSpace;
+ argSpace += size * sizeof(char *);
+ size--;
+
+ p = cmdLine;
+ for (argc = 0; argc < size; argc++) {
+ argv[argc] = arg = argSpace;
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+
+ inquote = 0;
+ 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 && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
+ break;
+ }
+ if (copy != 0) {
+ *arg = *p;
+ arg++;
+ }
+ p++;
+ }
+ *arg = '\0';
+ argSpace = arg + 1;
+ }
+ argv[argc] = NULL;
+
+ *argcPtr = argc;
+ *argvPtr = argv;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * Main entry point from the console.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the applications does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int main(int argc, char **argv)
+{
+ Tcl_SetPanicProc(WishPanic);
+
+ /*
+ * Set up the default locale to be standard "C" locale so parsing
+ * is performed correctly.
+ */
+
+ setlocale(LC_ALL, "C");
+ /*
+ * Increase the application queue size from default value of 8.
+ * At the default value, cross application SendMessage of WM_KILLFOCUS
+ * will fail because the handler will not be able to do a PostMessage!
+ * This is only needed for Windows 3.x, since NT dynamically expands
+ * the queue.
+ */
+
+ SetMessageQueue(64);
+
+ /*
+ * Create the console channels and install them as the standard
+ * channels. All I/O will be discarded until Tk_CreateConsoleWindow is
+ * called to attach the console to a text widget.
+ */
+
+ consoleRequired = FALSE;
+
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0;
+}
+
diff --git a/tcl/xlib/X11/X.h b/tcl/xlib/X11/X.h
new file mode 100644
index 00000000000..7755cacc4d8
--- /dev/null
+++ b/tcl/xlib/X11/X.h
@@ -0,0 +1,677 @@
+/*
+ * $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 */
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+# define Cursor XCursor
+# define Region XRegion
+#endif
+
+/* Resources */
+
+#ifdef _WIN64
+typedef __int64 XID;
+#else
+typedef unsigned long XID;
+#endif
+
+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 long KeyCode; /* In order to use IME, the Macintosh needs
+ * to pack 3 bytes into the keyCode field in
+ * the XEvent. In the real X.h, a KeyCode is
+ * defined as a short, which wouldn't be big
+ * enough. */
+
+/*****************************************************************
+ * RESERVED RESOURCE AND CONSTANT DEFINITIONS
+ *****************************************************************/
+
+#define None 0L /* universal null resource or null atom */
+
+#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
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+# undef Cursor
+# undef Region
+#endif
+
+#endif /* X_H */
diff --git a/tcl/xlib/X11/Xatom.h b/tcl/xlib/X11/Xatom.h
new file mode 100644
index 00000000000..485a4236db8
--- /dev/null
+++ b/tcl/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/tcl/xlib/X11/Xfuncproto.h b/tcl/xlib/X11/Xfuncproto.h
new file mode 100644
index 00000000000..a59379b3b65
--- /dev/null
+++ b/tcl/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/tcl/xlib/X11/Xlib.h b/tcl/xlib/X11/Xlib.h
new file mode 100644
index 00000000000..252b11d203a
--- /dev/null
+++ b/tcl/xlib/X11/Xlib.h
@@ -0,0 +1,1214 @@
+/* $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
+
+#if !defined(MAC_TCL) && !defined(MAC_OSX_TK)
+# include <X11/X.h>
+#endif
+#ifdef MAC_TCL
+# include <X.h>
+# define Cursor XCursor
+# define Region XRegion
+#endif
+#ifdef MAC_OSX_TK
+# include <X11/X.h>
+# define Cursor XCursor
+# define Region XRegion
+#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
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+/* Use define rather than typedef, since may need to undefine this later */
+#define Status int
+#else
+typedef int Status;
+#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 nbytes;
+} 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;
+
+typedef int (*XErrorHandler) ( /* WARNING, this type not in Xlib spec */
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ XErrorEvent* /* error_event */
+#endif
+);
+
+_XFUNCPROTOBEGIN
+
+
+
+#include "tkIntXlibDecls.h"
+
+_XFUNCPROTOEND
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+# undef Cursor
+# undef Region
+#endif
+
+#endif /* _XLIB_H_ */
diff --git a/tcl/xlib/X11/Xutil.h b/tcl/xlib/X11/Xutil.h
new file mode 100644
index 00000000000..8812c80905c
--- /dev/null
+++ b/tcl/xlib/X11/Xutil.h
@@ -0,0 +1,855 @@
+/* $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 */
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+# 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 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 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 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
+
+#if defined(MAC_TCL) || defined(MAC_OSX_TK)
+# undef Region
+#endif
+
+#endif /* _XUTIL_H_ */
diff --git a/tcl/xlib/X11/cursorfont.h b/tcl/xlib/X11/cursorfont.h
new file mode 100644
index 00000000000..617274fa806
--- /dev/null
+++ b/tcl/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/tcl/xlib/X11/keysym.h b/tcl/xlib/X11/keysym.h
new file mode 100644
index 00000000000..027afe08d5f
--- /dev/null
+++ b/tcl/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/tcl/xlib/X11/keysymdef.h b/tcl/xlib/X11/keysymdef.h
new file mode 100644
index 00000000000..b22d41b3385
--- /dev/null
+++ b/tcl/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/tcl/xlib/X11/license.terms b/tcl/xlib/X11/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tcl/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/tcl/xlib/license.terms b/tcl/xlib/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tcl/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/tcl/xlib/xbytes.h b/tcl/xlib/xbytes.h
new file mode 100644
index 00000000000..fb2ee851c43
--- /dev/null
+++ b/tcl/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/tcl/xlib/xcolors.c b/tcl/xlib/xcolors.c
new file mode 100644
index 00000000000..4b06097c410
--- /dev/null
+++ b/tcl/xlib/xcolors.c
@@ -0,0 +1,914 @@
+/*
+ * 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) | xColors[i].red);
+ colorPtr->green = ((xColors[i].green << 8) | xColors[i].green);
+ colorPtr->blue = ((xColors[i].blue << 8) | xColors[i].blue);
+ 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 = (int) 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)))
+ | ((unsigned short) red);
+ colorPtr->green = (((unsigned short) green) << (4 * (4 - i)))
+ | ((unsigned short) green);
+ colorPtr->blue = (((unsigned short) blue) << (4 * (4 - i)))
+ | ((unsigned short) blue);
+ } else {
+ if (!FindColor(spec, colorPtr)) {
+ return 0;
+ }
+ }
+ colorPtr->pixel = TkpGetPixel(colorPtr);
+ colorPtr->flags = DoRed|DoGreen|DoBlue;
+ colorPtr->pad = 0;
+ return 1;
+}
diff --git a/tcl/xlib/xdraw.c b/tcl/xlib/xdraw.c
new file mode 100644
index 00000000000..2655915b3c2
--- /dev/null
+++ b/tcl/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/tcl/xlib/xgc.c b/tcl/xlib/xgc.c
new file mode 100644
index 00000000000..447c05ffb40
--- /dev/null
+++ b/tcl/xlib/xgc.c
@@ -0,0 +1,551 @@
+/*
+ * 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>
+
+#if !defined(MAC_TCL) && !defined(MAC_OSX_TK)
+# include <X11/Xlib.h>
+#endif
+#ifdef MAC_TCL
+# include <Xlib.h>
+# include <X.h>
+# define Cursor XCursor
+# define Region XRegion
+#endif
+#ifdef MAC_OSX_TK
+# include <X11/Xlib.h>
+# include <X11/X.h>
+# define Cursor XCursor
+# define Region XRegion
+#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;
+
+/*
+ * In order to have room for a dash list, MAX_DASH_LIST_SIZE extra chars are
+ * defined, which is invisible from the outside. The list is assumed to end
+ * with a 0-char, so this must be set explicitely during initialization.
+ */
+
+#define MAX_DASH_LIST_SIZE 10
+
+ gp = (XGCValues *)ckalloc(sizeof(XGCValues) + MAX_DASH_LIST_SIZE);
+ 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;
+ (&(gp->dashes))[1] = 0;
+
+ 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; (&(gc->dashes))[1] = 0;}
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+XSetDashes(display, gc, dash_offset, dash_list, n)
+ Display* display;
+ GC gc;
+ int dash_offset;
+ _Xconst char* dash_list;
+ int n;
+{
+ char *p = &(gc->dashes);
+
+#ifdef TkWinDeleteBrush
+ TkWinDeleteBrush(gc->fgBrush);
+ TkWinDeletePen(gc->fgPen);
+ TkWinDeleteBrush(gc->bgBrush);
+ TkWinDeletePen(gc->fgExtPen);
+#endif
+ gc->dash_offset = dash_offset;
+ if (n > MAX_DASH_LIST_SIZE) n = MAX_DASH_LIST_SIZE;
+ while (n-- > 0) {
+ *p++ = *dash_list++;
+ }
+ *p = 0;
+}
+
+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;
+}
+
+/*
+ * Some additional dummy functions (hopefully implemented soon).
+ */
+
+Cursor
+XCreateFontCursor(display, shape)
+ Display* display;
+ unsigned int shape;
+{
+ return (Cursor) 0;
+}
+
+void
+XDrawImageString(display, d, gc, x, y, string, length)
+ Display* display;
+ Drawable d;
+ GC gc;
+ int x;
+ int y;
+ _Xconst char* string;
+ int length;
+{
+}
+
+void
+XDrawPoint(display, d, gc, x, y)
+ Display* display;
+ Drawable d;
+ GC gc;
+ int x;
+ int y;
+{
+ XDrawLine(display, d, gc, x, y, x, y);
+}
+
+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++) {
+ XDrawPoint(display, d, gc, points[i].x, points[i].y);
+ }
+}
+
+#if !defined(MAC_TCL) && !defined(MAC_OSX_TK)
+void
+XDrawSegments(display, d, gc, segments, nsegments)
+ Display* display;
+ Drawable d;
+ GC gc;
+ XSegment* segments;
+ int nsegments;
+{
+}
+#endif
+
+char *
+XFetchBuffer(display, nbytes_return, buffer)
+ Display* display;
+ int* nbytes_return;
+ int buffer;
+{
+ return (char *) 0;
+}
+
+Status XFetchName(display, w, window_name_return)
+ Display* display;
+ Window w;
+ char** window_name_return;
+{
+ return (Status) 0;
+}
+
+Atom *XListProperties(display, w, num_prop_return)
+ Display* display;
+ Window w;
+ int* num_prop_return;
+{
+ return (Atom *) 0;
+}
+
+void
+XMapRaised(display, w)
+ Display* display;
+ Window w;
+{
+}
+
+void
+XPutImage(display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height)
+ 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;
+{
+}
+
+void XQueryTextExtents(display, font_ID, string, nchars, direction_return,
+ font_ascent_return, font_descent_return, overall_return)
+ Display* display;
+ XID font_ID;
+ _Xconst char* string;
+ int nchars;
+ int* direction_return;
+ int* font_ascent_return;
+ int* font_descent_return;
+ XCharStruct* overall_return;
+{
+}
+
+void
+XReparentWindow(display, w, parent, x, y)
+ Display* display;
+ Window w;
+ Window parent;
+ int x;
+ int y;
+{
+}
+
+void
+XRotateBuffers(display, rotate)
+ Display* display;
+ int rotate;
+{
+}
+
+void
+XStoreBuffer(display, bytes, nbytes, buffer)
+ Display* display;
+ _Xconst char* bytes;
+ int nbytes;
+ int buffer;
+{
+}
+
+void
+XUndefineCursor(display, w)
+ Display* display;
+ Window w;
+{
+}
diff --git a/tcl/xlib/ximage.c b/tcl/xlib/ximage.c
new file mode 100644
index 00000000000..e11ce67ce64
--- /dev/null
+++ b/tcl/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, (int) width, (int) 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/tcl/xlib/xutil.c b/tcl/xlib/xutil.c
new file mode 100644
index 00000000000..b98a6fdd48c
--- /dev/null
+++ b/tcl/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;
+}